1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
| f<< /lib/array.fs
f<< /lib/str.fs
1000 const num-hands
74 const Joker \ ascii J
0 value jokermode
create scores ," 23456789TJQKA"
: cmp ( n n -- 1/0/-1 ) 2dup > if 2drop 1 exit then < if -1 exit then 0 ;
: cpoint ( c -- n ) >r scores >r begin V1 V2 c@ <> while to1+ V2 repeat V2 scores - 2rdrop ;
: hand-cards< ( a[5b] a[5b] -- f )
>r >r
begin V1 c@ cpoint V2 c@ cpoint cmp dup 0 = while
drop to1+ V1 to1+ V2 repeat 1+ 2rdrop ;
\ hand score = 2 digit number: top and 2nd most common value.
\ eg full house 32, pair 21
create handbuf 128 allot
: hand ( a[5b] -- u1 u2 )
5 rfor i c@ handbuf + 8b 1+! next
\ V1 top V2 second
1 >r 1 >r 128 for i
case
Joker = jokermode and? of endof \ skip adding joker
handbuf + c@ V1 >= of V1 to V2 r@ handbuf + c@ to V1 endof
handbuf + c@ V2 >= of r@ handbuf + c@ to V2 endof
drop
endcase next V1 jokermode if handbuf Joker + c@ + then 10 * V2 +
dup 61 = if drop 51 then \ Special case: JJJJJ
2rdrop handbuf 128 0 fill ;
\ bet (cell) hand (5 bytes)
3 cells num-hands Array :new structbind Array hands
: hand< ( a[5b] a[5b] -- f )
>r >r V2 hand V1 hand swap cmp
case
1 = of 1 endof
-1 = of 0 endof
drop V2 V1 hand-cards<
endcase 2rdrop ;
: insert-hand ( a[5b] u -- ) over >r
hands cnt dup 0 swap for2
i hands :' cell + V1 swap hand< if drop i break then next
1 swap hands :insert !+ 5 move rdrop ;
0 value total
: sum-scores ( -- )
0 hands cnt for2 i hands :' dup @ i 1+ * to+ total cell + 5 next ;
: solve
f" /aoc/input" 0 to total
begin file :readline ?dup while
c@+ 6 - over 6 + swap parsedec drop insert-hand
repeat sum-scores ;
: solveb
1 to jokermode
S" J23456789TQKA" 1+ scores 13 move
hands cnt 0 hands :delete
solve ;
solve total . nl>
solveb total . nl>
|
