diff --git a/day23/both.fth b/day23/both.fth new file mode 100644 index 0000000..d4108b8 --- /dev/null +++ b/day23/both.fth @@ -0,0 +1,209 @@ +\ Advent of Code 2022: Day 23, both parts (comment selected) +\ Written for gForth. TODO improve + +46 CONSTANT MEMPTY +35 CONSTANT MELF +13 CONSTANT MCR +10 CONSTANT MLF + +0 CONSTANT NOMOVE +1 CONSTANT NORTH +2 CONSTANT SOUTH +3 CONSTANT WEST +4 CONSTANT EAST +CREATE DIRECTIONS NORTH , SOUTH , WEST , EAST , + +5000 CONSTANT MAXELVES +VARIABLE ELVES MAXELVES 2 * CELLS ALLOT +VARIABLE NEWELVES MAXELVES 2 * CELLS ALLOT +VARIABLE ELFCOUNT + +: RESET ( -- ) + 0 ELFCOUNT ! ; + +: NEXTDIR ( dir -- dir ) + 3 AND CELLS DIRECTIONS + @ ; + +: ELF ( i -- c-addr ) + 2 * CELLS ELVES + ; + +: GETELF ( i -- y x ) + ELF DUP @ SWAP CELL+ @ ; + +: GETNEWELF ( i -- y x ) + 2 * CELLS NEWELVES + DUP @ SWAP CELL+ @ ; + +: SETELF ( i y x -- ) + SWAP ROT ELF TUCK ! CELL+ ! ; + +: SETNEWELF ( i y x -- ) + SWAP ROT 2 * CELLS NEWELVES + TUCK ! CELL+ ! ; + +: ADDELF ( y x -- ) + ELFCOUNT @ -ROT SETELF + 1 ELFCOUNT +! ; + +: SAMEELF? ( i y x -- b ) + ROT GETELF ROT = -ROT = AND ; + +: SAMENEWELF? ( i y x -- b ) + ROT GETNEWELF ROT = -ROT = AND ; + +: ELFAT? ( y x -- b ) + ELFCOUNT @ 0 DO + 2DUP I -ROT SAMEELF? + IF 2DROP TRUE UNLOOP EXIT THEN + LOOP 2DROP FALSE ; + +: NEIGHBOR? ( y x -- b ) + 1- SWAP 1- SWAP 0 -ROT + 3 0 DO + 3 0 DO + 2DUP ELFAT? IF + ROT 1+ DUP 1 > IF + DROP 2DROP TRUE UNLOOP UNLOOP EXIT ELSE + -ROT THEN THEN + 1+ + LOOP + 3 - SWAP 1+ SWAP + LOOP 2DROP 1 > ; + +: NNEIGHBOR? ( y x -- b ) + 1- SWAP 1- SWAP \ y x + 3 0 DO + 2DUP ELFAT? IF 2DROP TRUE UNLOOP EXIT THEN + 1+ + LOOP 2DROP FALSE ; + +: SNEIGHBOR? ( y x -- b ) + 1- SWAP 1+ SWAP + 3 0 DO + 2DUP ELFAT? IF 2DROP TRUE UNLOOP EXIT THEN + 1+ + LOOP 2DROP FALSE ; + +: WNEIGHBOR? ( y x -- b ) + 1- SWAP 1- SWAP + 3 0 DO + 2DUP ELFAT? IF 2DROP TRUE UNLOOP EXIT THEN + SWAP 1+ SWAP + LOOP 2DROP FALSE ; + +: ENEIGHBOR? ( y x -- b ) + 1+ SWAP 1- SWAP + 3 0 DO + 2DUP ELFAT? IF 2DROP TRUE UNLOOP EXIT THEN + SWAP 1+ SWAP + LOOP 2DROP FALSE ; + +: CANMOVE? ( y x dir -- b ) + CASE + NORTH OF NNEIGHBOR? 0= ENDOF + SOUTH OF SNEIGHBOR? 0= ENDOF + WEST OF WNEIGHBOR? 0= ENDOF + EAST OF ENEIGHBOR? 0= ENDOF + ENDCASE ; + +: READELVES ( -- ) + 0 0 \ Initial Y and X + BEGIN + KEY CASE + MELF OF 2DUP ADDELF 1+ ENDOF + MEMPTY OF 1+ ENDOF + MCR OF DROP 1+ 0 ENDOF + MLF OF DROP 1+ 0 ENDOF + DROP 2DROP EXIT + ENDCASE + AGAIN ; + +: PROPOSE ( i dir -- dir ) + SWAP GETELF + 2DUP NEIGHBOR? 0= IF 2DROP DROP NOMOVE EXIT THEN + 4 0 DO + 2DUP 4 PICK CANMOVE? IF 2DROP UNLOOP EXIT THEN + ROT NEXTDIR -ROT + LOOP 2DROP DROP NOMOVE ; + +: PROPOSED ( i dir -- y x ) + SWAP GETELF ROT CASE + NORTH OF SWAP 1- SWAP ENDOF + SOUTH OF SWAP 1+ SWAP ENDOF + WEST OF 1- ENDOF + EAST OF 1+ ENDOF + ENDCASE ; + +: MAKEPROPOSALS ( dir -- ) + ELFCOUNT @ 0 DO + I OVER PROPOSE + I SWAP PROPOSED + I -ROT SETNEWELF + LOOP DROP ; + +: UNDOELF ( i -- ) + DUP GETNEWELF SETELF ; + +: COLLISION? ( i -- b ) + DUP GETNEWELF + ELFCOUNT @ 0 DO + 2DUP I -ROT SAMENEWELF? 3 PICK I <> AND + IF 2DROP DROP TRUE UNLOOP EXIT THEN + LOOP 2DROP DROP FALSE ; + +: COMMITELVES ( -- ) + ELFCOUNT @ 0 DO + I DUP COLLISION? 0= IF DUP GETNEWELF SETELF ELSE DROP THEN + LOOP ; + +: STILL? ( -- ) + ELFCOUNT @ 0 DO + I DUP GETNEWELF SAMEELF? 0= IF FALSE UNLOOP EXIT THEN + LOOP TRUE ; + +: DISPELVES ( -- ) + ELFCOUNT @ 0 DO + I GETELF SWAP . . ." , " + LOOP CR ; + +: DISPNEWELVES ( -- ) + ELFCOUNT @ 0 DO + I GETNEWELF SWAP . . ." , " + LOOP CR ; + +: SCATTER ( init-dir n -- n ) + 0 -ROT + 0 DO + DUP MAKEPROPOSALS + SWAP 1+ SWAP + STILL? IF DROP UNLOOP EXIT THEN + COMMITELVES + NEXTDIR + LOOP DROP ; + +: XMINMAX ( -- min max ) + 10000 -10000 + ELFCOUNT @ 0 DO + I GETELF NIP \ mi ma x + 2DUP < IF NIP DUP THEN \ mi ma x + DUP 3 PICK < IF ROT DROP SWAP ELSE DROP THEN + LOOP ; + +: YMINMAX ( -- min max ) + 10000 -10000 + ELFCOUNT @ 0 DO + I GETELF DROP \ mi ma y + 2DUP < IF NIP DUP THEN + DUP 3 PICK < IF ROT DROP SWAP ELSE DROP THEN + LOOP ; + +: PROGRESS ( -- n ) + XMINMAX SWAP - 1+ + YMINMAX SWAP - 1+ * + ELFCOUNT @ - ; + +RESET +READELVES +ELFCOUNT @ . ." elves" CR +\ NORTH 10 SCATTER PROGRESS . CR \ part 1 +NORTH 0 SCATTER . ." rounds" CR \ part 2 (exec time: 9m31) +BYE +