blob: cd82c472197ef41044410677f0209f362da18805 (
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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
(defstruct board ()
rows)
(defstruct bingo ()
numbers
boards)
(defun read-bingo (name)
(let* ((lines (remqual "" (file-get-lines name)))
(numbers [mapcar toint (spl "," (pop lines))])
(boards (mapcar (do new board rows @1)
(tuples 5 (mapcar (opip (tok #/\d+/) (mapcar toint))
lines)))))
(new bingo numbers numbers boards boards)))
(defmeth board check (bo)
(when-match @(or @(some (* * * * *))
((* . @nil)
(* . @nil)
(* . @nil)
(* . @nil)
(* . @nil))
((@nil * . @nil)
(@nil * . @nil)
(@nil * . @nil)
(@nil * . @nil)
(@nil * . @nil))
((@nil @nil * . @nil)
(@nil @nil * . @nil)
(@nil @nil * . @nil)
(@nil @nil * . @nil)
(@nil @nil * . @nil))
((@nil @nil @nil * . @nil)
(@nil @nil @nil * . @nil)
(@nil @nil @nil * . @nil)
(@nil @nil @nil * . @nil)
(@nil @nil @nil * . @nil))
((@nil @nil @nil @nil * . @nil)
(@nil @nil @nil @nil * . @nil)
(@nil @nil @nil @nil * . @nil)
(@nil @nil @nil @nil * . @nil)
(@nil @nil @nil @nil * . @nil)))
bo.rows t))
(defmeth board daub (bo num)
(upd bo.rows
(mapcar (op mapcar (iffi (op eql num) (ret '*)))))
bo)
(defmeth board value (bo)
(sum bo.rows (op sum @1 [iff numberp use (ret 0)])))
(defmeth bingo solve (bi)
(each ((x bi.numbers))
(each ((bo bi.boards))
(if bo.(daub x).(check)
(return-from solve (* x bo.(value)))))))
(defmeth bingo solve-last (bi)
(each ((x bi.numbers))
(each ((bo bi.boards))
(if (and bo.(daub x).(check)
(empty (upd bi.boards (remq bo))))
(return-from solve-last (* x bo.(value)))))))
(defun tests ()
(assert (new board rows '((* * * * *))).(check))
(assert (new board rows '((1 2 3 4 5) (* * * * *))).(check))
(assert (new board rows '((* 2 3 4 5)
(* 2 3 4 5)
(* 2 3 4 5)
(* 2 3 4 5)
(* 2 3 4 5))).(check))
(assert (new board rows '((2 * 3 4 5)
(2 * 3 4 5)
(2 * 3 4 5)
(2 * 3 4 5)
(2 * 3 4 5))).(check))
(assert (new board rows '((2 3 * 4 5)
(2 3 * 4 5)
(2 3 * 4 5)
(2 3 * 4 5)
(2 3 * 4 5))).(check))
(assert (new board rows '((2 3 4 * 5)
(2 3 4 * 5)
(2 3 4 * 5)
(2 3 4 * 5)
(2 3 4 * 5))).(check))
(assert (new board rows '((2 3 4 5 *)
(2 3 4 5 *)
(2 3 4 5 *)
(2 3 4 5 *)
(2 3 4 5 *))).(check))
(assert (not (new board rows '((* * 3 * *))).(check)))
(assert (not (new board rows '((1 2 3 4 5) (* * * * 3))).(check)))
(assert (not (new board rows '((* 2 3 4 5)
(6 2 3 4 5)
(* 2 3 4 5)
(* 2 3 4 5)
(* 2 3 4 5))).(check)))
(assert (not (new board rows '((2 6 3 4 5)
(2 * 3 4 5)
(2 * 3 4 5)
(2 * 3 4 5)
(2 * 3 4 5))).(check)))
(assert (not (new board rows '((2 3 * 4 5)
(2 3 * 4 5)
(2 3 * 4 5)
(2 3 6 4 5)
(2 3 * 4 5))).(check)))
(assert (not (new board rows '((2 3 4 * 5)
(2 3 4 * 5)
(2 3 4 6 5)
(2 3 4 * 5)
(2 3 4 * 5))).(check)))
(assert (not (new board rows '((2 3 4 5 *)
(2 3 4 5 *)
(2 3 4 5 *)
(2 3 4 5 *)
(2 3 4 5 6))).(check)))
(assert (equal (new board rows '((1 2 3 4 5)
(6 7 8 9 10)
(11 12 13 14 15))).(daub 8).rows
'((1 2 3 4 5)
(6 7 * 9 10)
(11 12 13 14 15))))
(assert (eq (new board rows '((1 * * * *)
(* * * * 2)
(* * 3 * *))).(value)
6)))
|
