Browse Source

visceral pain

canon
Hazel Levine 7 months ago
parent
commit
cb6e58ccfe
Signed by: hazel GPG Key ID: 1884029A28789A62
  1. 13
      data/day22.test.txt
  2. 53
      data/day22.txt
  3. 1
      data/day23.txt
  4. 339
      data/day24.txt
  5. 61
      day20.rkt
  6. 144
      day22.rkt
  7. 67
      day23.rkt
  8. 110
      day24.rkt

13
data/day22.test.txt

@ -0,0 +1,13 @@
Player 1:
9
2
6
3
1
Player 2:
5
8
4
7
10

53
data/day22.txt

@ -0,0 +1,53 @@
Player 1:
20
28
50
36
35
15
41
22
39
45
30
19
47
38
25
6
2
27
5
4
37
24
42
29
21
Player 2:
23
43
34
49
13
48
44
18
14
9
12
31
16
26
33
3
10
1
46
17
32
11
40
7
8

1
data/day23.txt

@ -0,0 +1 @@
394618527

339
data/day24.txt

@ -0,0 +1,339 @@
neneneneneneeswneenene
wwsewnewwwswnwwswwwewswweswse
nwneseneneswnenwnenesene
wnwnwswnwwwwwwwwsenwenwnewnwe
neswseseswnwneweswwnwsweseswenwse
eeneenewseneweeeseeeeeenew
neewseeeneswsenewseewswwne
wwwwnwwnwnwnwnwsenwwne
nweeseswesweseeseeesenwseeenwww
eneswwweswwswswe
nenenwneneneneswnenenenwnene
eswwswswnewsenenwseseseseseeswseswsese
nwswswswseswswneswsweswswswnenenwsewsese
eneeeeesewewenweewe
nwnenwnwnwnenwnwwswnwnenwsenenwswenwnw
sesesenwswswswswseswswswe
weeneseeneeeenwswweeeesweee
sewwwwwwwwnwnwnwenwswnwnenwwnwe
wwwenewwwnwwwswnwwsw
swswwswswswsweswswsesw
nenenwsenwenenwnwnwnww
swswnesenewswnesesesesesewswsesesesesw
swseswswswnwseseswswwswseswneswneswswswew
eswnwweswsewwnw
seeeeweseeesenesesweeewnesese
seseneseweseseseseseswwnwseswswsesenese
nwnwswnwnwnenenwnewneenwnenwnene
ewswswwnwnwneseswnenenwnwwesesweswee
wwwwwseeswnwnwwsenwseeswnwnewsw
nwwnwwsesewwnwwnwwswwnwnwneenww
sewnewneneswneneeswneeeneneneenwnee
eswneeeeweneneneeneeeweseee
weeewsewnwwneeswwnwnwwsewew
swnwweswsenwnwnwnwnwnwnwnwnwnwnenwnwe
nwneswseswseseeeseswsesesesenenesewew
swneswnesesewswswwswswswse
swseewsewnwsesenesenenwesewene
neneswseneneenenwneseneneswneewnwneswne
swswsewseswneseswswswsesesesewseneswne
nwswnenwneneseneenwneswnenenesenwnwnww
eenwsweseseeneseenweeswsenweeswse
wwswnwnwwwnwnwnwe
wweneenenwseenenenesenenenewnwnew
seeeneenwswseeweneseeseenwwew
nwewnwweweenwwwwwnwnwwswnw
nenwnenesenwnwnenwsenwnewneswsenenenwnenw
nwneeeeneneneneeneswnenee
swnwnwseseswswseseseswswseswsesw
wswswswwseneenesesesesw
eneswnenesenwswsenenwnwnenenenwnenwne
eeseseseseseenwsesewsesenesenwesee
swswswwwwswsewneswwsw
swnenwseneseswseneswseenwswswesewnesesww
neneneswswwenenenene
wswwwwsewnwwwnewwwsewewnwsee
wnwwsewneenwwww
swswneswwneswswswswseseewswsw
neswewneeswswnee
senenwseeeesweseeeswseeeenwee
sewsenwswswnwswswswswswesweswswswswnwsww
nesenwsweswwwneeneswnwnwswweeesw
eeseneseseseeeeswwwenweseseewse
swsenwneenwnenenenwnwwnesw
wnwwwseswnwnwnenwneenwwwnwswnwew
nwneneneneeneeneneneeeswene
senwnesenewsesesenweswsesenesesesesew
eneneswwwneeewswsenesewwenenewse
eeswwwneeswneswneenwwnenenewnwnenese
eeeeeeeeneesw
wwewewwwwwwewnwswwwnwnwe
eseeeeewwswenwweseeeeneee
seeswseseseseseseesenwsese
nwwnwnwnwnweswnwwewnwsesenenwwenw
seseseswneeseswwnwsenesesenww
swnwseswseswseswswswseeswswswswnewnwsw
swswswsweswswswswwswswne
eeswnweswswewwesenwseeenewnenw
swswnewweenwnwwsenenewswswswwwsewe
seswswswswswneeswwswswnwseswseswswsenwne
eneneenenwwsewneenwsweeesweww
swweswseswnwswswswswseswnwseswswswnwswsw
eswnwnwnwswnenwnwnwsenwewnwnenenwnwnw
seseswsewsesenesesee
wwwewwwnwwnwwwwwnesw
esenwseseewnesewswseneewseseswnewse
swseswnenwwseweseseswnwwwswnwnewswswne
seneseseseneseeseswwewseneneewswnwe
nwneeswwwnwsewwse
sesesenenwsesenwwesesesewnesenesewese
nwswseseseesesesesese
nenwnwnenewnwnwnwnenwseswneneswnwnwswnesw
seneesenewnwnwswswsenwnwnwneswnwnwnwwnww
nenwwwwwwesenewesewwwnewsew
nenwneeeneeneseeneeenee
swnewnwnwewswseseswswswswswsenwwsww
senwnwewwwnewnwswwnenewnwnwnwwnwsw
nenenenenwneneenenenenenesw
eeeneneneeeenwseee
eneeenenenweweneeeeswenewsene
sewnwwseswewneenwwnwswwsewseswsww
enwseesenwsewnwswewneese
wswswswwneswsewswneweswwswwswww
swswsesenenwswsesenewseseseeseneewsese
sewnwnwnwnwnenwenwsenwsenwnwnwwnenwwnwse
neswnwsesenwsesewseswneswswswseswswswwse
seswswseseswseseseneswswnwswnwseswswse
esewnenewenewwswnesenwenenenwsese
eeseeeswneewsewseenwwswsenesene
enwsweeeeenwwseneweeeswnesww
seneneeenewweeneenenewseneswnwene
enwswnwswenwwsesenwnwwewnewswswsese
neswnwwneeseeeenenesenwnenenenenene
swwwewwewwsewsewwwwwnwnewnew
eesweeeweseeweeweeneeenee
swnenwswnesweswnwsenwneneeswenwswnenwene
swnwwwwwwwwwwswwswneeenwwww
nwnwnwwsewewewnwnwnwnweswnwneswswnw
nwsewseswsenwnwneewwnw
nenenwwsenwnenenewnenwneneneneswnwnwswse
eswwswswnesenwsenenewsw
seswwnewnwnwwseswswswswswsewesww
eneswnenwnenwnwswnwnw
weneswsenwseneweneeneenesesenewnenee
eseenenwswnweseeseeeseeseswsesese
swswseseseswseseswseswnw
nwseswswwswswswswswswenewswsenwsesenenw
nwneenenenewneneneeneneswnesewnenesw
swswnwswnwswsenwseswswswswswswsewnwswsew
sewseseneseswseswsewnewwswwenwnwnenese
nwnwwnwnwenwsenwwwwnwwnwnwsenwwsew
wswnwnwnwenenwnwneseswwenwnwenwswnew
wnwwwwwsenwsenwwwwwnewsew
seswseseswsesewseenesewnesenesewsesese
enwswwswswswwnwwnwswwsewwenenwew
neweneneeeeeneeenene
seeseeeenweneseneweesewnwseseeese
nesewnwenwnwneenwwswsenwne
senwswnwenwnenwnenwnwwnwnwwewnwneenwne
nenwnwnwneeneswnwnwnwsewnenese
swwwsewneswswwwswesewwnewnewnww
swswneswswswsewswswswswnwwsesweneswesww
wswswwwwsewwswswswnw
ewneenwwneseneseeswenenesewnewne
seswswsenenewswseseswswwneweswsewse
enewnwwwswenwnwewnwnwnwswesesee
seswswseswsweswnwseswnwswswswswse
nwseseswswseswswswneswseswswsesweswswne
eeeweenweeeeeeeeeswseswnwe
neneeeeeseeeeenw
eewseeeeeeeeeee
wwnenwnwnwwseenwwwnwwwneeswswwww
neneswnwnewnwwsenee
seswnwneeenwswswnwnenwwnwnwwwnwsenw
swswswseswnwsweseswnwseswswneswswswsese
seneseenwswseseseseseswsesesese
nenwseswswseeswseseseseseseneseesese
swnwnenenwneenwsenenwwneswsenwnenenenw
neswseeswneswsesenwsewse
sesewneneswswseseenenewsesesewnesew
eeswseewswneeneseneswenesweew
neswnwnwwewsweswnwenw
swwenwseswseswseseneswsewseseseseese
esewsewnewnwwwwneswnwswwwwnenesww
nwsenenwnenenewnwsenwnwswnwwewswwsw
nwseeeseeeeeneweeewneseenwee
nenweneswswseeswneeeneeeeneneswne
weeseewseeseneseesewseeseneeew
nwsesenenwneneseeenewenewswwneseww
neswnwswneswseneeeneneneneswnweenesw
ewswswswswswswsenwne
senwwnwnwswwnwnwnwnwnenwsenwswseenenw
eswesenenenewneneneneeeenwne
eeseeswnewsewseeesenwesweseeenee
nwnewswesesewseswsewneeneneswsw
wneneneneswneneswenenenwneneneenenene
nwnwswneneeneewneneswewenenenenee
swneeneeeneeesw
nenwnenwneswnwwnenwseseseneneneneneneswne
swseseswneswneseswswseneswswwne
swneseswnwsenwnenwwenwenwnwnwnenwwne
nwewwswswwewwswswseewnenwseww
esewsesenesesesenesesewesesesew
neneneeseswnwseswswnwsewsw
seseeewseneseseseseeeswe
wwsewswswnwwwwenwwwwewswww
sewsenwnwseswwswseseseeswneseseseswswe
seseswswseseswnwswsweswswwse
swnewswsenenwnweseneswwnwnwnww
wnwseneenwsesenenewnenwwnenewnenwnee
nwnwnwnwnwenwswnwenwswenwwswnwsewnwnwe
wwswswsweneswswswenewswwswswwswew
nwnwnenewnenweseeneseneswneenenesenese
swwseswenenenwswswswswswswswwswswseswsw
senenesenenwnewnenwneswnenwnenenenenwne
swswnweswenwnewswnwneeeswnenewswswnw
swseswwnenweseswsesesewneeswsenwseswe
nwsewwwswswwneswweswwswwsewww
esesewneenenwneeneneweeenee
swseseesesesesesesewnweneneswwnwnwse
neseseseseswwsesesese
ewenwwnweswseeeee
enenwnwwewenwseseseeeneseenenwe
neenwseenwnwnwwwnwnwnenwnenwnwnwnwswne
wnenwnwnwneneenenwnesewnenwnenewsenenw
nenenewsenwnenwnenwenenesenewsenenenene
senwneseneeeswsweswnenwwenenwnene
ewnwwnwnwnwnwnwnwnwsenwnwswnwwnw
wwswsewswewwwwwewsenwswwne
wnwwswwwwnenwwnwswwwwsene
nwnewwwnwwewwwewnwswwwsewww
eeeesweneeneswenenewnwneeeee
nwnwnwewwenenwse
neenewnesenenenwnenwnwnenene
seswswswswswnewseseswneseswseneswwsesw
newnwesewnenwnwsenenwnenwnwnwenwnwsw
wnwwnwwnwwwneswwwswnewse
esenweesesweeseseese
swnwnwseswwnwseswseeseseseeseswsesesenwnw
eeswneeswnenenewnwnenenenenesweswnwse
wswswwneswseseseneswswneswwnewwwse
wwneneneneeewswneeneenweswesee
swseswswswswnwswsesesene
swnwswswswswswswwesw
newneneeneneneenesenenene
eseswnwswswswswnweswseseswseswsesesesenw
weseeseeeeeweeneeneewnenee
ewwwwwnwwwwswwwswwweenww
nwnwnwnwenwnwwwsewwewwwwnenww
neeseeeseewswseneswwenwwwneswsese
seswseseweswswsesesesw
swnwsesweseseswwseswseswswneseswesenwse
swseweneswnwwsweswenewseswsewnwnwne
nwnwswswnwwnwenwswsenwnwnesene
swnenwswswswswswneseswswwseswswseswswsw
nenwnwneseneswnenwnenene
nenewseswsenesesesesesesesesesesesewwse
senewswnenenenesew
eneswwseewseseeseenwewnenenwesese
nwsenenenewneneseeneenenwnenenenenesw
weswsenwswnwsesenesenwweneseeswsewsw
eeseseseseseswsesesenese
swwwnwwnwenwwnewswnwnewwnenwsesw
weewneeeeeewsweeseeeeseee
sewnwseseseeneswsewseseweseseswsese
swnenwseenenwsewsenenewwnenenenwenene
wwswwnwwseswneneewwwswnewwneseww
senewseseseseseseenwsewseneswsesesesenw
seneneneweneenenenenwneneneneswnenew
eesweeneeeeeewswneeeeee
wwwswnewwwwew
nweeseseneeenwnweseweswsweee
nesewswswneseewnenenweneeswnesweene
nwwsewewwwweewewwswswwww
wswwnwwnewwwenenwwseswnwewwwse
wnenenwneeswnenwnwnwnenenwswnwnweswenw
eseswswwnwswswnesenwseswswseenwnwsenw
nenwnwnwneneswnwnenesesenwnenwnwwnwnwne
eswnenwswnwswneenweneswnenenw
nwnwnewwnwnwweswneswnwwnwnwnwwsewnw
wswnwswswewswwswwsww
swwnwwswswswweswswsweenwswwwswsww
wwwwewwwwwwwwwnw
senesenenenwnwnwnwsenenw
nwwnwwsenwwnwnwwenwnenww
nwnewnenwnenesenesenesenwnew
nwnwsenwswnwwwsenwenwenwnwnwnwsenwse
eswswsesewswnenesenwenwesesesenwswsw
nenewnenewswwswswsesenenenewnwnwsenwsw
nwsenwnewnenwnwnwswwswnesenenewenesenwse
swseneseseseewnweseswswswswewswnwnese
nwnenwnwseseeesesenwnwswsesewnweseeesw
wnwnwwnwnwnesenwnwnwseneseswnwnwnwnwnenwe
neewweswseneesesewnenewsesesenese
eewesweeeeswewneeneneneneene
neneeneeswneeneeneneenwnee
nwnwwsewsenwwnenwsewwnwnwnenwenwwnwnw
sesewswseswswseswesweswswswswswnwnwsw
swnwneenwnenewenwnwnwewseenwswesw
swnwenwnwneenenwnenwnwenwswnenenwswne
wsesweneseswswwwswswswnwsenwneenweww
wsenweeeeseeeeeesesewewesew
neswnwnwnwnwswesesenwneswnw
swwswswswneswsweswwswswneneswseeswswsw
sweswenwnesweeenweswnwsesenewwenw
senenwnwnewnwnenenenwnenw
nenwneneswnwnenenwnwe
nenenenwsewesweenewneneseweneee
eseswsenewnewsesewswwnwenesesesesese
neneenenenwneswnene
neswnwnwnenenenwnwswnenwnenwwe
eeswswnwsweeeeneene
eswswswnwnweswswswnwswswseswswswwswe
newswnwnwsweeneneeswnwseswnwenwnwnenwnw
nwwnwsewneswwwwnwsewsweewswneswsew
newsewnenenenenesweneeewwnwnesenew
wnewenwsewwwwnenwnwswnwwwwwsenw
neneeenweeeswneseenesenwsewesenw
neswswswswswswswseseenw
enwnwnenwswwnwneenwnwswnwnenenwnwnwenw
newswwsenewwwwwwseeswsewwwwswne
wwseseseseseseseenesenwneseseeseswsese
wswnwnwwneswsewwnenwswnwenwnwwnww
sesesewesewneswneneneseewsweeseswe
eneeswswneneseneneneenewnew
eeswnenenenwnwwnenwnenenwnenwnesenwne
seswseswnwneswswsesenwesesesenwesewseesw
seneeswwnwneswwswnwwwwewwnwnwe
wwweswwwsewwwnwwwww
seeneneeweneeeenwee
swnwnenwnwnwnwnenwwnwnwnenwsesw
nwwwenwwnwswwwnwnwsenw
eweeesenewneneneneeenene
nwwswnwnesenwnwnwnwnwnwswnenenwnwnwnwnw
eswseeseseswnwsesenwsenwseseswswseswswsw
enwseeeenwnwneseeswswweeeswese
wneeneeneneneneenenenese
neesesesesewenewsew
nenwsenwenwnesewnesenewwenwnwnwsene
neeeseesweneeesenwseswesweeew
seswswwsewnwswswwneswswswswseswwnwsw
sewwseseseneeseseesesesesewsesesese
swwneseswswswswseswswswseneweneseswswsw
swswwswswsweneswnwnwseseseswswswseswsw
swenwnenwnwnenenwnenenenenwne
seeseseeseeesesesenesewswsese
wwswwwwwnwwwwewwswnwwneesese
wneneenwneenenenwnwneswnenenwnwnenwnwsesw
wwnewswwswsewwneswwnewsewwww
wswseswswnwseswewwswwsenewswswnenw
seneweenenwneeeeeeeeesw
esesewnwnwnwwwswnenwwweneswswne
senwwwswwswwwweewwwswnenwsww
ewswswseneeeenwneseswseneesewnwew
nenwnwnwneseswenwseesenenenwwnwnwwnwnw
seseesesenweneseseneeeeeseswsewe
sewweneswneswswwswswwswwnwswswswwsw
wseneweweswsenenenesewweswnwsewsese
nenwnwswnweesenwnwswnwnwwwewweswnwse
senwseseseseseswseseswsesenesese

61
day20.rkt

@ -69,11 +69,6 @@
(define neighbors (length (get-neighbors G v)))
(if (= neighbors 2) v 1)))
(define *sea-monster*
" #
# ## ## ###
# # # # # #")
(define (board-flip board)
(vector-reverse board))
(define (board-rotate board)
@ -86,7 +81,7 @@
([_ (in-range 0 n)])
(board-rotate brd)))
(define (board-permutations board)
(for*/list ([fn (in-list identity board-flip)]
(for*/list ([fn (in-list (list identity board-flip))]
[rotations (in-range 4)])
(fn (board-rotate-n board rotations))))
@ -97,7 +92,7 @@
(= (cdr key) id)))
key))
(define (force-fit data board1 board2 direction)
(define (force-fit board1 board2 direction)
(define (get-working-edge dir edges)
(match-define (list left right top bottom) edges)
(match dir
@ -118,7 +113,9 @@
perm))
(define (meta-board-populated? meta-board x y)
(not (false? (board-ref meta-board x y))))
(match-define (cons m n) (board-dim meta-board))
(or (< x 0) (< y 0) (>= x m) (>= y n)
(not (false? (board-ref meta-board x y)))))
; populates the neighbors for the given id
; returns the ids and posns as pairs of the two boards placed
@ -130,18 +127,23 @@
['right (struct-copy posn pt [x (add1 x)])]
['top (struct-copy posn pt [y (sub1 y)])]
['bottom (struct-copy posn pt [y (add1 y)])]))
(define (gen-next-posn from to)
(match-define (list _ dir _) (hash-ref meta (cons from to)))
(define (place-direction from to)
(first (hash-ref meta (cons from to))))
(define (gen-next-posn dir)
(define p (next-posn dir))
(if (meta-board-populated? meta-board (posn-x p) (posn-y p))
#f
p))
(for*/list ([neighbor (in-list (get-neighbors G id))]
[next-psn (in-value (gen-next-posn id neighbor))]
[dir (in-value (place-direction id neighbor))]
[next-psn (in-value (gen-next-posn dir))]
#:when next-psn)
(board-set! meta-board (posn-x next-psn) (posn-y next-psn)
(hash-ref mapping neighbor))
(dbg
(force-fit (hash-ref mapping id)
(hash-ref mapping neighbor)
dir)))
(cons neighbor next-psn)))
; computes the entirety of the metaboard
@ -176,11 +178,35 @@
meta-board)
(define (collapse-meta-board meta-board)
(match-define (cons d _) (board-dim meta-board))
(match-define (cons m n) (board-dim (board-ref meta-board 0 0)))
(for/vector ([row (in-range (* d n))])
(for/vector ([col (in-range (* d m))])
(board-ref (board-ref meta-board (quotient col m) (quotient row n))
(modulo col m) (modulo row m)))))
; ---
; #
; # ## ## ### <-- look at this dude
; # # # # # #
; ---
(define (sea-monster? image x y)
#t)
(define (count-sea-monsters image)
0)
(define (day20b input)
(define dimension (/ (hash-count input) 2)) ; guaranteed to be square
(define-values (G meta) (gen-graph input))
(define image (collapse-meta-board (generate-meta-board input G meta)))
0)
(define n-hash
(for/sum ([row (in-vector image)])
(vector-count (λ (c) (char=? c #\#)))))
(- n-hash (* 15 (count-sea-monsters image))))
(module+ main
(call-with-input-file "data/day20.txt"
@ -190,11 +216,14 @@
(answer 20 2 (day20b input)))))
(module+ test
(require rackunit)
(define (dbg-board board)
(for ([row (in-vector board)])
(displayln (vector->list row)))
board)
(call-with-input-file "data/day20.test.txt"
(λ (prt)
(define input (parse prt))
(define-values (G meta) (gen-graph input))
(dbg meta)
(dbg (generate-meta-board input G meta)))))
(dbg-board (collapse-meta-board (dbg (generate-meta-board input G meta)))))))

144
day22.rkt

@ -0,0 +1,144 @@
#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)))))

67
day23.rkt

@ -0,0 +1,67 @@
#lang racket/base
(require "lib/common.rkt"
racket/set racket/string racket/vector
compatibility/mlist)
(define (run-game input steps)
(define len (vector-length input))
(define mapping
(for/vector ([i (in-range (add1 (vector-length input)))])
(if (zero? i) #f (mcons i #f))))
(define fst (vector-ref mapping (vector-ref input 0)))
(define lst (vector-ref mapping (vector-ref input (sub1 (vector-length input)))))
(set-mcdr! lst fst)
(for ([i (in-range 1 (vector-length input))])
(define item (vector-ref mapping (vector-ref input i)))
(define prev (vector-ref mapping (vector-ref input (sub1 i))))
(set-mcdr! prev item))
(define (tick-game item-ref)
(define cur (mcar item-ref))
(define top (mcdr item-ref))
(define bottom (mcdr (mcdr top)))
(define cups
(let loop ([d top] [cards (set)])
(if (eq? d bottom)
(set-add cards (mcar d))
(loop (mcdr d) (set-add cards (mcar d))))))
(set-mcdr! item-ref (mcdr bottom))
(set-mcdr! bottom #f)
(define wanted
(let loop ([wanted (sub1 cur)])
(cond [(zero? wanted) (loop len)]
[(set-member? cups wanted) (loop (sub1 wanted))]
[else wanted])))
(define wanted-ref (vector-ref mapping wanted))
(set-mcdr! bottom (mcdr wanted-ref))
(set-mcdr! wanted-ref top)
(mcdr item-ref))
(for/fold ([ref fst])
([_ (in-range steps)])
(tick-game ref))
(vector-ref mapping 1))
(define (day23a input)
(define result (run-game input 100))
(define one (mcar result))
(string-append*
(for/list ([v (in-mlist (mcdr result))]
#:break (= v one))
(number->string v))))
(define (day23b input)
(define real-input
(vector-append input (build-vector (- 1000000 (vector-length input))
(λ (x) (+ (add1 (vector-length input)) x)))))
(define result (run-game real-input 10000000))
(* (mlist-ref result 1) (mlist-ref result 2)))
(module+ main
(define input #(3 9 4 6 1 8 5 2 7))
(answer 23 1 (day23a input))
(answer 23 2 (day23b input)))

110
day24.rkt

@ -0,0 +1,110 @@
#lang racket
(require "lib/common.rkt")
(struct cposn (x y z) #:transparent)
(define (parse prt)
(define (line->directions chrs)
(match chrs
['() '()]
[(list* #\s #\e _) (cons 'southeast (line->directions (drop chrs 2)))]
[(list* #\s #\w _) (cons 'southwest (line->directions (drop chrs 2)))]
[(list* #\n #\e _) (cons 'northeast (line->directions (drop chrs 2)))]
[(list* #\n #\w _) (cons 'northwest (line->directions (drop chrs 2)))]
[(list* #\e _) (cons 'east (line->directions (rest chrs)))]
[(list* #\w _) (cons 'west (line->directions (rest chrs)))]))
(map (compose1 line->directions string->list) (port->lines prt)))
(define (direction->cposn dir)
(match dir
['east (cposn 1 -1 0)]
['west (cposn -1 1 0)]
['southeast (cposn 0 -1 1)]
['southwest (cposn -1 0 1)]
['northeast (cposn 1 0 -1)]
['northwest (cposn 0 1 -1)]))
(define directions
(map direction->cposn '(east west southeast southwest northeast northwest)))
(define (cposn+ p1 p2)
(match-define (cposn x1 y1 z1) p1)
(match-define (cposn x2 y2 z2) p2)
(cposn (+ x1 x2) (+ y1 y2) (+ z1 z2)))
(define (generate-tiles input)
(define traversals (map (λ (l) (map direction->cposn l)) input))
(define tiles (make-hash))
(define (flip! posn)
(hash-update! tiles posn not #f))
(define (follow-and-flip! path)
(for/fold ([p (cposn 0 0 0)]
#:result (flip! p))
([d (in-list path)])
(cposn+ p d)))
(for* ([trav (in-list traversals)])
(follow-and-flip! trav))
tiles)
(define (day24a input)
(for/sum ([(_ v) (in-hash (generate-tiles input))]
#:when v)
1))
(define (tile-black? tiles p)
(hash-ref tiles p #f))
(define (get-neighbors p)
(for/list ([d (in-list directions)])
(cposn+ d p)))
(define (count-neighbors tiles p)
(for/sum ([d (in-list (get-neighbors p))]
#:when (tile-black? tiles d))
1))
(define (tick-tiles tiles radius)
(define work (hash-copy tiles))
(define (flippe-floppe! posn)
(hash-update! work posn not #f))
(define (check-and-flip! p)
(define n (count-neighbors tiles p))
(when (or (and (tile-black? tiles p)
(or (zero? n) (> n 2)))
(and (not (tile-black? tiles p))
(= n 2)))
(flippe-floppe! p)))
(for* ([x (in-range (- radius) (add1 radius))]
[y (in-range (- radius) (add1 radius))]
[z (in-range (- radius) (add1 radius))]
#:when (zero? (+ x y z)))
(check-and-flip! (cposn x y z)))
work)
(define (day24b input)
(define tiles (generate-tiles input))
(define radius
(for/max ([(p _) (in-hash tiles)])
(max (abs (cposn-x p))
(abs (cposn-y p))
(abs (cposn-z p)))))
(define result
(for/fold ([t tiles])
([i (in-range 100)]
[r (in-range (add1 radius) +inf.0)])
(tick-tiles t r)))
(for/sum ([(_ v) (in-hash result)]
#:when v)
1))
(module+ main
(call-with-input-file "data/day24.txt"
(λ (prt)
(define input (parse prt))
(answer 24 1 (day24a input))
(answer 24 2 (day24b input)))))
Loading…
Cancel
Save