aoc-2023

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

day06.scm (2406B)

      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 ;;;;;;;;;;;;;;;;;
     21 ;; Input parsing
     22 
     23 (define (as-number parser)
     24   (bind (as-string parser)
     25         (lambda (s)
     26           (result (string->number s)))))
     27 
     28 (define spaces
     29   (one-or-more (is #\space)))
     30 
     31 (define digit
     32   (in char-set:digit))
     33 
     34 (define digits
     35   (as-number (one-or-more digit)))
     36 
     37 (define (prefixed-list prefix)
     38   (sequence* ((_ (char-seq prefix))
     39               (data (zero-or-more (preceded-by spaces digits)))
     40               (_ (is #\newline)))
     41     (result data)))
     42 
     43 (define all-data
     44   (sequence* ((times (prefixed-list "Time:"))
     45               (dists (prefixed-list "Distance:")))
     46     (result (zip times dists))))
     47 
     48 (define data (parse all-data (read-string)))
     49 (write-line (conc "Input: " data))
     50 
     51 ;;;;;;;;;;;;;;;;;
     52 ;; First Puzzle
     53 
     54 ; Traveled distance: (total_time - held_time) * held_time)
     55 ; Winning held_time when  -held_time² + total_time*held_time - other_dist >0
     56 ; So bounds are (total_time ± sqrt(total_time² - 4*other_dist))/2
     57 
     58 (define (time-breadth l)
     59   (let ((total-time (car l))
     60         (other-dist (cadr l)))
     61     (let* ((sqrt-discr (sqrt (- (* total-time total-time) (* 4 other-dist))))
     62            (lower (floor (* 0.5 (- total-time sqrt-discr))))
     63            (upper (ceiling (* 0.5 (+ total-time sqrt-discr)))))
     64       (- upper lower 1))))
     65 
     66 (write-line (conc "First puzzle:  " (apply * (map time-breadth data))))
     67 
     68 ;;;;;;;;;;;;;;;;;
     69 ;; Second Puzzle
     70 
     71 (define concat-data
     72   (list (string->number (apply conc (map car data)))
     73         (string->number (apply conc (map cadr data)))))
     74 
     75 (write-line (conc "Second puzzle: " (time-breadth concat-data)))