Code refactoring

Import STRING-STARTS-WITH-P from quickutil, and create a list of all the
possible digit prefixes (numerical, and spelled out), and use that to
pull out all the digits from a string

src/2023/day01.lisp

@@ -1,27 +1,30 @@
 (defpackage :aoc/2023/01 #.cl-user::*aoc-use*)
 (in-package :aoc/2023/01)
 
-(defun calibration-value (string)
-  (parse-integer (mkstr (find-if #'digit-char-p string)
-                        (find-if #'digit-char-p string :from-end t))))
+(defun char->int (ch) (- (char-code ch) (char-code #\0)))
+
+(defun calibration-value (s)
+  (+ (* (char->int (find-if #'digit-char-p s)) 10)
+     (char->int (find-if #'digit-char-p s :from-end t))))
 #+#:excluded (mapcar #'calibration-value (uiop:read-file-lines #P"src/2023/day01.txt"))
 #+#:excluded (reduce #'+ *)
 
-(defun find-digit (string &key from-end &aux (indices (iota (length string))))
-  (dolist (start (if from-end (reverse indices) indices))
-    (if (digit-char-p (char string start))
-      (return (- (char-code (char string start)) (char-code #\0)))
-      (let ((digit 1))
-        (dolist (s (list "one" "two" "three" "four" "five" "six" "seven" "eight" "nine"))
-          (if (>= (- (length string) start) (length s))
-            (if (string= s (subseq string start (+ (length s) start)))
-              (return-from find-digit digit)))
-          (incf digit))))))
+; Note: FORMAT's ~r directive lets you spell out numbers in English
+(defparameter *digits-prefixes*  (loop for i from 1 upto 9
+                                       collect (cons (format nil "~a" i) i)
+                                       collect (cons (format nil "~r" i) i)))
 
-(defun calibration-value-p2 (string)
-  (parse-integer (mkstr (find-digit string)
-                        (find-digit string :from-end t))))
+(defun calibration-value-p2 (s)
+  (flet ((extract-all-digits ()
+           (looping
+             (dotimes (start (length s))
+               (dolist+ ((prefix . d) *digits-prefixes*)
+                 (if (string-starts-with-p prefix (subseq s start))
+                   (collect! d)))))))
+    (bnd1 (digits (extract-all-digits))
+      (+ (* (first digits) 10) (car (last digits))))))
 #+#:excluded (calibration-value-p2 "7pqrstsixteen")
+#+#:excluded (calibration-value-p2 "eightwo")
 
 (define-solution (2023 01) (strings)
   (values (reduce #'+ (mapcar #'calibration-value strings))

vendor/make-quickutils.lisp

@@ -33,6 +33,7 @@
                :mulf
                :ncycle
                :repeat
+               :string-starts-with-p
                :symb
                :void
                :when-let

vendor/quickutils.lisp

@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:AIF :AWHEN :BND* :BND1 :COPY-ARRAY :COPY-HASH-TABLE :DIGITS :DIVF :DOLIST+ :DORANGE :DORANGEI :DOSEQ :FLATTEN :HASH-TABLE-ALIST :HASH-TABLE-KEY-EXISTS-P :HASH-TABLE-KEYS :HASH-TABLE-VALUES :IF-LET :IOTA :LOOPING :MAKE-KEYWORD :MKSTR :MULF :NCYCLE :REPEAT :SYMB :VOID :WHEN-LET :WITH-GENSYMS) :ensure-package T :package "AOC.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:AIF :AWHEN :BND* :BND1 :COPY-ARRAY :COPY-HASH-TABLE :DIGITS :DIVF :DOLIST+ :DORANGE :DORANGEI :DOSEQ :FLATTEN :HASH-TABLE-ALIST :HASH-TABLE-KEY-EXISTS-P :HASH-TABLE-KEYS :HASH-TABLE-VALUES :IF-LET :IOTA :LOOPING :MAKE-KEYWORD :MKSTR :MULF :NCYCLE :REPEAT :STRING-STARTS-WITH-P :SYMB :VOID :WHEN-LET :WITH-GENSYMS) :ensure-package T :package "AOC.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "AOC.QUICKUTILS")
@@ -22,7 +22,8 @@
                                          :HASH-TABLE-VALUES :IF-LET :IOTA
                                          :MKSTR :SYMB :STRING-DESIGNATOR
                                          :WITH-GENSYMS :LOOPING :MAKE-KEYWORD
-                                         :MULF :NCYCLE :REPEAT :VOID :WHEN-LET))))
+                                         :MULF :NCYCLE :REPEAT
+                                         :STRING-STARTS-WITH-P :VOID :WHEN-LET))))
 
   (defmacro let1 (var val &body body)
     "Bind VAR to VAL within BODY. Equivalent to LET with one binding."
@@ -499,6 +500,12 @@ Examples:
     `(loop repeat ,n do ,@body))
 
 
+  (defun string-starts-with-p (prefix s)
+    "Returns T if the first few characters of `s` are equalt to `prefix`."
+    (and (<= (length prefix) (length s))
+         (string= prefix s :end2 (length prefix))))
+
+
   (defun void (&rest args)
     "Do absolutely nothing, and return absolutely nothing."
     (declare (ignore args))
@@ -570,7 +577,8 @@ PROGN."
   (export '(aif awhen bnd* bnd1 copy-array copy-hash-table digits divf dolist+
             dorange dorangei doseq flatten hash-table-alist
             hash-table-key-exists-p hash-table-keys hash-table-values if-let
-            iota looping make-keyword mkstr mulf ncycle repeat symb void
-            when-let when-let* with-gensyms with-unique-names)))
+            iota looping make-keyword mkstr mulf ncycle repeat
+            string-starts-with-p symb void when-let when-let* with-gensyms
+            with-unique-names)))
 
 ;;;; END OF quickutils.lisp ;;;;