aoc2021-day04b Common Lisp/SBCL program
source code
;; SPDX-License-Identifier: LGPL-3.0-or-later
;; Copyright (C) 2021 Massimo Zaniboni <mzan@dokmelody.org>
;; WARNING: I'm learning CL
(ql:quickload :trivia) ;; common macro and functions and optimal pattern matching
(ql:quickload :alexandria) ;; common CL extensions
(ql:quickload :trivial-types) ;; common types
(ql:quickload :defstar) ;; add type annotations
(ql:quickload :str) ;; Common string manipulation functions
(ql:quickload :parse-float)
(ql:quickload :iterate)
(ql:quickload :let-plus) ;; extend "let"
(ql:quickload :array-operations) ;; rich management of arrays
(defpackage :main
(:import-from :alexandria)
(:import-from :trivial-types :proper-list :tuple)
(:use :cl :defstar :trivia :parse-float :iterate :let-plus)
(:export main))
(in-package :main)
(declaim (optimize (speed 3) (debug 0) (safety 0)))
; # Utilities
(defun nil-min2 (x y)
(if (null x)
y
(if (null y)
x
(min x y))))
(defun nil<= (x y)
(if (null x)
y
(if (null y)
x
(<= x y))))
(defun nil>= (x y)
(if (null x)
y
(if (null y)
x
(>= x y))))
; # Day 4b
; ## Solution design
;
; The idea is to replace numbers with their order of extraction.
; So a row with numbers "3 10 8"
; is replaced with extration order "8 1 2",
; hence it will be completed at 8th extraction.
; 8 is the winner-extraction.
;
; This approach simplifies comparison between rows and boards,
; because it suffices to store the maximum and minimum winniner-extraction.
; The extraction order of numbers.
(deftype extraction () `fixnum)
(defclass board ()
(
(number->extraction
:type hash-table
:documentation "Map a number to its extraction order."
:accessor board-number->extraction
:initarg :number->exctraction)
(extraction->number
:type (vector extraction)
:documentation "From an extraction order like 3, to the corresponding number."
:accessor board-extraction->number
:initarg :extraction->number)
(content
:type (vector extraction)
:documentation "The numbers inside the board, saved in extraction order format."
:accessor board-content
:initform (make-array 25 :element-type 'fixnum :fill-pointer 0 :adjustable t))
(winner-extraction
:type (or extraction null)
:documentation "The board winning extraction, i.e. the first extraction completing a row."
:initform nil
:accessor board-winner-extraction)
)
(:documentation "A Bingo board where numbers are expressed according their extraction order.")
)
(defun* (board-show -> string) ((self board))
(with-output-to-string (out)
(iter (for e in-sequence (board-content self))
(for n = (aref (board-extraction->number self) e))
(with we = (board-winner-extraction self))
(for extracted? = (or (null we) (<= e we)))
(for winner? = (and (not (null we)) (= e we)))
(for box = (if winner?
#\*
(if extracted?
#\+
#\ )))
(after-each (format out " ~a~a " n box)))))
(defun* (parse-board-extractions -> (tuple hash-table (vector extraction))) ((in stream))
"Parse a line with the extractions."
(let* ((nn (mapcar #'parse-integer (str:split "," (read-line in))))
(extractions (make-array
(length nn)
:element-type 'fixnum
:initial-contents nn))
(numbers (iter (for i index-of-vector extractions)
(with hash = (make-hash-table :size (length extractions)))
(after-each (setf (gethash (aref extractions i) hash) i))
(finally (return hash)))))
(read-line in nil nil) ; skip an empty line
(list numbers extractions)))
(defun* (board-add-row! -> null) ((self board) (row sequence) &key ((add-to-content? boolean) t))
"Add a row (or column) to the board and maintain board-state."
(iter (for n in-sequence row)
(for e = (gethash n (board-number->extraction self) -1))
(with never-win = nil)
(maximize e into row-winner)
; a row win when the last (maximum) number is extracted
(after-each
(if (= e -1)
(setf never-win t)
(when add-to-content? (vector-push-extend e (board-content self)))))
(finally
(unless never-win
(setf (board-winner-extraction self) (nil-min2 row-winner (board-winner-extraction self))))
nil)))
; the board win at the first (minimum) winning row
(defun* (parse-board! -> boolean) ((self board) (in stream))
"Start with a blank line and then complete the board. Return nil if there is no board to parse."
(iter (for rs in-stream in using #'read-line)
(for row = (map 'list #'parse-integer (str:split " " rs :omit-nulls t)))
(for curr-row from 0)
(for is-there-board? initially nil then t)
(with cols = nil)
(until (null row))
(if-first-time
(let ((d (length row)))
(setf cols (make-array (list d d) :element-type 'fixnum))))
(after-each
(board-add-row! self row)
(iter (for n in-sequence row)
(for curr-col from 0)
(setf (aref cols curr-col curr-row) n)))
(finally
(when cols
(let+ (((col-i _) (array-dimensions cols)))
(iter (for i from 0 below col-i)
(after-each (board-add-row! self (aops:sub cols i) :add-to-content? nil)))))
(return is-there-board?))))
(defun* (board-winner-number -> (or fixnum null)) ((self board))
(let* ((we (board-winner-extraction self)))
(if (null we)
nil
(aref (board-extraction->number self) we))))
(defun* (board-score -> fixnum) ((self board))
"Calculate the score according the rule of the exsercise."
(iter (for e in-sequence (board-content self))
(for n = (aref (board-extraction->number self) e))
(with we = (board-winner-extraction self))
(with wn = (board-winner-number self))
(for mn = (if (null we)
n ; TODO probably not correct: should take the last extracted number
(if (<= e we)
0 ; if the extraction is before the winner
n ; number not yet extracted
)))
(sum mn into smn)
(finally (return (* smn wn)))))
(defun select-board (&key select-best?)
(let ((in *standard-input*))
(let+ (((ne en) (parse-board-extractions in)))
(iter (for b = (make-instance 'board :number->exctraction ne :extraction->number en))
(for b? = (parse-board! b in))
(with best-b = nil)
(with best-extraction = nil)
(while b?)
(for b-extraction = (board-winner-extraction b))
(after-each
(let ((is-best? (if select-best?
(nil<= b-extraction best-extraction)
(nil>= b-extraction best-extraction))))
(when is-best?
(setf best-extraction b-extraction)
(setf best-b b))))
(finally (return (board-score best-b)))))))
(defun day4b () (select-board :select-best? nil))
(defun main () (format t "~a~%" (day4b)))
notes, command-line, and program output
NOTES:
Linux
Sun, 23 Jan 2022 13:44:10 GMT
MAKE:
sbcl --disable-debugger --load "aoc2021_day04b.lisp-1.lisp" --eval "(sb-ext:save-lisp-and-die \"app_lisp\" :executable t :toplevel #'main:main)"
This is SBCL 2.1.11, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.
SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses. See the CREDITS and COPYING files in the
distribution for more information.
To load "trivia":
Load 1 ASDF system:
trivia
; Loading "trivia"
To load "alexandria":
Load 1 ASDF system:
alexandria
; Loading "alexandria"
To load "trivial-types":
Load 1 ASDF system:
trivial-types
; Loading "trivial-types"
To load "defstar":
Load 1 ASDF system:
defstar
; Loading "defstar"
To load "str":
Load 1 ASDF system:
str
; Loading "str"
...
To load "parse-float":
Load 1 ASDF system:
parse-float
; Loading "parse-float"
To load "iterate":
Load 1 ASDF system:
iterate
; Loading "iterate"
To load "let-plus":
Load 1 ASDF system:
let-plus
; Loading "let-plus"
To load "array-operations":
Load 1 ASDF system:
array-operations
; Loading "array-operations"
; file: /bencher/tmp/aoc2021_day04b/tmp/aoc2021_day04b.lisp-1.lisp
; in: DEFUN* (PARSE-BOARD! -> BOOLEAN)
; (LET-PLUS:LET+ (((MAIN::COL-I MAIN::_) (ARRAY-DIMENSIONS MAIN::COLS)))
; (ITERATE:ITER
; (ITERATE:FOR MAIN::I MAIN::FROM 0 MAIN::BELOW MAIN::COL-I)
; (ITERATE:AFTER-EACH
; (MAIN::BOARD-ADD-ROW! MAIN::SELF
; (ARRAY-OPERATIONS/DISPLACING:SUB MAIN::COLS
; MAIN::I)
; :ADD-TO-CONTENT? NIL))))
; --> SB-INT:BINDING*
; ==>
; (LET* ((#:G31
; (SB-C::CHECK-DS-LIST (ARRAY-DIMENSIONS MAIN::COLS) 2 2
; '(MAIN::COL-I MAIN::_)))
; (MAIN::COL-I (POP #:G31))
; (MAIN::_ (POP #:G31)))
; (DECLARE (IGNORE))
; (ITERATE:ITER
; (ITERATE:FOR MAIN::I MAIN::FROM 0 MAIN::BELOW MAIN::COL-I)
; (ITERATE:AFTER-EACH
; (MAIN::BOARD-ADD-ROW! MAIN::SELF
; (ARRAY-OPERATIONS/DISPLACING:SUB MAIN::COLS
; MAIN::I)
; :ADD-TO-CONTENT? NIL))))
;
; caught STYLE-WARNING:
; The variable _ is defined but never used.
;
; compilation unit finished
; caught 1 STYLE-WARNING condition
[undoing binding stack and other enclosing state... done]
[performing final GC... done]
[defragmenting immobile space... (fin,inst,fdefn,code,sym)=1180+997+19877+20303+25976... done]
[saving current Lisp image into app_lisp:
writing 0 bytes from the read-only space at 0x50000000
writing 736 bytes from the static space at 0x50100000
writing 48250880 bytes from the dynamic space at 0x1000000000
writing 2080768 bytes from the immobile space at 0x50200000
writing 13074432 bytes from the immobile space at 0x52a00000
done]
2.54s to complete and log all make actions
COMMAND LINE:
./app_lisp 0 < aoc2021_day04b-input3600.txt
PROGRAM OUTPUT:
199953180