diff options
Diffstat (limited to '2022')
| -rw-r--r-- | 2022/puzzle-1.lisp | 26 | ||||
| -rw-r--r-- | 2022/puzzle-2.lisp | 54 | ||||
| -rw-r--r-- | 2022/puzzle-3.lisp | 67 | ||||
| -rw-r--r-- | 2022/puzzle-4.lisp | 59 |
4 files changed, 206 insertions, 0 deletions
diff --git a/2022/puzzle-1.lisp b/2022/puzzle-1.lisp new file mode 100644 index 0000000..3a1510e --- /dev/null +++ b/2022/puzzle-1.lisp @@ -0,0 +1,26 @@ +(defvar input (uiop:read-file-string "2022/1-input")) +(defvar *sep (format nil "~%~%")) + +(defun get-lists (input) + (let ((pos (search *sep input))) + (with-input-from-string (s (subseq input 0 pos)) + (let ((converted + (loop + for line = (read-line s nil nil) + while line + collect (parse-integer line)))) + (if (null pos) + (list converted) + (cons converted + (get-lists (subseq input (+ pos 2))))))))) + +(defvar sums (sort (mapcar (lambda (lst) (reduce #'+ lst)) (get-lists input)) #'>)) + +;; First challenge +(format t "Top snacks: ~a" (car sums)) + +;; Second challenge +(let ((first (car sums)) + (second (car (cdr sums))) + (third (car (cdr (cdr sums))))) + (format t "~a,~a,~a:>~a" first second third (+ first second third))) diff --git a/2022/puzzle-2.lisp b/2022/puzzle-2.lisp new file mode 100644 index 0000000..b3b0155 --- /dev/null +++ b/2022/puzzle-2.lisp @@ -0,0 +1,54 @@ +(defvar input (uiop:read-file-string "2022/2-input")) +;; Each newline represents a new round, which we should parse on the go + +(defun sensible-convert-input (str) + (cond + ((or (string= str "X") (string= str "A")) 0) + ((or (string= str "Y") (string= str "B")) 1) + ((or (string= str "Z") (string= str "C")) 2))) + +;; Round 1 +(defvar rounds + (with-input-from-string (stream input) + (loop + for strategy = (read-line stream nil) + until (null strategy) + collect + (let ((opponent (subseq strategy 0 1)) + (yours (subseq strategy 2 3))) + (list (sensible-convert-input opponent) (sensible-convert-input yours)))))) + +(loop + for round in rounds + until (null round) + sum + (destructuring-bind (opp you) round + (+ + 1 you ;; base score + (cond ; outcome score + ((eq you opp) 3) + ((eq (mod (+ 1 opp) 3) you) 6) + (t 0))))) + +;; Round 2. + +;; We can still use the same rounds data as previously, just +;; reinterpret it in when doing the sum. + +(defun get-correct-choice (opponent outcome) + (case outcome + (0 (mod (- opponent 1) 3)) + (1 opp) + (2 (mod (+ 1 opponent) 3)) + (t 0))) + +(loop for round in rounds + sum + (destructuring-bind (opp you) round + (let ((choice (get-correct-choice opp you))) + (+ 1 choice + (case you ;; outcome -> score + (0 0) + (1 3) + (2 6) + (t 0)))))) diff --git a/2022/puzzle-3.lisp b/2022/puzzle-3.lisp new file mode 100644 index 0000000..c5ee3d3 --- /dev/null +++ b/2022/puzzle-3.lisp @@ -0,0 +1,67 @@ +(defvar input (uiop:read-file-string "2022/3-input")) + +(defun split-string-in-two (s) + (let ((len (length s))) + (list (subseq s 0 (/ len 2)) (subseq s (/ len 2))))) + +(defvar inputs (with-input-from-string (s input) + (loop + for line = (read-line s nil) + until (null line) + collect (split-string-in-two line)))) + +(defun string-to-clist (str) + (loop for char across str collect char)) + +(defun common-types (s1 s2) + (car (intersection + (string-to-clist s1) + (string-to-clist s2)))) + +(defvar shared (mapcar (lambda (x) + (destructuring-bind (s1 s2) x + (common-types s1 s2))) + inputs)) + +(defun priority-map (c) + (if (upper-case-p c) + (+ 27 (- (char-code c) (char-code #\A))) + (+ 1 (- (char-code c) (char-code #\a))))) + +(defvar round-1-answer (reduce #'+ (mapcar #'priority-map shared))) + +;; Round 2 + +;; Simple recursive algorithm which produces consecutive groups of 3 elements +(defun group-by-3 (lst) + (if (null lst) + nil + (cons + (list (car lst) (car (cdr lst)) (car (cdr (cdr lst)))) + (group-by-3 (cdr (cdr (cdr lst))))))) + +;; Note the use of group-by-3 here +(defvar inputs (group-by-3 + (with-input-from-string (s input) + (loop + for line = (read-line s nil) + until (null line) + collect line)))) + +;; Extend intersection to three +(defun common-types-3 (s1 s2 s3) + (car + (intersection + (string-to-clist s1) + (intersection + (string-to-clist s2) + (string-to-clist s3))))) + +;; Extend the destructuring bind and use of common-types-3 +(defvar shared (mapcar (lambda (x) + (destructuring-bind (s1 s2 s3) x + (common-types-3 s1 s2 s3))) + inputs)) + +;; Same as before +(defvar round-2-answer (reduce #'+ (mapcar #'priority-map shared))) diff --git a/2022/puzzle-4.lisp b/2022/puzzle-4.lisp new file mode 100644 index 0000000..04c7bfb --- /dev/null +++ b/2022/puzzle-4.lisp @@ -0,0 +1,59 @@ +;; Example input: a-b,c-d which denotes [a,b] and [c,d] + +;; We want to find if [c,d] < [a,b] or vice versa (complete inclusion) +;; and since we're working with integers, it's simply checking if the +;; bounds are included i.e. c in [a,b] and d in [a,b] + +(defvar input (uiop:read-file-string "2022/4-input")) + +(defun parse-bound (str) + "Given STR=\"a-b\" return (a b)" + (let* ((sep (search "-" str)) + (first (subseq str 0 sep)) + (second (subseq str (+ sep 1)))) + (list (parse-integer first) (parse-integer second)))) + +(defvar completed-parse + (with-input-from-string (s input) + (loop for line = (read-line s nil) + until (null line) + collect + ;; given a-b,c-d we want ((a b) (c d)) + (let* ((sep (search "," line)) + (first-bound (subseq line 0 sep)) + (second-bound (subseq line (+ sep 1)))) + (list (parse-bound first-bound) (parse-bound second-bound)))))) + +(defun complete-inclusion (first-bound second-bound) + (destructuring-bind (a b) first-bound + (destructuring-bind (c d) second-bound + (or + (and + (>= a c) (<= a d) + (>= b c) (<= b d)) + (and + (>= c a) (<= c b) + (>= d a) (<= d b)))))) + +(defvar round-1-answer (length (remove-if #'null + (mapcar (lambda (pair) + (destructuring-bind (first second) pair + (complete-inclusion first second))) + completed-parse)))) + +;; Round 2: any overlap at all. Basically just overhaul the inclusion +;; function and then do the same answer checking. +(defun any-inclusion (first second) + (destructuring-bind (a b) first + (destructuring-bind (c d) second + ;; How about doing this through negation? [a,b] does not overlap with [c,d] at all if either b < c or a > d. + (not + (or + (< b c) + (> a d)))))) + +(defvar round-2-answer (length (remove-if #'null + (mapcar (lambda (pair) + (destructuring-bind (first second) pair + (any-inclusion first second))) + completed-parse)))) |