Skip to content

Commit

Permalink
Implement aoc2023 day16
Browse files Browse the repository at this point in the history
  • Loading branch information
vipentti committed Dec 16, 2023
1 parent 1878376 commit 9328ccc
Show file tree
Hide file tree
Showing 3 changed files with 437 additions and 0 deletions.
317 changes: 317 additions & 0 deletions visp/examples/aoc2023/day16.visp
Original file line number Diff line number Diff line change
@@ -0,0 +1,317 @@

;; Copyright 2023 Ville Penttinen
;; Distributed under the MIT License.
;; https://github.com/vipentti/visp-fs/blob/main/LICENSE.md
;;
;; for basic syntax highlighting
;; vim: set syntax=clojure:
(require SpanUtils "0.4.0")

(open System)
(open System.Collections.Generic)
(open System.Text.RegularExpressions)
(open SpanUtils.Extensions)

(fn WriteResult (part value ex)
(printfn "%s: %A %A" part value (= value ex)))

(let splitOptions StringSplitOptions.TrimEntries)

(fn SplitLines ([text: string])
(.EnumerateSplitSubstrings text [| #\lf #\cr |] splitOptions))

(fn SpanSplitChars ([ch: array<char>] [text: ReadOnlySpan<char>])
(.EnumerateSplitSubstrings text ch splitOptions))

(let example (not (Array.contains "full" ARGV)))
(let day "day16")
(let filepath (String.concat "" [| "./inputs/" day (if example "_example" "") ".txt" |]))
(printfn "file: %s" filepath)

(let fileText (System.IO.File.ReadAllText filepath))

(type Grid char[,])

(union Dir
Up
Left
Down
Right
)

(struct Pos ([x: int32] [y: int32])
(member _.X x)
(member _.Y y)

(override fn _.ToString ()
(sprintf "(y: %A, x: %A)" y x)
))


(fn inline UpOf ([p: Pos])
(mkPos (+X p) (dec (+Y p))))

(fn inline DownOf ([p: Pos])
(mkPos (+X p) (inc (+Y p))))

(fn inline LeftOf ([p: Pos])
(mkPos (dec (+X p)) (+Y p)))

(fn inline RightOf ([p: Pos])
(mkPos (inc (+X p)) (+Y p)))

(fn GetDirFun ([d: Dir])
(match d
[Up UpOf]
[Down DownOf]
[Left LeftOf]
[Right RightOf]
))

(type TileMap ([grid: Grid])
(let grid grid)
(let height (Array2D.length1 grid))
(let width (Array2D.length2 grid))

(member _.Grid grid)
(member _.Height height)
(member _.Width width)

(override fn t.ToString()
(sprintf "TileMap\n%s" (.Serialize t)))

(member fn _.Serialize ()
(let sb (new System.Text.StringBuilder))

(for/to [y (0 to (dec height))]
(for/to [x (0 to (dec width))]
(let _ (.Append sb (.[y, x] grid)))
())
(let _ (.AppendLine sb))
())

(.ToString sb))

(member _.Item
(get ([pos: Pos])
(let y (+Y pos))
(let x (+X pos))

(cond_
[(and (and (>= y 0) (< y height))
(and (>= x 0) (< x width)))
(Some (.[y, x] grid))
]
[_ None])
)
(set ([pos: Pos]) ch
(let y (+Y pos))
(let x (+X pos))
(cond_
[(and (and (>= y 0) (< y height))
(and (>= x 0) (< x width)))

(set! (.[y, x] grid) ch)
]
[_ ()])
)))

(type Beam ([p: Pos] [d: Dir] [s: Set<Pos*Dir>])
(mut pos p)
(mut dir d)
(mut visited (->> s (Set.add (p . d))))

(member fn _.Contains (p d)
(Set.contains (p . d) visited))

(member _.Pos pos)
(member _.Dir dir)
(member _.X (+X pos))
(member _.Y (+Y pos))
(member _.Visited visited)

(member fn _.SetPosDir (p d)
(set! pos p)
(set! dir d)
;(ignore (.Add visited (p . d)))
(set! visited (Set.add (p . d) visited)))

(override fn t.ToString ()
(sprintf "Beam(y: %A, x: %A, d: %A, vis: %A)" (+Y t) (+X t) dir visited))
)

(fn mkBeam (p d) (new Beam p d (!set)))
(fn cloneBeam (p d s) (new Beam p d s))

(fn MoveBeam ([tm: TileMap] [beam: Beam])
(let dir (+Dir beam))
(let next (->> (+Pos beam) (GetDirFun dir)))
;; (printfn "next: %A" next)

(mut nextBeam None)
(mut nextDir dir)
(mut canMove true)

(match (.[next] tm)
[None (set! canMove false)]
[(Some ch)
(match ch
[#\. ()]
[#\|
(match dir
[Up ()]
[Down ()]
[Left
(set! nextDir Up)
(set! nextBeam (Some (cloneBeam next Down (+Visited beam))))
]
[Right
(set! nextDir Up)
(set! nextBeam (Some (cloneBeam next Down (+Visited beam))))
]
)
]
[#\-
(match dir
[Left ()]
[Right ()]
[Up
(set! nextDir Left)
(set! nextBeam (Some (cloneBeam next Right (+Visited beam))))
]
[Down
(set! nextDir Left)
(set! nextBeam (Some (cloneBeam next Right (+Visited beam))))
]
)
]
[#\/
(match dir
[Right (set! nextDir Up)]
[Left (set! nextDir Down)]
[Up (set! nextDir Right) ]
[Down (set! nextDir Left)]
)
]
[#\\
(match dir
[Left (set! nextDir Up)]
[Right (set! nextDir Down)]
[Up (set! nextDir Left)]
[Down (set! nextDir Right)]
)
]

[_ (failwithf "unsupported char %A" ch)]
)
]
)

(cond_
[(and canMove (not (-Contains beam next nextDir)))
(-SetPosDir beam next nextDir)
(Some nextBeam)
]
[_ None])
)

(fn ParseFile ([text: string])
(mut lines (SplitLines text))

(let res (new ResizeArray<_>))
(while (.MoveNext lines)
(let line (+Current lines))
(unless (+IsEmpty line)
(.Add res (.ToArray line))
))

(new TileMap (array2D (.ToArray res))))

(fn Part1 ([tm: TileMap] [beam: Beam])
(let beams (!vec beam))
(mut activeBeams (!set ((+Pos beam) . (+Dir beam))))
(mut loop true)
(mut index 0)

(let temp (!vec))
(while loop
(.Clear temp)
(mut couldMove false)
(for/in [beam beams]
(match (MoveBeam tm beam)
[(Some next)
;; (printfn "%A" beam)
(set! couldMove true)
(match next
[None ()]
[(Some next)
(unless (Set.contains ((+Pos next) . (+Dir next)) activeBeams)
(.Add temp next)
(set! activeBeams (Set.add ((+Pos next) . (+Dir next)) activeBeams))
)

]
)
]
[None ()]
))

(unless couldMove
;; (printfn "no more moving beams after %A" index)
(set! loop false))

(.AddRange beams temp)

(set! index (inc index))
)

(->> beams
(Seq.map #(+Visited %1))
(Set.unionMany)
(Set.map #(fst %1))
(Set.filter #(+IsSome (.[%1] tm)))
(Set.count)
))

(fn Part2 ([tm: TileMap])
(let lastW (dec (+Width tm)))
(let lastH (dec (+Height tm)))

(let startZero 0)
(let startW lastW)
(let startH lastH)

(let starts (->>
(seq->
(for/to [y (0 to lastH)]
(yield (mkBeam (mkPos startZero y) Right))
(yield (mkBeam (mkPos startW y) Left))
)
(for/to [x (0 to lastW)]
(yield (mkBeam (mkPos x startZero) Down))
(yield (mkBeam (mkPos x startH) Up))
)
)
(Array.ofSeq)
))

(->>
starts
(Array.map (Part1 tm))
(Array.max)
)
)

(let tiles (ParseFile fileText))

(printfn "%A" tiles)

(let part1 (Part1 tiles (mkBeam (mkPos -1 0) Right)))

(WriteResult "part1" part1 (if example 46 6994))

(let part2 (Part2 tiles))

(WriteResult "part2" part2 (if example 51 7488))

()
Loading

0 comments on commit 9328ccc

Please sign in to comment.