commit 19fe7ce7a884d71a03bec28725ef894921e3dbf1
parent 05b208756f4f506e55a9d847dba8c524a868d480
Author: alex wennerberg <alex@alexwennerberg.com>
Date: Mon, 5 Dec 2022 10:59:04 -0800
fix day 5 part 2
Diffstat:
| M | 2022/05.fs | | | 57 | +++++++++++++++++++++++++++++++++++++-------------------- |
1 file changed, 37 insertions(+), 20 deletions(-)
diff --git a/2022/05.fs b/2022/05.fs
@@ -1,39 +1,56 @@
62 constant stack-size
+9 constant num-stacks
+
: stacks create ( n )
0 do here cell+ , stack-size allot loop does> swap stack-size cell+ * + ( [a] -- ) ;
-9 stacks crate-stack
+
+num-stacks stacks crate-stack
+
+: 3dup 2 pick 2 pick 2 pick ;
: push ( n a -- ) tuck @ c! 1 swap +! ;
: ?empty ( a -- f ) dup @ 2 - = ;
+: clear-stack ( a -- ) dup 2 + swap ! ;
+
\ 99 == error
: pop ( a -- n ) dup ?empty if 99 . cr bye then dup -1 swap +! @ dup 1+ 0 swap c! c@ ;
: c-to-n ( c -- u ) 48 - ;
: move-from ( u2 u3 ) crate-stack swap crate-stack pop swap push ;
\ move u1 items from u2 to u3
: cratemover-9000 ( u1 u2 u3 -- ) rot 0 do 2dup move-from loop 2drop ;
-: cratemover-9001 ( u1 u2 u3 -- ) >r crate-stack swap crate-stack swap @ r> - cmove ;
+: cratemover-9001 ( u1 u2 u3 -- ) \ a bit sloppy
+ rot >r crate-stack swap crate-stack ( a3 a2 )
+ dup dup @ r@ - swap ! swap
+ dup dup @ r@ + swap ! swap ( a3 a2 )
+ @ swap @ ( sp2 sp3 ) r@ - r> 3dup cmove nip erase ;
+
: 0idx ( u1 u2 -- u3 u4 ) 1- swap 1- swap ;
: move ( -- ) noop ; : from noop ;
: debug 0 crate-stack 64 9 * dump ;
: to ( -- | n ) bl parse drop c@ c-to-n 0idx cratemover-9000 ;
-: push-str ( a1 a2 u -- ) 0 do 2dup c@ swap push 1+ loop drop ;
-\ To save energy, start of input is manually parsed
-\ Sample
-\ 0 crate-stack " ZN" push-str
-\ 1 crate-stack " MCD" push-str
-\ 2 crate-stack " P" push-str
+: push-str ( a1 a2 u -- ) 0 do 2dup c@ swap push 1+ loop 2drop ;
+: print-sol num-stacks 0 do r@ crate-stack dup pop dup emit swap push loop ;
+: clear-stacks num-stacks 0 do r@ crate-stack clear-stack loop ;
-\ [P] [C] [C]
-\ [W] [B] [G] [V] [V]
-\ [V] [T] [Z] [J] [T] [S]
-\ [D] [L] [Q] [F] [Z] [W] [R]
-\ [C] [N] [R] [H] [L] [Q] [F] [G]
-\ [F] [M] [Z] [H] [G] [W] [L] [R] [H]
-\ [R] [H] [M] [C] [P] [C] [V] [N] [W]
-\ [W] [T] [P] [J] [C] [G] [W] [P] [J]
-\ 1 2 3 4 5 6 7 8 9
+\ To save energy, start of input is manually parsed TODO parse
+\ Sample
+ \ 0 crate-stack " ZN" push-str
+ \ 1 crate-stack " MCD" push-str
+ \ 2 crate-stack " P" push-str
+\ Real input
+0 crate-stack " WRF" push-str
+1 crate-stack " THMCDVWP" push-str
+2 crate-stack " PMZNL" push-str
+3 crate-stack " JCHR" push-str
+4 crate-stack " CPGHQTB" push-str
+5 crate-stack " GCWLFZ" push-str
+6 crate-stack " WVLQZJGC" push-str
+7 crate-stack " PNRFWTVC" push-str
+8 crate-stack " JWHGRSV" push-str
+include input.txt
+print-sol \ part 1
+clear-stacks
-\ Real input
0 crate-stack " WRF" push-str
1 crate-stack " THMCDVWP" push-str
2 crate-stack " PMZNL" push-str
@@ -44,7 +61,7 @@
7 crate-stack " PNRFWTVC" push-str
8 crate-stack " JWHGRSV" push-str
+: to ( -- | n ) bl parse drop c@ c-to-n 0idx cratemover-9001 ;
include input.txt
-: solve 9 0 do r@ crate-stack dup pop dup emit swap push loop ;
-solve
+print-sol \ part 2
bye
