aoc

Advent of Code Solutions
git clone git://git.alexkarle.com.com/aoc
Log | Files | Refs | README | LICENSE

sol.scm (1864B) [raw]


      1 #!/usr/local/bin/chicken-csi -ss
      2 (import (chicken io))
      3 
      4 (define (sum lst) (apply + lst))
      5 
      6 (define (prio c)
      7   (if (char-upper-case? c)
      8       (- (char->integer c) 38)   ; #\A -> 65 - 38 = 27
      9       (- (char->integer c) 96))) ; \#a -> 97 - 96 = 1
     10 
     11 (define (append-if-absent x lst)
     12   (if (member x lst)
     13       lst
     14       (cons x lst)))
     15 
     16 ; (1 2 3 4) -> ((1 2) (3 4))
     17 (define (bisect lst)
     18   (let ((len (length lst)))
     19     (define (bi lst a b)
     20       (cond ((null? lst)
     21               (list a b))
     22             ((> (length lst) (/ len 2))
     23               (bi (cdr lst) (append-if-absent (car lst) a) b))
     24             (else
     25               (bi (cdr lst) a (append-if-absent (car lst) b)))))
     26     (bi lst '() '())))
     27 
     28 (define (score-pack pk)
     29   (let* ((parts (bisect pk))
     30          (l (car parts))
     31          (r (cadr parts)))
     32     (sum (map (lambda (x) (if (member x r) (prio x) 0)) l))))
     33 
     34 ; lots of member checks.. could use a better data structure
     35 ; than linked lists (hash tables) if this was slow / large input
     36 (define (uniq lst)
     37   (if (null? lst)
     38       lst
     39       (if (member (car lst) (cdr lst))
     40           (uniq (cdr lst))
     41           (cons (car lst) (uniq (cdr lst))))))
     42 
     43 (define (score-group a b c)
     44   (sum (map (lambda (x)
     45                 (if (and (member x b) (member x c))
     46                     (prio x)
     47                     0))
     48             a)))
     49 
     50 (define (part-2 packs)
     51   (let loop ((i 0) (score 0) (pks (map uniq packs)))
     52     (if (null? pks)
     53         score
     54         (if (= (modulo i 3) 0)
     55             (loop (add1 i)
     56                   (+ score (score-group (car pks) (cadr pks) (caddr pks)))
     57                   (cdr pks))
     58             (loop (add1 i) score (cdr pks))))))
     59 
     60 
     61 (define (main args)
     62   (let* ((lines (read-lines))
     63          (packs (map string->list lines))
     64          (scores-1 (map score-pack packs))
     65          (score-2 (part-2 packs)))
     66     (print (sum scores-1))
     67     (print score-2)))