advent-of-code-2022/day-05/part-02.scm

(import
 (except (rnrs base) let-values map)
 (only (guile)
       lambda* λ
       string-split
       string->number
       string-join)
 (fileio)
 (srfi srfi-1)
 (srfi srfi-8)
 (srfi srfi-11)
 (ice-9 pretty-print)
 (ice-9 match))


(define split-list
  (λ (lst pred)
    (let iter ([lst° lst]
               [cont (λ (acc-split-off remaining)
                       (values acc-split-off remaining))])
      (cond
       [(null? lst°)
        (cont '() '())]
       [(pred (car lst°))
        (cont '() (cdr lst°))]
       [else
        (iter (cdr lst°)
              (λ (split-off remaining)
                (cont (cons (car lst°) split-off)
                      remaining)))]))))


(define split-stack-config-string
  (λ (str)
    ;; |0123456789
    ;; |[T] [L] [D] [G] [P] [P] [V] [N] [R]
    (let ([positions '(1 5 9 13 17 21 25 29 33)])
      (map (λ (pos) (substring str pos (+ pos 1)))
           positions))))


(define transpose
  (λ (mat)
    (let iter ([mat° mat] [transposed '()])
      (cond
       [(null? (car mat°)) transposed]
       [else
        (iter (map (λ (row) (cdr row)) mat°)
              (cons (map (λ (row) (car row)) mat°) transposed))]))))


(define execute-move
  (λ (amount from to stacks)
    (let iter ([stack-index 1] [stacks° stacks])
      (cond
       [(null? stacks°) '()]
       [(= stack-index from)
        (cons (drop (first stacks°) amount)
              (iter (+ stack-index 1)
                    (drop stacks° 1)))]
       [(= stack-index to)
        (cons (append (take (list-ref stacks (- from 1)) amount)
                      (first stacks°))
              (iter (+ stack-index 1)
                    (drop stacks° 1)))]
       [else
        (cons (first stacks°)
              (iter (+ stack-index 1)
                    (drop stacks° 1)))]))))


(define run-move
  (λ (move-str stacks)
    (display (simple-format #f "running move: ~a\n" move-str))
    (match (string-split move-str #\space)
      [(_1 amount-str _2 from-str _3 to-str)
       (let ([amount (string->number amount-str)]
             [from (string->number from-str)]
             [to (string->number to-str)])
         (execute-move amount from to stacks))]
      [_ (error "unrecognized move")])))


(define lines (get-lines-from-file "input"))
(define-values (stacks-config moves) (split-list lines string-null?))
(define initial-stacks
  (reverse
   (map (λ (stack)
          (filter (λ (elem)
                    (and (not (string=? " " elem))
                         (not (string->number elem))))
                  stack))
        (transpose
         (map split-stack-config-string stacks-config)))))

(pretty-print initial-stacks)

(define final-stacks
  (let iter ([moves° moves] [stacks° initial-stacks])
    (cond
     [(null? moves°) stacks°]
     [else
      (iter (cdr moves°)
            (run-move (car moves°)
                      stacks°))])))


(pretty-print final-stacks)
(pretty-print (string-join (map (λ (stack) (car stack)) final-stacks) ""))