blob: 94598dbc6ee75099f888ef83acaf660553e393d0 (
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
131
132
|
;; 11:45
;;
(ql:quickload '(fiveam arrows cl-heap))
(defun in-bounds (field crucible)
(destructuring-bind (maxrow maxcol) (array-dimensions field)
(destructuring-bind (dir row col) crucible
(declare (ignorable dir))
(and (< -1 row maxrow)
(< -1 col maxcol)))))
(defun advance (row col dir)
(cons dir
(ecase dir
(up (list (1- row) col))
(lf (list row (1- col)))
(dw (list (1+ row) col))
(rt (list row (1+ col))))))
(defun parse-input (filepath)
(let* ((input (uiop:read-file-lines filepath))
(rows (length input)))
(make-array (list rows (length (car input)))
:initial-contents
(mapcar (lambda (line)
(map 'vector (lambda (c)
(logand 15 (char-code c)))
line))
input))))
(defstruct (walker (:copier nil))
(path (make-hash-table :test #'equal))
dir row col
(track 0))
(defun backtrack (dir)
(ecase dir
(up 'dw)
(rt 'lf)
(dw 'up)
(lf 'rt)))
(defun next-direction (walker adv)
(with-slots (path dir track) walker
(destructuring-bind (move nrow ncol) adv
(let ((np (alexandria:copy-hash-table path)))
(setf (gethash adv np) t)
(make-walker :path np
:dir move
:row nrow
:col ncol
:track (if (eq move dir) (1+ track) 0))))))
(defun next-moves (field tried walker)
(with-slots (dir row col track) walker
(arrows:->>
(remove dir '(rt dw lf up) :key #'backtrack)
(remove-if (lambda (d) (and (eq d dir)
(<= 2 track))))
(mapcar (alexandria:curry #'advance row col))
(remove-if-not (alexandria:curry #'in-bounds field))
(remove-if (lambda (p)
(gethash (cons (if (eq (car p) dir) (1+ track) 0) p) tried)))
(mapcar (lambda (p)
(let ((nt (if (eq (car p) dir) (1+ track) 0)))
(setf (gethash (cons nt p) tried) t)
(next-direction walker p)
;; (destructuring-bind (dir row col) p
;; (make-walker :dir dir :row row :col col :track nt))
)))
;; (mapcar (lambda (d) (next-direction walker d)))
)))
(defun finish-p (field step)
(destructuring-bind (maxrow maxcol) (array-dimensions field)
(with-slots (row col) step
(and (= row (1- maxrow))
(= col (1- maxcol))))))
(defun path-cost (field walker)
(let ((cost 0))
(maphash (lambda (k v)
(declare (ignorable v))
(destructuring-bind (dir row col) k
(declare (ignorable dir))
(incf cost (aref field row col))))
(walker-path walker))
cost))
(defun try (options known field iters)
(let ((next (cl-heap:dequeue options)))
;; (with-slots (dir row col) next
;; (format t "i: ~d cost: ~d/~d p: ~a~%" iters (path-cost field next) (hash-table-count (walker-path next)) (list dir row col)))
(when next
(if (finish-p field next)
(progn (format t "Took ~d iters\n" iters)
next)
(progn
(dolist (newm (next-moves field known next))
(cl-heap:enqueue options
newm
(path-cost field newm)))
;; (print (cl-heap:queue-size options))
(try options known field (1+ iters))))))
)
(let* ((field (parse-input "input"))
;; (maxloss (apply #'* 9 (array-dimensions field)))
(options (make-instance 'cl-heap:priority-queue))
(known (make-hash-table :test #'equal))
(w (make-walker :dir 'rt :row 0 :col 0)))
;; (setf (gethash '(rt 0 0) (walker-path w)) 1)
;; (next-moves field w)
;; (carry field w maxloss 0)
;; (cl-heap:dequeue
;; options)
(cl-heap:enqueue options w 0)
;; (cl-heap:enqueue options '(rt 0 0 0) 0)
;; options
;; (print)
(time
(let ((r
(try options known field 0)))
(list (path-cost field r) r)))
)
;; (let ( (w (make-walker :dir 'rt :row 0 :col 0))
;; (y (make-walker :dir 'rt :row 0 :col 0)) )
;; (equalp w y))
;; (make-hash-table :test #'equalp)
|
