Advent of Code, 2022, Day 05, Common Lisp solution by Rainer Joswig

aoc2022-05.lisp

;;; -*- Syntax: ANSI-Common-Lisp; Package: CL-USER -*-

;;; Author: Rainer Joswig, joswig@lisp.de, 2022
;;; This code is written in portable Common Lisp.

; https://adventofcode.com/2022/day/5

(defparameter *file05*
  (if (member :lispm *features*)
      (pathname "rjmbp:/Users/joswig/Lisp/aoc2022/input-5.txt")
      (pathname "/Users/joswig/Lisp/aoc2022/input-5.txt"))
  "The provided input file with the description of the stacks
 and the list of moves.")

; ================================================================
; Utilities

(defun collect-non-empty-lines-from-stream (stream)
  "returns a list of non-empty-lines read from the stream
 until EOF or an empty line"
  (loop for line = (read-line stream nil nil)
	while (and line (plusp (length line)))
	collect line))

#-lispworks
(defun split-sequence (char-bag sequence &key (test #'char=) (one-item-splits-p nil))
  "Splits the sequence into subsequences at elements of the sequence char-bag.
Returns a list of sequences."
  (let ((len (length sequence))
        (index 0)
        result)
    (dotimes (i len (progn (unless (= index len)
                             (push (subseq sequence index) result))
                           (reverse result)))
      (when (some (lambda (item)
		    (funcall test (elt sequence i) item))
		  char-bag)
        (unless (and (not one-item-splits-p) (= index i))
          (push (subseq sequence index i) result))
        (setf index (1+ i))))))

; (split-sequence " " "a b  c")
; (split-sequence " " '(#\a #\space #\b #\space #\space #\c) :one-item-splits-p t)
; (split-sequence " " '(#\a #\space #\b #\space #\space #\c) :one-item-splits-p nil)


; ================================================================
; Reading the preamble

; The preamble is a description of the stacks.
;
;         [F] [Q]         [Q]        
; [B]     [Q] [V] [D]     [S]        
; [S] [P] [T] [R] [M]     [D]        
; [J] [V] [W] [M] [F]     [J]     [J]
; [Z] [G] [S] [W] [N] [D] [R]     [T]
; [V] [M] [B] [G] [S] [C] [T] [V] [S]
; [D] [S] [L] [J] [L] [G] [G] [F] [R]
; [G] [Z] [C] [H] [C] [R] [H] [P] [D]
;  1   2   3   4   5   6   7   8   9 

(defun get-element (lines stack-number n)
  "We look in the list of lines for the element in position
stack-number, element number n.
Stack-numbers increase from left to right.
It returns the character or NIL if there is none."
  (let ((element (aref (elt lines n)
                       (+ 1 (* stack-number 4)))))
    (when (alpha-char-p element)
      element)))

(defun read-preamble (stream)
  "First we collect the lines. Then we compute the number of stacks.
Then we read the characters at each stack.
The result is a vector of lists. Each list represents one stack."
  (let* ((all-lines (collect-non-empty-lines-from-stream stream))
         (lines (coerce (butlast all-lines) 'vector))
         (number-line (first (last all-lines)))
         (number-of-stacks (/ (1+ (length number-line)) 4)))
    (flet ((read-stack (lines i &aux stack)
             "Returns a list of elements on the stack."
             (loop for j downfrom (1- (length lines)) to 0
                   for element = (get-element lines i j)
                   while element
                   do (push element stack))
             stack))
      (coerce (loop for i below number-of-stacks
		    collect (read-stack lines i))
	      'vector))))

(defun show-stacks (stacks)
  "Print the stacks contents."
  (terpri)
  (loop for stack across stacks and i from 1
        do (format t "~%~a ~a" i (nreverse (coerce stack 'string))))
  (terpri)
  (terpri)
  stacks)

; ================================================================
; Moving crates

; Stacks is a vector of lists. Each list is a single stack.
; Elements in the lists are characters as stack contents.

; We are reading and executing the move instructions.

; Example move instructions:
;
; move 3 from 5 to 2
; move 3 from 8 to 4
; move 7 from 7 to 3
; move 14 from 3 to 9
; move 8 from 4 to 1


(defun move-crate-1 (stacks n from to)
  "Moving crates for solution part 1.
We move n crates one by one from stack number FROM to stack number TO.
The operation is destructive and returns the same stacks vector,
but updated. We pop an element from one stack and push it on the
other stack. This is done n times."
  (loop repeat n
	do (push (pop (svref stacks from))
		 (svref stacks to)))
  stacks)

(defun move-crate-2 (stacks n from to)
  "Moving crates for solution part 2.
We move n crates from stack number FROM to stack number TO.
The operation is destructive and returns the same stacks vector,
but updated. We pop n elements from one stack and make a new list
out of it. This list is then the new stack content and we append
the prior of the TO stack to the end."
  (setf (svref stacks to)
	(nconc (loop repeat n
		     collect (pop (svref stacks from)))
	       (svref stacks to)))
  stacks)

(defun execute-moves (stream stacks move-crate-fn)
  "Each move tells us to move N crates from stack number FROM to stack number TO.
The move function gets passed in and we call it for each line contents, which
is read from the stream.
Each move updates the stacks vector destructively.
The stacks vector is returned on EOF."
  (loop for line = (read-line stream nil nil)
        while line
        do (destructuring-bind (move-string n from-string from to-string to)
	       (split-sequence " " line)
	     (declare (ignore move-string from-string to-string))	   
             (funcall move-crate-fn stacks
		      (parse-integer n)
                      (1- (parse-integer from))
                      (1- (parse-integer to)))))
  stacks)

(defun tops-of-stacks (stacks)
  "The tops of the stacks in the stacks vector are their first elements.
Those elements are characters.
We construct a string from these elements, which is returned."
  (map 'string #'first stacks))

; ================================================================
; Solve AOC 2022 Day 05

(defun aoc2022-05 (&optional (file *file05*))
  "This is the solution for AOC 2022 Day 05, part 1 and 2.
The function reads uses the provided input file and returns
the results as two values. These values are the result strings."
  (flet ((solve (fn)
	   (with-open-file (s file)
	     (tops-of-stacks (execute-moves s (read-preamble s) fn))))
         (display-stacks ()
           (with-open-file (s file)
	     (show-stacks (read-preamble s)))))
    (format t "~%~%The initial stacks.")
    (display-stacks)
    (values (solve #'move-crate-1)
            (solve #'move-crate-2))))

; (aoc2022-05)

; ================================================================
; End of File