aoc-2022/elisp/day-5/solution.el

#!/usr/bin/env -S emacs --script

;; -*- lexical-binding: t; -*-

;; Copyright (C) 2022 notroot

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(add-to-list 'load-path default-directory)

(require 'cl-lib)
(require 'eieio)
(require 'ert)
(require 'advent-of-code)

(defmacro -make-crates (&rest exprs)
  `(make-advent-of-code-day-5-crates ,@exprs))

(defmacro -make-crates-multimove (&rest exprs)
  `(make-advent-of-code-day-5-crates-multimove ,@exprs))

(cl-defstruct -crates
  stacks)

(cl-defstruct (-crates-multimove (:include -crates)))

(defun -crates-pop (crates n)
  (with-slots (stacks) crates
    (when-let ((stack (assoc n stacks)))
      (pop (cdr stack)))))

(defun -crates-push (crates crate n)
  (with-slots (stacks) crates
    (if-let ((stack (assoc n stacks)))
        (push crate (cdr stack))
      (push (cons n (list crate)) stacks))))

(defun -crates-append (crates crate n)
  (with-slots (stacks) crates
    (if-let ((stack (assoc n stacks)))
        (setf (cdr stack) (append (cdr stack) (list crate)))
      (push (cons n (list crate)) stacks))))

(cl-defgeneric -crates-process-move (crates move)
  (with-slots (n from to) move
    (cl-loop repeat n
             do (-crates-push crates (-crates-pop crates (- from 1)) (- to 1)))))

(cl-defmethod -crates-process-move ((crates -crates-multimove) move)
  (if (= 1 (-move-n move))
      (cl-call-next-method)
    (with-slots (stacks) crates
      (let ((n (-move-n move))
            (from (- (-move-from move) 1))
            (to (- (-move-to move) 1)))
        (setf (alist-get to stacks) (append (seq-take (alist-get from stacks) n)
                                            (alist-get to stacks)))
        (setf (alist-get from stacks) (seq-drop (alist-get from stacks) n))))))

(defun -crates-process-moves (crates moves)
  (cl-loop for move in moves
           do (-crates-process-move crates move)))

(defun -crates-init (crates input)
  (cl-loop for (crate . n) in input
           do (-crates-append crates crate n)
           finally (return crates)))

(defmacro -make-move (&rest exprs)
  `(make-advent-of-code-day-5-move ,@exprs))

(cl-defstruct -move
  n from to)

(defun -parse-input-into-parts (input)
  (let* ((delimiter (seq-position input "" 'string=))
         (crates (seq-subseq input 0 (- delimiter 1)))
         (moves (seq-subseq input (+ delimiter 1))))
    (list crates moves)))

(defun -parse-crates-into-conses-from-line (line)
  (cl-loop for i from 0 to (- (length line) 3) by 4
           for n from 0
           for crate = (substring line i (+ i 3))
           for crate-id = (substring crate 1 2)
           for empty? = (not (string-match-p "[^\s\n]" crate))
           if (not empty?)
           collect (cons crate-id n)))

(defun -parse-move-into-parts-from-line (line)
  (save-match-data
    (string-match (rx "move" space (group (one-or-more digit)) space
                      "from" space (group (one-or-more digit)) space
                      "to" space (group (one-or-more digit)))
                  line)
    (list (string-to-number (match-string 1 line))
          (string-to-number (match-string 2 line))
          (string-to-number (match-string 3 line)))))

(defun -make-list-of-move-structs-from-input (input-moves)
  (cl-loop for line in input-moves
           for move = (pcase-let ((`(n from to) (-parse-move-into-parts-from-line line)))
                        (-make-move :n n :from from :to to))
           collect move))

(defun -solution (crates input)
  (pcase-let ((`(,input-crates ,input-moves) (-parse-input-into-parts input)))
    (-crates-init crates
                  (cl-loop for line in input-crates
                           append (-parse-crates-into-conses-from-line line)))
    (-crates-process-moves crates
                           (cl-loop for line in input-moves
                                    for move = (seq-let (n from to) (-parse-move-into-parts-from-line line)
                                                 (-make-move :n n :from from :to to))
                                    collect move))
    (cl-loop for n from 0 to (length (-crates-stacks crates))
             for top = (car (alist-get n (-crates-stacks crates)))
             for result = top then (seq-concatenate 'string result top)
             finally (return result))))
    

(ert-deftest -test-part-1-example ()
  (should (equal (-solution (-make-crates)
                          (aoc-read-file-lines "example.txt"))
                 "CMZ")))

(ert-deftest -test-part-1 ()
  (should (equal (-solution (-make-crates)
                          (aoc-read-file-lines "input.txt"))
                 "CFFHVVHNC")))

(ert-deftest -test-part-2-example ()
  (should (equal (-solution (-make-crates-multimove)
                            (aoc-read-file-lines "example.txt"))
                 "MCD")))

(ert-deftest -test-part-2 ()
  (should (equal (-solution (-make-crates-multimove)
                            (aoc-read-file-lines "input.txt"))
                 "FSZWBPTBG")))

(when noninteractive
  (ert-run-tests-batch))

;; Local Variables:
;; read-symbol-shorthands: (("-" . "advent-of-code-day-5-") ("aoc-" . "advent-of-code-"))
;; End: