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

(import
 (except (rnrs base)
         let-values
         map
         error
         vector-map)
 (only (guile)
       lambda* λ
       simple-format
       current-output-port)
 (fileio)
 ;; (ice-9 pretty-print)
 (ice-9 peg)
 (prefix (peg-tree-utils) peg-tree:)
 ;; (ice-9 format)
 (srfi srfi-1)
 (pipeline)
 (debug)
 (list-helpers)
 (parallelism)
 (math))


(define input-filename "input")


;; QLIST -- Merely adding a Q to avoid any name clashes, either actual
;; ones or in my mind.
(define-peg-pattern COMMA none ",")
(define-peg-pattern NUMBER all (+ (range #\0 #\9)))
(define-peg-pattern QOPEN none "[")
(define-peg-pattern QCLOSE none "]")
(define-peg-pattern QLIST-ITEM body (or NUMBER QLIST))
(define-peg-pattern QLIST-ALL-ITEMS all (* (and QLIST-ITEM (? COMMA))))
(define-peg-pattern QLIST all (and QOPEN QLIST-ALL-ITEMS QCLOSE))


(define parse-string-list
  (λ (str)
    (let ([tree (peg:tree (match-pattern QLIST str))])
      tree)))


(define parsed-list->list
  (λ (plist)
    (let ([label (first plist)])
      (cond
       [(eq? label 'NUMBER)
        (string->number (second plist))]
       [(eq? label 'QLIST)
        (map parsed-list->list
             (peg-tree:tree-refs plist '(QLIST-ALL-ITEMS) #:equal-test eq?))]
       [else (error "unrecognized parsed list" plist)]))))


(define list-transformer
  (λ (list-str)
    (-> list-str parse-string-list parsed-list->list)))


(define less
  (λ (lst1 lst2)
    (define compare
      ;; Usage of a continuation for the equals case avoids having to
      ;; encode the results of <, =, > in 3 values like 1, 0, -1.
      (λ (lst1° lst2° equal-case-cont)
        ;; (simple-format #t "comparing:\n~a\n~a\n" lst1° lst2°)
        (cond
         [(and (null? lst1°) (null? lst2°)) (equal-case-cont)]
         [(null? lst2°) #f]
         [(null? lst1°) #t]
         ;; no list ran out of elements yet -- OK!
         [else
          (let ([elem1 (first lst1°)] [elem2 (first lst2°)])
            (cond
             ;; both contain a list as first element
             [(and (or (pair? elem1) (null? elem1))
                   (or (pair? elem2) (null? elem2)))
              (compare elem1
                       elem2
                       ;; Build a new continuation. Compare this cdr,
                       ;; but also keep the outer cdr compare
                       ;; continuation.
                       (λ ()
                         (compare (cdr lst1°)
                                  (cdr lst2°)
                                  equal-case-cont)))]
             ;; both a number
             [(and (number? elem1) (number? elem2))
              ;; need to distinguish equals case
              (cond
               [(< elem1 elem2) #t]
               [(= elem1 elem2)
                (compare (cdr lst1°)
                         (cdr lst2°)
                         equal-case-cont)]
               [(> elem1 elem2) #f])]

             ;; transform into a list if not both a list
             [(and (number? elem1) (not (number? elem2)))
              (less (cons (list elem1) (cdr lst1°)) lst2°)]
             [(and (not (number? elem1)) (number? elem2))
              (less lst1° (cons (list elem2) (cdr lst2°)))]

             ;; both a list
             [(and (pair? elem1) (pair? elem2))
              (compare elem1
                       elem2
                       (λ () (less (cdr lst1°) (cdr lst2°))))]

             [else
              (simple-format #t "unrecognized situation while comparing: ~a with ~a\n" lst1 lst2)
              (error "unrecognized situation" lst1 lst2)]))])))

    (cond
     [(and (null? lst1) (null? lst2)) #t]
     [(null? lst1) #t]
     [(null? lst2) #f]
     [else
      (compare lst1
               lst2
               (λ () (less (cdr lst1) (cdr lst2))))])))


(define distress-signal-package-1 '((2)))
(define distress-signal-package-2 '((6)))


(define sorted-lists
  (-> (get-lines-from-file input-filename)
      (filter (λ (line) (not (string-null? line))) #|arg|#)
      (parallel-map (λ (line _ind) (list-transformer line)) #|arg|#)
      ((λ (transformed-lists)
         (cons distress-signal-package-1
               (cons distress-signal-package-2
                     transformed-lists))) #|arg|#)
      ((λ (lists-with-signal)
         (sort lists-with-signal less)) #|arg|#)))


(-> (list distress-signal-package-1 distress-signal-package-2)
    (parallel-map
     (λ (signal _ind)
       (list-index (λ (elem) (equal? elem signal))
                   sorted-lists)) #|arg|#)
    (map (λ (i) (+ i 1)) #|arg|#)
    product
    (simple-format #t "~a\n" #|arg|#))