13 Commits

Author SHA1 Message Date
Smaug123
3da77f08c3 Merge branch 'main' into day-18
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
2023-12-23 21:35:26 +00:00
16b801f267 Pull out bits from day 18 (#20)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #20
2023-12-23 21:35:10 +00:00
Smaug123
fd90f94653 Part 1
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
2023-12-23 21:28:39 +00:00
7646fb71c3 Day 19 (#19)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Can't be bothered to get it faster

Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #19
2023-12-23 19:58:35 +00:00
f2a2e630d6 Day 16 (#18)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #18
2023-12-16 11:44:45 +00:00
735a3dbdde Day 15 (#17)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #17
2023-12-15 12:43:27 +00:00
9ec99c8ee9 Day 14 (#16)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #16
2023-12-14 18:11:14 +00:00
dc0aa1ce30 Day 13 (#15)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #15
2023-12-13 12:59:57 +00:00
362a73cc41 Bench (#14)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #14
2023-12-12 21:03:49 +00:00
4e97a4d454 Day 12 (#13)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #13
2023-12-12 19:23:40 +00:00
a24d28ab5c Day 11, super slow (#12)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #12
2023-12-11 09:02:19 +00:00
8af8916d46 Day 10 (#11)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #11
2023-12-10 13:49:03 +00:00
3b98d704d1 Day 9 (#10)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Went with Lagrange interpolation instead because that seemed easier.

Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #10
2023-12-09 09:46:17 +00:00
54 changed files with 3804 additions and 88 deletions

1
.gitignore vendored
View File

@@ -10,3 +10,4 @@ result
.profile*
inputs/
AdventOfCode2023.FSharp/Test/TestResults/

View File

@@ -0,0 +1,22 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net8.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="Run.fs" />
<Compile Include="Inputs.fs" />
<Compile Include="Program.fs"/>
</ItemGroup>
<ItemGroup>
<PackageReference Include="BenchmarkDotNet" Version="0.13.11" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\AdventOfCode2023.FSharp.Lib\AdventOfCode2023.FSharp.Lib.fsproj" />
</ItemGroup>
</Project>

View File

@@ -0,0 +1,19 @@
namespace AdventOfCode2023
open System.IO
open System.Reflection
[<RequireQualifiedAccess>]
module Inputs =
let days =
let mutable dir = Assembly.GetEntryAssembly().Location |> FileInfo |> _.Directory
while not (dir.EnumerateDirectories () |> Seq.exists (fun i -> i.Name = "inputs")) do
dir <- dir.Parent
if isNull dir then
failwith "reached root of filesystem without finding inputs dir"
Array.init 16 (fun day -> Path.Combine (dir.FullName, "inputs", $"day%i{day + 1}.txt") |> File.ReadAllText)
let inline day (i : int) = days.[i - 1]

View File

@@ -0,0 +1,87 @@
namespace AdventOfCode2023
open BenchmarkDotNet.Attributes
open BenchmarkDotNet.Configs
open BenchmarkDotNet.Running
module Benchmarks =
type Benchmark1To5 () =
[<GlobalSetup>]
member _.Setup () = Run.shouldWrite <- false
[<Params(1, 2, 3, 4, 5)>]
member val Day = 0 with get, set
[<Params(false, true)>]
member val IsPartOne = false with get, set
[<Benchmark>]
member this.Benchmark () : unit =
Run.allRuns.[this.Day - 1] (not this.IsPartOne) (Inputs.day this.Day)
[<GlobalCleanup>]
member _.Cleanup () = Run.shouldWrite <- true
type Benchmark6To10 () =
[<GlobalSetup>]
member _.Setup () = Run.shouldWrite <- false
[<Params(6, 7, 8, 9, 10)>]
member val Day = 0 with get, set
[<Params(false, true)>]
member val IsPartOne = false with get, set
[<Benchmark>]
member this.Benchmark () : unit =
Run.allRuns.[this.Day - 1] (not this.IsPartOne) (Inputs.day this.Day)
[<GlobalCleanup>]
member _.Cleanup () = Run.shouldWrite <- true
type Benchmark11To15 () =
[<GlobalSetup>]
member _.Setup () = Run.shouldWrite <- false
[<Params(11, 12, 13, 14, 15)>]
member val Day = 0 with get, set
[<Params(false, true)>]
member val IsPartOne = false with get, set
[<Benchmark>]
member this.Benchmark () : unit =
Run.allRuns.[this.Day - 1] (not this.IsPartOne) (Inputs.day this.Day)
[<GlobalCleanup>]
member _.Cleanup () = Run.shouldWrite <- true
type Benchmark16To20 () =
[<GlobalSetup>]
member _.Setup () = Run.shouldWrite <- false
[<Params(16)>]
member val Day = 0 with get, set
[<Params(false, true)>]
member val IsPartOne = false with get, set
[<Benchmark>]
member this.Benchmark () : unit =
Run.allRuns.[this.Day - 1] (not this.IsPartOne) (Inputs.day this.Day)
[<GlobalCleanup>]
member _.Cleanup () = Run.shouldWrite <- true
module Program =
[<EntryPoint>]
let main args =
let config =
ManualConfig.Create(DefaultConfig.Instance).WithOptions ConfigOptions.DisableOptimizationsValidator
let _summary = BenchmarkRunner.Run<Benchmarks.Benchmark1To5> config
let _summary = BenchmarkRunner.Run<Benchmarks.Benchmark6To10> config
let _summary = BenchmarkRunner.Run<Benchmarks.Benchmark11To15> config
0

View File

@@ -0,0 +1,242 @@
namespace AdventOfCode2023
#if DEBUG
#else
#nowarn "9"
#endif
open System
[<RequireQualifiedAccess>]
module Run =
let mutable shouldWrite = true
let day1 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day1.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day1.part2 input
if shouldWrite then
Console.WriteLine output
let day2 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day2.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day2.part2 input
if shouldWrite then
Console.WriteLine output
let day3 (partTwo : bool) (input : string) =
let resultArr, len, lineCount = Day3.parse (input.ToCharArray () |> Array.map byte)
#if DEBUG
let contents =
{
Elements = Array.take len resultArr
Width = len / lineCount
}
#else
use ptr = fixed resultArr
let contents =
{
Elements = ptr
Length = len
Width = len / lineCount
}
#endif
if not partTwo then
let output = Day3.part1 contents
if shouldWrite then
Console.WriteLine output
else
let output = Day3.part2 contents
if shouldWrite then
Console.WriteLine output
let day4 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day4.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day4.part2 input
if shouldWrite then
Console.WriteLine output
let day5 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day5.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day5.part2 input
if shouldWrite then
Console.WriteLine output
let day6 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day6.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day6.part2 input
if shouldWrite then
Console.WriteLine output
let day7 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day7.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day7.part2 input
if shouldWrite then
Console.WriteLine output
let day8 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day8.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day8.part2 input
if shouldWrite then
Console.WriteLine output
let day9 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day9.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day9.part2 input
if shouldWrite then
Console.WriteLine output
let day10 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day10.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day10.part2 input
if shouldWrite then
Console.WriteLine output
let day11 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day11.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day11.part2 input
if shouldWrite then
Console.WriteLine output
let day12 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day12.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day12.part2 input
if shouldWrite then
Console.WriteLine output
let day13 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day13.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day13.part2 input
if shouldWrite then
Console.WriteLine output
let day14 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day14.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day14.part2 input
if shouldWrite then
Console.WriteLine output
let day15 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day15.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day15.part2 input
if shouldWrite then
Console.WriteLine output
let day16 (partTwo : bool) (input : string) =
if not partTwo then
let output = Day16.part1 input
if shouldWrite then
Console.WriteLine output
else
let output = Day16.part2 input
if shouldWrite then
Console.WriteLine output
let allRuns =
[|
day1
day2
day3
day4
day5
day6
day7
day8
day9
day10
day11
day12
day13
day14
day15
day16
|]

View File

@@ -1,23 +1,38 @@
<Project Sdk="Microsoft.NET.Sdk">
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
</PropertyGroup>
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<TreatWarningsAsErrors>true</TreatWarningsAsErrors>
</PropertyGroup>
<ItemGroup>
<Compile Include="Arr2D.fs" />
<Compile Include="ResizeArray.fs" />
<Compile Include="EfficientString.fs" />
<Compile Include="Arithmetic.fs" />
<Compile Include="Day1.fs" />
<Compile Include="Day2.fs" />
<Compile Include="Day3.fs" />
<Compile Include="Day4.fs" />
<Compile Include="Day5.fs" />
<Compile Include="Day6.fs" />
<Compile Include="Day7.fs" />
<Compile Include="Day8.fs" />
</ItemGroup>
<ItemGroup>
<Compile Include="Arr2D.fs"/>
<Compile Include="ResizeArray.fs"/>
<Compile Include="EfficientString.fs"/>
<Compile Include="Arithmetic.fs"/>
<Compile Include="Rational.fs"/>
<Compile Include="IntervalSet.fs" />
<Compile Include="Direction.fs" />
<Compile Include="List.fs" />
<Compile Include="Day1.fs"/>
<Compile Include="Day2.fs"/>
<Compile Include="Day3.fs"/>
<Compile Include="Day4.fs"/>
<Compile Include="Day5.fs"/>
<Compile Include="Day6.fs"/>
<Compile Include="Day7.fs"/>
<Compile Include="Day8.fs"/>
<Compile Include="Day9.fs"/>
<Compile Include="Day10.fs" />
<Compile Include="Day11.fs" />
<Compile Include="Day12.fs" />
<Compile Include="Day13.fs" />
<Compile Include="Day14.fs" />
<Compile Include="Day15.fs" />
<Compile Include="Day16.fs" />
<Compile Include="Day18.fs" />
<Compile Include="Day19.fs" />
</ItemGroup>
</Project>

View File

@@ -5,6 +5,7 @@
#nowarn "9"
#endif
open System
open Microsoft.FSharp.NativeInterop
[<Struct>]
@@ -100,3 +101,76 @@ module Arr2D =
#else
NativePtr.initBlock a.Elements 0uy (uint32 sizeof<'a> * uint32 a.Length)
#endif
/// Pass in a buffer of memory which we will use entirely for our own purposes (and may resize)
/// to maintain state.
/// `empty` is the value in empty cells; we will fill them with `fillWith`.
let floodFill
(stackBuf : ResizeArray<int>)
(s : Arr2D<'a>)
(empty : 'a)
(fillWith : 'a)
(currX : int)
(currY : int)
: unit
=
stackBuf.Clear ()
stackBuf.Add currX
stackBuf.Add currY
while stackBuf.Count > 0 do
let currY = stackBuf.[stackBuf.Count - 1]
stackBuf.RemoveAt (stackBuf.Count - 1)
let currX = stackBuf.[stackBuf.Count - 1]
stackBuf.RemoveAt (stackBuf.Count - 1)
if currX > 0 then
if get s (currX - 1) currY = empty then
set s (currX - 1) currY fillWith
stackBuf.Add (currX - 1)
stackBuf.Add currY
if currX < s.Width - 1 then
if get s (currX + 1) currY = empty then
set s (currX + 1) currY fillWith
stackBuf.Add (currX + 1)
stackBuf.Add currY
if currY > 0 then
if get s currX (currY - 1) = empty then
set s currX (currY - 1) fillWith
stackBuf.Add currX
stackBuf.Add (currY - 1)
if currY < s.Height - 1 then
if get s currX (currY + 1) = empty then
set s currX (currY + 1) fillWith
stackBuf.Add currX
stackBuf.Add (currY + 1)
/// SIMD go brr
let inline count< ^a when 'a : equality and 'a : unmanaged and 'a :> IEquatable<'a>>
(arr : Arr2D<'a>)
(x : 'a)
: int
=
let span =
#if DEBUG
arr.Elements.AsSpan ()
#else
ReadOnlySpan<'a> (NativePtr.toVoidPtr arr.Elements, arr.Length)
#endif
MemoryExtensions.Count (span, x)
let print (arr : Arr2D<byte>) =
for row = 0 to arr.Height - 1 do
for col = 0 to arr.Width - 1 do
match get arr col row with
| 1uy -> printf "#"
| 0uy -> printf "."
| 2uy -> printf "O"
| _ -> failwith "bad"
printfn ""
printfn ""

View File

@@ -0,0 +1,292 @@
namespace AdventOfCode2023
#if DEBUG
#else
#nowarn "9"
#endif
open System
[<RequireQualifiedAccess>]
module Day10 =
/// Returns first the line number, then the position within that line.
/// lineLength includes the newline, as does pos.
let inline private toRowAndCol (lineLength : int) (pos : int) : struct (int * int) =
let lineNum = pos / lineLength
let withinLine = pos % lineLength
struct (lineNum, withinLine)
let inline private ofRowAndCol (lineLength : int) (lineNum : int) (col : int) : int = lineNum * lineLength + col
let inline nextPoint (s : ReadOnlySpan<char>) (lineLength : int) (currPos : int) (prevPos : int) =
let struct (currLineNum, currCol) = toRowAndCol lineLength currPos
let struct (prevLineNum, prevCol) = toRowAndCol lineLength prevPos
match s.[currPos] with
| '|' ->
if prevLineNum < currLineNum then
ofRowAndCol lineLength (currLineNum + 1) currCol
else
ofRowAndCol lineLength (currLineNum - 1) currCol
| '-' ->
if prevCol < currCol then
ofRowAndCol lineLength currLineNum (currCol + 1)
else
ofRowAndCol lineLength currLineNum (currCol - 1)
| 'L' ->
if prevLineNum = currLineNum then
ofRowAndCol lineLength (currLineNum - 1) currCol
else
ofRowAndCol lineLength currLineNum (currCol + 1)
| '7' ->
if prevLineNum = currLineNum then
ofRowAndCol lineLength (currLineNum + 1) currCol
else
ofRowAndCol lineLength currLineNum (currCol - 1)
| 'F' ->
if prevLineNum = currLineNum then
ofRowAndCol lineLength (currLineNum + 1) currCol
else
ofRowAndCol lineLength currLineNum (currCol + 1)
| 'J' ->
if prevLineNum = currLineNum then
ofRowAndCol lineLength (currLineNum - 1) currCol
else
ofRowAndCol lineLength currLineNum (currCol - 1)
| c -> failwithf "unrecognised: %c" c
let part1 (s : string) =
let s = s.AsSpan ()
let lineLength = (s.IndexOf '\n' + 1)
let startPos = s.IndexOf 'S'
let struct (startLine, startCol) = toRowAndCol lineLength startPos
let mutable distance = 1
let mutable prevPointA = startPos
let mutable prevPointB = startPos
let mutable pointA =
let pos = ofRowAndCol lineLength startLine (startCol - 1)
match s.[pos] with
| '-'
| 'L'
| 'F' -> pos
| _ ->
let pos = ofRowAndCol lineLength startLine (startCol + 1)
match s.[pos] with
| '-'
| 'J'
| '7' -> pos
| _ ->
ofRowAndCol lineLength (startLine + 1) startCol
let mutable pointB =
let pos = ofRowAndCol lineLength (startLine - 1) startCol
match if pos >= 0 then s.[pos] else 'n' with
| '|'
| '7'
| 'F' -> pos
| _ ->
let pos = ofRowAndCol lineLength (startLine + 1) startCol
match if pos < s.Length then s.[pos] else 'n' with
| '|'
| 'L'
| 'J' -> pos
| _ ->
let pos = ofRowAndCol lineLength startLine (startCol + 1)
match if pos < s.Length then s.[pos] else 'n' with
| '-'
| 'J'
| '7' -> pos
| _ -> ofRowAndCol lineLength startLine (startCol - 1)
while pointA <> pointB do
let currentA = pointA
pointA <- nextPoint s lineLength pointA prevPointA
prevPointA <- currentA
let currentB = pointB
pointB <- nextPoint s lineLength pointB prevPointB
prevPointB <- currentB
distance <- distance + 1
distance
let print (s : Arr2D<byte>) =
for y = 0 to s.Height - 1 do
for x = 0 to s.Width - 1 do
match Arr2D.get s x y with
| 0uy -> printf " "
| 1uy -> printf "#"
| 2uy -> printf "."
| s -> failwithf "unrecognised: %i" s
printfn ""
printfn ""
printfn ""
let inline setAt (arr : Arr2D<byte>) (x : int) (y : int) (matching : char) (target : byte) =
Arr2D.set arr x y target
match matching with
| '-' ->
Arr2D.set arr (x - 1) y target
Arr2D.set arr (x + 1) y target
| '|' ->
Arr2D.set arr x (y - 1) target
Arr2D.set arr x (y + 1) target
| 'L' ->
Arr2D.set arr x (y - 1) target
Arr2D.set arr (x + 1) y target
| 'J' ->
Arr2D.set arr x (y - 1) target
Arr2D.set arr (x - 1) y target
| '7' ->
Arr2D.set arr x (y + 1) target
Arr2D.set arr (x - 1) y target
| 'F' ->
Arr2D.set arr x (y + 1) target
Arr2D.set arr (x + 1) y target
| c -> failwithf "bad char: %c" c
let part2 (s : string) =
let s = s.AsSpan ()
let lineCount = s.Count '\n'
let lineLength = (s.IndexOf '\n' + 1)
let startPos = s.IndexOf 'S'
let buffer = Array.zeroCreate (lineCount * lineLength * 9)
#if DEBUG
let system : Arr2D<byte> =
{
Elements = buffer
Width = 3 * lineLength
}
#else
use ptr = fixed buffer
let system : Arr2D<byte> =
{
Elements = ptr
Length = buffer.Length
Width = 3 * lineLength
}
#endif
let struct (startLine, startCol) = toRowAndCol lineLength startPos
let mutable prevPointA = startPos
let mutable prevPointB = startPos
Arr2D.set system (3 * startCol + 1) (3 * startLine + 1) 1uy
let mutable pointA =
let pos = ofRowAndCol lineLength startLine (startCol - 1)
match if pos >= 0 then s.[pos] else 'n' with
| '-'
| 'L'
| 'F' ->
Arr2D.set system (3 * startCol) (3 * startLine + 1) 1uy
pos
| _ ->
let pos = ofRowAndCol lineLength startLine (startCol + 1)
match if pos < s.Length then s.[pos] else 'n' with
| '-'
| 'J'
| '7' ->
Arr2D.set system (3 * startCol + 2) (3 * startLine + 1) 1uy
pos
| _ ->
Arr2D.set system (3 * startCol) (3 * startLine) 1uy
Arr2D.set system (3 * startCol) (3 * startLine + 2) 1uy
ofRowAndCol lineLength (startLine + 1) startCol
let mutable pointB =
let pos = ofRowAndCol lineLength (startLine - 1) startCol
match if pos >= 0 then s.[pos] else 'n' with
| '|'
| '7'
| 'F' ->
Arr2D.set system (3 * startCol + 1) (3 * startLine) 1uy
pos
| _ ->
let pos = ofRowAndCol lineLength (startLine + 1) startCol
match if pos < s.Length then s.[pos] else 'n' with
| '|'
| 'L'
| 'J' ->
Arr2D.set system (3 * startCol + 1) (3 * startLine + 2) 1uy
pos
| _ ->
let pos = ofRowAndCol lineLength startLine (startCol + 1)
match if pos < s.Length then s.[pos] else 'n' with
| '-'
| 'J'
| '7' ->
Arr2D.set system (3 * startCol + 2) (3 * startLine + 1) 1uy
pos
| _ -> ofRowAndCol lineLength startLine (startCol - 1)
do
let struct (row, col) = toRowAndCol lineLength pointA
setAt system (3 * col + 1) (3 * row + 1) s.[pointA] 1uy
do
let struct (row, col) = toRowAndCol lineLength pointB
setAt system (3 * col + 1) (3 * row + 1) s.[pointB] 1uy
while pointA <> pointB do
let currentA = pointA
pointA <- nextPoint s lineLength pointA prevPointA
prevPointA <- currentA
do
let struct (row, col) = toRowAndCol lineLength pointA
setAt system (3 * col + 1) (3 * row + 1) s.[pointA] 1uy
let currentB = pointB
pointB <- nextPoint s lineLength pointB prevPointB
prevPointB <- currentB
do
let struct (row, col) = toRowAndCol lineLength pointB
setAt system (3 * col + 1) (3 * row + 1) s.[pointB] 1uy
let stackBuf = ResizeArray ()
for line = 0 to system.Height - 1 do
Arr2D.floodFill stackBuf system 0uy 2uy 0 line
Arr2D.floodFill stackBuf system 0uy 2uy (system.Width - 1) line
for col = 0 to system.Width - 1 do
Arr2D.floodFill stackBuf system 0uy 2uy col 0
Arr2D.floodFill stackBuf system 0uy 2uy col (system.Height - 1)
let mutable answer = 0
for row = 0 to lineCount - 1 do
for col = 0 to lineLength - 1 do
if Arr2D.get system (3 * col + 1) (3 * row + 1) = 0uy then
answer <- answer + 1
answer

View File

@@ -0,0 +1,93 @@
namespace AdventOfCode2023
[<RequireQualifiedAccess>]
module Day11 =
type Data =
{
RowsWithoutGalaxies : ResizeArray<int>
ColsWithoutGalaxies : ResizeArray<int>
/// row * col
Galaxies : ResizeArray<int * int>
}
let parse (s : string) : Data =
let galaxies = ResizeArray ()
let rowsWithoutGalaxies = ResizeArray ()
let mutable hasAnyGalaxy = false
let mutable currRowIndex = 0
let mutable currColIndex = 0
for c in s do
if c = '\n' then
if not hasAnyGalaxy then
rowsWithoutGalaxies.Add currRowIndex
currRowIndex <- currRowIndex + 1
currColIndex <- 0
hasAnyGalaxy <- false
elif c = '#' then
hasAnyGalaxy <- true
galaxies.Add (currRowIndex, currColIndex)
currColIndex <- currColIndex + 1
else
currColIndex <- currColIndex + 1
galaxies.Sort (fun (_, c1) (_, c2) -> compare c1 c2)
let colsWithoutGalaxies =
let result = ResizeArray ()
let mutable prevCol = 0
for _, c in galaxies do
if c > prevCol then
for j = prevCol + 1 to c - 1 do
result.Add j
prevCol <- c
result
{
RowsWithoutGalaxies = rowsWithoutGalaxies
ColsWithoutGalaxies = colsWithoutGalaxies
Galaxies = galaxies
}
let solve (data : Data) (expansion : uint64) =
let mutable answer = 0uL
for galaxy1 = 0 to data.Galaxies.Count - 1 do
let row1, col1 = data.Galaxies.[galaxy1]
for galaxy2 = galaxy1 + 1 to data.Galaxies.Count - 1 do
let row2, col2 = data.Galaxies.[galaxy2]
let baseDistance = uint64 (abs (row1 - row2) + abs (col1 - col2))
let extraDistance =
let mutable extraDistance = 0uL
for i = 1 + min row1 row2 to max row1 row2 - 1 do
if data.RowsWithoutGalaxies.Contains i then
extraDistance <- extraDistance + expansion - 1uL
for i = 1 + min col1 col2 to max col1 col2 - 1 do
if data.ColsWithoutGalaxies.Contains i then
extraDistance <- extraDistance + expansion - 1uL
extraDistance
answer <- answer + extraDistance + baseDistance
answer
let part1 (s : string) =
let data = parse s
solve data 2uL
let part2 (s : string) =
let data = parse s
solve data 1_000_000uL

View File

@@ -0,0 +1,196 @@
namespace AdventOfCode2023
open System
open System.Collections.Generic
open System.Globalization
[<RequireQualifiedAccess>]
module Day12 =
let rec solve
(dict : Dictionary<int * int, uint64>)
(line : ReadOnlySpan<char>)
(groups : IReadOnlyList<int>)
(remainingToFill : int)
(currentGroupIndex : int)
: uint64
=
if line.Length = 0 then
if currentGroupIndex = groups.Count then
LanguagePrimitives.GenericOne
else
LanguagePrimitives.GenericZero
elif currentGroupIndex = groups.Count then
if line.Contains '#' then
LanguagePrimitives.GenericZero
else
LanguagePrimitives.GenericOne
else
match dict.TryGetValue ((line.Length, currentGroupIndex)) with
| true, v -> v
| false, _ ->
if remainingToFill > line.Length then
dict.Add ((line.Length, currentGroupIndex), LanguagePrimitives.GenericZero)
LanguagePrimitives.GenericZero
else
match line.[0] with
| '#' ->
if currentGroupIndex >= groups.Count then
LanguagePrimitives.GenericZero
else
let mutable isOk = true
for i = 1 to groups.[currentGroupIndex] - 1 do
if isOk && (i >= line.Length || (line.[i] <> '#' && line.[i] <> '?')) then
isOk <- false
if not isOk then
LanguagePrimitives.GenericZero
else if groups.[currentGroupIndex] < line.Length then
if line.[groups.[currentGroupIndex]] = '#' then
LanguagePrimitives.GenericZero
else
solve
dict
(line.Slice (groups.[currentGroupIndex] + 1))
groups
(remainingToFill - groups.[currentGroupIndex] - 1)
(currentGroupIndex + 1)
else
solve
dict
ReadOnlySpan<_>.Empty
groups
(remainingToFill - groups.[currentGroupIndex] - 1)
(currentGroupIndex + 1)
| '.' -> solve dict (line.Slice 1) groups remainingToFill currentGroupIndex
| '?' ->
let afterMark = line.IndexOfAnyExcept ('?', '#')
if afterMark >= 0 && groups.[currentGroupIndex] > afterMark then
// this group would extend into a dot if this were filled in!
let firstHash = line.IndexOf '#'
if firstHash >= 0 && firstHash < afterMark then
// this group *is* filled in, contradiction
LanguagePrimitives.GenericZero
else
solve dict (line.Slice afterMark) groups remainingToFill currentGroupIndex
else
let ifDot = solve dict (line.Slice 1) groups remainingToFill currentGroupIndex
dict.TryAdd ((line.Length - 1, currentGroupIndex), ifDot) |> ignore
let ifHash =
if currentGroupIndex >= groups.Count then
LanguagePrimitives.GenericZero
else
let mutable isOk = true
for i = 1 to groups.[currentGroupIndex] - 1 do
if isOk && (i >= line.Length || (line.[i] <> '#' && line.[i] <> '?')) then
isOk <- false
if not isOk then
LanguagePrimitives.GenericZero
else if groups.[currentGroupIndex] < line.Length then
if
groups.[currentGroupIndex] < line.Length
&& line.[groups.[currentGroupIndex]] = '#'
then
LanguagePrimitives.GenericZero
else
solve
dict
(line.Slice (groups.[currentGroupIndex] + 1))
groups
(remainingToFill - groups.[currentGroupIndex] - 1)
(currentGroupIndex + 1)
else
solve
dict
ReadOnlySpan<_>.Empty
groups
(remainingToFill - groups.[currentGroupIndex] - 1)
(currentGroupIndex + 1)
let ans = ifDot + ifHash
dict.TryAdd ((line.Length, currentGroupIndex), ans) |> ignore
ans
| _ ->
if currentGroupIndex = groups.Count then
LanguagePrimitives.GenericOne
else
LanguagePrimitives.GenericZero
let part1 (s : string) =
use mutable lines = StringSplitEnumerator.make '\n' s
let mutable answer = 0uL
let arr = ResizeArray ()
let dict = Dictionary ()
for line in lines do
if not line.IsEmpty then
arr.Clear ()
use ints = StringSplitEnumerator.make' ',' (line.Slice (line.IndexOf ' ' + 1))
for int in ints do
arr.Add (Int32.Parse (int, NumberStyles.None, CultureInfo.InvariantCulture))
let remainingToFill =
let mutable ans = -1
for i = 0 to arr.Count - 1 do
ans <- ans + arr.[i] + 1
ans
dict.Clear ()
let solved = solve dict line arr remainingToFill 0
answer <- answer + solved
answer
let part2 (s : string) =
use mutable lines = StringSplitEnumerator.make '\n' s
let mutable answer = 0uL
let arr = ResizeArray ()
let dict = Dictionary ()
for line in lines do
if not line.IsEmpty then
arr.Clear ()
let spaceIndex = line.IndexOf ' '
for _ = 0 to 4 do
use ints = StringSplitEnumerator.make' ',' (line.Slice (spaceIndex + 1))
for int in ints do
arr.Add (Int32.Parse (int, NumberStyles.None, CultureInfo.InvariantCulture))
let sliced = line.Slice(0, spaceIndex).ToString ()
let line =
String.Concat (sliced, '?', sliced, '?', sliced, '?', sliced, '?', sliced)
let remainingToFill =
let mutable ans = -1
for i = 0 to arr.Count - 1 do
ans <- ans + arr.[i] + 1
ans
dict.Clear ()
let solved = solve dict (line.AsSpan ()) arr remainingToFill 0
answer <- answer + solved
answer

View File

@@ -0,0 +1,191 @@
namespace AdventOfCode2023
open System
[<RequireQualifiedAccess>]
module Day13 =
let inline isPowerOf2 (i : uint32) =
// https://stackoverflow.com/a/600306/126995
(i &&& (i - 1ul)) = 0ul
let rowToInt (row : ReadOnlySpan<char>) : uint32 =
let mutable mult = 1ul
let mutable answer = 0ul
for c = row.Length - 1 downto 0 do
if row.[c] = '#' then
answer <- answer + mult
mult <- mult * 2ul
answer
let colToInt (grid : ReadOnlySpan<char>) (rowLength : int) (colNum : int) =
let mutable mult = 1ul
let mutable answer = 0ul
for i = grid.Count '\n' - 1 downto 0 do
if grid.[i * (rowLength + 1) + colNum] = '#' then
answer <- answer + mult
mult <- mult * 2ul
answer
let verifyReflection (group : ResizeArray<'a>) (smaller : int) (bigger : int) : bool =
let midPoint = (smaller + bigger) / 2
let rec isOkWithin (curr : int) =
if smaller + curr > midPoint then
true
else if group.[smaller + curr] = group.[bigger - curr] then
isOkWithin (curr + 1)
else
false
if not (isOkWithin 0) then
false
else
smaller = 0 || bigger = group.Count - 1
/// Find reflection among rows.
/// Returns 0 to indicate "no answer".
[<TailCall>]
let rec findRow (banAnswer : uint32) (rows : ResizeArray<uint32>) (currentLine : int) : uint32 =
if currentLine = rows.Count - 1 then
0ul
else
let mutable answer = UInt32.MaxValue
let mutable i = currentLine
while i < rows.Count - 1 do
i <- i + 1
if currentLine % 2 <> i % 2 then
if rows.[i] = rows.[currentLine] then
if verifyReflection rows currentLine i then
let desiredAnswer = uint32 (((currentLine + i) / 2) + 1)
if desiredAnswer <> banAnswer then
answer <- uint32 desiredAnswer
i <- Int32.MaxValue
if answer < UInt32.MaxValue then
answer
else
findRow banAnswer rows (currentLine + 1)
let render (rowBuf : ResizeArray<_>) (colBuf : ResizeArray<_>) (group : ReadOnlySpan<char>) =
rowBuf.Clear ()
colBuf.Clear ()
let lineLength = group.IndexOf '\n'
for col = 0 to lineLength - 1 do
colBuf.Add (colToInt group lineLength col)
for row in StringSplitEnumerator.make' '\n' group do
if not row.IsEmpty then
rowBuf.Add (rowToInt row)
/// Returns 0 to indicate "no solution".
let solve (banAnswer : uint32) (rowBuf : ResizeArray<_>) (colBuf : ResizeArray<_>) : uint32 =
match
findRow
(if banAnswer >= 100ul then
banAnswer / 100ul
else
UInt32.MaxValue)
rowBuf
0
with
| rowIndex when rowIndex > 0ul -> 100ul * rowIndex
| _ -> findRow banAnswer colBuf 0
/// Returns also the group with this gro
let peelGroup (s : ReadOnlySpan<char>) : ReadOnlySpan<char> =
let index = s.IndexOf "\n\n"
if index < 0 then
// last group
s
else
s.Slice (0, index + 1)
let part1 (s : string) =
let mutable s = s.AsSpan ()
let rows = ResizeArray ()
let cols = ResizeArray ()
let mutable answer = 0ul
while not s.IsEmpty do
let group = peelGroup s
render rows cols group
// There's an obvious perf optimisation where we don't compute cols
// until we know there's no row answer. Life's too short.
answer <- answer + solve UInt32.MaxValue rows cols
if group.Length >= s.Length then
s <- ReadOnlySpan<char>.Empty
else
s <- s.Slice (group.Length + 1)
answer
let flipAt (rows : ResizeArray<_>) (cols : ResizeArray<_>) (rowNum : int) (colNum : int) : unit =
rows.[rowNum] <-
let index = 1ul <<< (cols.Count - colNum - 1)
if rows.[rowNum] &&& index > 0ul then
rows.[rowNum] - index
else
rows.[rowNum] + index
cols.[colNum] <-
let index = 1ul <<< (rows.Count - rowNum - 1)
if cols.[colNum] &&& index > 0ul then
cols.[colNum] - index
else
cols.[colNum] + index
let part2 (s : string) =
let mutable s = s.AsSpan ()
let rows = ResizeArray ()
let cols = ResizeArray ()
let mutable answer = 0ul
while not s.IsEmpty do
let group = peelGroup s
render rows cols group
let bannedAnswer = solve UInt32.MaxValue rows cols
let mutable isDone = false
let mutable rowToChange = 0
while not isDone && rowToChange < rows.Count do
let mutable colToChange = 0
while not isDone && colToChange < cols.Count do
flipAt rows cols rowToChange colToChange
match solve bannedAnswer rows cols with
| solved when solved > 0ul ->
isDone <- true
answer <- answer + solved
| _ ->
flipAt rows cols rowToChange colToChange
colToChange <- colToChange + 1
rowToChange <- rowToChange + 1
if group.Length >= s.Length then
s <- ReadOnlySpan<char>.Empty
else
s <- s.Slice (group.Length + 1)
answer

View File

@@ -0,0 +1,279 @@
namespace AdventOfCode2023
#if DEBUG
#else
#nowarn "9"
#endif
open System
[<RequireQualifiedAccess>]
module Day14 =
let slideNorth (arr : Arr2D<byte>) : unit =
for col = 0 to arr.Width - 1 do
let mutable targetPos = -1
let mutable pos = 0
while targetPos = -1 do
if Arr2D.get arr col pos = 0uy then
targetPos <- pos
pos <- pos + 1
while pos < arr.Height do
let current = Arr2D.get arr col pos
if current = 2uy then
targetPos <- pos + 1
let mutable hasMoved = false
while pos < arr.Height && not hasMoved do
if Arr2D.get arr col pos = 0uy then
targetPos <- pos
hasMoved <- true
pos <- pos + 1
elif current = 1uy then
Arr2D.set arr col targetPos 1uy
Arr2D.set arr col pos 0uy
targetPos <- targetPos + 1
pos <- pos + 1
else // current = 0uy
pos <- pos + 1
let slideSouth (arr : Arr2D<byte>) : unit =
for col = 0 to arr.Width - 1 do
let mutable targetPos = arr.Height
let mutable pos = arr.Height - 1
while targetPos = arr.Height do
if Arr2D.get arr col pos = 0uy then
targetPos <- pos
pos <- pos - 1
while pos >= 0 do
let current = Arr2D.get arr col pos
if current = 2uy then
targetPos <- pos - 1
let mutable hasMoved = false
while pos >= 0 && not hasMoved do
if Arr2D.get arr col pos = 0uy then
targetPos <- pos
hasMoved <- true
pos <- pos - 1
elif current = 1uy then
Arr2D.set arr col targetPos 1uy
Arr2D.set arr col pos 0uy
targetPos <- targetPos - 1
pos <- pos - 1
else // current = 0uy
pos <- pos - 1
let slideEast (arr : Arr2D<byte>) : unit =
for row = 0 to arr.Height - 1 do
let mutable targetPos = arr.Width
let mutable pos = arr.Width - 1
while targetPos = arr.Width do
if Arr2D.get arr pos row = 0uy then
targetPos <- pos
pos <- pos - 1
while pos >= 0 do
let current = Arr2D.get arr pos row
if current = 2uy then
targetPos <- pos - 1
let mutable hasMoved = false
while pos >= 0 && not hasMoved do
if Arr2D.get arr pos row = 0uy then
targetPos <- pos
hasMoved <- true
pos <- pos - 1
elif current = 1uy then
Arr2D.set arr targetPos row 1uy
Arr2D.set arr pos row 0uy
targetPos <- targetPos - 1
pos <- pos - 1
else // current = 0uy
pos <- pos - 1
let slideWest (arr : Arr2D<byte>) : unit =
for row = 0 to arr.Height - 1 do
let mutable targetPos = -1
let mutable pos = 0
while targetPos = -1 do
if Arr2D.get arr pos row = 0uy then
targetPos <- pos
pos <- pos + 1
while pos < arr.Height do
let current = Arr2D.get arr pos row
if current = 2uy then
targetPos <- pos + 1
let mutable hasMoved = false
while pos < arr.Width && not hasMoved do
if Arr2D.get arr pos row = 0uy then
targetPos <- pos
hasMoved <- true
pos <- pos + 1
elif current = 1uy then
Arr2D.set arr targetPos row 1uy
Arr2D.set arr pos row 0uy
targetPos <- targetPos + 1
pos <- pos + 1
else // current = 0uy
pos <- pos + 1
let score (board : Arr2D<byte>) =
let mutable answer = 0ul
for row = 0 to board.Height - 1 do
for col = 0 to board.Width - 1 do
if Arr2D.get board col row = 1uy then
answer <- answer + (board.Height - row |> uint32)
answer
let hash (board : Arr2D<byte>) =
let mutable hash = 0uL
let mutable pos = 0uL
for x = 0 to board.Width - 1 do
for y = 0 to board.Height - 1 do
hash <- hash + pos * uint64 (Arr2D.get board x y)
pos <- pos + 1uL
hash
let part1 (s : string) =
let s = s.AsSpan ()
let lineLength = s.IndexOf '\n'
let buffer = Array.zeroCreate (lineLength * s.Length / (lineLength + 1))
let mutable i = 0
for c in s do
match c with
| '#' -> buffer.[i] <- 2uy
| '.' -> buffer.[i] <- 0uy
| 'O' -> buffer.[i] <- 1uy
| '\n' -> i <- i - 1
| _ -> failwith "bad char"
i <- i + 1
#if DEBUG
let system : Arr2D<byte> =
{
Elements = buffer
Width = lineLength
}
#else
use ptr = fixed buffer
let system : Arr2D<byte> =
{
Elements = ptr
Length = buffer.Length
Width = lineLength
}
#endif
slideNorth system
score system
let cycleOnce (arr : Arr2D<_>) =
slideNorth arr
slideWest arr
slideSouth arr
slideEast arr
let part2 (s : string) =
let s = s.AsSpan ()
let lineLength = s.IndexOf '\n'
let buffer = Array.zeroCreate (lineLength * s.Length / (lineLength + 1))
let mutable i = 0
for c in s do
match c with
| '#' -> buffer.[i] <- 2uy
| '.' -> buffer.[i] <- 0uy
| 'O' -> buffer.[i] <- 1uy
| '\n' -> i <- i - 1
| _ -> failwith "bad char"
i <- i + 1
#if DEBUG
let system : Arr2D<byte> =
{
Elements = buffer
Width = lineLength
}
#else
use ptr = fixed buffer
let system : Arr2D<byte> =
{
Elements = ptr
Length = buffer.Length
Width = lineLength
}
#endif
let mutable tortoise = 1
let mutable hare = 2
let scores = ResizeArray<_> ()
scores.Add (score system, hash system)
cycleOnce system
scores.Add (score system, hash system)
cycleOnce system
scores.Add (score system, hash system)
while scores.[hare] <> scores.[tortoise] do
cycleOnce system
scores.Add (score system, hash system)
cycleOnce system
scores.Add (score system, hash system)
hare <- hare + 2
tortoise <- tortoise + 1
tortoise <- 0
// mu-table heh heh
let mutable firstRepetition = 0
while scores.[hare] <> scores.[tortoise] do
cycleOnce system
scores.Add (score system, hash system)
hare <- hare + 1
tortoise <- tortoise + 1
firstRepetition <- firstRepetition + 1
let mutable cycleLength = 1
hare <- tortoise + 1
while scores.[tortoise] <> scores.[hare] do
hare <- hare + 1
cycleOnce system
scores.Add (score system, hash system)
cycleLength <- cycleLength + 1
let cycles = (1_000_000_000uL - uint64 firstRepetition) % (uint64 cycleLength)
fst scores.[firstRepetition + int cycles]

View File

@@ -0,0 +1,114 @@
namespace AdventOfCode2023
open System
open System.Globalization
[<RequireQualifiedAccess>]
module Day15 =
let hash (s : ReadOnlySpan<char>) : int =
let mutable v = 0
for c in s do
v <- v + int (byte c)
v <- (17 * v) % 256
v
let part1 (s : string) =
let s = s.AsSpan().TrimEnd ()
use chunks = StringSplitEnumerator.make' ',' s
let mutable answer = 0
for chunk in chunks do
answer <- answer + hash chunk
answer
let inline removeFirst<'a> ([<InlineIfLambda>] toRemove : 'a -> bool) (arr : ResizeArray<'a>) : unit =
let mutable i = 0
while i < arr.Count do
if toRemove arr.[i] then
for j = i to arr.Count - 2 do
arr.[j] <- arr.[j + 1]
arr.RemoveAt (arr.Count - 1)
i <- arr.Count
i <- i + 1
let inline replace
([<InlineIfLambda>] withKey : 'a -> 'key)
(key : 'key)
(value : 'a)
(arr : ResizeArray<'a>)
: unit
=
let mutable i = 0
while i < arr.Count do
if withKey arr.[i] = key then
arr.[i] <- value
i <- arr.Count
i <- i + 1
if i < arr.Count + 1 then
// no replacement was made
arr.Add value
let inline getLength (labelAndLength : uint64) : uint32 =
(labelAndLength % uint64 UInt32.MaxValue) |> uint32
let inline getLabel (labelAndLength : uint64) : uint32 =
(labelAndLength / uint64 UInt32.MaxValue) |> uint32
let inline focusingPower (boxNumber : uint32) (arr : ResizeArray<_>) =
let mutable answer = 0ul
for i = 0 to arr.Count - 1 do
answer <- answer + (boxNumber + 1ul) * (uint32 i + 1ul) * getLength arr.[i]
answer
let inline toUint32 (s : ReadOnlySpan<char>) : uint32 =
let mutable answer = 0ul
for c in s do
answer <- answer * 26ul + uint32 (byte c - byte 'a')
answer
let inline pack (label : uint32) (focalLength : uint32) : uint64 =
uint64 label * uint64 UInt32.MaxValue + uint64 focalLength
let part2 (s : string) =
let s = s.AsSpan().TrimEnd ()
use chunks = StringSplitEnumerator.make' ',' s
// The max length of a label turns out to be 6, which means we need 26^6 < 2^32 entries.
// So we'll use a uint32 instead of our string, to save hopping around memory.
// We'll also pack the focal length into the elements, to save tupling.
let lenses = Array.init 256 (fun _ -> ResizeArray<uint64> ())
for chunk in chunks do
if chunk.[chunk.Length - 1] = '-' then
let label = chunk.Slice (0, chunk.Length - 1)
let labelShrunk = toUint32 label
removeFirst (fun labelAndLength -> getLabel labelAndLength = labelShrunk) lenses.[hash label]
else
let equalsPos = chunk.IndexOf '='
let focalLength =
UInt32.Parse (chunk.Slice (equalsPos + 1), NumberStyles.None, CultureInfo.InvariantCulture)
let label = chunk.Slice (0, equalsPos)
let labelShrunk = toUint32 label
replace getLabel labelShrunk (pack labelShrunk focalLength) lenses.[hash label]
let mutable answer = 0ul
for i = 0 to 255 do
answer <- answer + focusingPower (uint32 i) lenses.[i]
answer

View File

@@ -0,0 +1,283 @@
namespace AdventOfCode2023
#if DEBUG
#else
#nowarn "9"
#endif
open System
[<RequireQualifiedAccess>]
module Day16 =
let inline storeDirectionAndPos (numCols : int) (col : int) (row : int) (direction : Direction) : uint16 =
4us * uint16 (col + numCols * row) + Direction.toUInt direction
let inline getDirection (input : uint16) =
match input % 4us with
| 0us -> Direction.Left
| 1us -> Direction.Right
| 2us -> Direction.Up
| 3us -> Direction.Down
| _ -> failwith "bad"
let inline getCol (numCols : int) (input : uint16) = (input / 4us) % uint16 numCols |> int
let inline getRow (numCols : int) (input : uint16) = (input / 4us) / uint16 numCols |> int
let inline maxEncoded (numCols : int) (numRows : int) : uint16 =
4us * uint16 ((numCols - 1) + numCols * (numRows - 1)) + 3us
let inline getAt (numCols : int) (s : string) (row : int) (col : int) = s.[row * (numCols + 1) + col]
let advance (arr : Arr2D<_>) (going : ResizeArray<_>) (s : string) (nextUp : uint16) =
let numCols = arr.Width
let numLines = arr.Height
let col = getCol numCols nextUp
let row = getRow numCols nextUp
let dir = getDirection nextUp
Arr2D.set arr col row true
match dir with
| Direction.Right ->
match getAt numCols s row col with
| '-'
| '.' ->
if col < arr.Width - 1 then
going.[going.Count - 1] <- storeDirectionAndPos numCols (col + 1) row dir
else
going.RemoveAt (going.Count - 1)
| '/' ->
if row > 0 then
going.[going.Count - 1] <- storeDirectionAndPos numCols col (row - 1) Direction.Up
else
going.RemoveAt (going.Count - 1)
| '\\' ->
if row < numLines - 1 then
going.[going.Count - 1] <- storeDirectionAndPos numCols col (row + 1) Direction.Down
else
going.RemoveAt (going.Count - 1)
| '|' ->
going.RemoveAt (going.Count - 1)
if row < numLines - 1 then
going.Add (storeDirectionAndPos numCols col (row + 1) Direction.Down)
if row > 0 then
going.Add (storeDirectionAndPos numCols col (row - 1) Direction.Up)
| c -> failwith $"Unrecognised char: %c{c}"
| Direction.Left ->
match getAt numCols s row col with
| '-'
| '.' ->
if col > 0 then
going.[going.Count - 1] <- storeDirectionAndPos numCols (col - 1) row dir
else
going.RemoveAt (going.Count - 1)
| '\\' ->
if row > 0 then
going.[going.Count - 1] <- storeDirectionAndPos numCols col (row - 1) Direction.Up
else
going.RemoveAt (going.Count - 1)
| '/' ->
if row < numLines - 1 then
going.[going.Count - 1] <- storeDirectionAndPos numCols col (row + 1) Direction.Down
else
going.RemoveAt (going.Count - 1)
| '|' ->
going.RemoveAt (going.Count - 1)
if row < numLines - 1 then
going.Add (storeDirectionAndPos numCols col (row + 1) Direction.Down)
if row > 0 then
going.Add (storeDirectionAndPos numCols col (row - 1) Direction.Up)
| c -> failwith $"Unrecognised char: %c{c}"
| Direction.Up ->
match getAt numCols s row col with
| '|'
| '.' ->
if row > 0 then
going.[going.Count - 1] <- storeDirectionAndPos numCols col (row - 1) dir
else
going.RemoveAt (going.Count - 1)
| '/' ->
if col < numCols - 1 then
going.[going.Count - 1] <- storeDirectionAndPos numCols (col + 1) row Direction.Right
else
going.RemoveAt (going.Count - 1)
| '\\' ->
if col > 0 then
going.[going.Count - 1] <- storeDirectionAndPos numCols (col - 1) row Direction.Left
else
going.RemoveAt (going.Count - 1)
| '-' ->
going.RemoveAt (going.Count - 1)
if col < numCols - 1 then
going.Add (storeDirectionAndPos numCols (col + 1) row Direction.Right)
if col > 0 then
going.Add (storeDirectionAndPos numCols (col - 1) row Direction.Left)
| c -> failwith $"Unrecognised char: %c{c}"
| Direction.Down ->
match getAt numCols s row col with
| '|'
| '.' ->
if row < arr.Height - 1 then
going.[going.Count - 1] <- storeDirectionAndPos numCols col (row + 1) dir
else
going.RemoveAt (going.Count - 1)
| '\\' ->
if col < numCols - 1 then
going.[going.Count - 1] <- storeDirectionAndPos numCols (col + 1) row Direction.Right
else
going.RemoveAt (going.Count - 1)
| '/' ->
if col > 0 then
going.[going.Count - 1] <- storeDirectionAndPos numCols (col - 1) row Direction.Left
else
going.RemoveAt (going.Count - 1)
| '-' ->
going.RemoveAt (going.Count - 1)
if col < numCols - 1 then
going.Add (storeDirectionAndPos numCols (col + 1) row Direction.Right)
if col > 0 then
going.Add (storeDirectionAndPos numCols (col - 1) row Direction.Left)
| c -> failwith $"Unrecognised char: %c{c}"
| _ -> failwith "bad"
let part1 (s : string) =
let numLines = s.AsSpan().Count '\n'
let numCols = s.IndexOf '\n'
let buf = Array.zeroCreate (numLines * numCols)
#if DEBUG
let arr : Arr2D<bool> =
{
Elements = buf
Width = numCols
}
#else
use ptr = fixed buf
let arr : Arr2D<bool> =
{
Elements = ptr
Width = numCols
Length = buf.Length
}
#endif
let going = ResizeArray ()
going.Add (storeDirectionAndPos numCols 0 0 Direction.Right)
let seen = Array.zeroCreate (int (maxEncoded numCols numLines) + 1)
while going.Count > 0 do
let nextUp = going.[going.Count - 1]
match seen.[int nextUp] with
| true -> going.RemoveAt (going.Count - 1)
| false ->
seen.[int nextUp] <- true
advance arr going s nextUp
buf.AsSpan().Count true
let part2 (s : string) =
let numLines = s.AsSpan().Count '\n'
let numCols = s.IndexOf '\n'
let buf = Array.zeroCreate (numLines * numCols)
#if DEBUG
let arr : Arr2D<bool> =
{
Elements = buf
Width = numCols
}
#else
use ptr = fixed buf
let arr : Arr2D<bool> =
{
Elements = ptr
Width = numCols
Length = buf.Length
}
#endif
let going = ResizeArray ()
let seen = Array.zeroCreate (int (maxEncoded numCols numLines) + 1)
let mutable best = 0
for start = 0 to numCols - 1 do
going.Clear ()
Array.Clear seen
Array.Clear buf
going.Add (storeDirectionAndPos numCols start 0 Direction.Down)
while going.Count > 0 do
let nextUp = going.[going.Count - 1]
match seen.[int nextUp] with
| true -> going.RemoveAt (going.Count - 1)
| false ->
seen.[int nextUp] <- true
advance arr going s nextUp
let lit = buf.AsSpan().Count true
best <- max best lit
going.Clear ()
Array.Clear seen
Array.Clear buf
going.Add (storeDirectionAndPos numCols start (numLines - 1) Direction.Up)
while going.Count > 0 do
let nextUp = going.[going.Count - 1]
match seen.[int nextUp] with
| true -> going.RemoveAt (going.Count - 1)
| false ->
seen.[int nextUp] <- true
advance arr going s nextUp
let lit = buf.AsSpan().Count true
best <- max best lit
for start = 0 to numLines - 1 do
going.Clear ()
Array.Clear seen
Array.Clear buf
going.Add (storeDirectionAndPos numCols 0 start Direction.Right)
while going.Count > 0 do
let nextUp = going.[going.Count - 1]
match seen.[int nextUp] with
| true -> going.RemoveAt (going.Count - 1)
| false ->
seen.[int nextUp] <- true
advance arr going s nextUp
let lit = buf.AsSpan().Count true
best <- max best lit
going.Clear ()
Array.Clear seen
Array.Clear buf
going.Add (storeDirectionAndPos numCols (numCols - 1) start Direction.Left)
while going.Count > 0 do
let nextUp = going.[going.Count - 1]
match seen.[int nextUp] with
| true -> going.RemoveAt (going.Count - 1)
| false ->
seen.[int nextUp] <- true
advance arr going s nextUp
let lit = buf.AsSpan().Count true
best <- max best lit
best

View File

@@ -0,0 +1,103 @@
namespace AdventOfCode2023
#if DEBUG
#else
#nowarn "9"
#endif
open System
open System.Collections.Generic
open System.Globalization
[<RequireQualifiedAccess>]
module Day18 =
let part1 (s : string) =
// Interleaved row and col
let mutable weHave = ResizeArray<int> ()
weHave.Add 0
weHave.Add 0
let mutable minCol = 0
let mutable maxCol = 0
let mutable minRow = 0
let mutable maxRow = 0
let mutable col = 0
let mutable row = 0
let mutable edgeCount = 0
use rows = StringSplitEnumerator.make '\n' s
for currRow in rows do
use mutable entries = StringSplitEnumerator.make' ' ' currRow
entries.MoveNext () |> ignore
let dir = Direction.ofChar entries.Current.[0]
entries.MoveNext () |> ignore
let distance =
Int32.Parse (entries.Current, NumberStyles.None, CultureInfo.InvariantCulture)
edgeCount <- edgeCount + distance
match dir with
| Direction.Down ->
for _ = 1 to distance do
row <- row + 1
weHave.Add row
weHave.Add col
maxRow <- max row maxRow
| Direction.Up ->
for _ = 1 to distance do
row <- row - 1
weHave.Add row
weHave.Add col
minRow <- min row minRow
| Direction.Left ->
for _ = 1 to distance do
col <- col - 1
weHave.Add row
weHave.Add col
minCol <- min col minCol
| Direction.Right ->
for _ = 1 to distance do
col <- col + 1
weHave.Add row
weHave.Add col
maxCol <- max col maxCol
| _ -> failwith "bad dir"
let buffer = Array.zeroCreate ((maxRow - minRow + 3) * (maxCol - minCol + 3))
#if DEBUG
let system : Arr2D<byte> =
{
Elements = buffer
Width = maxCol - minCol + 3
}
#else
use ptr = fixed buffer
let system : Arr2D<byte> =
{
Elements = ptr
Length = buffer.Length
Width = maxCol - minCol + 3
}
#endif
let mutable pointIndex = 0
while pointIndex < weHave.Count do
let row = weHave.[pointIndex]
let col = weHave.[pointIndex + 1]
Arr2D.set system (col - minCol + 1) (row - minRow + 1) 1uy
pointIndex <- pointIndex + 2
Arr2D.floodFill (ResizeArray ()) system 0uy 2uy 0 0
Arr2D.count system 0uy + edgeCount
let part2 (s : string) = -1

View File

@@ -0,0 +1,357 @@
namespace AdventOfCode2023
open System
open System.Collections.Generic
open System.Globalization
[<RequireQualifiedAccess>]
module Day19 =
type Component =
| X = 0
| M = 1
| A = 2
| S = 3
[<RequireQualifiedAccess>]
module Component =
let ofChar (c : char) : Component =
match c with
| 'x' -> Component.X
| 'm' -> Component.M
| 'a' -> Component.A
| 's' -> Component.S
| c -> failwith $"bad component: %c{c}"
type Dest =
| Register of string
| Accept
| Reject
static member OfString (s : EfficientString) : Dest =
if s.Length = 1 && s.[0] = 'A' then Dest.Accept
elif s.Length = 1 && s.[0] = 'R' then Dest.Reject
else Dest.Register (s.ToString ())
type Rule =
{
Component : Component
IsLess : bool
Operand : int
Target : Dest
}
static member OfString (s : EfficientString) : Choice<Rule, Dest> =
match s.IndexOf ':' with
| -1 -> Choice2Of2 (Dest.OfString (s.Slice (0, s.Length)))
| colon ->
let dest = Dest.OfString (s.Slice (colon + 1))
let comp = Component.ofChar s.[0]
let isLess =
match s.[1] with
| '>' -> false
| '<' -> true
| c -> failwith $"Bad comparison: %c{c}"
let operand =
Int32.Parse (s.Slice (2, colon - 2), NumberStyles.None, NumberFormatInfo.InvariantInfo)
{
Component = comp
IsLess = isLess
Target = dest
Operand = operand
}
|> Choice1Of2
let inline matches (rule : Rule) x m a s =
match rule.Component with
| Component.A ->
if (rule.IsLess && a < rule.Operand) || (not rule.IsLess && a > rule.Operand) then
Some rule.Target
else
None
| Component.X ->
if (rule.IsLess && x < rule.Operand) || (not rule.IsLess && x > rule.Operand) then
Some rule.Target
else
None
| Component.M ->
if (rule.IsLess && m < rule.Operand) || (not rule.IsLess && m > rule.Operand) then
Some rule.Target
else
None
| Component.S ->
if (rule.IsLess && s < rule.Operand) || (not rule.IsLess && s > rule.Operand) then
Some rule.Target
else
None
| _ -> failwith "bad component"
let rec computePart1 (components : Dictionary<string, Rule ResizeArray * Dest>) x m a s (reg : string) =
match components.TryGetValue reg with
| false, _ -> failwith $"no rule matched: %s{reg}"
| true, (rules, dest) ->
let mutable result = ValueNone
let mutable i = 0
while result.IsNone do
if i = rules.Count then
result <- ValueSome dest
else
match matches rules.[i] x m a s with
| Some dest -> result <- ValueSome dest
| None -> i <- i + 1
match result.Value with
| Register reg -> computePart1 components x m a s reg
| Accept -> true
| Reject -> false
let readWorkflows (rows : byref<StringSplitEnumerator>) =
let workflows = Dictionary<string, Rule ResizeArray * Dest> ()
while rows.MoveNext () && not rows.Current.IsEmpty do
let brace = rows.Current.IndexOf '{'
let name = rows.Current.Slice(0, brace).ToString ()
let rules = ResizeArray ()
for rule in StringSplitEnumerator.make' ',' (rows.Current.Slice(brace + 1).TrimEnd '}') do
match Rule.OfString rule with
| Choice1Of2 rule -> rules.Add rule
| Choice2Of2 dest -> workflows.[name] <- (rules, dest)
workflows
let part1 (workflows : _) (rows : byref<StringSplitEnumerator>) =
let mutable answer = 0
for row in rows do
if not row.IsEmpty then
let mutable x = 0
let mutable m = 0
let mutable a = 0
let mutable s = 0
for comp in StringSplitEnumerator.make' ',' (row.Slice (1, row.Length - 2)) do
let number =
Int32.Parse (comp.Slice 2, NumberStyles.None, NumberFormatInfo.InvariantInfo)
match comp.[0] with
| 'x' -> x <- number
| 'm' -> m <- number
| 'a' -> a <- number
| 's' -> s <- number
| c -> failwith $"Bad char: %c{c}"
if computePart1 workflows x m a s "in" then
answer <- answer + x + m + a + s
answer
type AcceptanceCriterion =
| True
| False
| Base of Component * low : int * high : int
| And of AcceptanceCriterion * AcceptanceCriterion
| Or of AcceptanceCriterion * AcceptanceCriterion
let rec acAnd a b =
match a, b with
| AcceptanceCriterion.Or (a1, a2), _ -> AcceptanceCriterion.Or (acAnd a1 b, acAnd a2 b)
| AcceptanceCriterion.True, _ -> b
| AcceptanceCriterion.False, _ -> False
| _, AcceptanceCriterion.Or (b1, b2) -> AcceptanceCriterion.Or (acAnd a b1, acAnd a b2)
| _, AcceptanceCriterion.True -> a
| _, AcceptanceCriterion.False -> False
| _, _ -> AcceptanceCriterion.And (a, b)
let inline acOr a b =
match a, b with
| AcceptanceCriterion.False, _ -> b
| AcceptanceCriterion.True, _ -> AcceptanceCriterion.True
| _, AcceptanceCriterion.False -> a
| _, AcceptanceCriterion.True -> AcceptanceCriterion.True
| _, _ -> AcceptanceCriterion.Or (a, b)
/// "low > high" means "empty interval"
[<Struct>]
type Interval =
{
Low : int
High : int
}
static member Empty =
{
Low = 1
High = 0
}
[<RequireQualifiedAccess>]
module Interval =
let size (i : Interval) =
if i.Low > i.High then 0 else i.High - i.Low + 1
let intersect (i1 : Interval) (i2 : Interval) =
if i1.Low > i1.High || i2.Low > i2.High then
i1
else if i1.High < i2.Low then
Interval.Empty
elif i2.High < i1.Low then
Interval.Empty
else
{
Low = max i1.Low i2.Low
High = min i1.High i2.High
}
type Conjunction =
{
X : Interval
M : Interval
A : Interval
S : Interval
}
static member All =
{
X =
{
Low = 1
High = 4000
}
M =
{
Low = 1
High = 4000
}
A =
{
Low = 1
High = 4000
}
S =
{
Low = 1
High = 4000
}
}
[<RequireQualifiedAccess>]
module Conjunction =
let conjAnd (c1 : Conjunction) (c2 : Conjunction) =
{
X = Interval.intersect c1.X c2.X
M = Interval.intersect c1.M c2.M
A = Interval.intersect c1.A c2.A
S = Interval.intersect c1.S c2.S
}
/// We rely on the intervals being disjoint by construction.
let size (x : Conjunction) : uint64 =
uint64 (Interval.size x.X)
* uint64 (Interval.size x.M)
* uint64 (Interval.size x.A)
* uint64 (Interval.size x.S)
type UnionOfConjunctions = Conjunction list
let rec toUnion (ac : AcceptanceCriterion) : UnionOfConjunctions =
match ac with
| Base (comp, low, high) ->
match comp with
| Component.A ->
{ Conjunction.All with
A =
{
Low = low
High = high
}
}
| Component.M ->
{ Conjunction.All with
M =
{
Low = low
High = high
}
}
| Component.S ->
{ Conjunction.All with
S =
{
Low = low
High = high
}
}
| Component.X ->
{ Conjunction.All with
X =
{
Low = low
High = high
}
}
| _ -> failwith "bad"
|> List.singleton
| And (a, b) ->
[
Conjunction.conjAnd (List.exactlyOne (toUnion a)) (List.exactlyOne (toUnion b))
]
| Or (a, b) -> toUnion a @ toUnion b
| True -> failwith "already stripped out"
| False -> failwith "already stripped out"
let rec acceptance
(store : Dictionary<string, AcceptanceCriterion>)
(workflows : Dictionary<string, ResizeArray<Rule> * Dest>)
(key : string)
: AcceptanceCriterion
=
match store.TryGetValue key with
| true, v -> v
| false, _ ->
let rules, final = workflows.[key]
let mutable result =
match final with
| Register s -> acceptance store workflows s
| Accept -> AcceptanceCriterion.True
| Reject -> AcceptanceCriterion.False
for i = rules.Count - 1 downto 0 do
let rule = rules.[i]
let cond =
if rule.IsLess then
AcceptanceCriterion.Base (rule.Component, 1, rule.Operand - 1)
else
AcceptanceCriterion.Base (rule.Component, rule.Operand + 1, 4000)
let negCond =
if rule.IsLess then
AcceptanceCriterion.Base (rule.Component, rule.Operand, 4000)
else
AcceptanceCriterion.Base (rule.Component, 1, rule.Operand)
result <-
match rule.Target with
| Register target -> acOr (acAnd cond (acceptance store workflows target)) (acAnd negCond result)
| Accept -> acOr cond (acAnd negCond result)
| Reject -> acAnd negCond result
store.[key] <- result
result
let part2 (workflows : _) (rows : byref<StringSplitEnumerator>) : uint64 =
let acceptanceRanges = Dictionary<string, AcceptanceCriterion> ()
let a = acceptance acceptanceRanges workflows "in"
let union = toUnion a
union |> List.sumBy Conjunction.size

View File

@@ -0,0 +1,55 @@
namespace AdventOfCode2023
open System
[<RequireQualifiedAccess>]
module Day9 =
let extrapolate (isStart : bool) (arr : ResizeArray<int64>) =
let mutable answer = 0L
let pos = if isStart then -1L else int64 arr.Count
for i = 0 to arr.Count - 1 do
let mutable product = Rational.ofInt arr.[i]
for j = 0 to arr.Count - 1 do
if j <> i then
product <- product * Rational.make (pos - int64 j) (int64 i - int64 j)
answer <- answer + Rational.assertIntegral product
answer
let part1 (s : string) =
use s = StringSplitEnumerator.make '\n' s
let mutable answer = 0L
let arr = ResizeArray ()
for line in s do
arr.Clear ()
use line = StringSplitEnumerator.make' ' ' line
for number in line do
let number = Int64.Parse number
arr.Add number
answer <- answer + extrapolate false arr
answer
let part2 (s : string) =
use s = StringSplitEnumerator.make '\n' s
let mutable answer = 0L
let arr = ResizeArray ()
for line in s do
arr.Clear ()
use line = StringSplitEnumerator.make' ' ' line
for number in line do
let number = Int64.Parse number
arr.Add number
answer <- answer + extrapolate true arr
answer

View File

@@ -0,0 +1,24 @@
namespace AdventOfCode2023
type Direction =
| Left = 0
| Right = 1
| Up = 2
| Down = 3
module Direction =
let inline toUInt (d : Direction) =
match d with
| Direction.Left -> 0us
| Direction.Right -> 1us
| Direction.Up -> 2us
| Direction.Down -> 3us
| _ -> failwith "Bad"
let inline ofChar (c : char) : Direction =
match c with
| 'L' -> Direction.Left
| 'R' -> Direction.Right
| 'U' -> Direction.Up
| 'D' -> Direction.Down
| c -> failwith $"Bad: %c{c}"

View File

@@ -1,7 +1,6 @@
namespace AdventOfCode2023
open System
open System.Globalization
open System.Runtime.CompilerServices
type EfficientString = System.ReadOnlySpan<char>

View File

@@ -0,0 +1,70 @@
namespace AdventOfCode2023
type IntervalSet = private | IntervalSet of (int * int) list
[<RequireQualifiedAccess>]
module IntervalSet =
let empty = IntervalSet []
let private add' (low : int) (high : int) intervals : _ list =
let rec go (low : int) (high : int) (intervals : (int * int) list) =
match intervals with
| [] -> [ low, high ]
| (lowExisting, highExisting) :: intervals ->
if low > highExisting then
(lowExisting, highExisting) :: go low high intervals
elif high < lowExisting then
(low, high) :: (lowExisting, highExisting) :: intervals
elif high = lowExisting then
(low, highExisting) :: intervals
elif high <= highExisting then
(min low lowExisting, highExisting) :: intervals
else
// low <= highExisting, highExisting < high
(min low lowExisting, highExisting) :: go (highExisting + 1) high intervals
go low high intervals
let add (low : int) (high : int) (IntervalSet intervals) : IntervalSet = add' low high intervals |> IntervalSet
let contains (x : int) (IntervalSet intervals) : bool =
let rec go (intervals : (int * int) list) =
match intervals with
| [] -> false
| (low, high) :: intervals ->
if low > x then false
elif x <= high then true
else go intervals
go intervals
let private union' i1 i2 =
(i2, i1) ||> List.fold (fun i (low, high) -> add' low high i)
let union (IntervalSet i1) (IntervalSet i2) : IntervalSet = union' i1 i2 |> IntervalSet
let private intersectionHelper (low : int) (high : int) (ints : (int * int) list) =
let rec go (low : int) (high : int) (ints : (int * int) list) =
match ints with
| [] -> []
| (lowExisting, highExisting) :: ints ->
if low > highExisting then
go low high ints
elif high < lowExisting then
[]
elif high <= highExisting then
[ max low lowExisting, high ]
else
(max low lowExisting, highExisting) :: go (highExisting + 1) high ints
go low high ints
let private intersection' i1 i2 =
// a int (b U c) = (a int b) U (a int c)
([], i1)
||> List.fold (fun soFar (low, high) -> union' soFar (intersectionHelper low high i2))
let intersection (IntervalSet i1) (IntervalSet i2) : IntervalSet = intersection' i1 i2 |> IntervalSet
let count (IntervalSet i) =
i |> List.sumBy (fun (low, high) -> high - low + 1)

View File

@@ -0,0 +1,38 @@
namespace AdventOfCode2023
open System
[<RequireQualifiedAccess>]
module List =
let rec nTuples (n : int) (xs : 'a list) : 'a list list =
#if DEBUG
if n < 0 then
raise (ArgumentException "n cannot be negative")
#endif
match n, xs with
| 0, _ -> [ [] ]
| _, [] -> []
| _, x :: xs ->
let withX = nTuples (n - 1) xs |> List.map (fun xs -> x :: xs)
let withoutX = nTuples n xs
withX @ withoutX
let inline inclusionExclusion (sizeOf : 'a -> 'ret) (sizeOfTuple : 'a list -> 'ret) (xs : 'a list) : 'ret =
let mutable result = List.sumBy sizeOf xs
let mutable i = 2
while i <= xs.Length do
let nTuples = nTuples i xs
let sum = List.sumBy sizeOfTuple nTuples
if sum = LanguagePrimitives.GenericZero then
i <- Int32.MaxValue
else
if i % 2 = 0 then
result <- result - sum
else
result <- result + sum
i <- i + 1
result

View File

@@ -0,0 +1,82 @@
namespace AdventOfCode2023
[<Struct>]
type Rational<'a
when 'a : (static member (+) : 'a * 'a -> 'a)
and 'a : (static member (*) : 'a * 'a -> 'a)
and 'a : (static member (/) : 'a * 'a -> 'a)
and 'a : (static member (-) : 'a * 'a -> 'a)
and 'a : (static member Zero : 'a)
and 'a : (static member One : 'a)
and 'a : comparison> =
{
Numerator : 'a
Denominator : 'a
}
static member inline (+) (a : Rational<'a>, b : Rational<'a>) =
let numerator = a.Numerator * b.Denominator + b.Numerator * a.Denominator
let denominator = a.Denominator * b.Denominator
let hcf = (Arithmetic.euclideanAlgorithm numerator denominator).Hcf
{
Numerator = numerator / hcf
Denominator = denominator / hcf
}
static member inline (*) (a : Rational<'a>, b : Rational<'a>) =
let numerator = a.Numerator * b.Numerator
let denominator = a.Denominator * b.Denominator
let hcf = (Arithmetic.euclideanAlgorithm numerator denominator).Hcf
{
Numerator = numerator / hcf
Denominator = denominator / hcf
}
[<RequireQualifiedAccess>]
module Rational =
let inline ofInt< ^a
when 'a : (static member (+) : 'a * 'a -> 'a)
and 'a : (static member (*) : 'a * 'a -> 'a)
and 'a : (static member (/) : 'a * 'a -> 'a)
and 'a : (static member (-) : 'a * 'a -> 'a)
and 'a : (static member Zero : 'a)
and 'a : (static member One : 'a)
and 'a : comparison>
(a : 'a)
=
{
Numerator = a
Denominator = LanguagePrimitives.GenericOne
}
let inline make< ^a
when 'a : (static member (+) : 'a * 'a -> 'a)
and 'a : (static member (*) : 'a * 'a -> 'a)
and 'a : (static member (/) : 'a * 'a -> 'a)
and 'a : (static member (-) : 'a * 'a -> 'a)
and 'a : (static member Zero : 'a)
and 'a : (static member One : 'a)
and 'a : comparison>
(numerator : 'a)
(denominator : 'a)
=
let hcf = (Arithmetic.euclideanAlgorithm numerator denominator).Hcf
{
Numerator = numerator / hcf
Denominator = denominator / hcf
}
let inline assertIntegral< ^a
when 'a : (static member (+) : 'a * 'a -> 'a)
and 'a : (static member (*) : 'a * 'a -> 'a)
and 'a : (static member (/) : 'a * 'a -> 'a)
and 'a : (static member (-) : 'a * 'a -> 'a)
and 'a : (static member Zero : 'a)
and 'a : (static member One : 'a)
and 'a : comparison>
(r : Rational<'a>)
=
r.Numerator

View File

@@ -6,6 +6,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Test", "Test\Test.fsproj",
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "AdventOfCode2023.FSharp.Lib", "AdventOfCode2023.FSharp.Lib\AdventOfCode2023.FSharp.Lib.fsproj", "{95CE0568-3D1A-4060-BB54-52460FB1E399}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "AdventOfCode2023.FSharp.Bench", "AdventOfCode2023.FSharp.Bench\AdventOfCode2023.FSharp.Bench.fsproj", "{5FD3221D-2C90-4173-8FC0-90553CEE1D4A}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
@@ -24,5 +26,9 @@ Global
{95CE0568-3D1A-4060-BB54-52460FB1E399}.Debug|Any CPU.Build.0 = Debug|Any CPU
{95CE0568-3D1A-4060-BB54-52460FB1E399}.Release|Any CPU.ActiveCfg = Release|Any CPU
{95CE0568-3D1A-4060-BB54-52460FB1E399}.Release|Any CPU.Build.0 = Release|Any CPU
{5FD3221D-2C90-4173-8FC0-90553CEE1D4A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{5FD3221D-2C90-4173-8FC0-90553CEE1D4A}.Debug|Any CPU.Build.0 = Debug|Any CPU
{5FD3221D-2C90-4173-8FC0-90553CEE1D4A}.Release|Any CPU.ActiveCfg = Release|Any CPU
{5FD3221D-2C90-4173-8FC0-90553CEE1D4A}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
EndGlobal

View File

@@ -1,28 +1,28 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net8.0</TargetFramework>
<PublishAot>true</PublishAot>
<InvariantGlobalization>true</InvariantGlobalization>
<UseSystemResourceKeys>true</UseSystemResourceKeys>
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net8.0</TargetFramework>
<PublishAot>true</PublishAot>
<InvariantGlobalization>true</InvariantGlobalization>
<UseSystemResourceKeys>true</UseSystemResourceKeys>
<IlcOptimizationPreference>Speed</IlcOptimizationPreference>
<IlcGenerateStackTraceData>false</IlcGenerateStackTraceData>
<IlcOptimizationPreference>Speed</IlcOptimizationPreference>
<IlcGenerateStackTraceData>false</IlcGenerateStackTraceData>
<DebuggerSupport>false</DebuggerSupport>
<EnableUnsafeBinaryFormatterSerialization>false</EnableUnsafeBinaryFormatterSerialization>
<EventSourceSupport>false</EventSourceSupport>
<HttpActivityPropagationSupport>false</HttpActivityPropagationSupport>
<MetadataUpdaterSupport>false</MetadataUpdaterSupport>
</PropertyGroup>
<DebuggerSupport>false</DebuggerSupport>
<EnableUnsafeBinaryFormatterSerialization>false</EnableUnsafeBinaryFormatterSerialization>
<EventSourceSupport>false</EventSourceSupport>
<HttpActivityPropagationSupport>false</HttpActivityPropagationSupport>
<MetadataUpdaterSupport>false</MetadataUpdaterSupport>
</PropertyGroup>
<ItemGroup>
<Compile Include="Program.fs"/>
</ItemGroup>
<ItemGroup>
<Compile Include="Program.fs"/>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\AdventOfCode2023.FSharp.Lib\AdventOfCode2023.FSharp.Lib.fsproj" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\AdventOfCode2023.FSharp.Lib\AdventOfCode2023.FSharp.Lib.fsproj"/>
</ItemGroup>
</Project>

View File

@@ -179,6 +179,187 @@ module Program =
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 9====="
do
let input = Path.Combine (dir.FullName, "day9.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day9.part1 input
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day9.part2 input
sw.Stop ()
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 10====="
do
let input = Path.Combine (dir.FullName, "day10.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day10.part1 input
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day10.part2 input
sw.Stop ()
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 11====="
do
let input = Path.Combine (dir.FullName, "day11.txt") |> File.ReadAllText
sw.Restart ()
let data = Day11.parse input
sw.Stop ()
Console.Error.WriteLine (
(1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString ()
+ "ms parse"
)
sw.Restart ()
let part1 = Day11.solve data 2uL
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day11.solve data 1_000_000uL
sw.Stop ()
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 12====="
do
let input = Path.Combine (dir.FullName, "day12.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day12.part1 input
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day12.part2 input
sw.Stop ()
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 13====="
do
let input = Path.Combine (dir.FullName, "day13.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day13.part1 input
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day13.part2 input
sw.Stop ()
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 14====="
do
let input = Path.Combine (dir.FullName, "day14.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day14.part1 input
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day14.part2 input
sw.Stop ()
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 15====="
do
let input = Path.Combine (dir.FullName, "day15.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day15.part1 input
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day15.part2 input
sw.Stop ()
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 16====="
do
let input = Path.Combine (dir.FullName, "day16.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day16.part1 input
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day16.part2 input
sw.Stop ()
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 18====="
do
let input = Path.Combine (dir.FullName, "day18.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day18.part1 input
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day18.part2 input
sw.Stop ()
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 19====="
do
let input = Path.Combine (dir.FullName, "day19.txt") |> File.ReadAllText
sw.Restart ()
use mutable s = StringSplitEnumerator.make '\n' input
let data = Day19.readWorkflows &s
sw.Stop ()
Console.Error.WriteLine (
(1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString ()
+ "ms parse"
)
let mutable sCopy = s
sw.Restart ()
let part1 = Day19.part1 data &s
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day19.part2 data &sCopy
sw.Stop ()
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
endToEnd.Stop ()
Console.Error.WriteLine (

View File

@@ -1,44 +1,72 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<IsPackable>false</IsPackable>
<IsTestProject>true</IsTestProject>
</PropertyGroup>
<IsPackable>false</IsPackable>
<IsTestProject>true</IsTestProject>
<ItemGroup>
<Compile Include="Util.fs" />
<Compile Include="TestDay1.fs" />
<Compile Include="TestDay2.fs" />
<Compile Include="TestDay3.fs" />
<Compile Include="TestDay4.fs" />
<Compile Include="TestDay5.fs" />
<Compile Include="TestDay6.fs" />
<Compile Include="TestDay7.fs" />
<Compile Include="TestDay8.fs" />
<EmbeddedResource Include="samples\day1.txt" />
<EmbeddedResource Include="samples\day1part1.txt" />
<EmbeddedResource Include="samples\day2.txt" />
<EmbeddedResource Include="samples\day3.txt" />
<EmbeddedResource Include="samples\day4.txt" />
<EmbeddedResource Include="samples\day5.txt" />
<EmbeddedResource Include="samples\day6.txt" />
<EmbeddedResource Include="samples\day7.txt" />
<EmbeddedResource Include="samples\day8part1.txt" />
<EmbeddedResource Include="samples\day8.txt" />
</ItemGroup>
<EnableStaticNativeInstrumentation>False</EnableStaticNativeInstrumentation>
<EnableDynamicNativeInstrumentation>False</EnableDynamicNativeInstrumentation>
</PropertyGroup>
<ItemGroup>
<PackageReference Include="FsUnit" Version="5.6.1" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.6.0"/>
<PackageReference Include="NUnit3TestAdapter" Version="4.2.1"/>
<PackageReference Include="NUnit.Analyzers" Version="3.6.1"/>
<PackageReference Include="coverlet.collector" Version="6.0.0"/>
</ItemGroup>
<ItemGroup>
<Compile Include="Util.fs"/>
<Compile Include="TestIntervalSet.fs" />
<Compile Include="TestList.fs" />
<Compile Include="TestDay1.fs"/>
<Compile Include="TestDay2.fs"/>
<Compile Include="TestDay3.fs"/>
<Compile Include="TestDay4.fs"/>
<Compile Include="TestDay5.fs"/>
<Compile Include="TestDay6.fs"/>
<Compile Include="TestDay7.fs"/>
<Compile Include="TestDay8.fs"/>
<Compile Include="TestDay9.fs"/>
<Compile Include="TestDay10.fs" />
<Compile Include="TestDay11.fs" />
<Compile Include="TestDay12.fs" />
<Compile Include="TestDay13.fs" />
<Compile Include="TestDay14.fs" />
<Compile Include="TestDay15.fs" />
<Compile Include="TestDay16.fs" />
<Compile Include="TestDay18.fs" />
<Compile Include="TestDay19.fs" />
<EmbeddedResource Include="samples\day1.txt"/>
<EmbeddedResource Include="samples\day1part1.txt"/>
<EmbeddedResource Include="samples\day2.txt"/>
<EmbeddedResource Include="samples\day3.txt"/>
<EmbeddedResource Include="samples\day4.txt"/>
<EmbeddedResource Include="samples\day5.txt"/>
<EmbeddedResource Include="samples\day6.txt"/>
<EmbeddedResource Include="samples\day7.txt"/>
<EmbeddedResource Include="samples\day8part1.txt"/>
<EmbeddedResource Include="samples\day8.txt"/>
<EmbeddedResource Include="samples\day9.txt"/>
<EmbeddedResource Include="samples\day10part1.txt" />
<EmbeddedResource Include="samples\day10.txt" />
<EmbeddedResource Include="samples\day11.txt" />
<EmbeddedResource Include="samples\day12.txt" />
<EmbeddedResource Include="samples\day13.txt" />
<EmbeddedResource Include="samples\day14.txt" />
<EmbeddedResource Include="samples\day15.txt" />
<EmbeddedResource Include="samples\day16.txt" />
<EmbeddedResource Include="samples\day18.txt" />
<EmbeddedResource Include="samples\day19.txt" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\AdventOfCode2023.FSharp.Lib\AdventOfCode2023.FSharp.Lib.fsproj" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FsCheck" Version="2.16.6" />
<PackageReference Include="FsUnit" Version="5.6.1"/>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.8.0"/>
<PackageReference Include="Microsoft.CodeCoverage" Version="17.8.0"/>
<PackageReference Include="NUnit3TestAdapter" Version="4.2.1"/>
<PackageReference Include="NUnit.Analyzers" Version="3.6.1"/>
<PackageReference Include="coverlet.collector" Version="6.0.0"/>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\AdventOfCode2023.FSharp.Lib\AdventOfCode2023.FSharp.Lib.fsproj"/>
</ItemGroup>
</Project>

View File

@@ -0,0 +1,104 @@
namespace AdventOfCode2023.Test
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay10 =
let part1Sample1 () =
""".....
.S-7.
.|.|.
.L-J.
.....
"""
|> Day10.part1
|> shouldEqual 4
[<Test>]
let part1Sample () =
Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day10part1.txt"
|> Day10.part1
|> shouldEqual 8
[<Test>]
let part2Sample1 () =
"""...........
.S-------7.
.|F-----7|.
.||.....||.
.||.....||.
.|L-7.F-J|.
.|..|.|..|.
.L--J.L--J.
...........
"""
|> Day10.part2
|> shouldEqual 4
[<Test>]
let part2Sample2 () =
"""..........
.S------7.
.|F----7|.
.||....||.
.||....||.
.|L-7F-J|.
.|..||..|.
.L--JL--J.
..........
"""
|> Day10.part2
|> shouldEqual 4
[<Test>]
let part2Sample3 () =
""".F----7F7F7F7F-7....
.|F--7||||||||FJ....
.||.FJ||||||||L7....
FJL7L7LJLJ||LJ.L-7..
L--J.L7...LJS7F-7L7.
....F-J..F7FJ|L7L7L7
....L7.F7||L7|.L7L7|
.....|FJLJ|FJ|F7|.LJ
....FJL-7.||.||||...
....L---J.LJ.LJLJ...
"""
|> Day10.part2
|> shouldEqual 8
[<Test>]
let part2Sample () =
Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day10.txt"
|> Day10.part2
|> shouldEqual 10
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day10.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day10.part1 s |> shouldEqual 6842
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day10.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day10.part2 s |> shouldEqual 393

View File

@@ -0,0 +1,47 @@
namespace AdventOfCode2023.Test
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay11 =
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day11.txt"
[<Test>]
let part1Sample () =
sample |> Day11.part1 |> shouldEqual 374uL
[<Test>]
let part2Sample () =
let data = sample |> Day11.parse
Day11.solve data 10uL |> shouldEqual 1030uL
Day11.solve data 100uL |> shouldEqual 8410uL
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day11.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day11.part1 s |> shouldEqual 9947476uL
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day11.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day11.part2 s |> shouldEqual 519939907614uL

View File

@@ -0,0 +1,45 @@
namespace AdventOfCode2023.Test
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay12 =
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day12.txt"
[<Test>]
let part1Sample () =
sample |> Day12.part1 |> shouldEqual 21uL
[<Test>]
let part2Sample () =
sample |> Day12.part2 |> shouldEqual 525152uL
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day12.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day12.part1 s |> shouldEqual 7402uL
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day12.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day12.part2 s |> shouldEqual 3384337640277uL

View File

@@ -0,0 +1,68 @@
namespace AdventOfCode2023.Test
open System
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay13 =
[<Test>]
let ``rowToInt test`` () =
Day13.rowToInt ("#.##..##.".AsSpan ()) |> shouldEqual 358ul
[<Test>]
let ``colToInt test`` () =
let s =
"""#.##..##.
..#.##.#.
##......#
##......#
..#.##.#.
..##..##.
#.#.##.#.
"""
Day13.colToInt (s.AsSpan ()) 9 0
|> shouldEqual (List.sum [ 1 ; 8 ; 16 ; 64 ] |> uint32)
[<Test>]
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day13.txt"
[<Test>]
let part1Sample () =
sample |> Day13.part1 |> shouldEqual 405ul
[<Test>]
let part2Sample () =
sample |> Day13.part2 |> shouldEqual 400ul
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day13.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day13.part1 s |> shouldEqual 30158ul
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day13.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day13.part2 s |> shouldEqual 36474ul

View File

@@ -0,0 +1,48 @@
namespace AdventOfCode2023.Test
open System
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay14 =
[<Test>]
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day14.txt"
[<Test>]
let part1Sample () =
sample |> Day14.part1 |> shouldEqual 136ul
[<Test>]
let part2Sample () =
sample |> Day14.part2 |> shouldEqual 64ul
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day14.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day14.part1 s |> shouldEqual 111339ul
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day14.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day14.part2 s |> shouldEqual 93736ul

View File

@@ -0,0 +1,46 @@
namespace AdventOfCode2023.Test
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay15 =
[<Test>]
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day15.txt"
[<Test>]
let part1Sample () =
sample |> Day15.part1 |> shouldEqual 1320
[<Test>]
let part2Sample () =
sample |> Day15.part2 |> shouldEqual 145ul
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day15.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day15.part1 s |> shouldEqual 521434
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day15.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day15.part2 s |> shouldEqual 248279ul

View File

@@ -0,0 +1,44 @@
namespace AdventOfCode2023.Test
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay16 =
[<Test>]
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day16.txt"
[<Test>]
let part1Sample () = sample |> Day16.part1 |> shouldEqual 46
[<Test>]
let part2Sample () = sample |> Day16.part2 |> shouldEqual 51
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day16.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day16.part1 s |> shouldEqual 8112
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day16.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day16.part2 s |> shouldEqual 8314

View File

@@ -0,0 +1,44 @@
namespace AdventOfCode2023.Test
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay18 =
[<Test>]
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day18.txt"
[<Test>]
let part1Sample () = sample |> Day18.part1 |> shouldEqual 62
[<Test>]
let part2Sample () = sample |> Day18.part2 |> shouldEqual 0
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day18.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day18.part1 s |> shouldEqual 106459
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day18.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day18.part2 s |> shouldEqual 0

View File

@@ -0,0 +1,55 @@
namespace AdventOfCode2023.Test
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay19 =
[<Test>]
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day19.txt"
[<Test>]
let part1Sample () =
use mutable s = StringSplitEnumerator.make '\n' sample
let workflows = Day19.readWorkflows &s
Day19.part1 workflows &s |> shouldEqual 19114
[<Test>]
let part2Sample () =
use mutable s = StringSplitEnumerator.make '\n' sample
let workflows = Day19.readWorkflows &s
Day19.part2 workflows &s |> shouldEqual 167409079868000uL
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day19.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
use mutable s = StringSplitEnumerator.make '\n' s
let workflows = Day19.readWorkflows &s
Day19.part1 workflows &s |> shouldEqual 368964
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day19.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
use mutable s = StringSplitEnumerator.make '\n' s
let workflows = Day19.readWorkflows &s
Day19.part2 workflows &s |> shouldEqual 127675188176682uL

View File

@@ -1,6 +1,5 @@
namespace AdventOfCode2023.Test
open System
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped

View File

@@ -1,6 +1,5 @@
namespace AdventOfCode2023.Test
open System
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped

View File

@@ -1,6 +1,5 @@
namespace AdventOfCode2023.Test
open System
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped

View File

@@ -0,0 +1,44 @@
namespace AdventOfCode2023.Test
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay9 =
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day9.txt"
[<Test>]
let part1Sample () =
sample |> Day9.part1 |> shouldEqual 114L
[<Test>]
let part2Sample () = sample |> Day9.part2 |> shouldEqual 2L
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day9.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day9.part1 s |> shouldEqual 1898776583L
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day9.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day9.part2 s |> shouldEqual 1100L

View File

@@ -0,0 +1,86 @@
namespace AdventOfCode2023.Test
open System.Threading
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open FsCheck
[<TestFixture>]
module TestIntervalSet =
/// Normalises e.g. (5, 3) to (3, 5) too.
let toIntervalSet (model : (int * int) list) =
(IntervalSet.empty, model)
||> List.fold (fun intervals (x1, x2) -> IntervalSet.add (min x1 x2) (max x1 x2) intervals)
let modelContains (x : int) (model : (int * int) list) =
model
|> List.exists (fun (x1, x2) ->
let x1, x2 = min x1 x2, max x1 x2
x1 <= x && x <= x2
)
[<Test>]
let ``IntervalSet add works`` () =
let property (pos : int ref) (neg : int ref) (x : int) (xs : (int * int) list) =
let intervals = toIntervalSet xs
let actual = IntervalSet.contains x intervals
let expected = modelContains x xs
if actual then
Interlocked.Increment pos |> ignore
else
Interlocked.Increment neg |> ignore
expected = actual
let pos = ref 0
let neg = ref 0
Check.One (
{ Config.Default with
MaxTest = 1000
},
property pos neg
)
printfn "Fraction of positive cases: %f" ((float pos.Value) / (float pos.Value + float neg.Value))
[<Test>]
let ``Intersection works`` () =
let property
(pos : int ref)
(neg : int ref)
(trials : int list)
(xsModel : (int * int) list)
(ysModel : (int * int) list)
=
let xs = toIntervalSet xsModel
let ys = toIntervalSet ysModel
let intervals = IntervalSet.intersection xs ys
for x in trials do
let actual = IntervalSet.contains x intervals
let expected = modelContains x xsModel && modelContains x ysModel
expected |> shouldEqual actual
if actual then
Interlocked.Increment pos |> ignore
else
Interlocked.Increment neg |> ignore
let pos = ref 0
let neg = ref 0
Check.One (
{ Config.Default with
MaxTest = 1000
},
property pos neg
)
printfn "Fraction of positive cases: %f" ((float pos.Value) / (float pos.Value + float neg.Value))

View File

@@ -0,0 +1,20 @@
namespace Test
open NUnit.Framework
open FsUnitTyped
open FsCheck
open AdventOfCode2023
[<TestFixture>]
module TestList =
[<Test>]
let ``n-tuples have the right length`` () =
let property (n : int) (xs : char list) =
let n = min (abs n) 6
let xs = xs |> List.take (min 10 xs.Length)
let tuples = List.nTuples n xs
tuples |> List.forall (fun i -> i.Length = n)
property 1 [ 'v' ] |> shouldEqual true
Check.QuickThrowOnFailure property

View File

@@ -0,0 +1,10 @@
FF7FSF7F7F7F7F7F---7
L|LJ||||||||||||F--J
FL-7LJLJ||||||LJL-77
F--JF--7||LJLJ7F7FJ-
L---JF-JLJ.||-FJLJJ7
|F|F-JF---7F7-L7L|7|
|FFJF7L7F-JF7|JL---7
7-L-JL7||F7|L7F-7F7|
L.L7LFJ|||||FJL7||LJ
L7JLJL-JLJLJL--JLJ.L

View File

@@ -0,0 +1,5 @@
..F7.
.FJ|.
SJ.L7
|F--J
LJ...

View File

@@ -0,0 +1,10 @@
...#......
.......#..
#.........
..........
......#...
.#........
.........#
..........
.......#..
#...#.....

View File

@@ -0,0 +1,6 @@
???.### 1,1,3
.??..??...?##. 1,1,3
?#?#?#?#?#?#?#? 1,3,1,6
????.#...#... 4,1,1
????.######..#####. 1,6,5
?###???????? 3,2,1

View File

@@ -0,0 +1,15 @@
#.##..##.
..#.##.#.
##......#
##......#
..#.##.#.
..##..##.
#.#.##.#.
#...##..#
#....#..#
..##..###
#####.##.
#####.##.
..##..###
#....#..#

View File

@@ -0,0 +1,10 @@
O....#....
O.OO#....#
.....##...
OO.#O....O
.O.....O#.
O.#..O.#.#
..O..#O..O
.......O..
#....###..
#OO..#....

View File

@@ -0,0 +1 @@
rn=1,cm-,qp=3,cm=2,qp-,pc=4,ot=9,ab=5,pc-,pc=6,ot=7

View File

@@ -0,0 +1,10 @@
.|...\....
|.-.\.....
.....|-...
........|.
..........
.........\
..../.\\..
.-.-/..|..
.|....-|.\
..//.|....

View File

@@ -0,0 +1,14 @@
R 6 (#70c710)
D 5 (#0dc571)
L 2 (#5713f0)
D 2 (#d2c081)
R 2 (#59c680)
D 2 (#411b91)
L 5 (#8ceee2)
U 2 (#caa173)
L 1 (#1b58a2)
U 2 (#caa171)
R 2 (#7807d2)
U 3 (#a77fa3)
L 2 (#015232)
U 2 (#7a21e3)

View File

@@ -0,0 +1,17 @@
px{a<2006:qkq,m>2090:A,rfg}
pv{a>1716:R,A}
lnx{m>1548:A,A}
rfg{s<537:gd,x>2440:R,A}
qs{s>3448:A,lnx}
qkq{x<1416:A,crn}
crn{x>2662:A,R}
in{s<1351:px,qqz}
qqz{s>2770:qs,m<1801:hdj,R}
gd{a>3333:R,R}
hdj{m>838:A,pv}
{x=787,m=2655,a=1222,s=2876}
{x=1679,m=44,a=2067,s=496}
{x=2036,m=264,a=79,s=2244}
{x=2461,m=1339,a=466,s=291}
{x=2127,m=1623,a=2188,s=1013}

View File

@@ -0,0 +1,3 @@
0 3 6 9 12 15
1 3 6 10 15 21
10 13 16 21 30 45

104
README.md
View File

@@ -7,23 +7,109 @@
Ahead-of-time compiled with `PublishAot`, M1 Max.
The format is: "answer part1\ntime\nanswer part2\ntime\n...", with possible extra lines indicating how long it took to parse the input if I happen to have split that out.
After day 3:
BenchmarkDotNet:
```
| Day | IsPartOne | Mean | Error | StdDev |
|---- |---------- |----------:|---------:|---------:|
| 1 | True | 10.23 us | 0.036 us | 0.032 us |
| 1 | False | 17.93 us | 0.203 us | 0.180 us |
| 2 | True | 17.39 us | 0.080 us | 0.075 us |
| 2 | False | 25.42 us | 0.155 us | 0.145 us |
| 3 | True | 65.60 us | 0.393 us | 0.328 us |
| 3 | False | 145.52 us | 0.256 us | 0.200 us |
| 4 | True | 109.78 us | 0.236 us | 0.209 us |
| 4 | False | 110.34 us | 0.081 us | 0.063 us |
| 5 | True | 13.44 us | 0.045 us | 0.042 us |
| 5 | False | 61.70 us | 0.199 us | 0.177 us |
| Day | IsPartOne | Mean | Error | StdDev |
|---- |---------- |---------------:|------------:|------------:|
| 6 | True | 314.7 ns | 1.87 ns | 1.65 ns |
| 6 | False | 316.3 ns | 0.31 ns | 0.26 ns |
| 7 | True | 89,256.3 ns | 578.24 ns | 540.88 ns |
| 7 | False | 95,062.7 ns | 921.75 ns | 862.21 ns |
| 8 | True | 423,461.0 ns | 7,218.95 ns | 6,752.61 ns |
| 8 | False | 2,045,302.1 ns | 4,338.61 ns | 3,846.06 ns |
| 9 | True | 1,390,976.2 ns | 2,171.39 ns | 1,813.21 ns |
| 9 | False | 2,173,468.1 ns | 3,171.04 ns | 2,647.96 ns |
| 10 | True | 57,460.7 ns | 1,135.45 ns | 2,160.31 ns |
| 10 | False | 694,553.9 ns | 2,935.74 ns | 2,746.09 ns |
| Day | IsPartOne | Mean | Error | StdDev | Median |
|---- |---------- |----------:|----------:|----------:|----------:|
| 11 | True | 39.085 ms | 0.0355 ms | 0.0297 ms | 39.082 ms |
| 11 | False | 38.608 ms | 0.0270 ms | 0.0211 ms | 38.617 ms |
| 12 | True | 1.846 ms | 0.0044 ms | 0.0041 ms | 1.845 ms |
| 12 | False | 18.692 ms | 0.3676 ms | 0.3775 ms | 18.962 ms |
```
After day 12, a single run of the ahead-of-time compiled version:
```
=====Day 1=====
54304
0.549458ms
3.418417ms
54418
0.710375ms
0.317958ms
=====Day 2=====
2727
0.119959ms
0.079917ms
56580
0.155708ms
0.1395ms parse
0.107292ms
=====Day 3=====
0.140292ms parse
540131
0.1395ms
0.140292ms
86879020
0.840791ms
4.144166ms total
0.664416ms
=====Day 4=====
27454
0.390541ms
6857330
0.360375ms
=====Day 5=====
806029445
0.161917ms
59370572
0.249708ms
=====Day 6=====
32076
0.002917ms
34278221
0.001667ms
=====Day 7=====
250058342
0.409792ms
250506580
0.431167ms
=====Day 8=====
19199
1.192792ms
13663968099527
5.276083ms
=====Day 9=====
1898776583
3.775667ms
1100
5.365875ms
=====Day 10=====
6842
0.201208ms
393
2.226042ms
=====Day 11=====
0.11225ms parse
9947476
48.423ms
519939907614
34.836125ms
=====Day 12=====
7402
4.704375ms
3384337640277
31.825583ms
151.644334ms total
```
# Building yourself

30
mathematica/day_21.m Normal file
View File

@@ -0,0 +1,30 @@
(* ::Package:: *)
(* ::Input:: *)
(*s="...........*)
(*.....###.#.*)
(*.###.##..#.*)
(*..#.#...#..*)
(*....#.#....*)
(*.##..S####.*)
(*.##..#...#.*)
(*.......##..*)
(*.##.#.####.*)
(*.##..##.##.*)
(*...........";*)
(* ::Input:: *)
(*reachable[grid_,{row_Integer,col_Integer}]:=reachable[grid,{row,col}]=Select[{{row+1,col},{row-1,col},{row,col+1},{row,col-1}},*)
(*1<=#[[1]]<=Length[grid]&&1<=#[[2]]<=Length[First@grid]&&grid[[#[[1]],#[[2]]]]!="#"&*)
(*]*)
(* ::Input:: *)
(*f[grid_,pos_,0]:={pos}*)
(*f[grid_,pos_,timestepsRemaining_Integer]:=*)
(*f[grid,pos,timestepsRemaining]=DeleteDuplicates@Flatten[f[grid,#,timestepsRemaining-1]&/@reachable[grid,pos],1]*)
(* ::Input:: *)
(*With[{grid=Characters/@StringSplit[s,"\n"]},f[grid,FirstPosition[grid,"S"],64]//Length]*)