blob: a1fbeeb56f618c843bb7b4306a4c41bfbc3681a3 (
plain) (
blame)
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
75
76
77
78
79
80
81
82
|
(defstruct hand cards bid)
(defun parse-hands (filespec)
(with-open-file (stream filespec)
(loop for line = (read-line stream nil)
while line
as hand = (make-hand :cards (subseq line 0 5)
:bid (parse-integer line :start 6))
collect hand)))
(defun count-cards (cards &optional joker)
(let ((scards (sort (subseq cards 0) #'char<)))
(labels ((f (&optional (i 0) (count 0) last acc)
(if (= i (length scards))
(cons count acc)
(let ((c (aref scards i)))
(if (and joker (char= c #\J))
(f (1+ i) count last acc)
(if last
(if (char= c last)
(f (1+ i) (1+ count) c acc)
(f (1+ i) 1 c (cons count acc)))
(f (1+ i) 1 c acc))))))
(count-jokers ()
(loop for card across cards
count (char= #\J card))))
(let ((scount (sort (f) #'>)))
(if joker
(cons (+ (count-jokers) (car scount)) (cdr scount))
scount)))))
(defun rank-cards (cards &optional joker)
(let ((count (count-cards cards joker)))
(cond ((equal '(5) count) 7)
((equal '(4 1) count) 6)
((equal '(3 2) count) 5)
((equal '(3 1 1) count) 4)
((equal '(2 2 1) count) 3)
((equal '(2 1 1 1) count) 2)
((equal '(1 1 1 1 1) count) 1))))
(defun rank-char (char &optional joker)
(cond ((char= char #\A) 14)
((char= char #\K) 13)
((char= char #\Q) 12)
((char= char #\J) (if joker 1 11))
((char= char #\T) 10)
(t (digit-char-p char))))
(defun lex-compare-cards (cards1 cards2 &optional joker)
(loop for i across cards1
for j across cards2
as ri = (rank-char i joker)
as rj = (rank-char j joker)
if (< ri rj)
return t
while (= ri rj)))
(defun compare-hands (h1 h2 &optional joker)
(let* ((cards1 (hand-cards h1))
(cards2 (hand-cards h2))
(rank1 (rank-cards cards1 joker))
(rank2 (rank-cards cards2 joker)))
(or (< rank1 rank2)
(and (= rank1 rank2) (lex-compare-cards cards1 cards2 joker)))))
(defun solve1 (f)
(let ((hands (sort (parse-hands f) #'compare-hands)))
(loop for i = 1 then (1+ i)
for hand in hands
sum (* i (hand-bid hand)))))
(defun solve2 (f)
(let ((hands (sort (parse-hands f) (lambda (h1 h2) (compare-hands h1 h2 t)))))
(loop for i = 1 then (1+ i)
for hand in hands
sum (* i (hand-bid hand)))))
(print (solve1 "data/07/example.txt")) ;; 6440
(print (solve1 "data/07/input.txt")) ;; 245794640
(print (solve2 "data/07/example.txt")) ;; 5905
(print (solve2 "data/07/input.txt")) ;; 247899149
|