summaryrefslogtreecommitdiff
path: root/02/lib.scm
blob: 0274dadcc744cac6fa7e073fead81deaa0529696 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
(library (lib)
  (export solve-part1 solve-part2)
  (import (chezscheme))

  ; Split list at first delimiter into `prefix' and `suffix'
  ; Return value is a pair like `((p r e f i x) s u f f i x)'
  (define (list-split-left delimiter? xs)
    (let loop ((prefix '())
               (suffix xs))
      (if (null? suffix)
        (cons prefix suffix)
        (let ((x (car suffix)))
          (if (delimiter? x)
              ; Found first delimiter, so return immediately
              (cons prefix (cdr suffix))
              ; `x' isn't a delimiter, so append it to `prefix'
              (loop (append prefix (list x)) (cdr suffix)))))))

  ; Split list at given delimiter into list of sublists
  (define (list-split delimiter? xs)
    (let loop ((pieces '())
               (rest xs))
      (if (null? rest)
          ; Fix order and remove all empty sublists from output
          ; (which are caused by consecutive delimiters in `xs')
          (reverse (remp null? pieces))
          ; Extract next piece from `rest' and prepend it to `pieces'
          (let ((next (list-split-left delimiter? rest)))
            (loop (cons (car next) pieces) (cdr next))))))

  ; Split string at whitespace into list of words
  (define (string-split str)
    (map list->string (list-split char-whitespace? (string->list str))))

  ; Partially applied divisibility check
  (define (check-divisor? x)
    (lambda (y)
      (and (not (= y 0)) ; Don't try dividing by zero
           (not (= x y)) ; Disallow trivial solution
           (= (mod x y) 0))))

  ; Find minimum and maximum in row, return difference
  (define (find-range row)
    (- (apply max row) (apply min row)))

  ; Find `x' and `y' where `y' is divisor of `x', return quotient
  (define (find-quotient row)
    ; Note: we don't check if we've reached the end of `xs',
    ; because we're guaranteed success before that happens.
    ; We're also guaranteed only one non-trivial solution.
    (let loop ((xs row))
      (let* ((x (car xs))
             (y (find (check-divisor? x) row)))
        ; Is this the (`x',`y') combination we're looking for,
        ; i.e. have we found a valid divisor `y' for this `x'?
        (if y
            (div x y)
            (loop (cdr xs))))))

  ; Add up result of `proc' for each `row' of numbers in `lines'
  (define (solve-puzzle proc lines)
    (fold-left
      (lambda (accum row)
        (+ accum (proc (map string->number row))))
      0
      (map string-split lines)))

  (define (solve-part1 lines)
    (solve-puzzle find-range lines))

  (define (solve-part2 lines)
    (solve-puzzle find-quotient lines))

)