aoc-all

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

day02.scm (2871B)

      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         comparse
     17         srfi-1
     18         srfi-14)
     19 
     20 (define spaces
     21   (one-or-more (char-set #\space)))
     22 
     23 (define digit
     24   (in char-set:digit))
     25 
     26 (define digits
     27   (as-string (one-or-more digit)))
     28 
     29 (define color
     30   (any-of (char-seq "red")
     31           (char-seq "green")
     32           (char-seq "blue")))
     33 
     34 (define dice-count
     35   (sequence* ((count digits)
     36               (_ (is #\space))
     37               (c color))
     38     (result (list c count))))
     39 
     40 (define (rgb dice-count-list)
     41   (map (lambda (key) (string->number (car (alist-ref key dice-count-list equal? '("0")))))
     42       '("red" "green" "blue")))
     43 
     44 (define hand-shown
     45   (sequence* ((first dice-count)
     46               (rest (zero-or-more (preceded-by (char-seq ", ") dice-count))))
     47     (result (rgb (cons first rest)))))
     48 
     49 (define hands-shown
     50   (sequence* ((first hand-shown)
     51               (rest (zero-or-more (preceded-by (char-seq "; ") hand-shown))))
     52     (result (cons first rest))))
     53 
     54 (define game-line
     55   (sequence* ((_ (char-seq "Game "))
     56               (id digits)
     57               (_ (char-seq ": "))
     58               (hands hands-shown)
     59               (_ (is #\newline)))
     60     (result (list id hands))))
     61 
     62 (define all-data
     63   (one-or-more game-line))
     64 
     65 (define (hand-valid-1? hand)
     66   (and (<= (car hand) 12)
     67        (<= (cadr hand) 13)
     68        (<= (caddr hand) 14)))
     69 
     70 (define (hands-valid-1? hands)
     71   (or (null? hands)
     72       (and (hand-valid-1? (car hands))
     73            (hands-valid-1? (cdr hands)))))
     74 
     75 (define (game-term-1 game)
     76   (if (hands-valid-1? (cadr game))
     77       (string->number (car game))
     78       0))
     79 
     80 (define (answer-1 game-list)
     81   (apply + (map game-term-1 game-list)))
     82 
     83 (define (rgb-max rgb-list cur-max)
     84   (if (null? rgb-list)
     85       cur-max
     86       (rgb-max (cdr rgb-list)
     87                (map (lambda (x) (apply max x)) (zip (car rgb-list) cur-max)))))
     88 
     89 (define (game-power game)
     90   (apply * (rgb-max (cadr game) '(0 0 0))))
     91 
     92 (define (answer-2 game-list)
     93   (apply + (map game-power game-list)))
     94 
     95 (define data (parse all-data (read-string)))
     96 (write-line (conc "First puzzle:  " (answer-1 data)))
     97 (write-line (conc "Second puzzle: " (answer-2 data)))