151 lines
4.4 KiB
Scheme
151 lines
4.4 KiB
Scheme
(import (srfi :43))
|
|
|
|
; returns a list of numbers parsed from the first line of the file,
|
|
; separated by commas
|
|
(define (parse-draws file)
|
|
(let loop [(draws '()) (n 0)]
|
|
(let [(c (get-char file))]
|
|
(cond
|
|
[(char=? c #\,) (loop (cons n draws) 0)]
|
|
[(char-whitespace? c) (reverse (cons n draws))]
|
|
[else (loop draws (+ (* n 10) (string->number (string c))))]))))
|
|
|
|
; returns numbers 0 to 9 from ascii character
|
|
(define (char->number c)
|
|
(- (char->integer c) 48)) ; 48 is ASCII's number zero
|
|
|
|
; returns a number from two characters
|
|
; ex: '0' and '9' => 9
|
|
; ' ' and '6' => 6
|
|
; '1' and '2' => 12
|
|
(define (char-pair->number c1 c2)
|
|
(if (char-numeric? c1)
|
|
[+ (* 10 (char->number c1)) (char->number c2)]
|
|
[char->number c2]))
|
|
|
|
; returns a vector of 25 numbers
|
|
; parsed from input file where numbers are separated by whitespace
|
|
(define (read-board file)
|
|
(let parse-loop [(i 0) (numbers '())]
|
|
(if (= i 25)
|
|
[list->vector (reverse numbers)]
|
|
[let [(c2 (get-char file))
|
|
(c1 (get-char file))]
|
|
(get-char file) ; consume space or empty line
|
|
(parse-loop
|
|
(+ i 1)
|
|
(cons (char-pair->number c1 c2) numbers))])))
|
|
|
|
; returns a list of vectors of 25 numbers parsed from input file
|
|
(define (read-boards file)
|
|
(reverse
|
|
(let loop [(boards '())]
|
|
(get-char file) ; consume empty line
|
|
(if (eof-object? (peek-char file))
|
|
boards
|
|
[loop (cons (read-board file) boards)]))))
|
|
|
|
; returns a number where bit N is set if N'th number
|
|
; in board matches given number
|
|
; bits that are already set in mark are kept
|
|
(define (mark-bingo number board mark)
|
|
(let loop [(i 0)]
|
|
(if (< i 25)
|
|
[if (= (vector-ref board i) number)
|
|
[bitwise-ior mark (bitwise-arithmetic-shift-left 1 i)]
|
|
[loop (+ i 1)]]
|
|
mark)))
|
|
|
|
; marks the corresponding n'th bit in each board if
|
|
; an n'th element of the corresponding board matches input number
|
|
(define (mark-bingos! number boards marks)
|
|
(let loop [(board (car boards))
|
|
(boards (cdr boards))
|
|
(index 0)]
|
|
(vector-set! marks index
|
|
(mark-bingo number board (vector-ref marks index)))
|
|
(when (not (null? boards))
|
|
(loop (car boards) (cdr boards) (+ index 1)))))
|
|
|
|
; all possible bitfields corresponding to a line or column of bingo
|
|
(define bingos
|
|
'#(; lines
|
|
#b1111100000000000000000000
|
|
#b0000011111000000000000000
|
|
#b0000000000111110000000000
|
|
#b0000000000000001111100000
|
|
#b0000000000000000000011111
|
|
; columns
|
|
#b1000010000100001000010000
|
|
#b0100001000010000100001000
|
|
#b0010000100001000010000100
|
|
#b0001000010000100001000010
|
|
#b0000100001000010000100001))
|
|
|
|
; check if any bitfield represented grid of marked bingo cell is bingo!
|
|
(define (check-bingos marks)
|
|
(vector-index
|
|
(lambda (mark)
|
|
(vector-any
|
|
(lambda (mask)
|
|
(= mask (bitwise-and mask mark)))
|
|
bingos))
|
|
marks))
|
|
|
|
; computes the score of the winning board
|
|
(define (score boards marks index last-draw)
|
|
(let [(board (list-ref boards index))
|
|
(mark (vector-ref marks index))]
|
|
(let loop [(score 0) (index 0)]
|
|
(if (< index 25)
|
|
[if (bitwise-bit-set? mark index)
|
|
[loop score (+ index 1)]
|
|
[loop (+ score (vector-ref board index)) (+ index 1)]]
|
|
[* last-draw score]))))
|
|
|
|
; returns list with the index of the board that won and the score
|
|
; #f if none won after all draws
|
|
(define (bingo draws boards marks)
|
|
(let loop [(draw (car draws))
|
|
(draws (cdr draws))]
|
|
(mark-bingos! draw boards marks)
|
|
(let [(check (check-bingos marks))]
|
|
(if check
|
|
[list check (score boards marks check draw)]
|
|
[if (null? draws)
|
|
#f
|
|
[loop (car draws) (cdr draws)]]))))
|
|
|
|
; returns a list without its n-th element
|
|
(define (except list n-th)
|
|
(let loop [(list list) (i 0)]
|
|
(if (= i n-th)
|
|
(cdr list)
|
|
(cons (car list) (loop (cdr list) (+ i 1))))))
|
|
|
|
(define (last-winning draws boards)
|
|
(let loop [(boards boards)
|
|
(prev-score 0)
|
|
(marks (make-vector (length boards) 0))]
|
|
(if (null? boards)
|
|
prev-score
|
|
[let [(index+score (bingo draws boards marks))]
|
|
(if index+score
|
|
[loop
|
|
(except boards (car index+score))
|
|
(cadr index+score)
|
|
(make-vector (length boards) 0)]
|
|
[cadr index+score])])))
|
|
|
|
(call-with-input-file
|
|
"input"
|
|
(lambda (file)
|
|
(let* [(draws (parse-draws file))
|
|
(boards (read-boards file))]
|
|
(printf "part 1: ~% ")
|
|
(let* [(marks (make-vector (length boards) 0))
|
|
(index+score (bingo draws boards marks))]
|
|
(printf "bingo! ~a~%" (cadr index+score)))
|
|
(printf "part 2: ~% bingo! ~a~%"
|
|
(last-winning draws boards)))))
|