Advent of Code 2020 solutions in Racket, I guess
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

144 lines
5.6 KiB

#lang typed/racket
(require (prefix-in q: pfds/queue/real-time)
(only-in pfds/queue/real-time
Queue queue enqueue head tail queue->list build-queue head+tail))
(require/typed "lib/common.rkt"
[answer (-> Positive-Integer Positive-Integer Any Void)]
[dbg (All (A) (-> A A))])
(: parse (-> Input-Port (Listof (Listof Integer))))
(define (parse prt)
(: parse-player (-> String (Listof Integer)))
(define (parse-player str)
(match-define (list _ cards ...) (string-split str "\n"))
(cast (map string->number cards)
(Listof Integer)))
(map parse-player (string-split (port->string prt) "\n\n")))
(: list->queue (All (A) (-> (Listof A) (Queue A))))
(define (list->queue lst)
(apply queue lst))
(: enqueue* (All (A) (-> (Queue A) A * (Queue A))))
(define (enqueue* queue . to-queue)
(for/fold ([q queue])
([v (in-list (reverse to-queue))])
(enqueue v q)))
(: queue-length (All (A) (-> (Queue A) Integer)))
(define (queue-length queue)
(let loop ([q queue] [l 0])
(cond [(q:empty? q) l]
[else (loop (tail q) (add1 l))])))
(: queue-take (All (A) (-> (Queue A) Integer (Queue A))))
(define (queue-take queue n)
(for/fold : (Queue A)
([#{q : (Queue A)} queue]
[#{r : (Queue A)} (q:empty A)]
#:result r)
([_ (in-range n)])
(values (tail q)
(enqueue (head q) r))))
(: play-game (-> (Queue Integer) (Queue Integer) (Queue Integer)))
(define (play-game player-one player-two)
(cond [(q:empty? player-one) player-two]
[(q:empty? player-two) player-one]
[(> (head player-one) (head player-two))
(play-game (enqueue* (tail player-one) (head player-two) (head player-one))
(tail player-two))]
[(< (head player-one) (head player-two))
(play-game (tail player-one)
(enqueue* (tail player-two) (head player-one) (head player-two)))]
[else (error "play-game: unreachable")]))
(: day22a (-> (Listof (Listof Integer)) Integer))
(define (day22a input)
(define player-one (list->queue (first input)))
(define player-two (list->queue (second input)))
(define winner (queue->list (play-game player-one player-two)))
(for/sum ([card (in-list winner)]
[num (in-range (length winner) 0 -1)])
(* card num)))
(: play-game* (-> (Queue Integer) (Queue Integer)
(Pairof (Queue Integer) Integer)))
(define (play-game* p1 p2)
(: play-game*/iter (-> (Queue Integer) (Queue Integer)
(Setof (Pairof (Queue Integer) (Queue Integer)))
(Pairof (Queue Integer) Integer)))
(define (play-game*/iter p1 p2 visited)
(displayln (queue->list p1))
(displayln (queue->list p2))
(cond [(q:empty? p1) (cons p1 1)]
[(q:empty? p2) (cons p2 2)]
[(set-member? visited (cons p1 p2)) (cons p1 1)]
[else
(define p1-card (head p1))
(define p2-card (head p2))
(define new-visited : (Setof (Pairof (Queue Integer) (Queue Integer)))
(set-add visited (cons p1 p2)))
(cond [(and (>= (queue-length (tail p1)) p1-card)
(>= (queue-length (tail p2)) p2-card))
(match-define (cons deck winner)
(play-game* (queue-take (tail p1) p1-card)
(queue-take (tail p2) p2-card)))
(match winner
[1 (play-game*/iter
(enqueue* (tail p1) p1-card p2-card)
(tail p2)
new-visited)]
[2 (play-game*/iter
(tail p1)
(enqueue* (tail p2) p2-card p1-card)
new-visited)]
[_ (error "play-game*: unreachable (non 1/2 winner)")])]
[(> p1-card p2-card)
(play-game*/iter (enqueue* (tail p1) p1-card p2-card)
(tail p2)
new-visited)]
[(< p1-card p2-card)
(play-game*/iter (tail p1)
(enqueue* (tail p2) p2-card p1-card)
new-visited)]
[else (error "play-game*: unreachable (p1-card = p2-card)")])]))
(play-game*/iter p1 p2 (set)))
;; (define (day22b input)
;; (define player-one (first input))
;; (define player-two (second input))
;; (define winner (car (play-game* player-one player-two 0 (make-hash))))
;; (for/sum ([card (in-list winner)]
;; [num (in-range (length winner) 0 -1)])
;; (* card num)))
(module+ main
(call-with-input-file "data/day22.txt"
(λ ([prt : Input-Port])
(define input (parse prt))
(answer 22 1 (time (day22a input))))))
;(answer 22 2 (time (day22b input))))))
(module+ test
(displayln (queue->list (list->queue (list 1 2 3 4 5))))
(displayln (queue-length (queue 1 2 3 4 5)))
(displayln (queue->list (queue-take (build-queue 50000 (inst identity Integer)) 27)))
(call-with-input-file "data/day22.test.txt"
(λ ([prt : Input-Port])
(define input (parse prt))
(displayln (queue->list
(play-game (list->queue (first input))
(list->queue (second input)))))
(displayln (queue->list
(car
(play-game* (list->queue (first input))
(list->queue (second input)))))))))
;; (check-equal? (car
;; (play-game* (first input)
;; (second input)))
;; '(7 5 6 2 4 1 10 8 9 3)))))