day-4.lisp (2248B)
1 (defpackage #:aoc/day-4 2 (:use #:cl #:aoc/utils) 3 (:export #:day-4)) 4 (in-package #:aoc/day-4) 5 6 (defun read-card-numbers (line) 7 (loop with winning-numbers = nil 8 with my-numbers = nil 9 with divider? = nil 10 for i from (1+ (position #\: line)) below (length line) 11 for char = (aref line i) 12 do (cond 13 ((char= char #\Space)) 14 ((char= char #\|) 15 (setf divider? t)) 16 ((digit-char-p char) 17 (multiple-value-bind (number end) 18 (parse-integer line 19 :start i 20 :junk-allowed t) 21 (if divider? 22 (push number my-numbers) 23 (push number winning-numbers)) 24 (setf i end)))) 25 finally (return (list winning-numbers my-numbers)))) 26 27 (declaim (ftype (function (list list) fixnum) card-matching-numbers)) 28 (defun card-matching-numbers (winning-numbers my-numbers) 29 (loop for number fixnum in my-numbers 30 when (member number winning-numbers) 31 sum 1 fixnum)) 32 33 (declaim (ftype (function (list) (values fixnum list)) process-copies)) 34 (defun process-copies (copies) 35 (loop with total-copies fixnum = 0 36 with new-copies = nil 37 for copy fixnum in copies 38 do (decf copy) 39 when (>= copy 0) 40 do (incf total-copies) 41 when (> copy 0) 42 do (push copy new-copies) 43 finally (return (values total-copies new-copies)))) 44 45 (defun day-4 (input) 46 (loop with copies = nil 47 with task-2 fixnum = 0 48 for line = (read-line input nil) 49 while line 50 for (winning-numbers my-numbers) = (read-card-numbers line) 51 for matching-numbers = (card-matching-numbers winning-numbers my-numbers) 52 when (> matching-numbers 0) 53 sum (expt 2 (1- matching-numbers)) into task-1 fixnum 54 do (multiple-value-bind (this-card-copies new-copies) 55 (process-copies copies) 56 (incf task-2 (1+ this-card-copies)) 57 (setf copies new-copies) 58 (loop for copy from 0 to this-card-copies 59 do (push matching-numbers copies))) 60 finally (return (values task-1 task-2))))