Compare commits

28 Commits

Author SHA1 Message Date
Smaug123
c3611bffe3 Dead
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
ci/woodpecker/pr/build Pipeline was successful
ci/woodpecker/pr/all-checks-complete Pipeline was successful
2023-12-23 16:34:17 +00:00
Smaug123
a26a2a982b More 2023-12-23 16:31:04 +00:00
Smaug123
ad5dae8db7 Delete cata 2023-12-23 16:28:31 +00:00
Smaug123
1efec664ad Format 2023-12-23 16:27:28 +00:00
Smaug123
02a204ebb3 WIP 2023-12-23 16:07:15 +00:00
Smaug123
c84514aa38 No allocation please we're British 2023-12-23 15:42:20 +00:00
Smaug123
dbbb8a0326 Faster 2023-12-23 15:38:55 +00:00
Smaug123
9dd1148025 Rem todo 2023-12-23 15:28:20 +00:00
Smaug123
b0ebbe5842 Format 2023-12-23 15:24:43 +00:00
Smaug123
fd5b914237 Part 2 2023-12-23 15:24:37 +00:00
Smaug123
b66861e83b Union of interseections 2023-12-23 13:07:17 +00:00
Smaug123
8c60bfb744 Tree of ors with 'and' at leaf 2023-12-23 12:52:36 +00:00
Smaug123
8519bdfe05 wip 2023-12-23 12:52:25 +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
d94663ae0e Day 8 (#8)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Blown way through my time budget and there's a bunch of low hanging fruit (data dependencies in LCM, for example) but I'm late for work.

Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #8
2023-12-08 09:07:04 +00:00
bcd2bb6349 Speed up day 7 a bit (#7)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
I'm going mad, why am I doing this

Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #7
2023-12-07 23:52:34 +00:00
2fbdf2c362 Day 7 (#6)
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: #6
2023-12-07 09:32:21 +00:00
786a7eba8e Day 6 (#5)
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: #5
2023-12-06 09:06:05 +00:00
9c48e5fa96 Day 5 (#4)
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: #4
2023-12-05 20:26:07 +00:00
c8c1cdc950 Day 4 (#2)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Reviewed-on: #2
2023-12-04 19:29:11 +00:00
77 changed files with 4982 additions and 181 deletions

1
.gitignore vendored
View File

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

View File

@@ -6,8 +6,14 @@ steps:
# Lint
- "nix flake check"
# Test
- nix develop --command dotnet test
- nix develop --command dotnet test --configuration Release
- nix develop --command dotnet test AdventOfCode2023.FSharp
- nix develop --command dotnet test AdventOfCode2023.FSharp --configuration Release
- nix develop --command alejandra --check .
- nix develop --command dotnet tool restore
- nix develop --command dotnet fantomas --check .
# TODO: if https://github.com/dotnet/sdk/issues/37295 ever gets fixed, remove the PublishAot=false
- "nix develop --command dotnet publish AdventOfCode2023.FSharp/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.fsproj --configuration Release -p:PublishAot=false -p:SelfContained=true"
- '$(find . -type f -name AdventOfCode2023.FSharp | grep Release | grep publish) "$(pwd)/AdventOfCode2023.FSharp/Test/samples"'
when:
- event: "push"

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,16 +1,36 @@
<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="EfficientString.fs" />
<Compile Include="Day1.fs" />
<Compile Include="Day2.fs" />
<Compile Include="Day3.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="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="Day19.fs" />
</ItemGroup>
</Project>

View File

@@ -0,0 +1,67 @@
namespace AdventOfCode2023
[<RequireQualifiedAccess>]
module Arithmetic =
[<Struct>]
type EuclidResult<'a> =
{
Hcf : 'a
A : 'a
B : 'a
}
/// Compute floor(sqrt(i)).
let inline sqrt (i : ^a) =
if i <= LanguagePrimitives.GenericOne then
i
else
let rec go start =
let next = start + LanguagePrimitives.GenericOne
let sqr = next * next
if sqr < LanguagePrimitives.GenericZero then
// Overflow attempted, so the sqrt is between start and next
start
elif i < sqr then
start
elif i = sqr then
next
else
go next
go LanguagePrimitives.GenericOne
/// Find Hcf, A, B s.t. A * a + B * b = Hcf, and Hcf is the highest common factor of a and b.
let inline euclideanAlgorithm (a : ^a) (b : ^a) : EuclidResult< ^a > =
let rec go rMin1 r sMin1 s tMin1 t =
if r = LanguagePrimitives.GenericZero then
{
Hcf = rMin1
A = sMin1
B = tMin1
}
else
let newQ = rMin1 / r
go r (rMin1 - newQ * r) s (sMin1 - newQ * s) t (tMin1 - newQ * t)
let maxA = max a b
let minB = min a b
let result =
go
maxA
minB
LanguagePrimitives.GenericOne
LanguagePrimitives.GenericZero
LanguagePrimitives.GenericZero
LanguagePrimitives.GenericOne
if a = maxA then
result
else
{
Hcf = result.Hcf
A = result.B
B = result.A
}

View File

@@ -5,21 +5,13 @@ open System
[<RequireQualifiedAccess>]
module Day1 =
let firstDigit (s : ReadOnlySpan<char>) =
let mutable pos = 0
while '0' > s.[pos] || s.[pos] > '9' do
pos <- pos + 1
let inline firstDigit (s : ReadOnlySpan<char>) =
let pos = s.IndexOfAnyInRange ('0', '9')
byte s.[pos] - byte '0'
// No surrogate pairs please!
let lastDigit (s : ReadOnlySpan<char>) =
let mutable pos = s.Length - 1
while '0' > s.[pos] || s.[pos] > '9' do
pos <- pos - 1
let inline lastDigit (s : ReadOnlySpan<char>) =
let pos = s.LastIndexOfAnyInRange ('0', '9')
byte s.[pos] - byte '0'
let part1 (s : string) =
@@ -35,35 +27,66 @@ module Day1 =
total
let table =
[|
"one", 1uy
"two", 2uy
"three", 3uy
"four", 4uy
"five", 5uy
"six", 6uy
"seven", 7uy
"eight", 8uy
"nine", 9uy
|]
let isDigitSpelled (s : ReadOnlySpan<char>) (pos : int) (answer : byref<byte>) =
// Can't be bothered to write a jump-table compiler
if s.[pos] >= '0' && s.[pos] <= '9' then
answer <- byte s.[pos] - byte '0'
else if s.[pos] = 'o' then
if pos + 2 < s.Length && s.[pos + 1] = 'n' && s.[pos + 2] = 'e' then
answer <- 1uy
elif s.[pos] = 't' then
if pos + 2 < s.Length && s.[pos + 1] = 'w' && s.[pos + 2] = 'o' then
answer <- 2uy
elif
pos + 4 < s.Length
&& s.[pos + 1] = 'h'
&& s.[pos + 2] = 'r'
&& s.[pos + 3] = 'e'
&& s.[pos + 4] = 'e'
then
answer <- 3uy
elif s.[pos] = 'f' then
if pos + 3 < s.Length then
if s.[pos + 1] = 'o' && s.[pos + 2] = 'u' && s.[pos + 3] = 'r' then
answer <- 4uy
elif s.[pos + 1] = 'i' && s.[pos + 2] = 'v' && s.[pos + 3] = 'e' then
answer <- 5uy
elif s.[pos] = 's' then
if pos + 2 < s.Length && s.[pos + 1] = 'i' && s.[pos + 2] = 'x' then
answer <- 6uy
elif
pos + 4 < s.Length
&& s.[pos + 1] = 'e'
&& s.[pos + 2] = 'v'
&& s.[pos + 3] = 'e'
&& s.[pos + 4] = 'n'
then
answer <- 7uy
elif s.[pos] = 'e' then
if
pos + 4 < s.Length
&& s.[pos + 1] = 'i'
&& s.[pos + 2] = 'g'
&& s.[pos + 3] = 'h'
&& s.[pos + 4] = 't'
then
answer <- 8uy
elif s.[pos] = 'n' then
if
pos + 3 < s.Length
&& s.[pos + 1] = 'i'
&& s.[pos + 2] = 'n'
&& s.[pos + 3] = 'e'
then
answer <- 9uy
let firstDigitIncSpelled (s : ReadOnlySpan<char>) =
let mutable pos = 0
let mutable answer = 255uy
while answer = 255uy do
if s.[pos] >= '0' && s.[pos] <= '9' then
answer <- byte s.[pos] - byte '0'
else
for i, value in table do
if
pos + i.Length < s.Length
&& MemoryExtensions.SequenceEqual (s.Slice (pos, i.Length), i)
then
answer <- value
pos <- pos + 1
isDigitSpelled s pos &answer
pos <- pos + 1
answer
@@ -72,17 +95,8 @@ module Day1 =
let mutable answer = 255uy
while answer = 255uy do
if s.[pos] >= '0' && s.[pos] <= '9' then
answer <- byte s.[pos] - byte '0'
else
for i, value in table do
if
pos - i.Length + 1 >= 0
&& MemoryExtensions.SequenceEqual (s.Slice (pos - i.Length + 1, i.Length), i)
then
answer <- value
pos <- pos - 1
isDigitSpelled s pos &answer
pos <- pos - 1
answer

View File

@@ -0,0 +1,327 @@
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 floodFill (stackBuf : ResizeArray<_>) (s : Arr2D<byte>) (currX : int) (currY : int) =
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 Arr2D.get s (currX - 1) currY = 0uy then
Arr2D.set s (currX - 1) currY 2uy
stackBuf.Add (currX - 1)
stackBuf.Add currY
if currX < s.Width - 1 then
if Arr2D.get s (currX + 1) currY = 0uy then
Arr2D.set s (currX + 1) currY 2uy
stackBuf.Add (currX + 1)
stackBuf.Add currY
if currY > 0 then
if Arr2D.get s currX (currY - 1) = 0uy then
Arr2D.set s currX (currY - 1) 2uy
stackBuf.Add currX
stackBuf.Add (currY - 1)
if currY < s.Height - 1 then
if Arr2D.get s currX (currY + 1) = 0uy then
Arr2D.set s currX (currY + 1) 2uy
stackBuf.Add currX
stackBuf.Add (currY + 1)
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
floodFill stackBuf system 0 line
floodFill stackBuf system (system.Width - 1) line
for col = 0 to system.Width - 1 do
floodFill stackBuf system col 0
floodFill stackBuf system 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,292 @@
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 print (board : Arr2D<byte>) =
for row = 0 to board.Height - 1 do
for col = 0 to board.Width - 1 do
match Arr2D.get board col row with
| 0uy -> printf "."
| 1uy -> printf "O"
| 2uy -> printf "#"
| _ -> failwith "bad value"
printfn ""
printfn ""
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,297 @@
namespace AdventOfCode2023
#if DEBUG
#else
#nowarn "9"
#endif
open System
[<RequireQualifiedAccess>]
module Day16 =
type Direction =
| Left = 0
| Right = 1
| Up = 2
| Down = 3
let inline dirToInt (d : Direction) =
match d with
| Direction.Left -> 0us
| Direction.Right -> 1us
| Direction.Up -> 2us
| Direction.Down -> 3us
| _ -> failwith "Bad"
let inline storeDirectionAndPos (numCols : int) (col : int) (row : int) (direction : Direction) : uint16 =
4us * uint16 (col + numCols * row) + dirToInt 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,363 @@
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 (s : string) =
use mutable rows = StringSplitEnumerator.make '\n' s
let workflows = readWorkflows &rows
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 (s : string) : uint64 =
use mutable rows = StringSplitEnumerator.make '\n' s
let workflows = readWorkflows &rows
let acceptanceRanges = Dictionary<string, AcceptanceCriterion> ()
let a = acceptance acceptanceRanges workflows "in"
let union = toUnion a
union |> List.sumBy Conjunction.size

View File

@@ -1,9 +1,12 @@
namespace AdventOfCode2023
open System
open System.Globalization
[<RequireQualifiedAccess>]
module Day2 =
let inline parseInt (s : ReadOnlySpan<char>) : int =
Int32.Parse (s, NumberStyles.None, CultureInfo.InvariantCulture)
let part1 (s : string) =
use lines = StringSplitEnumerator.make '\n' s
@@ -18,20 +21,20 @@ module Day2 =
while isOk && words.MoveNext () do
match words.Current.[0] with
| 'b' ->
if Int32.Parse prevWord > 14 then
if parseInt prevWord > 14 then
isOk <- false
| 'r' ->
if Int32.Parse prevWord > 12 then
if parseInt prevWord > 12 then
isOk <- false
| 'g' ->
if Int32.Parse prevWord > 13 then
if parseInt prevWord > 13 then
isOk <- false
| _ -> ()
prevWord <- words.Current
if isOk then
answer <- answer + Int32.Parse (line.Slice (5, line.IndexOf ':' - 5))
answer <- answer + parseInt (line.Slice (5, line.IndexOf ':' - 5))
answer
@@ -49,9 +52,9 @@ module Day2 =
while words.MoveNext () do
match words.Current.[0] with
| 'b' -> blues <- max blues (Int32.Parse prevWord)
| 'r' -> reds <- max reds (Int32.Parse prevWord)
| 'g' -> greens <- max greens (Int32.Parse prevWord)
| 'b' -> blues <- max blues (parseInt prevWord)
| 'r' -> reds <- max reds (parseInt prevWord)
| 'g' -> greens <- max greens (parseInt prevWord)
| _ -> ()
prevWord <- words.Current

View File

@@ -146,7 +146,7 @@ module Day3 =
let mutable answer = 0
for KeyValue (_gearPos, gears) in gears do
for gears in gears.Values do
if gears.Count = 2 then
answer <- answer + gears.[0] * gears.[1]

View File

@@ -0,0 +1,101 @@
namespace AdventOfCode2023
open System
open System.Globalization
[<RequireQualifiedAccess>]
module Day4 =
let inline parseByte (chars : ReadOnlySpan<char>) : byte =
Byte.Parse (chars, NumberStyles.None, NumberFormatInfo.InvariantInfo)
//let mutable answer = 0uy
//for c in chars do
// answer <- answer * 10uy + (byte c - 48uy)
//answer
let part1 (s : string) =
use lines = StringSplitEnumerator.make '\n' s
let mutable total = 0
let winningNumbers = ResizeArray<byte> ()
for line in lines do
if not (line.IsWhiteSpace ()) then
let mutable accumulatingWinning = true
winningNumbers.Clear ()
use mutable split = StringSplitEnumerator.make' ' ' line
StringSplitEnumerator.chomp "Card" &split
while split.Current.IsEmpty || split.Current.[split.Current.Length - 1] <> ':' do
split.MoveNext () |> ignore
split.MoveNext () |> ignore
while accumulatingWinning do
while split.Current.IsEmpty do
split.MoveNext () |> ignore
if split.Current.[0] = '|' then
accumulatingWinning <- false
else
winningNumbers.Add (parseByte split.Current)
split.MoveNext () |> ignore
let mutable answer = 0
while split.MoveNext () do
if not split.Current.IsEmpty then
let n = parseByte split.Current
if winningNumbers.Contains n then
answer <- answer + 1
if answer > 0 then
total <- total + (1 <<< (answer - 1))
total
let part2 (s : string) =
use lines = StringSplitEnumerator.make '\n' s
let winningNumbers = ResizeArray<byte> ()
let winners = ResizeArray<int> ()
for line in lines do
if not (line.IsWhiteSpace ()) then
let mutable accumulatingWinning = true
winningNumbers.Clear ()
use mutable split = StringSplitEnumerator.make' ' ' line
StringSplitEnumerator.chomp "Card" &split
while split.Current.IsEmpty || split.Current.[split.Current.Length - 1] <> ':' do
split.MoveNext () |> ignore
split.MoveNext () |> ignore
while accumulatingWinning do
while split.Current.IsEmpty do
split.MoveNext () |> ignore
if split.Current.[0] = '|' then
accumulatingWinning <- false
else
winningNumbers.Add (parseByte split.Current)
split.MoveNext () |> ignore
let mutable answer = 0
while split.MoveNext () do
if not split.Current.IsEmpty then
let n = parseByte split.Current
if winningNumbers.Contains n then
answer <- answer + 1
winners.Add answer
let ans = Array.create winners.Count 1
for i = 0 to winners.Count - 1 do
for j = i + 1 to winners.[i] + i do
ans.[j] <- ans.[j] + ans.[i]
ans |> Array.sum

View File

@@ -0,0 +1,191 @@
namespace AdventOfCode2023
open System
[<Struct>]
type Range =
{
SourceStart : uint32
DestStart : uint32
Len : uint32
}
[<RequireQualifiedAccess>]
module Day5 =
let parse (s : string) =
use mutable lines = StringSplitEnumerator.make '\n' s
lines.MoveNext () |> ignore
let seeds =
use mutable line1 = StringSplitEnumerator.make' ' ' lines.Current
StringSplitEnumerator.chomp "seeds:" &line1
let result = ResizeArray ()
while line1.MoveNext () do
result.Add (UInt32.Parse line1.Current)
result.ToArray ()
lines.MoveNext () |> ignore
let mappings = ResizeArray ()
let mutable currentMapping = null
for line in lines do
if line.IsEmpty then
if not (isNull currentMapping) then
mappings.Add currentMapping
currentMapping <- null
else if isNull currentMapping then
currentMapping <- ResizeArray ()
else
use mutable line = StringSplitEnumerator.make' ' ' line
let destStart = StringSplitEnumerator.consumeU32 &line
let sourceStart = StringSplitEnumerator.consumeU32 &line
let rangeLen = StringSplitEnumerator.consumeU32 &line
{
SourceStart = sourceStart
DestStart = destStart
Len = rangeLen
}
|> currentMapping.Add
seeds, mappings
let part1 (s : string) =
let seeds, mappings = parse s
let mutable best = UInt32.MaxValue
for seed in seeds do
let mutable remapped = seed
for map in mappings do
let mutable hasRemappedThisLayer = false
for interval in map do
if not hasRemappedThisLayer then
if
interval.SourceStart <= remapped
&& remapped - interval.SourceStart < interval.Len
then
hasRemappedThisLayer <- true
remapped <- remapped + (interval.DestStart - interval.SourceStart)
if remapped < best then
best <- remapped
best
// The input ranges are inclusive at both ends.
// Returns any range we didn't map.
let private split
(resultStarts : ResizeArray<uint32>)
(resultEnds : ResizeArray<uint32>)
start
finish
(rangeFromLayer : Range)
: (uint32 * uint32 * (uint32 * uint32) voption) voption
=
let low = rangeFromLayer.SourceStart
let high = rangeFromLayer.SourceStart + rangeFromLayer.Len - 1ul
if low <= start then
if finish <= high then
// low ... start .. finish .. high
// so the entire input range gets mapped down
resultStarts.Add (start + rangeFromLayer.DestStart - rangeFromLayer.SourceStart)
resultEnds.Add (finish + rangeFromLayer.DestStart - rangeFromLayer.SourceStart)
ValueNone
elif start <= high then
// low .. start .. high .. finish
// so start .. high gets mapped down
// and high + 1 .. finish stays where it is.
// high < finish is already guaranteed by previous if block.
resultStarts.Add (start + rangeFromLayer.DestStart - rangeFromLayer.SourceStart)
resultEnds.Add (high + rangeFromLayer.DestStart - rangeFromLayer.SourceStart)
ValueSome (high + 1ul, finish, ValueNone)
else
ValueSome (start, finish, ValueNone)
else if high <= finish then
// start .. low .. high .. finish
// so start .. low - 1 stays where it is
// low .. high gets mapped down
// and high + 1 .. finish stays where it is
resultStarts.Add (low + rangeFromLayer.DestStart - rangeFromLayer.SourceStart)
resultEnds.Add (high + rangeFromLayer.DestStart - rangeFromLayer.SourceStart)
ValueSome (start, low - 1ul, ValueSome (high + 1ul, finish))
elif low < finish then
// start .. low .. finish .. high
// so start .. low - 1 stays where it is
// and low .. finish gets mapped down
resultStarts.Add (low + rangeFromLayer.DestStart - rangeFromLayer.SourceStart)
resultEnds.Add (finish + rangeFromLayer.DestStart - rangeFromLayer.SourceStart)
ValueSome (start, low - 1ul, ValueNone)
else
ValueSome (start, finish, ValueNone)
let part2 (s : string) : uint32 =
let seeds, mappings = parse s
let mutable intervalStarts = ResizeArray ()
let mutable intervalEnds = ResizeArray ()
for i = 0 to (seeds.Length - 1) / 2 do
intervalStarts.Add seeds.[2 * i]
intervalEnds.Add (seeds.[2 * i + 1] + seeds.[2 * i] - 1ul)
let mutable nextIntervalStarts = ResizeArray ()
let mutable nextIntervalEnds = ResizeArray ()
for mapLayer in mappings do
let mutable i = 0
while i < intervalStarts.Count do
// split interval according to every map
let mutable allMoved = false
let mutable currentRange = 0
while not allMoved && currentRange < mapLayer.Count do
let range = mapLayer.[currentRange]
// range is e.g. 50 98 2, i.e. "98-99 goes to 50-51"
match split nextIntervalStarts nextIntervalEnds intervalStarts.[i] intervalEnds.[i] range with
| ValueNone -> allMoved <- true
| ValueSome (start, finish, v) ->
intervalStarts.[i] <- start
intervalEnds.[i] <- finish
match v with
| ValueNone -> ()
| ValueSome (start, finish) ->
intervalStarts.Add start
intervalEnds.Add finish
currentRange <- currentRange + 1
if not allMoved then
nextIntervalStarts.Add intervalStarts.[i]
nextIntervalEnds.Add intervalEnds.[i]
i <- i + 1
let oldIntervals = intervalStarts
oldIntervals.Clear ()
intervalStarts <- nextIntervalStarts
nextIntervalStarts <- oldIntervals
let oldIntervals = intervalEnds
oldIntervals.Clear ()
intervalEnds <- nextIntervalEnds
nextIntervalEnds <- oldIntervals
// SIMD go brrr
System.Linq.Enumerable.Min intervalStarts

View File

@@ -0,0 +1,86 @@
namespace AdventOfCode2023
open System
[<RequireQualifiedAccess>]
module Day6 =
let parse (s : string) =
use mutable lines = StringSplitEnumerator.make '\n' s
let times =
lines.MoveNext () |> ignore
use mutable line = StringSplitEnumerator.make' ' ' lines.Current
StringSplitEnumerator.chomp "Time:" &line
line.MoveNext () |> ignore
let times = ResizeArray ()
while line.MoveNext () do
if not line.Current.IsEmpty then
times.Add (UInt64.Parse line.Current)
times
let distance =
lines.MoveNext () |> ignore
use mutable line = StringSplitEnumerator.make' ' ' lines.Current
StringSplitEnumerator.chomp "Distance:" &line
line.MoveNext () |> ignore
let distance = ResizeArray ()
while line.MoveNext () do
if not line.Current.IsEmpty then
distance.Add (UInt64.Parse line.Current)
distance
times, distance
let furthest (distance : uint64) (toBeat : uint64) =
// Count i in [1 .. distance - 1] such that (distance - i) * i > toBeat
// i.e. such that distance * i - i * i > toBeat
// -i^2 + distance * i - toBeat = 0 when:
// i = (distance +- sqrt(distance^2 - 4 * toBeat)) / 2
let distFloat = float distance
let inside = sqrt (distFloat * distFloat - 4.0 * float toBeat)
let limit1 = (distFloat + inside) / 2.0
let limit2 = (distFloat - sqrt (distFloat * distFloat - 4.0 * float toBeat)) / 2.0
// round limit2 up and limit1 down
let limit1 = uint64 (floor limit1)
let limit2 = uint64 (ceil limit2)
// cope with edge case of an exact square
if (uint64 inside) * (uint64 inside) = uint64 distance * uint64 distance - 4uL * uint64 toBeat then
limit1 - limit2 - 1uL
else
limit1 - limit2 + 1uL
let part1 (s : string) =
let times, distance = parse s
let mutable answer = 1uL
for i = 0 to times.Count - 1 do
let time = times.[i]
let distance = distance.[i]
let winners = furthest time distance
answer <- answer * winners
answer
let concat (digits : ResizeArray<uint64>) : uint64 =
let mutable answer = 0uL
for digit in digits do
let mutable power = 10uL
while digit >= power do
power <- power * 10uL
answer <- answer * power + digit
answer
let part2 (s : string) =
let times, distance = parse s
let concatTime = concat times
let concatDist = concat distance
furthest concatTime concatDist

View File

@@ -0,0 +1,215 @@
namespace AdventOfCode2023
open System
open System.Globalization
open AdventOfCode2023.ResizeArray
type Hand =
| Five = 6
| Four = 5
| FullHouse = 4
| Three = 3
| TwoPairs = 2
| Pair = 1
| High = 0
type HandContents =
{
First : byte
Second : byte
Third : byte
Fourth : byte
Fifth : byte
}
[<RequireQualifiedAccess>]
module Day7 =
[<Literal>]
let joker = 0uy
let inline toByte (adjustJoker : bool) (c : char) : byte =
if c <= '9' then byte c - byte '1'
elif c = 'T' then 9uy
elif c = 'J' then (if adjustJoker then joker else 10uy)
elif c = 'Q' then 11uy
elif c = 'K' then 12uy
elif c = 'A' then 13uy
else failwithf "could not parse: %c" c
let inline private updateState (tallies : ResizeArray<_>) newNum =
let mutable isAdded = false
for i = 0 to tallies.Count - 1 do
if fst tallies.[i] = newNum then
tallies.[i] <- (fst tallies.[i], snd tallies.[i] + 1)
isAdded <- true
if not isAdded then
tallies.Add (newNum, 1)
type RankedHand = uint32
[<Literal>]
let fourteen = 14ul
[<Literal>]
let fourteenFive = fourteen * fourteen * fourteen * fourteen * fourteen
[<Literal>]
let fourteenFour = fourteen * fourteen * fourteen * fourteen
[<Literal>]
let fourteenThree = fourteen * fourteen * fourteen
[<Literal>]
let fourteenTwo = fourteen * fourteen
let toInt (hand : Hand) (contents : HandContents) : RankedHand =
uint32 hand * fourteenFive
+ uint32 contents.First * fourteenFour
+ uint32 contents.Second * fourteenThree
+ uint32 contents.Third * fourteenTwo
+ uint32 contents.Fourth * fourteen
+ uint32 contents.Fifth
let parseHand (tallyBuffer : ResizeArray<_>) (adjustJoker : bool) (s : ReadOnlySpan<char>) : RankedHand =
let contents =
{
First = toByte adjustJoker s.[0]
Second = toByte adjustJoker s.[1]
Third = toByte adjustJoker s.[2]
Fourth = toByte adjustJoker s.[3]
Fifth = toByte adjustJoker s.[4]
}
tallyBuffer.Clear ()
tallyBuffer.Add (contents.First, 1)
updateState tallyBuffer contents.Second
updateState tallyBuffer contents.Third
updateState tallyBuffer contents.Fourth
updateState tallyBuffer contents.Fifth
let jokerCount, jokerPos =
if not adjustJoker then
0, -1
else
let mutable jokerCount = 0
let mutable jokerPos = 0
while jokerPos < tallyBuffer.Count && jokerCount = 0 do
let card, tally = tallyBuffer.[jokerPos]
if card = joker then
jokerCount <- tally
else
jokerPos <- jokerPos + 1
jokerCount, jokerPos
let hand =
if jokerCount > 0 then
match tallyBuffer.Count with
| 1 ->
// Five jokers
Hand.Five
| 2 ->
// Jokers plus one other card type
Hand.Five
| 3 ->
// Jokers plus two other card types. Either full house, or four of a kind
if jokerCount >= 2 then
// JJABB or JJJAB
Hand.Four
else if
// JAABB or JAAAB
jokerPos <> 0
then
if snd tallyBuffer.[0] = 2 then
Hand.FullHouse
else
Hand.Four
else if snd tallyBuffer.[1] = 2 then
Hand.FullHouse
else
Hand.Four
| 4 ->
// Jokers plus three other card types, exactly one of which therefore is a two-of.
Hand.Three
| 5 ->
// Five different cards, one of which is a joker.
Hand.Pair
| _ -> failwith "bad tallyBuffer"
elif tallyBuffer.Count = 1 then
Hand.Five
elif tallyBuffer.Count = 2 then
// AAAAB or AAABB
if snd tallyBuffer.[0] = 3 || snd tallyBuffer.[0] = 2 then
Hand.FullHouse
else
Hand.Four
elif tallyBuffer.Count = 3 then
// AAABC or AABBC
if snd tallyBuffer.[0] = 3 then Hand.Three
elif snd tallyBuffer.[0] = 2 then Hand.TwoPairs
elif snd tallyBuffer.[1] = 3 then Hand.Three
elif snd tallyBuffer.[1] = 2 then Hand.TwoPairs
else Hand.Three
elif tallyBuffer.Count = 4 then
Hand.Pair
else
Hand.High
toInt hand contents
type RankedHandAndBid = uint32
[<Literal>]
let bidSeparator = 1001ul
let inline toRankedHandAndBid (r : RankedHand) (bid : uint32) : RankedHandAndBid = bidSeparator * r + bid
let inline getBid (r : RankedHandAndBid) : uint32 = uint32 (r % bidSeparator)
let parse (adjustJoker : bool) (s : string) : ResizeArray<RankedHandAndBid> =
use mutable lines = StringSplitEnumerator.make '\n' s
let result = ResizeArray.create 4
let tallies = ResizeArray.create 5
while lines.MoveNext () do
if not lines.Current.IsEmpty then
use mutable line = StringSplitEnumerator.make' ' ' lines.Current
line.MoveNext () |> ignore
let rankedHand = parseHand tallies adjustJoker line.Current
line.MoveNext () |> ignore
let bid =
UInt32.Parse (line.Current, NumberStyles.Integer, CultureInfo.InvariantCulture)
result.Add (toRankedHandAndBid rankedHand bid)
result
let part1 (s : string) =
let arr = parse false s
arr.Sort ()
let mutable answer = 0ul
for i = 0 to arr.Count - 1 do
answer <- answer + getBid arr.[i] * (uint32 i + 1ul)
answer
let part2 (s : string) =
let arr = parse true s
arr.Sort ()
let mutable answer = 0ul
for i = 0 to arr.Count - 1 do
answer <- answer + getBid arr.[i] * (uint32 i + 1ul)
answer

View File

@@ -0,0 +1,110 @@
namespace AdventOfCode2023
open System
open System.Collections.Generic
[<RequireQualifiedAccess>]
module Day8 =
type Instructions =
{
/// "true" is 'R'
Steps : bool array
Nodes : Dictionary<string, string * string>
}
let parse (s : string) =
use mutable lines = StringSplitEnumerator.make '\n' s
lines.MoveNext () |> ignore
let stepsLine = lines.Current.TrimEnd ()
let steps = Array.zeroCreate stepsLine.Length
for i = 0 to stepsLine.Length - 1 do
steps.[i] <- (stepsLine.[i] = 'R')
let dict = Dictionary ()
while lines.MoveNext () do
if not lines.Current.IsEmpty then
use mutable line = StringSplitEnumerator.make' ' ' lines.Current
line.MoveNext () |> ignore
let key = line.Current.ToString ()
line.MoveNext () |> ignore
line.MoveNext () |> ignore
let v1 = line.Current.Slice(1, line.Current.Length - 2).ToString ()
line.MoveNext () |> ignore
let v2 = line.Current.Slice(0, line.Current.Length - 1).ToString ()
dict.[key] <- (v1, v2)
{
Steps = steps
Nodes = dict
}
let part1 (s : string) =
let data = parse s
let mutable i = 0
let mutable currentNode = "AAA"
let mutable answer = 0
while currentNode <> "ZZZ" do
let instruction = data.Nodes.[currentNode]
if data.Steps.[i] then
// "true" is R
currentNode <- snd instruction
else
currentNode <- fst instruction
i <- (i + 1) % data.Steps.Length
answer <- answer + 1
answer
let inline lcm (periods : ^T[]) =
let mutable lcm = periods.[0]
let mutable i = 1
while i < periods.Length do
let euclid = Arithmetic.euclideanAlgorithm lcm periods.[i]
lcm <- (lcm * periods.[i]) / euclid.Hcf
i <- i + 1
lcm
let part2 (s : string) =
let data = parse s
let startingNodes = ResizeArray ()
for key in data.Nodes.Keys do
if key.[key.Length - 1] = 'A' then
startingNodes.Add key
let periods =
Array.init
startingNodes.Count
(fun startNode ->
let mutable i = 0
let mutable currentNode = startingNodes.[startNode]
let mutable answer = 0ul
while currentNode.[currentNode.Length - 1] <> 'Z' do
let instruction = data.Nodes.[currentNode]
if data.Steps.[i] then
// "true" is R
currentNode <- snd instruction
else
currentNode <- fst instruction
i <- (i + 1) % data.Steps.Length
answer <- answer + 1ul
uint64 answer
)
lcm periods

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

@@ -1,7 +1,6 @@
namespace AdventOfCode2023
open System
open System.Globalization
open System.Runtime.CompilerServices
type EfficientString = System.ReadOnlySpan<char>
@@ -95,3 +94,15 @@ module StringSplitEnumerator =
failwith "expected an int, got nothing"
Int32.Parse e.Current
let consumeU32 (e : byref<StringSplitEnumerator>) : uint32 =
if not (e.MoveNext ()) then
failwith "expected an int, got nothing"
UInt32.Parse e.Current
let consumeU64 (e : byref<StringSplitEnumerator>) : uint64 =
if not (e.MoveNext ()) then
failwith "expected an int, got nothing"
UInt64.Parse e.Current

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

@@ -0,0 +1,40 @@
namespace AdventOfCode2023.ResizeArray
open System
type ResizeArray<'T> =
private
{
mutable Array : 'T array
mutable Length : int
}
member this.Count = this.Length
member this.Clear () = this.Length <- 0
member this.Add (t : 'T) =
if this.Length < this.Array.Length then
this.Array.[this.Length] <- t
else
let newLength = this.Length * 2
let newArray = Array.zeroCreate<'T> newLength
Array.blit this.Array 0 newArray 0 this.Length
newArray.[this.Length] <- t
this.Array <- newArray
this.Length <- this.Length + 1
member this.Item
with get (i : int) = this.Array.[i]
and set (i : int) (t : 'T) = this.Array.[i] <- t
member this.Sort () =
Span(this.Array).Slice(0, this.Count).Sort ()
[<RequireQualifiedAccess>]
module ResizeArray =
let create<'T> (capacity : int) =
{
Array = Array.zeroCreate<'T> capacity
Length = 0
}

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

@@ -23,19 +23,30 @@ module Program =
let sw = Stopwatch.StartNew ()
Console.WriteLine "=====Day 1====="
do
sw.Restart ()
let input = Path.Combine (dir.FullName, "day1.txt") |> File.ReadAllText
let input =
try
Path.Combine (dir.FullName, "day1part1.txt") |> File.ReadAllText
with :? FileNotFoundException ->
Path.Combine (dir.FullName, "day1.txt") |> File.ReadAllText
let part1 = Day1.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 input = Path.Combine (dir.FullName, "day1.txt") |> File.ReadAllText
let part2 = Day1.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 2====="
do
let input = Path.Combine (dir.FullName, "day2.txt") |> File.ReadAllText
sw.Restart ()
@@ -49,6 +60,8 @@ module Program =
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 3====="
do
let input = Path.Combine (dir.FullName, "day3.txt") |> File.ReadAllBytes
@@ -85,7 +98,245 @@ module Program =
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 4====="
do
let input = Path.Combine (dir.FullName, "day4.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day4.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 = Day4.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 5====="
do
let input = Path.Combine (dir.FullName, "day5.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day5.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 = Day5.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 6====="
do
let input = Path.Combine (dir.FullName, "day6.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day6.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 = Day6.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 7====="
do
let input = Path.Combine (dir.FullName, "day7.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day7.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 = Day7.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 8====="
do
let input =
try
Path.Combine (dir.FullName, "day8part1.txt") |> File.ReadAllText
with :? FileNotFoundException ->
Path.Combine (dir.FullName, "day8.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day8.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 input = Path.Combine (dir.FullName, "day8.txt") |> File.ReadAllText
let part2 = Day8.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 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 19====="
do
let input = Path.Combine (dir.FullName, "day19.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day19.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 = Day19.part2 input
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 ((1_000.0 * float endToEnd.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms total")
Console.Error.WriteLine (
(1_000.0 * float endToEnd.ElapsedTicks / float Stopwatch.Frequency).ToString ()
+ "ms total"
)
0

View File

@@ -1,28 +1,70 @@
<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="TestDay1.fs" />
<Compile Include="TestDay2.fs" />
<Compile Include="TestDay3.fs" />
</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="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\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

@@ -8,26 +8,13 @@ open System.IO
[<TestFixture>]
module TestDay1 =
let sample1 =
"""1abc2
pqr3stu8vwx
a1b2c3d4e5f
treb7uchet
"""
let sample1 = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day1part1.txt"
[<Test>]
let part1Sample () =
sample1 |> Day1.part1 |> shouldEqual 142
let sample2 =
"""two1nine
eightwothree
abcone2threexyz
xtwone3four
4nineeightseven2
zoneight234
7pqrstsixteen
"""
let sample2 = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day1.txt"
[<Test>]
let part2Sample () =
@@ -38,7 +25,9 @@ zoneight234
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day1.txt"))
with :? FileNotFoundException ->
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
@@ -49,7 +38,9 @@ zoneight234
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day1.txt"))
with :? FileNotFoundException ->
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"

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,45 @@
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 () =
sample |> Day19.part1 |> shouldEqual 19114
[<Test>]
let part2Sample () =
sample |> Day19.part2 |> shouldEqual 167409079868000uL
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day19.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day19.part1 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"
Day19.part2 s |> shouldEqual 127675188176682uL

View File

@@ -8,13 +8,7 @@ open System.IO
[<TestFixture>]
module TestDay2 =
let sample =
"""Game 1: 3 blue, 4 red; 1 red, 2 green, 6 blue; 2 green
Game 2: 1 blue, 2 green; 3 green, 4 blue, 1 red; 1 green, 1 blue
Game 3: 8 green, 6 blue, 20 red; 5 blue, 4 red, 13 green; 5 green, 1 red
Game 4: 1 green, 3 red, 6 blue; 3 green, 6 red; 3 green, 15 blue, 14 red
Game 5: 6 red, 1 blue, 3 green; 2 blue, 1 red, 2 green
"""
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day2.txt"
[<Test>]
let part1Sample () = sample |> Day2.part1 |> shouldEqual 8
@@ -28,7 +22,9 @@ Game 5: 6 red, 1 blue, 3 green; 2 blue, 1 red, 2 green
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day2.txt"))
with :? FileNotFoundException ->
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
@@ -39,7 +35,9 @@ Game 5: 6 red, 1 blue, 3 green; 2 blue, 1 red, 2 green
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day2.txt"))
with :? FileNotFoundException ->
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"

View File

@@ -13,18 +13,7 @@ open System.IO
[<TestFixture>]
module TestDay3 =
let sample =
"""467..114..
...*......
..35..633.
......#...
617*......
.....+.58.
..592.....
......755.
...$.*....
.664.598..
"""
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day3.txt"
[<Test>]
let part1Sample () =
@@ -77,7 +66,9 @@ module TestDay3 =
let bytes =
try
File.ReadAllBytes (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day3.txt"))
with :? FileNotFoundException ->
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
@@ -107,7 +98,9 @@ module TestDay3 =
let bytes =
try
File.ReadAllBytes (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day3.txt"))
with :? FileNotFoundException ->
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"

View File

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

View File

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

View File

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

View File

@@ -0,0 +1,45 @@
namespace AdventOfCode2023.Test
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay7 =
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day7.txt"
[<Test>]
let part1Sample () =
sample |> Day7.part1 |> shouldEqual 6440ul
[<Test>]
let part2Sample () =
sample |> Day7.part2 |> shouldEqual 5905ul
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day7.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day7.part1 s |> shouldEqual 250058342ul
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day7.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day7.part2 s |> shouldEqual 250506580ul

View File

@@ -0,0 +1,57 @@
namespace AdventOfCode2023.Test
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay8 =
[<Test>]
let part1Sample () =
Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day8part1.txt"
|> Day8.part1
|> shouldEqual 2
[<Test>]
let part1Sample2 () =
"""LLR
AAA = (BBB, BBB)
BBB = (AAA, ZZZ)
ZZZ = (ZZZ, ZZZ)"""
|> Day8.part1
|> shouldEqual 6
[<Test>]
let part2Sample () =
Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day8.txt"
|> Day8.part2
|> shouldEqual 6uL
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day8.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day8.part1 s |> shouldEqual 19199
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day8.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day8.part2 s |> shouldEqual 13663968099527uL

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,22 @@
namespace AdventOfCode2023.Test
open System.IO
open System.Reflection
type Dummy =
class
end
[<RequireQualifiedAccess>]
module Assembly =
let getEmbeddedResource (assembly : Assembly) (name : string) : string =
let names = assembly.GetManifestResourceNames ()
let names = names |> Seq.filter (fun s -> s.EndsWith name)
use s =
names
|> Seq.exactlyOne
|> assembly.GetManifestResourceStream
|> fun s -> new StreamReader (s)
s.ReadToEnd ()

View File

@@ -0,0 +1,7 @@
two1nine
eightwothree
abcone2threexyz
xtwone3four
4nineeightseven2
zoneight234
7pqrstsixteen

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,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,4 @@
1abc2
pqr3stu8vwx
a1b2c3d4e5f
treb7uchet

View File

@@ -0,0 +1,5 @@
Game 1: 3 blue, 4 red; 1 red, 2 green, 6 blue; 2 green
Game 2: 1 blue, 2 green; 3 green, 4 blue, 1 red; 1 green, 1 blue
Game 3: 8 green, 6 blue, 20 red; 5 blue, 4 red, 13 green; 5 green, 1 red
Game 4: 1 green, 3 red, 6 blue; 3 green, 6 red; 3 green, 15 blue, 14 red
Game 5: 6 red, 1 blue, 3 green; 2 blue, 1 red, 2 green

View File

@@ -0,0 +1,10 @@
467..114..
...*......
..35..633.
......#...
617*......
.....+.58.
..592.....
......755.
...$.*....
.664.598..

View File

@@ -0,0 +1,6 @@
Card 1: 41 48 83 86 17 | 83 86 6 31 17 9 48 53
Card 2: 13 32 20 16 61 | 61 30 68 82 17 32 24 19
Card 3: 1 21 53 59 44 | 69 82 63 72 16 21 14 1
Card 4: 41 92 73 84 69 | 59 84 76 51 58 5 54 83
Card 5: 87 83 26 28 32 | 88 30 70 12 93 22 82 36
Card 6: 31 18 13 56 72 | 74 77 10 23 35 67 36 11

View File

@@ -0,0 +1,33 @@
seeds: 79 14 55 13
seed-to-soil map:
50 98 2
52 50 48
soil-to-fertilizer map:
0 15 37
37 52 2
39 0 15
fertilizer-to-water map:
49 53 8
0 11 42
42 0 7
57 7 4
water-to-light map:
88 18 7
18 25 70
light-to-temperature map:
45 77 23
81 45 19
68 64 13
temperature-to-humidity map:
0 69 1
1 0 69
humidity-to-location map:
60 56 37
56 93 4

View File

@@ -0,0 +1,2 @@
Time: 7 15 30
Distance: 9 40 200

View File

@@ -0,0 +1,5 @@
32T3K 765
T55J5 684
KK677 28
KTJJT 220
QQQJA 483

View File

@@ -0,0 +1,10 @@
LR
11A = (11B, XXX)
11B = (XXX, 11Z)
11Z = (11B, XXX)
22A = (22B, XXX)
22B = (22C, 22C)
22C = (22Z, 22Z)
22Z = (22B, 22B)
XXX = (XXX, XXX)

View File

@@ -0,0 +1,9 @@
RL
AAA = (BBB, CCC)
BBB = (DDD, EEE)
CCC = (ZZZ, GGG)
DDD = (DDD, DDD)
EEE = (EEE, EEE)
GGG = (GGG, GGG)
ZZZ = (ZZZ, ZZZ)

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

View File

@@ -1,26 +1,45 @@
{
description = "Advent of Code 2023";
inputs = {
flake-utils.url = "github:numtide/flake-utils";
nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
};
description = "Advent of Code 2023";
inputs = {
flake-utils.url = "github:numtide/flake-utils";
nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
};
outputs = {
self,
nixpkgs,
flake-utils,
}: flake-utils.lib.eachDefaultSystem (system:
let pkgs = nixpkgs.legacyPackages.${system}; in
{
devShells = { default = pkgs.mkShell {
buildInputs = with pkgs; [
(with dotnetCorePackages;
combinePackages [
dotnet-sdk_8
dotnetPackages.Nuget
])
] ++ [pkgs.swift darwin.apple_sdk.frameworks.Foundation darwin.apple_sdk.frameworks.CryptoKit darwin.apple_sdk.frameworks.GSS pkgs.zlib pkgs.zlib.dev pkgs.openssl pkgs.icu];
};};
}
outputs = {
self,
nixpkgs,
flake-utils,
}:
flake-utils.lib.eachDefaultSystem (
system: let
pkgs = nixpkgs.legacyPackages.${system};
in
# Conditionally include Swift and Apple SDK for Darwin systems
let
darwinDeps =
if system == "x86_64-darwin" || system == "aarch64-darwin"
then [
pkgs.swift
pkgs.darwin.apple_sdk.frameworks.Foundation
pkgs.darwin.apple_sdk.frameworks.CryptoKit
pkgs.darwin.apple_sdk.frameworks.GSS
]
else [];
in {
devShells = {
default = pkgs.mkShell {
buildInputs = with pkgs;
[
(with dotnetCorePackages;
combinePackages [
dotnet-sdk_8
dotnetPackages.Nuget
])
]
++ darwinDeps
++ [pkgs.zlib pkgs.zlib.dev pkgs.openssl pkgs.icu pkgs.alejandra];
};
};
}
);
}

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]*)