81 lines
2.4 KiB
Racket
81 lines
2.4 KiB
Racket
|
#lang curly-fn racket
|
||
|
|
|
||
|
|
(require "scripts/aoc.rkt")
|
||
|
|
|
||
|
|
;; solution for day 22
|
||
|
|
(define (score cards)
|
||
|
|
(for/sum ([card (in-list cards)] [mult (in-range (length cards) 0 -1)])
|
||
|
|
(* card mult)))
|
||
|
|
|
||
|
|
(define (play p1 p2)
|
||
|
|
(cond
|
||
|
|
[(empty? p1) (score p2)]
|
||
|
|
[(empty? p2) (score p1)]
|
||
|
|
[else
|
||
|
|
(define p1-card (first p1))
|
||
|
|
(define p2-card (first p2))
|
||
|
|
(cond
|
||
|
|
[(> p1-card p2-card) (play (append (rest p1) (list p1-card p2-card)) (rest p2))]
|
||
|
|
[else (play (rest p1) (append (rest p2) (list p2-card p1-card)))])]))
|
||
|
|
|
||
|
|
(define (part1 input)
|
||
|
|
(match-define (list p1 p2) input)
|
||
|
|
|
||
|
|
(play p1 p2))
|
||
|
|
|
||
|
|
|
||
|
|
(define (part2 input)
|
||
|
|
(match-define (list p1 p2) input)
|
||
|
|
|
||
|
|
(define memo (make-hash))
|
||
|
|
(define (do-memo level p1 p2)
|
||
|
|
(hash-update! memo level (lambda (x) (set-add x (list p1 p2))) (set)))
|
||
|
|
|
||
|
|
(define (play/recur p1 p2 [level 0])
|
||
|
|
; (printf "~a ~a\n" p1 p2)
|
||
|
|
(cond
|
||
|
|
[(set-member? (hash-ref memo level (set)) (list p1 p2)) (cons 'p1 (score p1))]
|
||
|
|
[(empty? p1) (cons 'p2 (score p2))]
|
||
|
|
[(empty? p2) (cons 'p1 (score p1))]
|
||
|
|
[else
|
||
|
|
(define p1-card (first p1))
|
||
|
|
(define p1-rest (rest p1))
|
||
|
|
(define p2-card (first p2))
|
||
|
|
(define p2-rest (rest p2))
|
||
|
|
(cond
|
||
|
|
[(and (>= (length p1-rest) p1-card)
|
||
|
|
(>= (length p2-rest) p2-card))
|
||
|
|
(match-define (cons winner score)
|
||
|
|
(play/recur (take p1-rest p1-card) (take p2-rest p2-card) (add1 level)))
|
||
|
|
; (printf "submatch ~a\n" winner)
|
||
|
|
(do-memo level p1 p2)
|
||
|
|
(if (symbol=? winner 'p1)
|
||
|
|
(play/recur (append p1-rest (list p1-card p2-card)) p2-rest level)
|
||
|
|
(play/recur p1-rest (append p2-rest (list p2-card p1-card)) level))]
|
||
|
|
[(> p1-card p2-card)
|
||
|
|
(do-memo level p1 p2)
|
||
|
|
(play/recur (append p1-rest (list p1-card p2-card)) p2-rest level)]
|
||
|
|
[else
|
||
|
|
(do-memo level p1 p2)
|
||
|
|
(play/recur p1-rest (append p2-rest (list p2-card p1-card)) level)])]))
|
||
|
|
|
||
|
|
(cdr (play/recur p1 p2)))
|
||
|
|
|
||
|
|
;; parse input file
|
||
|
|
(define (parse fname)
|
||
|
|
(match-define (list p1 p2) (string-split (file->string fname) "\n\n"))
|
||
|
|
(list
|
||
|
|
(map string->number (rest (string-split p1 "\n")))
|
||
|
|
(map string->number (rest (string-split p2 "\n")))))
|
||
|
|
|
||
|
|
(module+ test
|
||
|
|
(require rackunit)
|
||
|
|
;; tests here
|
||
|
|
(displayln "no tests :("))
|
||
|
|
|
||
|
|
(module+ main
|
||
|
|
(define input (parse "inputs/22"))
|
||
|
|
(answer 22 1 (time (part1 input)))
|
||
|
|
(answer 22 2 (time (part2 input)))
|
||
|
|
(displayln "meow"))
|