aoc18/day2.lisp -rw-r--r-- 2.0 KiB View raw
                                                                                
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
(in-package :aoc18)

(defun print-hash (h)
  (loop for k being the hash-keys of h using (hash-value v) do
       (format t "~a: ~a~%" k v)))

(declaim (inline letter-frequencies))
(defun letter-frequencies (word f)
  (declare (optimize (speed 3) (compilation-speed 0))
	   (type simple-string word))
  (clrhash f)
  (loop for l across word do
       (incf (the fixnum (gethash l f 0))))
  f)

(declaim (inline has-duplicate))
(defun has-duplicate (hash &optional (count 2 fixnum))
  (declare (optimize (speed 3) (compilation-speed 0))
	   (type hash-table hash))
  (loop for v being the hash-values of hash do
       (if (= count v) (return t))))

(defun solve-day2-part1 (words)
  (declare (optimize (speed 3) (compilation-speed 0))
	   (type list words))
  (loop
     with hhh = (make-hash-table)
     for w simple-string in words
     for f = (letter-frequencies w hhh)
     counting (has-duplicate f) into two fixnum
     counting (has-duplicate f 3) into three fixnum
     finally (return (the fixnum (* two three)))))

(defun solve-day2-part2 (words)
  (declare (optimize (speed 3) (compilation-speed 0)))
  (dolist (w1 words)
    (dolist (w2 words)
      (when (correct-words w1 w2)
	(return-from solve-day2-part2 (common-letters w1 w2))))))

(defun correct-words (w1 w2)
  (declare (optimize (speed 3) (compilation-speed 0))
	   (type simple-string w1 w2))  
  (loop
     for c1 base-char across w1
     for c2 base-char across w2
     counting (char-not-equal c1 c2) into diff fixnum
     when (> diff 1) do (return nil)
     finally (return (= 1 diff))))

(defun common-letters (w1 w2)
  (declare (optimize (speed 3))
	   (type simple-string w1 w2))
  (coerce
   (loop
      for c1 base-char across w1
      for c2 base-char across w2
      when (char-equal c1 c2)
      collecting c1)
   'simple-string))

(test day2-part1
  (is (= 6944 (solve-day2-part1 (read-lines "day2.input")))))

(test day2-part2
  (is (string-equal "srijafjzloguvlntqmphenbkd" (solve-day2-part2 (read-lines "day2.input")))))