advent-of-code-2023

My solutions to AoC 2023
git clone git://git.entf.net/advent-of-code-2023
Log | Files | Refs

day-1.lisp (3233B)

      1 (defpackage #:aoc/day-1
      2   (:use #:cl #:aoc/utils)
      3   (:export #:day-1))
      4 (in-package #:aoc/day-1)
      5 
      6 #+release (declaim (inline first-digit last-digit
      7                            alpha-digit-at reverse-alpha-digit-at
      8                            first-digit-alpha last-digit-alpha))
      9 
     10 (declaim (ftype (function (simple-string) fixnum) first-digit))
     11 (defun first-digit (line)
     12   (or (loop for char across line
     13             when (digit-char-p char)
     14               do (return (char-number char)))
     15       0))
     16 
     17 (declaim (ftype (function (simple-string) fixnum) last-digit))
     18 (defun last-digit (line)
     19   (or (loop for i from (1- (length line)) downto 0
     20             for char = (aref line i)
     21             when (digit-char-p char)
     22               do (return (char-number char)))
     23       0))
     24 
     25 (defparameter *alpha-digit-table* '(("one" . 1)
     26                                     ("two" . 2)
     27                                     ("three" . 3)
     28                                     ("four" . 4)
     29                                     ("five" . 5)
     30                                     ("six" . 6)
     31                                     ("seven" . 7)
     32                                     ("eight" . 8)
     33                                     ("nine" . 9)))
     34 
     35 (declaim (ftype (function (simple-string fixnum) (or fixnum null)) alpha-digit-at))
     36 (defun alpha-digit-at (line start)
     37   (loop for (compare . digit) (simple-string . fixnum) in *alpha-digit-table*
     38         when (loop for i from start below (min (length line)
     39                                                (+ start (length compare)))
     40                    for ci from 0
     41                    always (char= (aref line i)
     42                                  (aref compare ci)))
     43           do (return digit)))
     44 
     45 (declaim (ftype (function (simple-string fixnum) (or fixnum null)) reverse-alpha-digit-at))
     46 (defun reverse-alpha-digit-at (line end)
     47   (loop for (compare . digit) (simple-string . fixnum) in *alpha-digit-table*
     48         for compare-length = (1- (length compare))
     49         when (loop for i from end downto (max (- end compare-length) 0)
     50                    for ci downfrom compare-length
     51                    always (char= (aref line i)
     52                                  (aref compare ci)))
     53           do (return digit)))
     54 
     55 (declaim (ftype (function (simple-string) fixnum) first-digit-alpha))
     56 (defun first-digit-alpha (line)
     57   (or (loop for i from 0 below (length line)
     58             for char = (aref line i)
     59             when (digit-char-p char)
     60               do (return (char-number char))
     61             thereis (alpha-digit-at line i))
     62       0))
     63 
     64 (declaim (ftype (function (simple-string) fixnum) last-digit-alpha))
     65 (defun last-digit-alpha (line)
     66   (or (loop for i from (1- (length line)) downto 0
     67             for char = (aref line i)
     68             when (digit-char-p char)
     69               do (return (char-number char))
     70             thereis (reverse-alpha-digit-at line i))
     71       0))
     72 
     73 (defun day-1 (input)
     74   (loop for line = (read-line input nil)
     75         while line
     76         sum (+ (the fixnum (* (first-digit line) 10))
     77                (last-digit line)) into task-1 fixnum
     78         sum (+ (the fixnum (* (first-digit-alpha line) 10))
     79                (last-digit-alpha line)) into task-2 fixnum
     80         finally (return (values task-1 task-2))))