aoc-all

My solutions to all Advent of Code
git clone https://git.instinctive.eu/aoc-all.git
Log | Files | Refs | README | LICENSE

day01.scm (2996B)

      1 ; Copyright (c) 2023, Natacha Porté
      2 ;
      3 ; Permission to use, copy, modify, and distribute this software for any
      4 ; purpose with or without fee is hereby granted, provided that the above
      5 ; copyright notice and this permission notice appear in all copies.
      6 ;
      7 ; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
      8 ; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
      9 ; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
     10 ; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
     11 ; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
     12 ; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
     13 ; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
     14 
     15 (import (chicken io) (chicken string))
     16 
     17 (define (line-value-1 line first last)
     18   (cond ((null? line) (+ (* first 10) last))
     19         ((char-numeric? (car line))
     20            (let ((val (- (char->integer (car line)) 48)))
     21               (line-value-1 (cdr line)
     22                             (if (>= first 0) first val)
     23                             val)))
     24         (else (line-value-1 (cdr line) first last))))
     25 
     26 (define (is-at? text pat pos)
     27   (and (>= (- (string-length text) pos) (string-length pat))
     28        (equal? (substring text pos (+ pos (string-length pat))) pat)))
     29 
     30 (define (line-value-2 line pos first last)
     31   (if (> pos (string-length line))
     32       (+ (* first 10) last)
     33       (let ((val (cond ((is-at? line "one"   pos) 1)
     34                        ((is-at? line "two"   pos) 2)
     35                        ((is-at? line "three" pos) 3)
     36                        ((is-at? line "four"  pos) 4)
     37                        ((is-at? line "five"  pos) 5)
     38                        ((is-at? line "six"   pos) 6)
     39                        ((is-at? line "seven" pos) 7)
     40                        ((is-at? line "eight" pos) 8)
     41                        ((is-at? line "nine"  pos) 9)
     42                        ((is-at? line "0"     pos) 0)
     43                        ((is-at? line "1"     pos) 1)
     44                        ((is-at? line "2"     pos) 2)
     45                        ((is-at? line "3"     pos) 3)
     46                        ((is-at? line "4"     pos) 4)
     47                        ((is-at? line "5"     pos) 5)
     48                        ((is-at? line "6"     pos) 6)
     49                        ((is-at? line "7"     pos) 7)
     50                        ((is-at? line "8"     pos) 8)
     51                        ((is-at? line "9"     pos) 9)
     52                        (else -1))))
     53         (if (= val -1)
     54             (line-value-2 line (+ pos 1) first last)
     55             (line-value-2 line (+ pos 1) (if (>= first 0) first val) val)))))
     56 
     57 
     58 
     59 (define (process acc1 acc2)
     60   (let ((line (read-line)))
     61     (if (eof-object? line)
     62         (output acc1 acc2)
     63         (process (+ acc1 (line-value-1 (string->list line) -1 -1))
     64                  (+ acc2 (line-value-2 line 0 -1 -1))))))
     65 
     66 (define (output acc1 acc2)
     67   (write-line (conc "First puzzle:  " acc1))
     68   (write-line (conc "Second puzzle: " acc2)))
     69 
     70 (process 0 0)