summaryrefslogtreecommitdiff
path: root/04/lib.scm
blob: 5a1fff5b99f9a92634f6ba5e2d1deaccdbb6a615 (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))))

  ; Sort chars in string according to `proc'
  (define (string-sort proc str)
    (list->string (list-sort proc (string->list str))))

  ; Partially applied equality check
  (define (check-identical? word1)
    (lambda (word2) (equal? word1 word2)))

  ; Partially applied anagram check
  (define (check-anagram? word1)
    (lambda (word2)
      ; Sort chars by Unicode value, then check string equality
      (string=? (string-sort char<? word1)
                (string-sort char<? word2))))

  ; Count for how many elements of `xs' `proc' returns true
  (define (count proc xs)
    (length (filter proc xs)))

  ; Count how many passphrases in `lines' are reported valid by `proc'
  (define (solve-puzzle proc lines)
    (count
      (lambda (phrase)
        ; For each word in `phrase', does it have any copies/anagrams?
        (let loop ((words phrase))
          (if (null? words)
              #t
              ; Count copies/anagrams, including `(car words)' itself
              (if (> (count (proc (car words)) phrase) 1)
                  #f
                  (loop (cdr words))))))
      (map string-split lines)))

  (define (solve-part1 lines)
    (solve-puzzle check-identical? lines))

  (define (solve-part2 lines)
    (solve-puzzle check-anagram? lines))

)