├── COPYING ├── README.org ├── aoc-in-loop.asd └── src ├── d1.lisp ├── d10.lisp ├── d11.lisp ├── d12.lisp ├── d13.lisp ├── d14.lisp ├── d15.lisp ├── d2.lisp ├── d3.lisp ├── d4.lisp ├── d5.lisp ├── d6.lisp ├── d7.lisp ├── d8.lisp ├── d9.lisp ├── generic.lisp └── package.lisp /COPYING: -------------------------------------------------------------------------------- 1 | Copyright 2021 Artyom Bologov 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | 7 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 8 | 9 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE:Advent of Code in Loop 2 | 3 | This is a repo for my horrible attempts to solve AoC 2021 puzzles with ~loop~ and nothing else. By "nothing else" I mean no other big control flow or programming paradigm but ~loop~. This means: 4 | - No functional transformations: ~mapcar~, ~reduce~, ~remove~ etc. 5 | - No usual iteration: ~do~, ~dotimes~. 6 | - No assembly-like things: ~block~, ~tagbody~. 7 | - No recursive functions. 8 | - No classes/structures. 9 | 10 | All (well... most) of those have their ~loop~ counterpart that should be used instead. ~if~ and similar simple control flow macros are not imposing any paradigm, and thus can be used. Same goes for small built-in functions. Defining separate functions is fine, as long as their body is either a single ~loop~ or is less than four lines. Libraries that I use there are restricted to ASDF and UIOP, thus it should run on almost any standard-conformant and ASDF-bundling implementation. 11 | 12 | * Why? 13 | [[https://teddit.net/r/LispMemes/comments/q9rnkb/but_does_it_have/][Loop is the original zero-cost abstraction]] and the most comprehensive iteration DSL there probably is to programming. If C ~for~ loop allows building browsers and OSes, CL ~loop~, with all its strength, should handle anything, right? Advent of Code is a perfect occasion to prove that. 14 | -------------------------------------------------------------------------------- /aoc-in-loop.asd: -------------------------------------------------------------------------------- 1 | (in-package :asdf) 2 | 3 | (defsystem :aoc-in-loop 4 | :author "Artyom Bologov" 5 | :description "Solving Advent of Code 2021 using only CL loop macro." 6 | :license "BSD 2-Clause" 7 | :serial t 8 | :pathname "src/" 9 | :components ((:file "package") 10 | (:file "generic") 11 | (:file "d1") 12 | (:file "d2") 13 | (:file "d3") 14 | (:file "d4") 15 | (:file "d5") 16 | (:file "d6") 17 | (:file "d7") 18 | (:file "d8") 19 | (:file "d9") 20 | (:file "d10") 21 | (:file "d11") 22 | (:file "d12") 23 | (:file "d13") 24 | (:file "d14") 25 | (:file "d15"))) 26 | -------------------------------------------------------------------------------- /src/d1.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:aoc-in-loop) 2 | 3 | (defun measurements () 4 | (loop for raw-measurement 5 | in (uiop:read-file-lines (asdf:system-relative-pathname :aoc-in-loop "input/d1.in")) 6 | collect (parse-integer raw-measurement))) 7 | 8 | (export 'd1-1) 9 | (defun d1-1 () 10 | ;; Thanks @vindarel! 11 | (loop for depth in (measuments) 12 | and prev = nil then depth 13 | when prev 14 | count (< prev depth))) 15 | 16 | (export 'd1-2) 17 | (defun d1-2 () 18 | (loop with increasing-window-measurements = 0 19 | with previous-window-measurement = nil 20 | for (one two three) on (measurements) 21 | for window-measurement 22 | = (ignore-errors (+ one two three)) 23 | collect window-measurement 24 | until (null window-measurement) 25 | when (and previous-window-measurement 26 | (> window-measurement previous-window-measurement)) 27 | do (incf increasing-window-measurements) 28 | do (setf previous-window-measurement window-measurement) 29 | finally (return increasing-window-measurements))) 30 | -------------------------------------------------------------------------------- /src/d10.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun syntax-lines () 4 | (uiop:read-file-lines 5 | (asdf:system-relative-pathname :aoc-in-loop "input/d10.in"))) 6 | 7 | (defun assoc-value (key list) 8 | (loop for (k v) in list 9 | when (equal key k) 10 | do (return v))) 11 | 12 | (defun check-lines (&optional (lines (syntax-lines))) 13 | (loop for line in lines 14 | collect (loop with matching-brackets 15 | = '((#\) #\() 16 | (#\] #\[) 17 | (#\} #\{) 18 | (#\> #\<)) 19 | with stack = (list) 20 | for char across line 21 | for column from 0 upto (length line) 22 | if (loopind char '(#\( #\[ #\{ #\<)) 23 | do (push char stack) 24 | else if (loopind char '(#\) #\] #\} #\>)) 25 | do (if (equal (assoc-value char matching-brackets) 26 | (first stack)) 27 | (pop stack) 28 | (return (list :corrupted column char))) 29 | finally (return 30 | (if stack 31 | (list :incomplete stack) 32 | (list :complete)))))) 33 | 34 | (defun d10-1 () 35 | (loop with score-table = '((#\) 3) 36 | (#\] 57) 37 | (#\} 1197) 38 | (#\> 25137)) 39 | with lines = (syntax-lines) 40 | with check-stata = (check-lines lines) 41 | for (status . args) in check-stata 42 | when (eq :corrupted status) 43 | sum (assoc-value (second args) score-table))) 44 | 45 | (defun d10-2 () 46 | "TIL that: 47 | - Lisp is (unsurprisingly) good for parsers. 48 | - I don't remember whether alists consist of (KEY . VALUE) or (KEY 49 | VALUE) entries. 50 | - I've gone with the second one, although the first one is most 51 | probably the correct way to do alists. 52 | - Stacks are a cool data structure, and knowing about stacks saved me 53 | today. Especially if it's such a thing as paren-stack." 54 | (loop with score-table = '((#\( 1) 55 | (#\[ 2) 56 | (#\{ 3) 57 | (#\< 4)) 58 | with lines = (syntax-lines) 59 | with check-stata = (check-lines lines) 60 | for (status . args) in check-stata 61 | when (eq :incomplete status) 62 | collect (loop with score = 0 63 | with stack = (first args) 64 | while stack 65 | do (setf score 66 | (+ (* 5 score) 67 | (assoc-value (pop stack) score-table))) 68 | finally (return score)) 69 | into scores 70 | finally (return (elt (loop-sort scores) (floor (/ (length scores) 2)))))) 71 | -------------------------------------------------------------------------------- /src/d11.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun octopuses () 4 | (read-matrix (asdf:system-relative-pathname :aoc-in-loop "input/d11.in"))) 5 | 6 | (defun 8-neighbors (point map) 7 | (loop for (xdiff ydiff) in '((0 1) (1 0) (0 -1) (-1 0) (1 1) (1 -1) (-1 1) (-1 -1)) 8 | for x = (first point) 9 | for y = (second point) 10 | when (and (<= 0 (+ xdiff x) (1- (length map))) 11 | (<= 0 (+ ydiff y) (1- (length (first map))))) 12 | collect (list (+ xdiff x) (+ ydiff y)))) 13 | 14 | (defun flash (map) 15 | (loop with flash-count = 0 16 | with flashed-already = '() 17 | with flashers = (loop for x below (length map) 18 | append (loop for y below (length (first map)) 19 | when (> (mref map x y) 9) 20 | collect (list x y))) 21 | while flashers 22 | do (loop with (x y) = (pop flashers) 23 | initially (setf (mref map x y) 0) 24 | initially (incf flash-count) 25 | initially (pushnew (list x y) flashed-already :test #'equal) 26 | for (nx ny) in (8-neighbors (list x y) map) 27 | unless (loopind (list nx ny) flashed-already) 28 | do (incf (mref map nx ny)) 29 | and when (> (mref map nx ny) 9) 30 | do (pushnew (list nx ny) flashers :test #'equal)) 31 | finally (return flash-count))) 32 | 33 | (defun d11-1 (&optional (steps 100)) 34 | (loop with map = (octopuses) 35 | for step below steps 36 | do (loop for x below (length map) 37 | do (loop for y below (length (first map)) 38 | do (incf (mref map x y)))) 39 | sum (flash map))) 40 | 41 | (defun d11-2 () 42 | (loop with map = (octopuses) 43 | for step from 0 by 1 44 | do (loop for x below (length map) 45 | do (loop for y below (length (first map)) 46 | do (incf (mref map x y)))) 47 | when (= (* (length map) (length (first map))) 48 | (flash map)) 49 | do (return (1+ step)))) 50 | -------------------------------------------------------------------------------- /src/d12.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun all-upcase-p (string) 4 | (not (loop for char across string 5 | thereis (lower-case-p char)))) 6 | 7 | (defun caves () 8 | (loop with cave-table = (make-hash-table :test 'equal) 9 | for raw-cave in (uiop:read-file-lines 10 | (asdf:system-relative-pathname :aoc-in-loop "input/d12.in")) 11 | for (start end) = (uiop:split-string raw-cave :separator '(#\-)) 12 | unless (gethash start cave-table) 13 | do (setf (gethash start cave-table) 14 | (make-hash-table :test 'equal)) 15 | unless (gethash end cave-table) 16 | do (setf (gethash end cave-table) 17 | (make-hash-table :test 'equal)) 18 | do (setf (gethash start (gethash end cave-table)) t 19 | (gethash end (gethash start cave-table)) t) 20 | finally (return cave-table))) 21 | 22 | (defun hash-keys (hash) 23 | (when hash 24 | (loop for key being the hash-key of hash 25 | collect key))) 26 | 27 | (defvar *choices* (make-hash-table :test 'equalp)) 28 | 29 | (defun visitable-p (choice visited can-visit-extra-small-cave) 30 | (and (string/= "start" choice) 31 | (or (all-upcase-p choice) 32 | can-visit-extra-small-cave 33 | (not (loopind choice visited))))) 34 | 35 | (defun paths (&optional 36 | (cave-map (caves)) 37 | (visited '("start")) 38 | can-visit-extra-small-cave) 39 | (loopmove-if 40 | (lambda (path) (string/= "end" (first (reverse path)))) 41 | (loop with choices = (loop for choice in (hash-keys 42 | (gethash (first (reverse visited)) cave-map)) 43 | when (visitable-p choice visited can-visit-extra-small-cave) 44 | collect choice) 45 | with whatever = (setf (gethash visited *choices*) 46 | choices) 47 | if (null choices) 48 | do (return (list visited)) 49 | else if (and (= 1 (length choices)) 50 | (not (string= "end" (first choices)))) 51 | do (return (paths cave-map (append visited choices) 52 | (if (or (all-upcase-p (first choices)) 53 | (not (loopind (first choices) visited))) 54 | can-visit-extra-small-cave 55 | nil))) 56 | else do (return (loop for ch in choices 57 | if (string= "end" ch) 58 | append (list (append visited (list ch))) 59 | else 60 | append (paths cave-map (append visited (list ch)) 61 | (if (or (all-upcase-p ch) 62 | (not (loopind ch visited))) 63 | can-visit-extra-small-cave 64 | nil))))))) 65 | 66 | (export 'd12-1) 67 | (defun d12-1 () 68 | (length (paths))) 69 | 70 | (export 'd12-2) 71 | (defun d12-2 () 72 | (length (paths (caves) '("start") t))) 73 | -------------------------------------------------------------------------------- /src/d13.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun folding () 4 | (loop with fold-instructions = nil 5 | with raw-lines = (uiop:read-file-lines 6 | (asdf:system-relative-pathname :aoc-in-loop "input/d13.in")) 7 | with dots = (loop for raw-line in raw-lines 8 | until (uiop:emptyp raw-line) 9 | collect (loopcar #'parse-integer 10 | (uiop:split-string raw-line :separator '(#\,)))) 11 | with instructions = (loop with instructions-p = nil 12 | for raw-line in raw-lines 13 | for (raw-axis raw-number) 14 | = (when instructions-p 15 | (uiop:split-string 16 | (third (uiop:split-string raw-line)) 17 | :separator '(#\=))) 18 | when instructions-p 19 | collect (if (string= raw-axis "x") 20 | (list (parse-integer raw-number) 0) 21 | (list 0 (parse-integer raw-number))) 22 | when (uiop:emptyp raw-line) 23 | do (setf instructions-p t)) 24 | initially (return (list dots instructions)))) 25 | 26 | (defun fold (paper fold) 27 | (loop with (x-fold y-fold) = fold 28 | for (x-dot y-dot) in paper 29 | if (and (zerop x-fold) 30 | (> y-dot y-fold)) 31 | collect (list x-dot (- y-fold (- y-dot y-fold))) 32 | else if (and (zerop y-fold) 33 | (> x-dot x-fold)) 34 | collect (list (- x-fold (- x-dot x-fold)) y-dot) 35 | else collect (list x-dot y-dot))) 36 | 37 | (export 'd13-1) 38 | (defun d13-1 () 39 | (loop with (dots instructions) = (folding) 40 | initially (return (loopmove-duplicates (fold dots (first instructions)))))) 41 | 42 | (defun print-paper (paper) 43 | (loop with (max-x max-y) = (loop for (x y) in paper 44 | maximize x into max-x 45 | maximize y into max-y 46 | finally (return (list max-x max-y))) 47 | with strings = (loop for y upto max-y 48 | collect (make-string (1+ max-x) :initial-element #\ )) 49 | for (x y) in paper 50 | do (setf (elt (elt strings y) x) 51 | #\#) 52 | finally (print (loop with result = "" 53 | for string in strings 54 | do (setf result (concatenate 'string result (string #\Newline) string)) 55 | finally (return result))))) 56 | 57 | (export 'd13-2) 58 | (defun d13-2 () 59 | "TIL that: 60 | - Typos are the most dreadful thing in Lisp programming, after the wrong program logic. 61 | - Mapping list -> string (and thus printing) is quirky to do with loop. 62 | - Expressing the AoC problem domain in small composable functions is the best approach to AoC. 63 | - In addition to array processing, loop is also bad at string parsing. 64 | - But c'mon, which programming construct (except for parsing combinators) is good with parsing?" 65 | (loop with (dots instructions) = (folding) 66 | with fold = dots 67 | for instruction in instructions 68 | do (setf fold (loopmove-duplicates (fold fold instruction))) 69 | finally (print-paper fold))) 70 | -------------------------------------------------------------------------------- /src/d14.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun sequences () 4 | (loop with file = (asdf:system-relative-pathname :aoc-in-loop "input/d14.in") 5 | with template = (coerce (uiop:read-file-line file) 'list) 6 | with raw-rules = (subseq (uiop:read-file-lines file) 2) 7 | with rules = (make-hash-table :test 'equalp) 8 | for raw-rule in raw-rules 9 | do (setf (gethash (coerce (subseq raw-rule 0 2) 'list) rules) 10 | (elt raw-rule (1- (length raw-rule)))) 11 | finally (return (list template rules)))) 12 | 13 | (defun incfhash (key table &optional (amount 1)) 14 | (if (gethash key table) 15 | (incf (gethash key table) amount) 16 | (setf (gethash key table) amount))) 17 | 18 | (defun pair-insert (&optional (steps 10)) 19 | (loop with sequence-data = (sequences) 20 | with freqs = (make-hash-table :test 'equalp) 21 | with sequence = (first sequence-data) 22 | with rules = (second sequence-data) 23 | initially (loop for (a b . rest) on sequence 24 | for pair = (list a b) 25 | until (null b) 26 | do (incfhash pair freqs)) 27 | for step from 0 below steps 28 | do (setf freqs 29 | (loop with new-freqs = (make-hash-table :test 'equalp) 30 | for pair being the hash-key of rules 31 | using (hash-value new) 32 | for first-pair = (list (first pair) new) 33 | for second-pair = (list new (second pair)) 34 | when (gethash pair freqs) 35 | do (incfhash first-pair new-freqs 36 | (gethash pair freqs)) 37 | and do (incfhash second-pair new-freqs 38 | (gethash pair freqs)) 39 | finally (return new-freqs))) 40 | finally (return freqs))) 41 | 42 | (defun d14 (&optional (steps 10)) 43 | "TIL that: 44 | - Lanternfish always hits you when you don't expect it. 45 | - You can destructure the variables in the hash iteration `loop'. 46 | - The pattern of increasing the hash value is appearing so often in 47 | AoC that I'm surprized no one has added such a function to any 48 | utility library that I'm aware of. 49 | - Doing the problem using `reduce', `mapcar' &c. is almost twice as 50 | short as `loop' solution, especially with `alexandria:curry' and 51 | other functional idioms. 52 | - Does this mean I'm giving up on doing AoC in loop? Hell no!" 53 | (loop with result = (pair-insert steps) 54 | with freqs = (make-hash-table) 55 | for (first second) being the hash-key of result 56 | using (hash-value freq) 57 | do (incfhash first freqs freq) 58 | do (incfhash second freqs freq) 59 | finally (return (loop for freq being the hash-value of freqs 60 | maximize freq into max 61 | minimize freq into min 62 | finally (return (- (ceiling (/ max 2)) (ceiling (/ min 2)))))))) 63 | -------------------------------------------------------------------------------- /src/d15.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun chiton-risks () 4 | (read-matrix (asdf:system-relative-pathname :aoc-in-loop "input/d15-sample.in"))) 5 | 6 | (defun cost (map path) 7 | (loop for (x y) in path 8 | sum (elt (elt map x) y))) 9 | 10 | (defun 2-neighbors (map point) 11 | (append 12 | (when (< (1+ (second point)) (length (first map))) 13 | (list (list (first point) (1+ (second point))))) 14 | (when (< (1+ (first point)) (length map)) 15 | (list (list (1+ (first point)) (second point)))))) 16 | 17 | (defun path (map &optional (start '(0 0)) 18 | (end (list (1- (length map)) (1- (length (first map)))))) 19 | "This is basically a dumbed-down version of A-star." 20 | (loop named a-star 21 | with frontier = (list (list start)) 22 | with paths = '() 23 | while frontier 24 | for lowest-cost-option 25 | = (loop with min-cost = most-positive-fixnum 26 | with min-index = nil 27 | for path in frontier 28 | for i below (length frontier) 29 | when (< (cost map path) min-cost) 30 | do (setf min-cost (cost map path) 31 | min-index i) 32 | finally (return (let ((min (elt frontier min-index))) 33 | (setf frontier (append (subseq frontier 0 min-index) 34 | (subseq frontier (1+ min-index)))) 35 | min))) 36 | for prev-step = (car (last lowest-cost-option)) 37 | do (loop for neigh in (2-neighbors map prev-step) 38 | for path = (append lowest-cost-option (list neigh)) 39 | if (equalp neigh end) 40 | do (return-from a-star path) 41 | else do (push path frontier)))) 42 | 43 | (defun d15-1 () 44 | (loop with map = (chiton-risks) 45 | with path = (path map) 46 | initially (return (cost map (cdr path))))) 47 | -------------------------------------------------------------------------------- /src/d2.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:aoc-in-loop) 2 | 3 | (defun commands () 4 | (loop for raw-command 5 | in (uiop:read-file-lines (asdf:system-relative-pathname :aoc-in-loop "input/d2.in")) 6 | for (command raw-quantity) = (uiop:split-string raw-command) 7 | for quantity = (parse-integer raw-quantity) 8 | collect (list command quantity))) 9 | 10 | (export 'd2-1) 11 | (defun d2-1 () 12 | (loop with horisontal = 0 13 | with vertical = 0 14 | for (command quantity) in (commands) 15 | if (equal "up" command) 16 | do (decf vertical quantity) 17 | else if (equal "down" command) 18 | do (incf vertical quantity) 19 | else do (incf horisontal quantity) 20 | finally (return (* horisontal vertical)))) 21 | 22 | (export 'd2-2) 23 | (defun d2-2 () 24 | (loop with aim = 0 25 | with horisontal = 0 26 | with vertical = 0 27 | for (command quantity) in (commands) 28 | if (equal "up" command) 29 | do (decf aim quantity) 30 | else if (equal "down" command) 31 | do (incf aim quantity) 32 | else do (progn (incf horisontal quantity) 33 | (incf vertical (* aim quantity))) 34 | finally (return (* horisontal vertical)))) 35 | -------------------------------------------------------------------------------- /src/d3.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:aoc-in-loop) 2 | 3 | (defun diagnostics () 4 | (loop for byte 5 | in (uiop:read-file-lines (asdf:system-relative-pathname :aoc-in-loop "input/d3.in")) 6 | collect (parse-integer byte :radix 2) 7 | into diags 8 | finally (return (list (length byte) diags)))) 9 | 10 | (defun most-common-bit (diagnostics mask) 11 | (loop for byte in diagnostics 12 | count (not (zerop (logand mask byte))) :into ones 13 | finally (return (if (>= ones (/ (length diagnostics) 2)) 14 | 1 0)))) 15 | 16 | (defun least-common-bit (diagnostics mask) 17 | (loop for byte in diagnostics 18 | count (not (zerop (logand mask byte))) :into ones 19 | finally (return (if (>= ones (/ (length diagnostics) 2)) 20 | 0 1)))) 21 | 22 | (export 'd3-1) 23 | (defun d3-1 () 24 | (loop with (byte-length diagnostics) = (diagnostics) 25 | for i below byte-length 26 | for mask = (expt 2 i) 27 | for g-bit = (most-common-bit diagnostics mask) 28 | sum (* g-bit mask) into gamma 29 | finally (return (* gamma (- (1- (expt 2 byte-length)) gamma))))) 30 | 31 | (export 'd3-2) 32 | (defun d3-2 () 33 | (loop with (byte-length diagnostics) = (diagnostics) 34 | with o2-diagnostics = diagnostics 35 | with o2-result = nil 36 | with co2-diagnostics = diagnostics 37 | with co2-result = nil 38 | for i from (1- byte-length) downto 0 39 | for mask = (expt 2 i) 40 | for o2b = (most-common-bit o2-diagnostics mask) 41 | for co2b = (least-common-bit co2-diagnostics mask) 42 | do (setf o2-diagnostics 43 | (loop for o2 in o2-diagnostics 44 | when (eq (zerop (logand mask o2)) (zerop o2b)) 45 | collect o2)) 46 | do (setf co2-diagnostics 47 | (loop for co2 in co2-diagnostics 48 | when (eq (plusp (logand mask co2)) (plusp co2b)) 49 | collect co2)) 50 | when (and (null o2-result) 51 | (= 1 (length o2-diagnostics))) 52 | do (setf o2-result (first o2-diagnostics) 53 | o2-diagnostics nil) 54 | when (and (null co2-result) 55 | (= 1 (length co2-diagnostics))) 56 | do (setf co2-result (first co2-diagnostics) 57 | co2-diagnostics nil) 58 | finally (return (* o2-result co2-result)))) 59 | -------------------------------------------------------------------------------- /src/d4.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun bingo () 4 | (loop with lines = (uiop:read-file-lines (asdf:system-relative-pathname :aoc-in-loop "input/d4-sample.in")) 5 | with numbers = (loopcar #'parse-integer (uiop:split-string (first lines) :separator '(#\,))) 6 | with boards = (loop for (l1 l2 l3 l4 l5) on (loopmove-if #'uiop:emptyp (rest lines)) 7 | by (lambda (list) (cddr (cdddr list))) 8 | collect (loop for l in (list l1 l2 l3 l4 l5) 9 | collect (loopcar #'parse-integer 10 | (loopmove-if #'uiop:emptyp (uiop:split-string l))))) 11 | initially (return (list numbers boards)))) 12 | 13 | (defun winning-p (board numbers) 14 | (loop with row-win 15 | = (loop for row in board 16 | when (loop for e in row 17 | when (not (loopind e numbers)) 18 | do (return nil) 19 | finally (return t)) 20 | do (return t) 21 | finally (return nil)) 22 | with column-win 23 | = (loop for column-index below 5 24 | when (loop for row-index below 5 25 | when (not (loopind (elt (elt board row-index) column-index) numbers)) 26 | do (return nil) 27 | finally (return t)) 28 | do (return t) 29 | finally (return nil)) 30 | initially (return (or row-win column-win)))) 31 | 32 | (defun final-score (board numbers) 33 | (loop :for row :in board 34 | :sum (loop :for num :in row 35 | :when (not (loopind num numbers)) 36 | :sum num :into sum 37 | :finally (return (* sum (first (last numbers))))))) 38 | 39 | (defun number-lists (numbers) 40 | (loop :for ns :on (loopverse numbers) 41 | :collect ns :into nsx 42 | :finally (return (loop :for n :in (loopverse nsx) 43 | :collect (loopverse n))))) 44 | 45 | (defun d4-1 () 46 | (loop :named d4 47 | :with bingo := (bingo) 48 | :with nums := (first bingo) 49 | :with boards := (second bingo) 50 | :with number-lists := (number-lists nums) 51 | :for numbers :in number-lists 52 | :do (loop :for board :in boards 53 | :when (winning-p board numbers) 54 | :do (return-from d4 (final-score board numbers))))) 55 | 56 | (defun d4-2 () 57 | (loop :named d4 58 | :with bingo := (bingo) 59 | :with nums := (first bingo) 60 | :with boards := (second bingo) 61 | :with number-lists := (number-lists nums) 62 | :for numbers :in number-lists 63 | :when (and (= (length boards) 1) 64 | (winning-p (first boards) numbers)) 65 | :do (return-from d4 (final-score (first boards) numbers)) 66 | :do (setf boards 67 | (loop :for board :in boards 68 | :unless (winning-p board numbers) 69 | :collect board)))) 70 | -------------------------------------------------------------------------------- /src/d5.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun lines () 4 | (loop with input-lines = (uiop:read-file-lines (asdf:system-relative-pathname :aoc-in-loop "input/d5.in")) 5 | with raw-lines = (loopcar #'uiop:split-string input-lines) 6 | with lines = (loop for raw-line in raw-lines 7 | collect (list (loopcar #'parse-integer 8 | (uiop:split-string (first raw-line) 9 | :separator '(#\,))) 10 | (loopcar #'parse-integer 11 | (uiop:split-string (third raw-line) 12 | :separator '(#\,))))) 13 | initially (return lines))) 14 | 15 | (defun horisontal-p (line) 16 | (= (first (first line)) 17 | (first (second line)))) 18 | 19 | (defun vertical-p (line) 20 | (= (second (first line)) 21 | (second (second line)))) 22 | 23 | (defun direction (number) 24 | (cond 25 | ((plusp number) 1) 26 | ((zerop number) 0) 27 | ((minusp number) -1))) 28 | 29 | (export 'd5-2) 30 | (defun d5-2 () 31 | "TIL that: 32 | - CL:LOOP has no generic arithmetic stepping (e.g., to work both from -5 to 5 and from 5 to -5). 33 | - To have this generic stepping, a form like `FOR X = X0 THEN (INCF X BY)' would work, 34 | but this is essentially a C-like loop :/ 35 | - Off-by-one errors are indeed dreadful. 36 | 37 | How do I solve this without a two-dimentional array?" 38 | (loop with lines = (lines) 39 | with x-dimension = (1+ (loop for ((x1 __) (x2 _)) in lines 40 | maximize (max x1 x2))) 41 | with y-dimension = (1+ (loop for ((x1 y1) (x2 y2)) in lines 42 | maximize (max y1 y2))) 43 | with map = (make-array (list x-dimension y-dimension) :initial-element 0) 44 | with fill-map 45 | = (loop for ((x1 y1) (x2 y2)) in lines 46 | do (loop for x = x1 then (incf x (direction (- x2 x1))) 47 | for y = y1 then (incf y (direction (- y2 y1))) 48 | until (and (= x x2) (= y y2)) 49 | do (incf (aref map x y)) 50 | finally (incf (aref map x y)))) 51 | for x from 0 below (array-dimension map 0) 52 | sum (loop for y from 0 below (array-dimension map 1) 53 | count (> (aref map x y) 1)))) 54 | -------------------------------------------------------------------------------- /src/d6.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun lanternfish () 4 | (loop for raw-fish in (uiop:split-string 5 | (uiop:read-file-line 6 | (asdf:system-relative-pathname :aoc-in-loop "input/d6.in")) 7 | :separator '(#\,)) 8 | collect (parse-integer raw-fish))) 9 | 10 | (export 'd6) 11 | (defun d6 (&optional (days 80)) 12 | "TIL that 13 | - Not all the data is worthy of storage, sometimes it's only the general info that you need. 14 | - As an extension: if you have lots of repeating items it's easier do split those into buckets. 15 | - Sometimes `psetf' is inevitable. 16 | - SBCL has a surprisingly small stack size, and it blows up on some two megabytes of data. 17 | - \"--dynamic-space-size\" CLI argument can help with that. 18 | - when condition sum 1 == count condition" 19 | (loop with fish = (lanternfish) 20 | with zero = (loop for f in fish count (= 0 f)) 21 | with one = (loop for f in fish count (= 1 f)) 22 | with two = (loop for f in fish count (= 2 f)) 23 | with three = (loop for f in fish count (= 3 f)) 24 | with four = (loop for f in fish count (= 4 f)) 25 | with five = (loop for f in fish count (= 5 f)) 26 | with six = (loop for f in fish count (= 6 f)) 27 | with seven = (loop for f in fish count (= 7 f)) 28 | with eight = (loop for f in fish count (= 8 f)) 29 | for day from 1 upto days 30 | do (psetf eight zero 31 | seven eight 32 | six (+ zero seven) 33 | five six 34 | four five 35 | three four 36 | two three 37 | one two 38 | zero one) 39 | finally (return (+ zero one two three four five six seven eight)))) 40 | -------------------------------------------------------------------------------- /src/d7.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun submarines () 4 | (loop for raw-submarine in (uiop:split-string 5 | (uiop:read-file-line 6 | (asdf:system-relative-pathname :aoc-in-loop "input/d7.in")) 7 | :separator '(#\,)) 8 | collect (parse-integer raw-submarine))) 9 | 10 | (defun mean (list) 11 | (loop for e in list 12 | sum e into sum 13 | finally (return (round (/ sum (length list)))))) 14 | 15 | (defun standard-deviation (list) 16 | (loop with mean = (mean list) 17 | for e in list 18 | sum (expt (- e mean) 2) into sum-of-squares 19 | finally (return (sqrt (/ sum-of-squares (1- (length list))))))) 20 | 21 | (defun sigma-fuel-function (n) 22 | (/ (+ (expt n 2) n) 2)) 23 | 24 | (defun d7 (&optional (submarines (submarines)) (fuel-function #'identity)) 25 | "TIL that 26 | - Knowing statistics is helpful. 27 | - Mean and deviation still help, even in highly dispersed samples. 28 | - It seems quite unavoidable having `finally (return...)' clause in any non-trivial LOOP. 29 | - What a shame. 30 | 31 | How does one optimize statistical calculations?" 32 | (loop with mean = (mean submarines) 33 | with delta = (round (/ (standard-deviation submarines) 2)) 34 | for alignment from (max 0 (- mean delta)) 35 | upto (+ mean delta) 36 | minimize (loop for sub in submarines 37 | sum (funcall fuel-function (abs (- sub alignment)))))) 38 | -------------------------------------------------------------------------------- /src/d8.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun letters->integers (string) 4 | (loop for letter across string 5 | collect (- (char-code letter) (char-code #\a)))) 6 | 7 | (defun segment-digits () 8 | (loop for line in (uiop:read-file-lines 9 | (asdf:system-relative-pathname :aoc-in-loop "input/d8.in")) 10 | for split-line = (uiop:split-string line :separator '(#\|)) 11 | collect (list (loopcar #'letters->integers 12 | (loopmove-if #'uiop:emptyp 13 | (uiop:split-string (first split-line)))) 14 | (loopcar #'letters->integers 15 | (loopmove-if #'uiop:emptyp 16 | (uiop:split-string (second split-line))))))) 17 | 18 | (defun d8-1 () 19 | (loop for (in out) in (segment-digits) 20 | sum (loop for o in out 21 | count (= (length o) 2) 22 | count (= (length o) 3) 23 | count (= (length o) 4) 24 | count (= (length o) 7)))) 25 | 26 | (defun find-by-length (list length) 27 | (loop for e in list 28 | when (= (length e) length) 29 | do (return e))) 30 | 31 | (defun orderless-equal (a b) 32 | (zerop (+ (length (loop-diff a b)) 33 | (length (loop-diff b a))))) 34 | 35 | (defun decode-segments (inputs) 36 | (loop with one = (find-by-length inputs 2) 37 | with three = (loop for in in inputs 38 | when (and (= (length in) 5) 39 | (orderless-equal in (loop-unite one in))) 40 | do (return in)) 41 | with seven = (find-by-length inputs 3) 42 | with six = (loop for in in inputs 43 | when (and (= (length in) 6) 44 | (= (length (loop-intersect in one)) 1)) 45 | do (return in)) 46 | with four = (find-by-length inputs 4) 47 | with eight = (find-by-length inputs 7) 48 | with nine = (loop for in in inputs 49 | when (and (= (length in) 6) 50 | (= (length (loop-diff in three)) 1)) 51 | do (return in)) 52 | with zero = (loop for in in inputs 53 | when (and (= (length in) 6) 54 | (not (orderless-equal in nine)) 55 | (not (orderless-equal in six))) 56 | do (return in)) 57 | with five = (loop for in in inputs 58 | when (and (= (length in) 5) 59 | (= (length (loop-intersect in six)) 5)) 60 | do (return in)) 61 | with two = (loop for in in inputs 62 | when (and (= (length in) 5) 63 | (not (orderless-equal in five)) 64 | (not (orderless-equal in three))) 65 | do (return in)) 66 | initially (return (list zero one two three four five six seven eight nine)))) 67 | 68 | (defun d8-2 () 69 | "TIL that: 70 | - `loop' does get cumbersome on the tasks it's not really well-tailored for. 71 | - One, however, can never encounter such tasks. 72 | - `loop' is bad for logic programming, as building sets of conditions 73 | for it is too wordy, compared to e.g., `cond' or `case'. 74 | - Strings are better transformed into lists, as loop is still bad with arrays. 75 | - Loop is bad at type-checking. Well... any compiler is bad at type 76 | checking, because it doesn't know what my domain is. If my domain is 77 | sets of numbers that always have the number I look for, I can afford 78 | having `when x do (return y)' with no `finally (return z)' simply 79 | because my domain allows that. Compilers have no knowledge of this, 80 | unfortunately." 81 | (loop for (inputs outputs) in (segment-digits) 82 | for decoding = (decode-segments inputs) 83 | sum (loop for order from 3 downto 0 84 | for out in outputs 85 | sum (* (expt 10 order) 86 | (loop for de in decoding 87 | for i upto 9 88 | when (orderless-equal de out) 89 | do (return i)))))) 90 | -------------------------------------------------------------------------------- /src/d9.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun heightmap () 4 | (read-matrix (asdf:system-relative-pathname :aoc-in-loop "input/d9.in"))) 5 | 6 | (defun 4-neighbors (point map) 7 | (loop for (xdiff ydiff) in '((0 1) (1 0) (0 -1) (-1 0)) 8 | for x = (first point) 9 | for y = (second point) 10 | when (and (<= 0 (+ xdiff x) (1- (length map))) 11 | (<= 0 (+ ydiff y) (1- (length (first map))))) 12 | collect (list (+ xdiff x) (+ ydiff y)))) 13 | 14 | (defun low-points (map) 15 | (loop for x below (length map) 16 | append (loop for y below (length (first map)) 17 | when (loop for neigh in (4-neighbors (list x y) map) 18 | unless (< (mref map x y) 19 | (mref map (first neigh) (second neigh))) 20 | do (return nil) 21 | finally (return t)) 22 | collect (list x y)))) 23 | 24 | (defun d9-1 () 25 | (loop with map = (heightmap) 26 | for (x y) in (low-points map) 27 | sum (1+ (mref map x y)))) 28 | 29 | (defun drain-frontier (frontier map) 30 | (loop with basin = nil 31 | while frontier 32 | do (setf frontier 33 | (loop for f in frontier 34 | unless (null f) 35 | append (loopmove-if 36 | (lambda (x) 37 | (or (= 9 (mref map (first x) (second x))) 38 | (loopind x basin))) 39 | (4-neighbors f map)) 40 | ;; Yes, I've given up on replacing pushnew. 41 | and do (pushnew f basin :test #'equal))) 42 | finally (return basin))) 43 | 44 | (defun basins (map) 45 | (loop with map = map 46 | with low-points = (low-points map) 47 | with frontiers = (loopcar #'list low-points) 48 | with basins = (loopcar (lambda (f) (drain-frontier f map)) frontiers) 49 | initially (return basins))) 50 | 51 | (defun d9-2 () 52 | "TIL that 53 | - `loop' imposes a C-like programming style with a 54 | declarations-(iteration|condition)-return structure. 55 | - Array crunching is quirky to do in any language, including CL. 56 | 57 | I've been lucky with my puzzle input today, because I'm not checking 58 | for local optima in my solution and a good puzzle input would've 59 | revealed that." 60 | (loop with map = (heightmap) 61 | with basins = (basins map) 62 | with max = 0 and second-max and third-max 63 | for basin in basins 64 | if (> (length basin) max) 65 | do (setf third-max second-max 66 | second-max max 67 | max (length basin)) 68 | else if (> (length basin) second-max) 69 | do (setf third-max second-max 70 | second-max (length basin)) 71 | else if (> (length basin) third-max) 72 | do (setf third-max (length basin)) 73 | finally (return (* max second-max third-max)))) 74 | -------------------------------------------------------------------------------- /src/generic.lisp: -------------------------------------------------------------------------------- 1 | (in-package :aoc-in-loop) 2 | 3 | (defun loopmove-if (predicate list) 4 | "A loop-based copy of `remove-if'." 5 | (loop for l in list 6 | unless (funcall predicate l) 7 | collect l)) 8 | 9 | (defun loopmove (item list) 10 | (loopmove-if (lambda (i) (equal i item)) list)) 11 | 12 | (defun loopcar (function list) 13 | "A loop-based copy of `mapcar'." 14 | (loop for l in list 15 | collect (funcall function l))) 16 | 17 | (defun loopind (item list) 18 | "A loop-based copy of `find'." 19 | (loop for e in list 20 | when (equalp item e) 21 | do (return t) 22 | finally (return nil))) 23 | 24 | (defun loopverse (list) 25 | "A loop-based copy of `reverse'." 26 | (loop for i from (1- (length list)) downto 0 27 | collect (elt list i))) 28 | 29 | (defun loop-diff (l1 l2) 30 | "A loop-based copy of `set-difference'." 31 | (loop for e1 in l1 32 | unless (loopind e1 l2) 33 | collect e1)) 34 | 35 | (defun loop-unite (l1 l2) 36 | "A loop-based copy of `union'." 37 | (loop repeat 1 38 | append (loop for e in l1 39 | unless (loopind e result1) 40 | collect e into result1 41 | finally (return result1)) 42 | into result 43 | append (loop for e in l2 44 | unless (or (loopind e result) 45 | (loopind e result2)) 46 | collect e into result2 47 | finally (return result2)) 48 | into result 49 | finally (return result))) 50 | 51 | (defun loop-intersect (l1 l2) 52 | "A loop-based copy of `intersection'." 53 | (loop for e in l1 54 | when (loopind e l2) 55 | collect e)) 56 | 57 | (defun loop-sort (list) 58 | "A terribly ineffective and duplicate-removing sorting algo." 59 | (loop while list 60 | collect (loop for elem in list 61 | maximize elem into max 62 | finally (progn 63 | (setf list (loopmove max list)) 64 | (return max))))) 65 | 66 | (defun read-matrix (file &optional (processing-fn #'(lambda (char) 67 | (- (char-code char) (char-code #\0))))) 68 | (loop for line in (uiop:read-file-lines file) 69 | collect (loop for char across line 70 | collect (funcall processing-fn char)))) 71 | 72 | (defun mref (matrix x y) 73 | (elt (elt matrix x) y)) 74 | 75 | (defun (setf mref) (value matrix x y) 76 | (setf (elt (elt matrix x) y) 77 | value)) 78 | 79 | (defun loopmove-duplicates (list) 80 | (loop for elem in list 81 | unless (loopind elem new-list) 82 | collect elem into new-list 83 | finally (return new-list))) 84 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :aoc-in-loop 2 | (:nicknames :aoc-loop :aoc) 3 | (:use :cl)) 4 | --------------------------------------------------------------------------------