pti/aoc-cl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

clean up day 19

Browse source
This commit is contained in:
Peter Tillemans 2024-12-19 14:26:56 +01:00
parent 57f4a063d6
commit 5926b5cd3f
1 changed files with 14 additions and 73 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

87
src/2024/day19.lisp
View file

@ -43,72 +43,13 @@ bbrgwb"))
(defparameter sample-data
(parse-input sample-text))
(defstruct node
name
terminates
next)
(defun towel-tree (towels word)
(let ((towel-tree (make-hash-table))
(terminates nil))
(loop
for towel in towels
if (emptyp towel)
do (setf terminates t)
else
do (setf (gethash (char towel 0) towel-tree)
(sort
(let ((r (subseq towel 1)))
(cons r (gethash (char towel 0) towel-tree)))
#'(lambda (a b)
(cond
((< (length a) (length b)) t)
((> (length a) (length b)) nil)
(t (string-lessp a b)))
)))
(loop
for k being the hash-keys in towel-tree
for v being the hash-values in towel-tree
do (setf (gethash k towel-tree) (towel-tree v (concatenate 'string word (list k))))
)
(make-node
:name word
:terminates terminates
:next towel-tree))))
(defun show-tree (tree &optional (depth 0))
(loop
for k being the hash-keys in (node-next tree)
for v being the hash-values in (node-next tree)
do (format t "~v@{~A~:*~}" depth " ")
(format t "~A(~A)~%" k (if (node-terminates v) " OK" ""))
(show-tree v (1+ depth))))
(defun valid-pattern-p-old (og-tree pattern)
(defun check (tree pattern word words)
(let ((terminate (node-terminates tree)))
(if (emptyp pattern)
terminate
(let* ((c (char pattern 0))
(np (subseq pattern 1))
(nw (concatenate 'string word (list c))))
(or
(if-let ((nt (gethash c (node-next tree))))
(check nt np nw words))
(and terminate
(if-let ((nt (gethash c (node-next og-tree))))
(check nt np "" (cons word words))
))
)))))
(check og-tree pattern "" '()))
(defvar *patterns* (make-hash-table :test #'equal))
(defvar *valid-patterns* (make-hash-table :test #'equal))
(defvar *possible-patterns* (make-hash-table :test #'equal))
(defvar *pattern-cache* (make-hash-table :test #'equal))
(defvar *valid-cache* (make-hash-table :test #'equal))
(defvar *possible-cache* (make-hash-table :test #'equal))
(defun reset-patterns ()
(setf *patterns* (make-hash-table :test #'equal))
(setf *valid-patterns* (make-hash-table :test #'equal))
(setf *possible-patterns* (make-hash-table :test #'equal))
(setf *pattern-cache* (make-hash-table :test #'equal))
(setf *valid-cache* (make-hash-table :test #'equal))
(setf *possible-cache* (make-hash-table :test #'equal))
)
(defun string-prefix-p (prefix string)
@ -118,20 +59,20 @@ bbrgwb"))
(defun remaining-patterns (towels pattern)
(or
(gethash pattern *patterns*)
(gethash pattern *pattern-cache*)
(let ((remaining (loop
for towel in towels
if (string-prefix-p towel pattern)
collect (subseq pattern (length towel))
)))
(setf (gethash pattern *patterns*) remaining))))
(setf (gethash pattern *pattern-cache*) remaining))))
(defun valid-pattern-p (towels pattern)
(multiple-value-bind (is-valid found)
(gethash pattern *valid-patterns*)
(gethash pattern *valid-cache*)
(if found
is-valid
(setf (gethash pattern *valid-patterns*)
(setf (gethash pattern *valid-cache*)
(if (emptyp pattern)
t
(if-let (ps (remaining-patterns towels pattern))
@ -145,7 +86,7 @@ bbrgwb"))
(defun towels-to-regex (onsen)
(format nil "^(~{~A~^|~})*$" (onsen-towels onsen)))
(defun valid-patterns (onsen)
(defun valid-cache (onsen)
(reset-patterns)
(loop
for pattern in (onsen-patterns onsen)
@ -154,10 +95,10 @@ bbrgwb"))
(defun possible-patterns (towels pattern)
(multiple-value-bind (n found)
(gethash pattern *possible-patterns*)
(gethash pattern *possible-cache*)
(if found
n
(setf (gethash pattern *possible-patterns*)
(setf (gethash pattern *possible-cache*)
(if (emptyp pattern)
1
(if-let (ps (remaining-patterns towels pattern))
@ -170,7 +111,7 @@ bbrgwb"))
))
(defun part1 (onsen)
(format nil "~A" (length (valid-patterns onsen))))
(format nil "~A" (length (valid-cache onsen))))
(defun part2 (data)
(reset-patterns)