advent-of-code-2022/day-03/gforth/part-02.fth

require string.fs

: not 0= ;
: even? dup 2 mod 0= ;
: success -1 ;
: failure 0 ;

: input-filename s" input" ;

: crlf-len 2 ;
256 Constant max-bytes-line
Create line-buffer max-bytes-line crlf-len + allot
input-filename r/o open-file throw Value puzzle-input-handle

: upper-case? ( char -- flag )
  dup dup
  65 >= swap 90 <= and ;

: char-priority ( char -- score )
  upper-case? if
    38 -  \ upper-case letter shift to 27 - 52 is 38
  else
    96 -  \ lower-case letter shift to 1 - 26 is 96
  then ;

\ tests
char a char-priority 1 = 0= throw
char b char-priority 2 = 0= throw
char c char-priority 3 = 0= throw
char d char-priority 4 = 0= throw
char e char-priority 5 = 0= throw
char f char-priority 6 = 0= throw
char g char-priority 7 = 0= throw
char h char-priority 8 = 0= throw
char i char-priority 9 = 0= throw
char j char-priority 10 = 0= throw
char k char-priority 11 = 0= throw
char l char-priority 12 = 0= throw
char m char-priority 13 = 0= throw
char n char-priority 14 = 0= throw
char o char-priority 15 = 0= throw
char p char-priority 16 = 0= throw
char q char-priority 17 = 0= throw
char r char-priority 18 = 0= throw
char s char-priority 19 = 0= throw
char t char-priority 20 = 0= throw
char u char-priority 21 = 0= throw
char v char-priority 22 = 0= throw
char w char-priority 23 = 0= throw
char x char-priority 24 = 0= throw
char y char-priority 25 = 0= throw
char z char-priority 26 = 0= throw
char A char-priority 27 = 0= throw
char Z char-priority 52 = 0= throw

: char-in-string? ( c-addr len char -- c-addr len char flag )
  dup 2>r \ c-addr len char
  2dup
  r>
  scan 0<>
  nip
  r> swap ;

\ tests
s" abc" char d char-in-string? throw drop drop drop
s" abc" char b char-in-string? 0= throw drop drop drop

: first-char ( c-addr len -- char )
  drop c@ ;

s" abc" first-char char a = 0= throw
s" rthsdasdfgfdfgabc" first-char char r = 0= throw

: zero-string? ( c-addr len -- flag )
  2dup 0= nip ;

: non-empty-string? ( c-addr len -- flag )
  2dup 0> nip ;

: char->string ( c -- addr 1)
  here tuck c! 1 ;

\ can only be created outside of definition???
create empty-string 0 chars allot
create result-string 128 chars allot

: common-chars ( c-addr1 len1 c-addr2 len2 -- result-string )
  \ put empty string as neutral accumulation element
  s" " result-string place
  begin
    \ s" current result string:" type result-string count type cr
    non-empty-string? while
    \ c-addr1 len1 c-addr2 len2 | _
    2dup 2>r
    \ c-addr1 len1 c-addr2 len2 | len2 c-addr2
    first-char
    \ c-addr1 len1 char | len2 c-addr2
    char-in-string?
    \ c-addr1 len1 char flag | len2 c-addr2
    if  \ c-addr1 len1 char | len2 c-addr2
      char->string  \ c-addr1 len1 char-as-string len | len2 c-addr2
      \ concat result string
      result-string +place  \ c-addr1 len1 | len2 c-addr2
      \ cleanup return stack
      2r>  \ c-addr1 len1 c-addr2 len2 | _
    else
      \ drop the empty string char address
      drop  \ c-addr1 len1 | len2 c-addr2
      2r>  \ c-addr1 len1 c-addr2 len2 | _
    then
    \ drop first character from string
    1
    /string
    \ result-string len c-addr1 len1 c-addr2' len2' | _
  repeat
  2drop 2drop
  result-string count ;

\ tests
create str1 256 chars allot
create str2 256 chars allot

s" aaaaaxbbby" str1 place
s" xdddxeeye" str2 place
str1 count str2 count
common-chars s" xxy" compare throw

s" gdfhzdujrz" str1 place
s" aaaaaazuja" str2 place
str1 count str2 count
common-chars s" zuj" compare throw

: read-ok? ( read-length eof-flag -- read-length flag )
  \ s" checking if read ok:" type .s cr
  swap dup 0 >
  rot
  and ;

\ Read the strings of 3 lines from the input file and put
\ them on the stack.
: read-3-lines ( -- c-addr1 len1 c-addr2 len2 c-addr3 len3 )
  3 0 ?DO
    \ read line from file
    \ clear line buffer
    line-buffer empty-buffer
    line-buffer max-bytes-line puzzle-input-handle read-line
    \ STACK: read-len eof-flag read-error-flag
    \ s" before checking if read ok:" type .s cr
    throw  \ stack: acc length eof-flag
    \ check that everything was read OK from the line buffer
    read-ok?
    \ s" stack after read-ok?:" type .s cr
    if
      line-buffer swap  \ acc c-addr length
      \ Check, that each line has an even number of characters.
      \ This is not strictly necessary, just trying out some
      \ validation and cleanup.
      even? if
        \ Remove trailing whitespace.
        -trailing
      else
        s" invalid input" type cr bye
      then
    then
  LOOP
  \ create success or failure flag
  dup 0<> ;

: process-group ( c-addr1 len1 c-addr2 len2 c-addr3 len3 -- prio )
  .s cr
  2dup 2>r type s" --" type 2dup 2>r type s" --" type 2dup 2>r type cr
  2r> 2r> 2r>

  common-chars
  common-chars
  2dup s" common chars of all 3 lines:" type type cr
  dup 0= if
    s" invalid input, no common character" type bye
  then
  \ common-chars len
  drop c@
  dup s" common char is:" type emit cr
  \ char
  char-priority ;

\ tests
Create a 256 allot s" aaabccc" a 256 insert a 7
Create b 256 allot s" dddbeee" b 256 insert b 7
Create c 256 allot s" fffbggg" c 256 insert c 7
process-group char b char-priority = 0= throw
\ this test somehow fails, wrong score?
Create a 256 allot s" tdltdtmhlRNCBcwmHr" a 256 insert a 18
Create b 256 allot s" WDzDPnvvGnsWLWpGJJHRzCCRZNBRrRwMNwHH" b 256 insert b 36
Create c 256 allot s" DsDsQnJDnWsJnJvrQDPJddgShFQhjljqhggbdbbt" c 256 insert c 40
process-group char r char-priority = 0= throw


\ TODO: There is only 1 common char in the 2 halves of a
\ string, but there may be multiple common chars within 2
\ given lines! If one does not exist in all 3 lines, you
\ need to try the next common char.


: process ( c-addr length -- ??? )
  0  \ accumulator value for score
  begin
    puzzle-input-handle file-eof? not
  while
    read-3-lines if
      process-group
      s" accumulating:" type .s cr
      +
    then
  repeat
  \ drop length of read characters from EOF read
  s" EOF reached:" type .s cr
  drop drop drop ;

process . cr
puzzle-input-handle close-file