Quest 5: Fishbone Order

What a fiddlybit. I needed records to save me from list-hell on this one.

Scheme/Guile

(import (rnrs io ports (6))
        (rnrs records syntactic))

(define (parse-file file-name)
  (let* ((lines (string-split (string-trim-both (call-with-input-file file-name get-string-all)) #\newline)))
    (map (lambda (line)
       (let* ((colon-split (string-split line #\:))
             (segments (map string->number (string-split (cadr colon-split) #\,)))
             (label (string->number (car colon-split))))
        (cons label segments)))
       lines)))

(define-record-type fishbone-segment (fields middle left right))
(define (construct-fishbone fishbone segments)
  (if (null? segments)
      fishbone
      (let ((fishbone (add-fishbone-segment fishbone (car segments))))
        (construct-fishbone fishbone (cdr segments)))))
(define (add-fishbone-segment fishbone segment)
  (if (null? fishbone)
      (list (make-fishbone-segment segment #f #f))
      (let* ((fish-head (car fishbone))
             (fish-middle (fishbone-segment-middle fish-head))
             (fish-left (fishbone-segment-left fish-head))
             (fish-right (fishbone-segment-right fish-head)))
        (cond
          ((and (< segment fish-middle) (not fish-left)) (cons (make-fishbone-segment fish-middle segment fish-right) (cdr fishbone)))
          ((and (> segment fish-middle) (not fish-right)) (cons (make-fishbone-segment fish-middle fish-left segment) (cdr fishbone)))
          (else (cons fish-head (add-fishbone-segment (cdr fishbone) segment)))))))
(define (score-fishbone fishbone)
  (string->number (string-join (map (compose number->string fishbone-segment-middle) fishbone) "")))

(define-record-type sword (fields id fishbone quality))
(define (parse-swords file-name)
  (map (lambda (sword-line)
          (let ((fishbone (construct-fishbone '() (cdr sword-line))))
            (make-sword (car sword-line) fishbone (score-fishbone fishbone))))
    (parse-file file-name)))

(format #t "P1 Answer: ~a\n\n" (sword-quality (car (parse-swords "notes/everybody_codes_e2025_q05_p1.txt"))))

(let* ((swords (parse-swords "notes/everybody_codes_e2025_q05_p2.txt"))
       (sword-scores (map sword-quality swords)))
  (format #t "P2 Answer: ~a\n\n" (- (apply max sword-scores) (apply min sword-scores))))


(define (segment-score segment)
  (string->number
    (string-join
     (map (lambda (n) (if (eqv? #f n) "" (number->string n)))
      (list (fishbone-segment-left segment) (fishbone-segment-middle segment) (fishbone-segment-right segment)))
     "")))
(define (sort-fishbones a b)
  (if (null? a) '()
  (let ((line-score-a (segment-score (car a)))
        (line-score-b (segment-score (car b))))
    (cond
      ((> line-score-a line-score-b) #t)
      ((< line-score-a line-score-b) #f)
      (else (sort-fishbones (cdr a) (cdr b)))))))
(define (sort-swords a b)
  (cond
    ((> (sword-quality a) (sword-quality b)) #t)
    ((< (sword-quality a) (sword-quality b)) #f)
    (else (let ((fb-sort (sort-fishbones (sword-fishbone a) (sword-fishbone b))))
      (cond
        ((null? fb-sort) (> (sword-id a) (sword-id b)))
        (else fb-sort))))))
(let* ((swords (parse-swords "notes/everybody_codes_e2025_q05_p3.txt"))
       (sorted-swords (sort swords sort-swords))
       (swords-length (length swords)))
  (let loop ((i 1) (total 0) (sorted-swords sorted-swords))
    (if (<= i swords-length)
        (loop (1+ i) (+ total (* i (sword-id (car sorted-swords)))) (cdr sorted-swords))
        (format #t "P2 Answer: ~a\n\n" total))))