4 Commits

Author SHA1 Message Date
8f4d6a9062 Modernise CI (#22)
All checks were successful
ci/woodpecker/push/build Pipeline was successful
ci/woodpecker/push/all-checks-complete Pipeline was successful
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
Reviewed-on: #22
2025-09-08 23:18:09 +00:00
46b4f2d715 Direnv support (#21)
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: #21
2024-01-28 23:47:20 +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
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
21 changed files with 361 additions and 164 deletions

View File

@@ -3,7 +3,7 @@
"isRoot": true,
"tools": {
"fantomas": {
"version": "6.2.3",
"version": "7.0.3",
"commands": [
"fantomas"
]

View File

@@ -2,7 +2,6 @@ root=true
[*]
charset=utf-8
end_of_line=crlf
trim_trailing_whitespace=true
insert_final_newline=true
indent_style=space

1
.envrc Normal file
View File

@@ -0,0 +1 @@
use flake

1
.gitignore vendored
View File

@@ -8,6 +8,7 @@ _ReSharper.Caches/
.DS_Store
result
.profile*
.direnv/
inputs/
AdventOfCode2023.FSharp/Test/TestResults/

View File

@@ -1,4 +1,4 @@
<Project Sdk="Microsoft.NET.Sdk">
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
@@ -13,6 +13,8 @@
<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"/>

View File

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

View File

@@ -123,41 +123,6 @@ module Day10 =
distance
let floodFill (stackBuf : ResizeArray<_>) (s : Arr2D<byte>) (currX : int) (currY : int) =
stackBuf.Clear ()
stackBuf.Add currX
stackBuf.Add currY
while stackBuf.Count > 0 do
let currY = stackBuf.[stackBuf.Count - 1]
stackBuf.RemoveAt (stackBuf.Count - 1)
let currX = stackBuf.[stackBuf.Count - 1]
stackBuf.RemoveAt (stackBuf.Count - 1)
if currX > 0 then
if Arr2D.get s (currX - 1) currY = 0uy then
Arr2D.set s (currX - 1) currY 2uy
stackBuf.Add (currX - 1)
stackBuf.Add currY
if currX < s.Width - 1 then
if Arr2D.get s (currX + 1) currY = 0uy then
Arr2D.set s (currX + 1) currY 2uy
stackBuf.Add (currX + 1)
stackBuf.Add currY
if currY > 0 then
if Arr2D.get s currX (currY - 1) = 0uy then
Arr2D.set s currX (currY - 1) 2uy
stackBuf.Add currX
stackBuf.Add (currY - 1)
if currY < s.Height - 1 then
if Arr2D.get s currX (currY + 1) = 0uy then
Arr2D.set s currX (currY + 1) 2uy
stackBuf.Add currX
stackBuf.Add (currY + 1)
let print (s : Arr2D<byte>) =
for y = 0 to s.Height - 1 do
for x = 0 to s.Width - 1 do
@@ -310,12 +275,12 @@ module Day10 =
let stackBuf = ResizeArray ()
for line = 0 to system.Height - 1 do
floodFill stackBuf system 0 line
floodFill stackBuf system (system.Width - 1) line
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
floodFill stackBuf system col 0
floodFill stackBuf system col (system.Height - 1)
Arr2D.floodFill stackBuf system 0uy 2uy col 0
Arr2D.floodFill stackBuf system 0uy 2uy col (system.Height - 1)
let mutable answer = 0

View File

@@ -137,19 +137,6 @@ module Day14 =
else // current = 0uy
pos <- pos + 1
let print (board : Arr2D<byte>) =
for row = 0 to board.Height - 1 do
for col = 0 to board.Width - 1 do
match Arr2D.get board col row with
| 0uy -> printf "."
| 1uy -> printf "O"
| 2uy -> printf "#"
| _ -> failwith "bad value"
printfn ""
printfn ""
let score (board : Arr2D<byte>) =
let mutable answer = 0ul

View File

@@ -10,22 +10,8 @@ open System
[<RequireQualifiedAccess>]
module Day16 =
type Direction =
| Left = 0
| Right = 1
| Up = 2
| Down = 3
let inline dirToInt (d : Direction) =
match d with
| Direction.Left -> 0us
| Direction.Right -> 1us
| Direction.Up -> 2us
| Direction.Down -> 3us
| _ -> failwith "Bad"
let inline storeDirectionAndPos (numCols : int) (col : int) (row : int) (direction : Direction) : uint16 =
4us * uint16 (col + numCols * row) + dirToInt direction
4us * uint16 (col + numCols * row) + Direction.toUInt direction
let inline getDirection (input : uint16) =
match input % 4us with

View File

@@ -55,7 +55,8 @@ module Day19 =
| '<' -> true
| c -> failwith $"Bad comparison: %c{c}"
let operand = Int32.Parse (s.Slice (2, colon - 2), NumberStyles.None)
let operand =
Int32.Parse (s.Slice (2, colon - 2), NumberStyles.None, NumberFormatInfo.InvariantInfo)
{
Component = comp
@@ -89,7 +90,7 @@ module Day19 =
None
| _ -> failwith "bad component"
let rec compute (components : Dictionary<string, Rule ResizeArray * Dest>) x m a s (reg : string) =
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) ->
@@ -106,7 +107,7 @@ module Day19 =
| None -> i <- i + 1
match result.Value with
| Register reg -> compute components x m a s reg
| Register reg -> computePart1 components x m a s reg
| Accept -> true
| Reject -> false
@@ -125,10 +126,7 @@ module Day19 =
workflows
let part1 (s : string) =
use mutable rows = StringSplitEnumerator.make '\n' s
let workflows = readWorkflows &rows
let part1 (workflows : _) (rows : byref<StringSplitEnumerator>) =
let mutable answer = 0
for row in rows do
@@ -139,7 +137,8 @@ module Day19 =
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)
let number =
Int32.Parse (comp.Slice 2, NumberStyles.None, NumberFormatInfo.InvariantInfo)
match comp.[0] with
| 'x' -> x <- number
@@ -148,7 +147,7 @@ module Day19 =
| 's' -> s <- number
| c -> failwith $"Bad char: %c{c}"
if compute workflows x m a s "in" then
if computePart1 workflows x m a s "in" then
answer <- answer + x + m + a + s
answer
@@ -178,34 +177,134 @@ module Day19 =
| _, AcceptanceCriterion.True -> AcceptanceCriterion.True
| _, _ -> AcceptanceCriterion.Or (a, b)
let rec cata<'ret>
(atOr : 'ret -> 'ret -> 'ret)
(atAnd : 'ret -> 'ret -> 'ret)
(atFalse : unit -> 'ret)
(atTrue : unit -> 'ret)
(atBase : Component -> int -> int -> 'ret)
(ac : AcceptanceCriterion)
: 'ret
=
/// "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
| AcceptanceCriterion.False -> atFalse ()
| AcceptanceCriterion.True -> atTrue ()
| AcceptanceCriterion.Base (comp, low, high) -> atBase comp low high
| AcceptanceCriterion.And (a1, a2) ->
atAnd (cata atOr atAnd atFalse atTrue atBase a1) (cata atOr atAnd atFalse atTrue atBase a2)
| AcceptanceCriterion.Or (a1, a2) ->
atOr (cata atOr atAnd atFalse atTrue atBase a1) (cata atOr atAnd atFalse atTrue atBase a2)
type UnionOfConjunctions = (Component * int * int) list list
let toUnion (ac : AcceptanceCriterion) : UnionOfConjunctions =
cata
List.append
(fun l1 l2 -> [ List.concat (l1 @ l2) ])
(fun () -> failwith "no falses")
(fun () -> failwith "no trues")
(fun comp low high -> [ [ comp, low, high ] ])
ac
| 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>)
@@ -219,56 +318,40 @@ module Day19 =
let rules, final = workflows.[key]
let seed =
let mutable result =
match final with
| Register s -> acceptance store workflows s
| Accept -> AcceptanceCriterion.True
| Reject -> AcceptanceCriterion.False
let result =
(seed, Seq.rev rules)
||> Seq.fold (fun crit rule ->
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 ->
let cond =
if rule.IsLess then
AcceptanceCriterion.Base (rule.Component, 1, rule.Operand - 1)
else
AcceptanceCriterion.Base (rule.Component, rule.Operand + 1, 4000)
acOr (acAnd cond (acceptance store workflows target)) crit
| Accept ->
let cond =
if rule.IsLess then
AcceptanceCriterion.Base (rule.Component, 1, rule.Operand - 1)
else
AcceptanceCriterion.Base (rule.Component, rule.Operand + 1, 4000)
acOr cond crit
| Reject ->
let negCond =
if not rule.IsLess then
AcceptanceCriterion.Base (rule.Component, 1, rule.Operand - 1)
else
AcceptanceCriterion.Base (rule.Component, rule.Operand + 1, 4000)
acAnd negCond crit
)
| Register target -> acOr (acAnd cond (acceptance store workflows target)) (acAnd negCond result)
| Accept -> acOr cond (acAnd negCond result)
| Reject -> acAnd negCond result
store.[key] <- result
result
let part2 (s : string) =
use mutable rows = StringSplitEnumerator.make '\n' s
let workflows = readWorkflows &rows
let part2 (workflows : _) (rows : byref<StringSplitEnumerator>) : uint64 =
let acceptanceRanges = Dictionary<string, AcceptanceCriterion> ()
let a = acceptance acceptanceRanges workflows "in"
let union = toUnion a
printfn "%+A" a
printfn "%+A" union
//uint64 (IntervalSet.count resolved.X) * uint64 (IntervalSet.count resolved.M) * uint64 (IntervalSet.count resolved.A) * uint64 (IntervalSet.count resolved.S)
0uL
union |> List.sumBy Conjunction.size

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

@@ -322,12 +322,24 @@ module Program =
let input = Path.Combine (dir.FullName, "day19.txt") |> File.ReadAllText
sw.Restart ()
let part1 = Day19.part1 input
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 input
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")

View File

@@ -13,6 +13,7 @@
<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"/>

View File

@@ -7,17 +7,20 @@ open System.IO
[<TestFixture>]
module TestDay19 =
[<Test>]
let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day19.txt"
[<Test>]
let part1Sample () =
sample |> Day19.part1 |> shouldEqual 19114
use mutable s = StringSplitEnumerator.make '\n' sample
let workflows = Day19.readWorkflows &s
Day19.part1 workflows &s |> shouldEqual 19114
[<Test>]
let part2Sample () =
sample |> Day19.part2 |> shouldEqual 167409079868000uL
use mutable s = StringSplitEnumerator.make '\n' sample
let workflows = Day19.readWorkflows &s
Day19.part2 workflows &s |> shouldEqual 167409079868000uL
[<Test>]
let part1Actual () =
@@ -30,7 +33,10 @@ module TestDay19 =
Assert.Inconclusive ()
failwith "unreachable"
Day19.part1 s |> shouldEqual 368964
use mutable s = StringSplitEnumerator.make '\n' s
let workflows = Day19.readWorkflows &s
Day19.part1 workflows &s |> shouldEqual 368964
[<Test>]
let part2Actual () =
@@ -43,4 +49,7 @@ module TestDay19 =
Assert.Inconclusive ()
failwith "unreachable"
Day19.part2 s |> shouldEqual 8314uL
use mutable s = StringSplitEnumerator.make '\n' s
let workflows = Day19.readWorkflows &s
Day19.part2 workflows &s |> shouldEqual 127675188176682uL

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

@@ -3,9 +3,7 @@ namespace AdventOfCode2023.Test
open System.IO
open System.Reflection
type Dummy =
class
end
type Dummy = class end
[<RequireQualifiedAccess>]
module Assembly =

12
flake.lock generated
View File

@@ -5,11 +5,11 @@
"systems": "systems"
},
"locked": {
"lastModified": 1694529238,
"narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=",
"lastModified": 1731533236,
"narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "ff7b65b44d01cf9ba6a71320833626af21126384",
"rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
"type": "github"
},
"original": {
@@ -20,11 +20,11 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1701253981,
"narHash": "sha256-ztaDIyZ7HrTAfEEUt9AtTDNoCYxUdSd6NrRHaYOIxtk=",
"lastModified": 1757068644,
"narHash": "sha256-NOrUtIhTkIIumj1E/Rsv1J37Yi3xGStISEo8tZm3KW4=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "e92039b55bcd58469325ded85d4f58dd5a4eaf58",
"rev": "8eb28adfa3dc4de28e792e3bf49fcf9007ca8ac9",
"type": "github"
},
"original": {

View File

@@ -14,15 +14,12 @@
system: let
pkgs = nixpkgs.legacyPackages.${system};
in
# Conditionally include Swift and Apple SDK for Darwin systems
# Conditionally include Swift 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 {