advent-of-code-2023/advent-of-code/2023/05/part2.scm

#!/usr/bin/env guile
!#

(use-modules (ice-9 rdelim))

(define port (open-input-file "input"))

(define seed 
  (let ()
    (define nums-str 
      (string-trim
          (list-ref (string-split (read-line port) #\:) 1)))
    (define (pairing l)
      (define (loop ret l)
        (if (null? l)
          ret
          (loop
            (cons (cons 
                    (car l) 
                    (+ (car l) (cadr l)))
                  ret)
            (cddr l))))
      (loop '() l))
    (reverse 
      (pairing (map string->number (string-split nums-str #\space))))))

(read-line port)

(define (read-line-convert-eof port)
  (define line (read-line port))
  (if (eof-object? line) "" line))

(define (read-map)
  (define (loop ret)
    (define line (string-trim (read-line-convert-eof port)))
    (if (= 0 (string-length line))
      (sort (reverse ret) (lambda (x y) (< (cadr x) (cadr y))))
      (loop (cons (map string->number (string-split line #\space))
                  ret))))
  (read-line port)
  (loop '()))

(define s2s (read-map))
(define s2f (read-map))
(define f2w (read-map))
(define w2l (read-map))
(define l2t (read-map))
(define t2h (read-map))
(define h2l (read-map))
(define maps (list s2s s2f f2w w2l l2t t2h h2l))

(define (range-map mlist r)
  ;; r :: Range :: (start . end)
  ;; mlist :: List of (Map :: (dest, src, len))
  (define (loop result mlist r)
    (define start (car r))
    (define end (cdr r))
    (if (null? mlist)
      (cons r result)
      (let ()
        (define cur-map (car mlist))
        (define map-target (car cur-map))
        (define map-start (cadr cur-map))
        (define map-end (+ map-start (caddr cur-map)))
        (define offset (- map-target map-start))
        (define (pair-offset p) (cons (+ offset (car p)) (+ offset (cdr p))))
        (cond ((<= end start)
                    result)
              ((>= start map-end)
                    (loop result (cdr mlist) r))
              ((>= start map-start)
                    (loop
                      (cons (pair-offset (cons start (min end map-end)))
                            result)
                      (cdr mlist)
                      (cons (min end map-end) end)))
              ((<= end map-start)
                    (cons r result))
              ((< start map-start)
                    (loop
                      (cons (cons start map-start) result)
                      mlist
                      (cons map-start end)))
              (else (error "unhandled cond in range-map"))))))
  (reverse (loop '() mlist r)))

(define (gen-range-mapper the-map)
  (define (mapper range-list)
    (apply append
        (map 
            (lambda (range)
              (range-map the-map range)) 
            range-list)))
  mapper)

(define mappers (map gen-range-mapper maps))

(define (comp-func funcs)
  (define procs (reverse funcs))
  (define (comp-rec arg)
    (if (null? procs)
        arg
        (let ((proc (car procs))
              (rest (cdr procs)))
          (set! procs rest)
          (proc (comp-rec arg)))))
  comp-rec)

(define (find-location x)
  ((comp-func mappers) x))

(display (apply min (map car (find-location seed))))