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)