Commit a1a3a78d authored by Peter Fidelman's avatar Peter Fidelman
Browse files

Day 4

parent c90218fe
......@@ -42,6 +42,14 @@ Finally, at the end of the calculation I have to convert the binary strings back
# Day 4
As in Day 3, the data structure can be a bunch of contiguous bytes in memory. The problem description can't make up its mind about whether numbers will be space-delimited or comma-delimited, so I'll spend a little effort building a generic parser that pulls out all numbers in a line and skips over anything that isn't a number. I'll still use PAD as a buffer for each line, but I'll build my data structure by appending to the dictionary.
Annoyingly, blank lines are also an expected part of the problem input. `read-boards` is written to quit if it ever sees two blank lines in a row, so whack the "return" key after entering all of the bingo boards and you're off and running.
As each number is called (via `call-number`), I obliterate any matches on each board by setting them to 128. The function `score-board` does a `127 and` when adding up numbers, which excludes matches from the sum. My check for bingos themselves isn't particular clever -- it is the doubly nested loop you'd expect.
In part B, any winners are wiped out (overwritten with all 127's) which ensures they will never match any successive calls, effectively taking them out of the running. I keep track of the total count of winners, and once it equals the total number of bingo boards I know I've found the last winner and can report the result.
# Day 5
Instead of playing with sparse representations, I took the coward's way out with a 1000*1000 array of zero-initialized bytes. This was too big to fit in pforth's dictionary space, so I used [ALLOCATE](https://forth-standard.org/standard/memory/ALLOCATE). This makes me itch a bit because it's way too big to fit in the memory space of classical Forth systems, and I'm sure there's a more efficient way of solving this.
......
: get-line ( -- a n ) pad pad 1024 accept ;
: is-num ( c -- f ) dup 48 >= swap 57 <= and ;
: skip-nonnum ( a n -- a n ) begin
dup 0= if exit then over c@ is-num if exit then 1- swap 1+ swap
again ;
: lay ( x 0 a n -- 0 0 a n ) >r >r >r c, 0 r> r> r> ;
: str>nums ( a n -- ) >r >r 0 0 r> r> ( 0 0 a n )
begin skip-nonnum dup while >number lay repeat 2drop 2drop ;
variable (calls) : calls ( -- a ) (calls) @ ;
variable (boards) : boards ( -- a ) (boards) @ ; variable #boards
: @nth-board ( n -- a ) 25 * boards + ;
: read-calls ( -- ) here (calls) ! get-line str>nums ;
: read-boards ( -- )
here (boards) !
0 >r
begin get-line dup 0= if r> 1+ dup >r else rdrop 0 dup >r then 2 <
while str>nums
repeat 2drop rdrop
here (boards) @ - 25 / #boards ! ;
: mark-boards ( n -- ) boards #boards @ 25 * over + swap do
dup i c@ = if 128 i c! then loop drop ;
variable last-call
: call-number ( -- n ) calls c@ dup last-call ! 1 (calls) +! ;
: score-board ( a -- n ) 0 swap dup 25 + swap do i @ 127 and + loop ;
: row-wins ( a n -- f ) 128 -rot ( 128 a n )
5 * + dup 5 + swap do i c@ and loop ;
: col-wins ( a n -- f ) 128 -rot ( 128 a n )
+ 5 0 do dup i 5 * + c@ swap >r and r> loop drop ;
: bail ( -- ) rdrop ;
: board-wins ( a -- f )
5 0 do dup i row-wins if unloop drop -1 bail then loop
5 0 do dup i col-wins if unloop drop -1 bail then loop drop 0 ;
: check-winner ( -- f )
#boards @ 0 do
i @nth-board board-wins if
i @nth-board score-board last-call @ * ." Answer:" . -1 unloop bail
then loop 0 ;
: go ( -- ) read-calls read-boards
begin call-number mark-boards check-winner until ;
\ No newline at end of file
: get-line ( -- a n ) pad pad 1024 accept ;
: is-num ( c -- f ) dup 48 >= swap 57 <= and ;
: skip-nonnum ( a n -- a n ) begin
dup 0= if exit then over c@ is-num if exit then 1- swap 1+ swap
again ;
: lay ( x 0 a n -- 0 0 a n ) >r >r >r c, 0 r> r> r> ;
: str>nums ( a n -- ) >r >r 0 0 r> r> ( 0 0 a n )
begin skip-nonnum dup while >number lay repeat 2drop 2drop ;
variable (calls) : calls ( -- a ) (calls) @ ;
variable (boards) : boards ( -- a ) (boards) @ ; variable #boards
variable #winners 0 #winners !
: @nth-board ( n -- a ) 25 * boards + ;
: read-calls ( -- ) here (calls) ! get-line str>nums ;
: read-boards ( -- )
here (boards) !
0 >r
begin get-line dup 0= if r> 1+ dup >r else rdrop 0 dup >r then 2 <
while str>nums
repeat 2drop rdrop
here (boards) @ - 25 / #boards ! ;
: mark-boards ( n -- ) boards #boards @ 25 * over + swap do
dup i c@ = if 128 i c! then loop drop ;
variable last-call
: call-number ( -- n ) calls c@ dup last-call ! 1 (calls) +! ;
: score-board ( a -- n ) 0 swap dup 25 + swap do i @ 127 and + loop ;
: row-wins ( a n -- f ) 128 -rot ( 128 a n )
5 * + dup 5 + swap do i c@ and loop ;
: col-wins ( a n -- f ) 128 -rot ( 128 a n )
+ 5 0 do dup i 5 * + c@ swap >r and r> loop drop ;
: bail ( -- ) rdrop ;
: board-wins ( a -- f )
5 0 do dup i row-wins if unloop drop -1 bail then loop
5 0 do dup i col-wins if unloop drop -1 bail then loop drop 0 ;
: wipe-board ( a -- ) dup 25 + swap do 127 i c! loop ;
: win ( a -- )
#winners 1 over +! @ #boards @ =
if score-board last-call @ * ." Answer:" . quit
else wipe-board then ;
: check-winner ( -- )
#boards @ 0 do
i @nth-board dup board-wins if win else drop then loop ;
: go ( -- ) read-calls read-boards
begin call-number mark-boards check-winner again ;
\ No newline at end of file
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment