sol.scm (2479B) [raw]
1 #!/usr/local/bin/chicken-csi -ss 2 (import (chicken string) 3 (chicken port) 4 (chicken irregex) 5 (chicken sort) 6 (chicken io)) 7 8 (define (parse line) 9 ;; HACK: Instead of writing a parser, leverage (read) 10 (let* ((t1 (irregex-replace/all "\\[" line "(")) 11 (t2 (irregex-replace/all "]" t1 ")")) 12 (t3 (irregex-replace/all "," t2 " "))) 13 (with-input-from-string t3 (lambda () (read))))) 14 15 (define (good? pair) 16 (let ((l (car pair)) (r (cadr pair))) 17 (cond ((and (null? l) (null? r)) '()) ; passed the check 18 ((null? l) #t) ; left ran out first 19 ((null? r) #f) ; right ran out first 20 ((and (number? l) (number? r)) 21 (cond ((< l r) #t) 22 ((> l r) #f) 23 (else '()))) ; null => keep checking 24 ((number? l) (good? (list (list l) r))) 25 ((number? r) (good? (list l (list r)))) 26 ; compare items in lists 27 (else 28 (let ((g (good? (list (car l) (car r))))) 29 (cond ((null? g) 30 (good? (list (cdr l) (cdr r)))) 31 ((eq? g #f) #f) 32 ((eq? g #t) #t) 33 (else "Bad result"))))))) 34 35 (define (parse-pairs lines) 36 (let loop ((lines lines)) 37 (if (null? lines) 38 '() 39 (let ((left (parse (car lines))) 40 (right (parse (cadr lines)))) ; NOTE: not robust to bad input... (cdddr) 41 (cons (list left right) (loop (cdddr lines))))))) 42 43 (define (parse-all lines) 44 (let loop ((lines (append lines '("[[2]]" "[[6]]")))) 45 (if (null? lines) 46 '() 47 (if (equal? (car lines) "") 48 (loop (cdr lines)) 49 (cons (parse (car lines)) (loop (cdr lines))))))) 50 51 (define (score pairs) 52 (let loop ((sum 0) (i 1) (ps pairs)) 53 (if (null? ps) 54 sum 55 (if (good? (car ps)) 56 (loop (+ i sum) (add1 i) (cdr ps)) 57 (loop sum (add1 i) (cdr ps)))))) 58 59 (define (index lst obj) 60 ;; why 1 indexed, advent of code?? 61 (let loop ((i 1) (items lst)) 62 (cond ((null? items) #f) 63 ((equal? (car items) obj) i) 64 (else (loop (add1 i) (cdr items)))))) 65 66 (define (signal all) 67 (let ((sorted (sort all (lambda (x y) (good? (list x y)))))) 68 (* (index sorted '((2))) 69 (index sorted '((6)))))) 70 71 (define (main args) 72 (let* ((lines (read-lines)) 73 (pairs (parse-pairs lines)) 74 (all (parse-all lines))) 75 (print (score pairs)) 76 (print (signal all))))