From 43743266a1be3ca6330a5e7d96f257f42594b46f Mon Sep 17 00:00:00 2001 From: rhiannon morris Date: Sat, 2 Dec 2023 18:39:27 +0100 Subject: [PATCH] ya hear about these macro things --- day2.ss | 150 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 79 insertions(+), 71 deletions(-) diff --git a/day2.ss b/day2.ss index 326db2b..fb9bd32 100644 --- a/day2.ss +++ b/day2.ss @@ -1,4 +1,4 @@ -(import (rnrs)) +(import (rnrs) (only (chezscheme) define-values)) (define-syntax curry (syntax-rules () @@ -6,78 +6,84 @@ (define (mapmap f lst) (map (curry map f) lst)) -(define (split-at ch str) - (let [(len (string-length str))] - (let loop [(start 0) (end 0) (acc '())] - (cond - [(>= start len) - (reverse (if (= start end) (cons "" acc) acc))] - [(>= end len) - (reverse (cons (substring str start len) acc))] - [(char=? ch (string-ref str end)) - (loop (+ end 1) (+ end 1) (cons (substring str start end) acc))] - [else (loop start (+ end 1) acc)])))) - -(define (trim str) - (let loop [(i 0)] - (if (char-whitespace? (string-ref str i)) - (loop (+ i 1)) - (let loop [(j (- (string-length str) 1))] - (if (char-whitespace? (string-ref str j)) - (loop (- j 1)) - (substring str i (+ j 1))))))) - -(define (one-col str) - (let* [(str (trim str)) - (words (split-at #\space str))] - (cons (string->symbol (cadr words)) (string->number (car words))))) - -(define (split-line line) - (let* [(line (split-at #\: line)) - (id (car line)) (line (cadr line)) - (id (string->number (cadr (split-at #\space id)))) - (draws (split-at #\; line)) - (colours (map (curry split-at #\,) draws)) - (pairs (mapmap one-col colours))] - (cons id pairs))) - -(define (max-count col) - (case col [(red) 12] [(green) 13] [(blue) 14])) - +(define-syntax let-pair + (syntax-rules () + [(_ [(x y) pair] . body) + (let* [(xpair pair) (x (car xpair)) (y (cdr xpair))] . body)])) (define-syntax case-list (syntax-rules (nil cons) - [(_ lst [nil n ...] [(cons x xs) c ...]) - (if (null? lst) - (begin n ...) - (let [(x (car lst)) (xs (cdr lst))] c ...))] - [(_ lst [(cons x xs) c ...] [nil n ...]) - (case-list lst [nil n ...] [(cons x xs) c ...])])) + [(_ lst [nil . nbody] [(cons x xs) . cbody]) + (let [(xlst lst)] + (if (null? xlst) (begin . nbody) (let-pair [(x xs) xlst] . cbody)))] + [(_ lst [(cons x xs) . cbody] [nil . nbody]) + (case-list lst [nil . nbody] [(cons x xs) . cbody])])) + +(define-syntax split-list + (syntax-rules () [(_ names lst) (define-values names (apply values lst))])) + +(define sum (curry apply +)) +(define product (curry apply *)) +(define concat (curry apply append)) + +(define (split-at ch str) + (define len (string-length str)) + (let loop [(start 0) (end 0) (acc '())] + (cond + [(>= end len) + (reverse (cons (substring str start len) acc))] + [(char=? ch (string-ref str end)) + (loop (+ end 1) (+ end 1) (cons (substring str start end) acc))] + [else (loop start (+ end 1) acc)]))) + +(define (split-at-nested chs0 str) + (define chs (cond [(list? chs0) chs0] [(string? chs0) (string->list chs0)])) + (case-list chs + [nil str] + [(cons ch chs) (map (curry split-at-nested chs) (split-at ch str))])) + +(define (trim-by p str) + (define (ok k) (not (p (string-ref str k)))) + (define i (do [(i 0 (+ i 1))] [(ok i) i])) + (define j (do [(j (string-length str) (- j 1))] [(ok (- j 1)) j])) + (substring str i j)) + +(define trim (curry trim-by char-whitespace?)) + +(define (one-col str) + (split-list (count col) (split-at #\space (trim str))) + (cons (string->symbol col) (string->number count))) + +(define (split-line line0) + (split-list (id-str line) (split-at #\: line0)) + (define id (string->number (cadr (split-at #\space id-str)))) + (define pairs (mapmap one-col (split-at-nested ";," line))) + (cons id pairs)) + +(define (maybe-split-line line) + (and (not (string=? line "")) (split-line line))) + +(define max-counts '((red . 12) (green . 13) (blue . 14))) +(define (max-count col) (cond [(assq col max-counts) => cdr] [else 0])) -(define-syntax let-pair - (syntax-rules () - [(_ [(x y) pair] body ...) - (let [(x (car pair)) (y (cdr pair))] body ...)])) (define (valid-draw draws) - (case-list draws - [nil #t] - [(cons this rest) - (let-pair [(col count) this] - (if (<= count (max-count col)) (valid-draw rest) #f))])) + (define (ok p) (let-pair [(col n) p] (<= n (max-count col)))) + (for-all ok draws)) (define (valid line) - (let-pair [(id draws) line] - (if (for-all valid-draw draws) id #f))) + (let-pair [(id draws) line] (and (for-all valid-draw draws) id))) + +(define (map-filter p lst) + (define (one x ys) (let [(y (p x))] (if y (cons y ys) ys))) + (fold-right one '() lst)) (define (read-file path) - (let* [(str (call-with-input-file path get-string-all))] - (map split-line - (filter (lambda (s) (not (string=? s ""))) - (split-at #\newline str))))) + (map-filter maybe-split-line + (split-at #\newline (call-with-input-file path get-string-all)))) (define (total lines) - (apply + (map (lambda (line) (or (valid line) 0)) lines))) + (sum (map (lambda (line) (or (valid line) 0)) lines))) (define input (read-file "in/day2")) @@ -85,17 +91,19 @@ (display (cons "part1" (part1))) (newline) -(define (min-cubes draws) - (fold-left - (lambda (a b) - (let* [(get (lambda (col draw) (cond [(assq col draw) => cdr] [else 0]))) - (get-max (lambda (c) (cons c (max (get c a) (get c b)))))] - (list (get-max 'red) (get-max 'green) (get-max 'blue)))) - '() draws)) +(define (get-col col draw) (cond [(assq col draw) => cdr] [else 0])) -(define (power line) - (fold-left (lambda (n c) (* n (cdr c))) 1 (min-cubes (cdr line)))) +(define (get-max draw1 draw2 col) + (cons col (max (get-col col draw1) (get-col col draw2)))) -(define (part2) (apply + (map power input))) +(define (combine draw1 draw2) + (define (get-max-of col) (get-max draw1 draw2 col)) + (list (get-max-of 'red) (get-max-of 'green) (get-max-of 'blue))) + +(define (min-cubes draws) (fold-left combine '() draws)) + +(define (power line) (product (map cdr (min-cubes (cdr line))))) + +(define (part2) (sum (map power input))) (display (cons "part2" (part2))) (newline)