diff --git a/visp/examples/aoc2023/day21.visp b/visp/examples/aoc2023/day21.visp new file mode 100644 index 0000000..650a3d9 --- /dev/null +++ b/visp/examples/aoc2023/day21.visp @@ -0,0 +1,259 @@ + +;; 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") +(require FSharpx.Collections "3.1.0") + +(open System) +(open System.Text.RegularExpressions) +(open SpanUtils.Extensions) +(open FSharpx.Collections) + +(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] [text: ReadOnlySpan]) + (.EnumerateSplitSubstrings text ch splitOptions)) + +(let example (not (Array.contains "full" ARGV))) +(let day "day21") +(let filepath (String.concat "" [| "./inputs/" day (if example "_example" "") ".txt" |])) +(printfn "file: %s" filepath) + +(let fileText (System.IO.File.ReadAllText filepath)) + +(union Dir + Up + Left + Down + Right) + +(typedef Pos int * int) +(typedef Grid char[,]) + +(fn inline LeftOf ([(x, y): Pos]) ((dec x), y)) +(fn inline RightOf ([(x, y): Pos]) ((inc x), y)) +(fn inline UpOf ([(x, y): Pos]) (x, (dec y))) +(fn inline DownOf ([(x, y): Pos]) (x, (inc y))) + +(let G_DIRS [| Dir.Up Dir.Left Dir.Down Dir.Right |]) + +(fn inline GetDirFun ([d: Dir]) + (match d + [Up UpOf] + [Down DownOf] + [Left LeftOf] + [Right RightOf] + )) + +(fn inline Around ([p: Pos]) + (->> G_DIRS + (Array.map #(->> p (GetDirFun %1))))) + +(fn inline Width ([g: Grid]) (Array2D.length2 g)) +(fn inline Height ([g: Grid]) (Array2D.length1 g)) + +(fn inline AroundGrid ([g: Grid] [p: Pos]) + (->> p + (Around) + (Array.filter #(begin + (let (x, y) %1) + (cond_ + [(&& + (&& (>= x 0) (< x (Width g))) + (&& (>= y 0) (< y (Height g)))) + (match (.[y, x] g) + [#\S true] + [#\O true] + [#\. true] + [_ false] + )] + [_ false] + ))))) + +(fn inline AroundGridSeq ([g: Grid] [p: Pos]) + (seq-> + (let w (Width g)) + (let h (Height g)) + (for/in [dir G_DIRS] + (let nextp (->> p (GetDirFun dir))) + (let (x, y) nextp) + (cond_ + [(&& + (&& (>= x 0) (< x w)) + (&& (>= y 0) (< y h))) + (match (.[y, x] g) + [#\# ()] + [_ (yield nextp)] + )] + [_ ()] + )))) + +(fn ParseFile ([text: string]) + (mut lines (SplitLines text)) + + (mut yi 0) + + (let res (!vec)) + (mut start (0, 0)) + + (while (.MoveNext lines) + (let line (+Current lines)) + + (unless (+IsEmpty line) + (mut xi 0) + (for/in [ch line] + (match ch + [#\S (set! start (xi, yi)) ] + [_ ()]) + (up! xi inc)) + (.Add res (.ToArray line)) + (up! yi inc) + )) + + ((array2D (.ToArray res)) . start)) + +(let (map, start) (ParseFile fileText)) + +(typedef PosStep Pos * int) + +(fn Fill ([map: Grid] [start: Pos] [maxSteps: int]) + (fn rec Recurse ([map: Grid] [steps: int] results) + (cond_ + [(= steps 0) results] + [_ + (Recurse map (dec steps) (->> results + (Seq.map (AroundGridSeq map)) + (Seq.concat) + (Set.ofSeq))) + ]) + ) + (Recurse map maxSteps (Set.singleton start))) + +(fn CountPoints ([map: Grid] [start: Pos] [maxSteps: int]) + (mut ans (!set)) + (mut seen (Set.singleton start)) + (mut que (->> Queue.empty<_> (Queue.conj (start . maxSteps)))) + (mut looping true) + + (while looping + (match (Queue.tryUncons que) + [None (set! looping false)] + [(Some ((pos, steps), nq)) + (set! que nq) + + (when_ (= (rem steps 2) 0) + (set! ans (Set.add pos ans))) + + (cond_ + [(= steps 0) ()] + [_ + (for/in [nbr (AroundGridSeq map pos)] + (unless (Set.contains nbr seen) + (set! que (Queue.conj (nbr . (dec steps)) que)) + (set! seen (Set.add nbr seen)) + )) + ]) + ])) + + (Set.count ans)) + +(fn Part1 ([map: Grid] [start: Pos] [maxSteps: int]) + ;; (mut results (Set.singleton start)) + ;; (for/to [_ (1 to maxSteps)] + ;; (set! results (->> results + ;; (Seq.map (AroundGridSeq map)) + ;; (Seq.concat) + ;; (Set.ofSeq)))) + + (id (CountPoints map start maxSteps))) + +(fn Part2 ([map: Grid] [start: Pos]) + (fn inline wrap (a b) + (if (< a 0) + (erem a b) + (rem a b) + )) + + (let steps 26501365L) + (let size (int64 (max (Width map) (Height map)))) + (let sizei (int size)) + + (let grid_width (dec (/ steps size))) + (printfn "%A" size) + (printfn "%A" grid_width) + + (let odd_grids (pown (inc (* (/ grid_width 2L) 2L)) 2)) + (let even_grids (pown (* (/ (inc grid_width) 2L) 2L) 2)) + + (printfn "%A" (odd_grids, even_grids)) + + ;; (let odd_points (->> (Fill map start (inc (* sizei 2))) Set.count int64)) + ;; (let even_points (->> (Fill map start (id (* sizei 2))) Set.count int64)) + + ;; (printfn "%A" (odd_points, even_points)) + + (let (sx, sy) start) + + (let last_size (dec sizei)) + (let half_w_1 (dec (/ sizei 2))) + (let size_3 (dec (/ (* sizei 3) 2))) + + (fn Mapper ((pos, size)) (->> (CountPoints map pos size) bigint)) + + (let mains (->> [| + (start . (inc (* sizei 2))) + (start . (id (* sizei 2))) + |] (Array.map Mapper))) + + (printfn "%A" mains) + + (let corners (->> [| + ((sx, last_size) . last_size) + ((0, sy) . last_size) + ((sx, 0) . last_size) + ((last_size, sy) . last_size) + |] (Array.map Mapper) (Array.reduce add))) + + (let smalls (->> [| + ((0, last_size) . half_w_1) + ((last_size, last_size) . half_w_1) + ((0, 0) . half_w_1) + ((last_size, 0) . half_w_1) + |] (Array.map Mapper) (Array.reduce add))) + + (let bigs (->> [| + ((0, last_size) . size_3) + ((last_size, last_size) . size_3) + ((0, 0) . size_3) + ((last_size, 0) . size_3) + |] (Array.map Mapper) (Array.reduce add))) + + (let big_width (bigint grid_width)) + + (+ + (* (bigint odd_grids) (.[0] mains)) + (* (bigint even_grids) (.[1] mains)) + corners + (* (inc big_width) smalls) + (* big_width bigs) + )) + +(let part1 (Part1 map start (if example 6 64))) + +(WriteResult "part1" part1 (if example 16 3682)) + +(let part2 (Part2 map start)) + +(WriteResult "part2" part2 (if example (bigint 470149860542205L) (bigint 609012263058042L))) + +() diff --git a/visp/examples/aoc2023/inputs/day21_example.txt b/visp/examples/aoc2023/inputs/day21_example.txt new file mode 100644 index 0000000..9e1d842 --- /dev/null +++ b/visp/examples/aoc2023/inputs/day21_example.txt @@ -0,0 +1,11 @@ +........... +.....###.#. +.###.##..#. +..#.#...#.. +....#.#.... +.##..S####. +.##..#...#. +.......##.. +.##.#.####. +.##..##.##. +........... diff --git a/visp/lib/core.visp b/visp/lib/core.visp index 37d4cc8..b7d791b 100644 --- a/visp/lib/core.visp +++ b/visp/lib/core.visp @@ -41,6 +41,7 @@ (fn inline mul [(lhs: ^a) (rhs: ^a)] (* lhs rhs)) (fn inline div [(lhs: ^a) (rhs: ^a)] (* lhs rhs)) (fn inline rem [(lhs: ^a) (rhs: ^a)] (CoreMethods.rem_impl lhs rhs)) +(fn inline erem [(lhs: ^a) (rhs: ^a)] (CoreMethods.euc_rem_impl lhs rhs)) (fn inline sub1 [a] (- a LanguagePrimitives.GenericOne)) (fn inline dec [a] (- a LanguagePrimitives.GenericOne)) (fn inline add1 [a] (+ a LanguagePrimitives.GenericOne))