27 Commits

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

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

Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #10
2023-12-09 09:46:17 +00:00
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
9454c0ac1a Woodpecker (#1)
Some checks failed
ci/woodpecker/push/build Pipeline failed
ci/woodpecker/push/all-checks-complete unknown status
Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #1
2023-12-03 17:32:16 +00:00
Smaug123
ee38b17138 README 2023-12-03 17:24:47 +00:00
Smaug123
5c451057bf Licence MIT 2023-12-03 17:21:26 +00:00
Smaug123
4a1d9d1cae Better program 2023-12-03 17:20:55 +00:00
Smaug123
a48aaa78b1 Day 2 2023-12-03 17:11:15 +00:00
Smaug123
1f505a7cce Day 1 in F# 2023-12-03 16:56:38 +00:00
Smaug123
a637f79bf1 Format and tests 2023-12-03 16:31:46 +00:00
Smaug123
3a8061e28d Add day 3 2023-12-03 14:35:47 +00:00
88 changed files with 6202 additions and 0 deletions

12
.config/dotnet-tools.json Normal file
View File

@@ -0,0 +1,12 @@
{
"version": 1,
"isRoot": true,
"tools": {
"fantomas": {
"version": "6.2.3",
"commands": [
"fantomas"
]
}
}
}

41
.editorconfig Normal file
View File

@@ -0,0 +1,41 @@
root=true
[*]
charset=utf-8
end_of_line=crlf
trim_trailing_whitespace=true
insert_final_newline=true
indent_style=space
indent_size=4
# ReSharper properties
resharper_xml_indent_size=2
resharper_xml_max_line_length=100
resharper_xml_tab_width=2
[*.{csproj,fsproj,sqlproj,targets,props,ts,tsx,css,json}]
indent_style=space
indent_size=2
[*.{fs,fsi}]
fsharp_bar_before_discriminated_union_declaration=true
fsharp_space_before_uppercase_invocation=true
fsharp_space_before_class_constructor=true
fsharp_space_before_member=true
fsharp_space_before_colon=true
fsharp_space_before_semicolon=true
fsharp_multiline_bracket_style=aligned
fsharp_newline_between_type_definition_and_members=true
fsharp_align_function_signature_to_indentation=true
fsharp_alternative_long_member_definitions=true
fsharp_multi_line_lambda_closing_newline=true
fsharp_experimental_keep_indent_in_branch=true
fsharp_max_value_binding_width=80
fsharp_max_record_width=0
max_line_length=120
end_of_line=lf
[*.{appxmanifest,build,dtd,nuspec,xaml,xamlx,xoml,xsd}]
indent_style=space
indent_size=2
tab_width=2

1
.gitattributes vendored Normal file
View File

@@ -0,0 +1 @@
*.txt text eol=lf

13
.gitignore vendored Normal file
View File

@@ -0,0 +1,13 @@
bin/
obj/
riderModule.iml
_ReSharper.Caches/
.idea/
*.user
*.DotSettings
.DS_Store
result
.profile*
inputs/
AdventOfCode2023.FSharp/Test/TestResults/

View File

@@ -0,0 +1,10 @@
steps:
echo:
image: alpine
commands:
- echo "All required checks complete"
depends_on:
- build
skip_clone: true

21
.woodpecker/.build.yml Normal file
View File

@@ -0,0 +1,21 @@
steps:
build:
image: nixos/nix
commands:
- echo 'experimental-features = flakes nix-command' >> /etc/nix/nix.conf
# Lint
- "nix flake check"
# Test
- 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"
evaluate: 'CI_COMMIT_BRANCH == CI_REPO_DEFAULT_BRANCH'
- event: "pull_request"

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

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

View File

@@ -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

@@ -0,0 +1,176 @@
namespace AdventOfCode2023
#if DEBUG
#else
#nowarn "9"
#endif
open System
open Microsoft.FSharp.NativeInterop
[<Struct>]
#if DEBUG
type Arr2D<'a> =
{
Elements : 'a array
Width : int
}
member this.Height = this.Elements.Length / this.Width
#else
type Arr2D<'a when 'a : unmanaged> =
{
Elements : nativeptr<'a>
Length : int
Width : int
}
member this.Height = this.Length / this.Width
#endif
[<RequireQualifiedAccess>]
module Arr2D =
/// It's faster to iterate forward over the first argument, `x`.
let inline get (arr : Arr2D<'a>) (x : int) (y : int) : 'a =
#if DEBUG
arr.Elements.[y * arr.Width + x]
#else
NativePtr.get arr.Elements (y * arr.Width + x)
#endif
let inline set (arr : Arr2D<'a>) (x : int) (y : int) (newVal : 'a) : unit =
#if DEBUG
arr.Elements.[y * arr.Width + x] <- newVal
#else
NativePtr.write (NativePtr.add arr.Elements (y * arr.Width + x)) newVal
#endif
#if DEBUG
let create (width : int) (height : int) (value : 'a) : Arr2D<'a> =
let arr = Array.create (width * height) value
{
Width = width
Elements = arr
}
#else
/// The input array must be at least of size width * height
let create (arr : nativeptr<'a>) (width : int) (height : int) (value : 'a) : Arr2D<'a> =
{
Width = width
Elements = arr
Length = width * height
}
#endif
[<RequiresExplicitTypeArguments>]
#if DEBUG
let zeroCreate<'a when 'a : unmanaged> (width : int) (height : int) : Arr2D<'a> =
{
Elements = Array.zeroCreate (width * height)
Width = width
}
#else
let zeroCreate<'a when 'a : unmanaged> (elts : nativeptr<'a>) (width : int) (height : int) : Arr2D<'a> =
{
Elements = elts
Width = width
Length = width * height
}
#endif
/// The closure is given x and then y.
#if DEBUG
let inline init (width : int) (height : int) (f : int -> int -> 'a) : Arr2D<'a> =
let result = zeroCreate<'a> width height
#else
let inline init (arr : nativeptr<'a>) (width : int) (height : int) (f : int -> int -> 'a) : Arr2D<'a> =
let result = zeroCreate<'a> arr width height
#endif
for y = 0 to height - 1 do
for x = 0 to width - 1 do
set result x y (f x y)
result
let inline clear (a : Arr2D<'a>) : unit =
#if DEBUG
System.Array.Clear a.Elements
#else
NativePtr.initBlock a.Elements 0uy (uint32 sizeof<'a> * uint32 a.Length)
#endif
/// Pass in a buffer of memory which we will use entirely for our own purposes (and may resize)
/// to maintain state.
/// `empty` is the value in empty cells; we will fill them with `fillWith`.
let floodFill
(stackBuf : ResizeArray<int>)
(s : Arr2D<'a>)
(empty : 'a)
(fillWith : 'a)
(currX : int)
(currY : int)
: unit
=
stackBuf.Clear ()
stackBuf.Add currX
stackBuf.Add currY
while stackBuf.Count > 0 do
let currY = stackBuf.[stackBuf.Count - 1]
stackBuf.RemoveAt (stackBuf.Count - 1)
let currX = stackBuf.[stackBuf.Count - 1]
stackBuf.RemoveAt (stackBuf.Count - 1)
if currX > 0 then
if get s (currX - 1) currY = empty then
set s (currX - 1) currY fillWith
stackBuf.Add (currX - 1)
stackBuf.Add currY
if currX < s.Width - 1 then
if get s (currX + 1) currY = empty then
set s (currX + 1) currY fillWith
stackBuf.Add (currX + 1)
stackBuf.Add currY
if currY > 0 then
if get s currX (currY - 1) = empty then
set s currX (currY - 1) fillWith
stackBuf.Add currX
stackBuf.Add (currY - 1)
if currY < s.Height - 1 then
if get s currX (currY + 1) = empty then
set s currX (currY + 1) fillWith
stackBuf.Add currX
stackBuf.Add (currY + 1)
/// SIMD go brr
let inline count< ^a when 'a : equality and 'a : unmanaged and 'a :> IEquatable<'a>>
(arr : Arr2D<'a>)
(x : 'a)
: int
=
let span =
#if DEBUG
arr.Elements.AsSpan ()
#else
ReadOnlySpan<'a> (NativePtr.toVoidPtr arr.Elements, arr.Length)
#endif
MemoryExtensions.Count (span, x)
let print (arr : Arr2D<byte>) =
for row = 0 to arr.Height - 1 do
for col = 0 to arr.Width - 1 do
match get arr col row with
| 1uy -> printf "#"
| 0uy -> printf "."
| 2uy -> printf "O"
| _ -> failwith "bad"
printfn ""
printfn ""

View File

@@ -0,0 +1,111 @@
namespace AdventOfCode2023
open System
[<RequireQualifiedAccess>]
module Day1 =
let inline firstDigit (s : ReadOnlySpan<char>) =
let pos = s.IndexOfAnyInRange ('0', '9')
byte s.[pos] - byte '0'
// No surrogate pairs please!
let inline lastDigit (s : ReadOnlySpan<char>) =
let pos = s.LastIndexOfAnyInRange ('0', '9')
byte s.[pos] - byte '0'
let part1 (s : string) =
use enum = StringSplitEnumerator.make '\n' s
let mutable total = 0
for line in enum do
if not line.IsEmpty then
let firstDigit = firstDigit line
let lastDigit = lastDigit line
total <- total + int (lastDigit + 10uy * firstDigit)
total
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
isDigitSpelled s pos &answer
pos <- pos + 1
answer
let lastDigitIncSpelled (s : ReadOnlySpan<char>) =
let mutable pos = s.Length - 1
let mutable answer = 255uy
while answer = 255uy do
isDigitSpelled s pos &answer
pos <- pos - 1
answer
let part2 (s : string) =
use enum = StringSplitEnumerator.make '\n' s
let mutable total = 0
for line in enum do
if not line.IsEmpty then
total <- total + int (10uy * firstDigitIncSpelled line + lastDigitIncSpelled line)
total

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -0,0 +1,64 @@
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
let mutable answer = 0
for line in lines do
if not line.IsEmpty then
use mutable words = StringSplitEnumerator.make' ' ' line
let mutable prevWord = ReadOnlySpan<char>.Empty
let mutable isOk = true
while isOk && words.MoveNext () do
match words.Current.[0] with
| 'b' ->
if parseInt prevWord > 14 then
isOk <- false
| 'r' ->
if parseInt prevWord > 12 then
isOk <- false
| 'g' ->
if parseInt prevWord > 13 then
isOk <- false
| _ -> ()
prevWord <- words.Current
if isOk then
answer <- answer + parseInt (line.Slice (5, line.IndexOf ':' - 5))
answer
let part2 (s : string) =
use lines = StringSplitEnumerator.make '\n' s
let mutable answer = 0
for line in lines do
if not line.IsEmpty then
let mutable reds = 0
let mutable blues = 0
let mutable greens = 0
use mutable words = StringSplitEnumerator.make' ' ' line
let mutable prevWord = ReadOnlySpan<char>.Empty
while words.MoveNext () do
match words.Current.[0] with
| 'b' -> blues <- max blues (parseInt prevWord)
| 'r' -> reds <- max reds (parseInt prevWord)
| 'g' -> greens <- max greens (parseInt prevWord)
| _ -> ()
prevWord <- words.Current
answer <- answer + (reds * greens * blues)
answer

View File

@@ -0,0 +1,153 @@
namespace AdventOfCode2023
open System.Collections.Generic
[<RequireQualifiedAccess>]
module Day3 =
let inline private isSymbol (i : byte) = i > 200uy
let inline private isGear (i : byte) = i = 255uy
/// Returns the parsed board as a buffer, the length of the buffer (there may be garbage at the end), and
/// the number of lines the resulting 2D array has.
let parse (fileContents : byte[]) =
let mutable lineCount = 0
let mutable len = 0
let resultArr = Array.zeroCreate fileContents.Length
for b in fileContents do
if b = byte '.' then
resultArr.[len] <- 100uy
len <- len + 1
elif b = byte '*' then
resultArr.[len] <- 255uy
len <- len + 1
elif byte '0' <= b && b <= byte '9' then
resultArr.[len] <- b - byte '0'
len <- len + 1
elif b = 10uy then
lineCount <- lineCount + 1
else
resultArr.[len] <- 254uy
len <- len + 1
resultArr, len, lineCount
let part1 (contents : Arr2D<byte>) =
let lineLength = contents.Width
let isNearSymbol (row : int) (numStart : int) (curCol : int) : bool =
let mutable isNearSymbol = false
if row > 0 then
for col = max (numStart - 1) 0 to min curCol (lineLength - 1) do
if isSymbol (Arr2D.get contents col (row - 1)) then
isNearSymbol <- true
if row < contents.Height - 1 then
for col = max (numStart - 1) 0 to min curCol (lineLength - 1) do
if isSymbol (Arr2D.get contents col (row + 1)) then
isNearSymbol <- true
if
(numStart > 0 && isSymbol (Arr2D.get contents (numStart - 1) row))
|| (curCol < lineLength && isSymbol (Arr2D.get contents curCol row))
then
isNearSymbol <- true
isNearSymbol
let mutable total = 0
for row = 0 to contents.Height - 1 do
let mutable currNum = 0
let mutable numStart = -1
for col = 0 to lineLength - 1 do
if Arr2D.get contents col row < 10uy then
if numStart = -1 then
numStart <- col
currNum <- currNum * 10 + int (Arr2D.get contents col row)
elif numStart > -1 then
if isNearSymbol row numStart col then
total <- total + currNum
currNum <- 0
numStart <- -1
if numStart >= 0 then
if isNearSymbol row numStart lineLength then
total <- total + currNum
currNum <- 0
numStart <- -1
total
let part2 (contents : Arr2D<byte>) =
let lineLength = contents.Width
let isNearGear (row : int) (numStart : int) (curCol : int) : (int * int) IReadOnlyList =
let gearsNear = ResizeArray ()
if row > 0 then
for col = max (numStart - 1) 0 to min curCol (lineLength - 1) do
if isGear (Arr2D.get contents col (row - 1)) then
gearsNear.Add (row - 1, col)
if row < lineLength - 1 then
for col = max (numStart - 1) 0 to min curCol (lineLength - 1) do
if isGear (Arr2D.get contents col (row + 1)) then
gearsNear.Add (row + 1, col)
if (numStart > 0 && isGear (Arr2D.get contents (numStart - 1) row)) then
gearsNear.Add (row, numStart - 1)
if (curCol < lineLength && isGear (Arr2D.get contents curCol row)) then
gearsNear.Add (row, curCol)
gearsNear
let gears = Dictionary<int * int, ResizeArray<int>> ()
let addGear (gearPos : int * int) (num : int) =
match gears.TryGetValue gearPos with
| false, _ ->
let arr = ResizeArray ()
arr.Add num
gears.Add (gearPos, arr)
| true, arr when arr.Count < 3 -> arr.Add num
| _ -> ()
for row = 0 to contents.Height - 1 do
let mutable currNum = 0
let mutable numStart = -1
for col = 0 to lineLength - 1 do
if Arr2D.get contents col row < 10uy then
if numStart = -1 then
numStart <- col
currNum <- currNum * 10 + int (Arr2D.get contents col row)
elif numStart > -1 then
for gearPos in isNearGear row numStart col do
addGear gearPos currNum
currNum <- 0
numStart <- -1
if numStart >= 0 then
for gearPos in isNearGear row numStart lineLength do
addGear gearPos currNum
currNum <- 0
numStart <- -1
let mutable answer = 0
for gears in gears.Values do
if gears.Count = 2 then
answer <- answer + gears.[0] * gears.[1]
answer

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

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

View File

@@ -0,0 +1,108 @@
namespace AdventOfCode2023
open System
open System.Runtime.CompilerServices
type EfficientString = System.ReadOnlySpan<char>
[<RequireQualifiedAccess>]
module EfficientString =
let inline isEmpty (s : EfficientString) : bool = s.IsEmpty
let inline ofString (s : string) : EfficientString = s.AsSpan ()
let inline toString (s : EfficientString) : string = s.ToString ()
let inline trimStart (s : EfficientString) : EfficientString = s.TrimStart ()
let inline slice (start : int) (length : int) (s : EfficientString) : EfficientString = s.Slice (start, length)
let inline equals (a : string) (other : EfficientString) : bool =
MemoryExtensions.Equals (other, a.AsSpan (), StringComparison.Ordinal)
/// Mutates the input to drop up to the first instance of the input char,
/// and returns what was dropped.
/// If the char is not present, deletes the input.
let takeUntil<'a> (c : char) (s : EfficientString byref) : EfficientString =
let first = s.IndexOf c
if first < 0 then
let toRet = s
s <- EfficientString.Empty
toRet
else
let toRet = slice 0 first s
s <- slice (first + 1) (s.Length - first - 1) s
toRet
[<Struct>]
[<IsByRefLike>]
type StringSplitEnumerator =
internal
{
Original : EfficientString
mutable Remaining : EfficientString
mutable InternalCurrent : EfficientString
SplitOn : char
}
interface IDisposable with
member this.Dispose () = ()
member this.Current : EfficientString = this.InternalCurrent
member this.MoveNext () =
if this.Remaining.Length = 0 then
false
else
this.InternalCurrent <- EfficientString.takeUntil this.SplitOn &this.Remaining
true
member this.GetEnumerator () = this
[<RequireQualifiedAccess>]
module StringSplitEnumerator =
let make (splitChar : char) (s : string) : StringSplitEnumerator =
{
Original = EfficientString.ofString s
Remaining = EfficientString.ofString s
InternalCurrent = EfficientString.Empty
SplitOn = splitChar
}
let make' (splitChar : char) (s : ReadOnlySpan<char>) : StringSplitEnumerator =
{
Original = s
Remaining = s
InternalCurrent = EfficientString.Empty
SplitOn = splitChar
}
let chomp (s : string) (e : byref<StringSplitEnumerator>) : unit =
#if DEBUG
if not (e.MoveNext ()) || not (EfficientString.equals s e.Current) then
failwithf "expected '%s', got '%s'" s (e.Current.ToString ())
#else
e.MoveNext () |> ignore
#endif
let consumeInt (e : byref<StringSplitEnumerator>) : int =
if not (e.MoveNext ()) then
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

@@ -0,0 +1,34 @@

Microsoft Visual Studio Solution File, Format Version 12.00
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "AdventOfCode2023.FSharp", "AdventOfCode2023.FSharp\AdventOfCode2023.FSharp.fsproj", "{E2EC7715-E2C9-4671-AFBD-84D740B604FE}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Test", "Test\Test.fsproj", "{AC9C7858-2F5D-4DE1-8E13-0A87E1EA8598}"
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
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{E2EC7715-E2C9-4671-AFBD-84D740B604FE}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{E2EC7715-E2C9-4671-AFBD-84D740B604FE}.Debug|Any CPU.Build.0 = Debug|Any CPU
{E2EC7715-E2C9-4671-AFBD-84D740B604FE}.Release|Any CPU.ActiveCfg = Release|Any CPU
{E2EC7715-E2C9-4671-AFBD-84D740B604FE}.Release|Any CPU.Build.0 = Release|Any CPU
{AC9C7858-2F5D-4DE1-8E13-0A87E1EA8598}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{AC9C7858-2F5D-4DE1-8E13-0A87E1EA8598}.Debug|Any CPU.Build.0 = Debug|Any CPU
{AC9C7858-2F5D-4DE1-8E13-0A87E1EA8598}.Release|Any CPU.ActiveCfg = Release|Any CPU
{AC9C7858-2F5D-4DE1-8E13-0A87E1EA8598}.Release|Any CPU.Build.0 = Release|Any CPU
{95CE0568-3D1A-4060-BB54-52460FB1E399}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{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

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

View File

@@ -0,0 +1,370 @@
namespace AdventOfCode2023
#if DEBUG
#else
#nowarn "9"
#endif
open System
open System.Diagnostics
open System.IO
module Program =
let inline toUs (ticks : int64) =
1_000_000.0 * float ticks / float Stopwatch.Frequency
[<EntryPoint>]
let main argv =
let endToEnd = Stopwatch.StartNew ()
endToEnd.Restart ()
let dir = DirectoryInfo argv.[0]
let sw = Stopwatch.StartNew ()
Console.WriteLine "=====Day 1====="
do
sw.Restart ()
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 ()
let part1 = Day2.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 = Day2.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 3====="
do
let input = Path.Combine (dir.FullName, "day3.txt") |> File.ReadAllBytes
sw.Restart ()
let resultArr, len, lineCount = Day3.parse input
sw.Stop ()
Console.Error.WriteLine (
(1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString ()
+ "ms parse"
)
#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
let part1 = Day3.part1 contents
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day3.part2 contents
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 18====="
do
let input = Path.Combine (dir.FullName, "day18.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day18.part1 input
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day18.part2 input
sw.Stop ()
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
Console.WriteLine "=====Day 19====="
do
let input = Path.Combine (dir.FullName, "day19.txt") |> File.ReadAllText
sw.Restart ()
use mutable s = StringSplitEnumerator.make '\n' input
let data = Day19.readWorkflows &s
sw.Stop ()
Console.Error.WriteLine (
(1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString ()
+ "ms parse"
)
let mutable sCopy = s
sw.Restart ()
let part1 = Day19.part1 data &s
sw.Stop ()
Console.WriteLine (part1.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
sw.Restart ()
let part2 = Day19.part2 data &sCopy
sw.Stop ()
Console.WriteLine (part2.ToString ())
Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
endToEnd.Stop ()
Console.Error.WriteLine (
(1_000.0 * float endToEnd.ElapsedTicks / float Stopwatch.Frequency).ToString ()
+ "ms total"
)
0

View File

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

View File

@@ -0,0 +1,47 @@
namespace AdventOfCode2023.Test
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay1 =
let sample1 = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day1part1.txt"
[<Test>]
let part1Sample () =
sample1 |> Day1.part1 |> shouldEqual 142
let sample2 = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day1.txt"
[<Test>]
let part2Sample () =
sample2 |> Day1.part2 |> shouldEqual 281
[<Test>]
let part1Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day1.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day1.part1 s |> shouldEqual 54304
[<Test>]
let part2Actual () =
let s =
try
File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day1.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
Day1.part2 s |> shouldEqual 54418

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -0,0 +1,126 @@
namespace AdventOfCode2023.Test
#if DEBUG
#else
#nowarn "9"
#endif
open AdventOfCode2023
open NUnit.Framework
open FsUnitTyped
open System.IO
[<TestFixture>]
module TestDay3 =
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day3.txt"
[<Test>]
let part1Sample () =
let arr, len, rows = sample.ToCharArray () |> Array.map byte |> Day3.parse
#if DEBUG
let arr =
{
Elements = arr
Width = len / rows
}
#else
use arr = fixed arr
let arr =
{
Elements = arr
Length = len
Width = len / rows
}
#endif
arr |> Day3.part1 |> shouldEqual 4361
[<Test>]
let part2Sample () =
let arr, len, rows = sample.ToCharArray () |> Array.map byte |> Day3.parse
#if DEBUG
let arr =
{
Elements = arr
Width = len / rows
}
#else
use arr = fixed arr
let arr =
{
Elements = arr
Length = len
Width = len / rows
}
#endif
arr |> Day3.part2 |> shouldEqual 467835
[<Test>]
let part1Actual () =
let bytes =
try
File.ReadAllBytes (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day3.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
let arr, len, rows = Day3.parse bytes
#if DEBUG
let arr =
{
Elements = arr
Width = len / rows
}
#else
use arr = fixed arr
let arr =
{
Elements = arr
Length = len
Width = len / rows
}
#endif
Day3.part1 arr |> shouldEqual 540131
[<Test>]
let part2Actual () =
let bytes =
try
File.ReadAllBytes (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day3.txt"))
with
| :? DirectoryNotFoundException
| :? FileNotFoundException ->
Assert.Inconclusive ()
failwith "unreachable"
let arr, len, rows = Day3.parse bytes
#if DEBUG
let arr =
{
Elements = arr
Width = len / rows
}
#else
use arr = fixed arr
let arr =
{
Elements = arr
Length = len
Width = len / rows
}
#endif
Day3.part2 arr |> shouldEqual 86879020

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

View File

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

View File

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

21
LICENSE Normal file
View File

@@ -0,0 +1,21 @@
MIT License
Copyright (c) 2023 Patrick Stevens
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

119
README.md Normal file
View File

@@ -0,0 +1,119 @@
# Advent of Code 2023
[Puzzle site](https://adventofcode.com/2023).
# Speed
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.
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
3.418417ms
54418
0.317958ms
=====Day 2=====
2727
0.079917ms
56580
0.107292ms
=====Day 3=====
0.140292ms parse
540131
0.140292ms
86879020
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
Note that `PublishAot` assumes a lot of stuff about your environment, which is not necessarily true.
The given flake should allow you to complete the publish except for a linking stage at the end: the publish will print out a failed command line, and you'll have to strip out some `-o` flags from it and run it manually.
Then run `dotnet publish` again and it should succeed.

61
flake.lock generated Normal file
View File

@@ -0,0 +1,61 @@
{
"nodes": {
"flake-utils": {
"inputs": {
"systems": "systems"
},
"locked": {
"lastModified": 1694529238,
"narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "ff7b65b44d01cf9ba6a71320833626af21126384",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1701253981,
"narHash": "sha256-ztaDIyZ7HrTAfEEUt9AtTDNoCYxUdSd6NrRHaYOIxtk=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "e92039b55bcd58469325ded85d4f58dd5a4eaf58",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixos-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"flake-utils": "flake-utils",
"nixpkgs": "nixpkgs"
}
},
"systems": {
"locked": {
"lastModified": 1681028828,
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
"owner": "nix-systems",
"repo": "default",
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
"type": "github"
},
"original": {
"owner": "nix-systems",
"repo": "default",
"type": "github"
}
}
},
"root": "root",
"version": 7
}

45
flake.nix Normal file
View File

@@ -0,0 +1,45 @@
{
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
# 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]*)