advent-of-code/day23/both.fth

\ 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