Speed up day 7 a bit (#7)

I'm going mad, why am I doing this

Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #7

AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/AdventOfCode2023.FSharp.Lib.fsproj

@@ -7,6 +7,7 @@
 
     <ItemGroup>
         <Compile Include="Arr2D.fs" />
+        <Compile Include="ResizeArray.fs" />
         <Compile Include="EfficientString.fs" />
         <Compile Include="Day1.fs" />
         <Compile Include="Day2.fs" />

AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day2.fs

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

AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day7.fs

@@ -1,16 +1,17 @@
 namespace AdventOfCode2023
 
 open System
-open System.Collections.Generic
+open System.Globalization
+open AdventOfCode2023.ResizeArray
 
 type Hand =
-    | Five = 10
-    | Four = 9
-    | FullHouse = 8
-    | Three = 7
-    | TwoPairs = 6
-    | Pair = 5
-    | High = 4
+    | Five = 6
+    | Four = 5
+    | FullHouse = 4
+    | Three = 3
+    | TwoPairs = 2
+    | Pair = 1
+    | High = 0
 
 type HandContents =
     {
@@ -24,13 +25,16 @@ type HandContents =
 [<RequireQualifiedAccess>]
 module Day7 =
 
+    [<Literal>]
+    let joker = 0uy
+
     let inline toByte (adjustJoker : bool) (c : char) : byte =
-        if c <= '9' then byte c - byte '0'
-        elif c = 'T' then 10uy
-        elif c = 'J' then (if adjustJoker then 1uy else 11uy)
-        elif c = 'Q' then 12uy
-        elif c = 'K' then 13uy
-        elif c = 'A' then 14uy
+        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 =
@@ -44,12 +48,32 @@ module Day7 =
         if not isAdded then
             tallies.Add (newNum, 1)
 
-    let inline parseHand
-        (tallyBuffer : ResizeArray<_>)
-        (adjustJoker : bool)
-        (s : ReadOnlySpan<char>)
-        : Hand * HandContents
-        =
+    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]
@@ -70,17 +94,18 @@ module Day7 =
             if not adjustJoker then
                 0, -1
             else
-                let mutable count = 0
-                let mutable jokerPos = -1
+                let mutable jokerCount = 0
+                let mutable jokerPos = 0
 
-                for i = 0 to tallyBuffer.Count - 1 do
-                    let card, tally = tallyBuffer.[i]
+                while jokerPos < tallyBuffer.Count && jokerCount = 0 do
+                    let card, tally = tallyBuffer.[jokerPos]
 
-                    if card = 1uy then
-                        count <- tally
-                        jokerPos <- i
+                    if card = joker then
+                        jokerCount <- tally
+                    else
+                        jokerPos <- jokerPos + 1
 
-                count, jokerPos
+                jokerCount, jokerPos
 
         let hand =
             if jokerCount > 0 then
@@ -135,70 +160,56 @@ module Day7 =
             else
                 Hand.High
 
-        hand, contents
+        toInt hand contents
 
-    let parse (adjustJoker : bool) (s : string) : ResizeArray<Hand * HandContents * int> =
+    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 ()
-        let tallies = ResizeArray 5
+        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 hand, contents = parseHand tallies adjustJoker line.Current
+                let rankedHand = parseHand tallies adjustJoker line.Current
                 line.MoveNext () |> ignore
-                let bid = Int32.Parse line.Current
 
-                result.Add (hand, contents, bid)
+                let bid =
+                    UInt32.Parse (line.Current, NumberStyles.Integer, CultureInfo.InvariantCulture)
+
+                result.Add (toRankedHandAndBid rankedHand bid)
 
         result
 
-    let compArrBasic (a : HandContents) (b : HandContents) =
-        if a.First > b.First then 1
-        elif a.First < b.First then -1
-        elif a.Second > b.Second then 1
-        elif a.Second < b.Second then -1
-        elif a.Third > b.Third then 1
-        elif a.Third < b.Third then -1
-        elif a.Fourth > b.Fourth then 1
-        elif a.Fourth < b.Fourth then -1
-        elif a.Fifth > b.Fifth then 1
-        elif a.Fifth < b.Fifth then -1
-        else 0
+    let part1 (s : string) =
+        let arr = parse false s
 
-    let compBasic : IComparer<Hand * HandContents * int> =
-        { new IComparer<_> with
-            member _.Compare ((aHand, aContents, _), (bHand, bContents, _)) =
-                match compare aHand bHand with
-                | 0 -> compArrBasic aContents bContents
-                | x -> x
-        }
+        arr.Sort ()
 
-    let part1 (s : string) : int =
-        let parsed = parse false s
+        let mutable answer = 0ul
 
-        parsed.Sort compBasic
-
-        let mutable answer = 0
-        let mutable pos = 1
-
-        for _, _, bid in parsed do
-            answer <- answer + bid * pos
-            pos <- pos + 1
+        for i = 0 to arr.Count - 1 do
+            answer <- answer + getBid arr.[i] * (uint32 i + 1ul)
 
         answer
 
     let part2 (s : string) =
-        let parsed = parse true s
+        let arr = parse true s
 
-        parsed.Sort compBasic
+        arr.Sort ()
 
-        let mutable answer = 0
-        let mutable pos = 1
+        let mutable answer = 0ul
 
-        for _, _, bid in parsed do
-            answer <- answer + bid * pos
-            pos <- pos + 1
+        for i = 0 to arr.Count - 1 do
+            answer <- answer + getBid arr.[i] * (uint32 i + 1ul)
 
         answer

AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/ResizeArray.fs

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

AdventOfCode2023.FSharp/AdventOfCode2023.FSharp/Program.fs

@@ -23,11 +23,17 @@ module Program =
 
         let sw = Stopwatch.StartNew ()
 
-        printfn "=====Day 1====="
+        Console.WriteLine "=====Day 1====="
 
         do
             sw.Restart ()
-            let input = Path.Combine (dir.FullName, "day1part1.txt") |> File.ReadAllText
+
+            let input =
+                try
+                    Path.Combine (dir.FullName, "day1part1.txt") |> File.ReadAllText
+                with :? FileNotFoundException ->
+                    Path.Combine (dir.FullName, "day1.txt") |> File.ReadAllText
+
             let part1 = Day1.part1 input
             sw.Stop ()
             Console.WriteLine (part1.ToString ())
@@ -39,7 +45,7 @@ module Program =
             Console.WriteLine (part2.ToString ())
             Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
 
-        printfn "=====Day 2====="
+        Console.WriteLine "=====Day 2====="
 
         do
             let input = Path.Combine (dir.FullName, "day2.txt") |> File.ReadAllText
@@ -54,7 +60,7 @@ module Program =
             Console.WriteLine (part2.ToString ())
             Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
 
-        printfn "=====Day 3====="
+        Console.WriteLine "=====Day 3====="
 
         do
             let input = Path.Combine (dir.FullName, "day3.txt") |> File.ReadAllBytes
@@ -92,7 +98,7 @@ module Program =
             Console.WriteLine (part2.ToString ())
             Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
 
-        printfn "=====Day 4====="
+        Console.WriteLine "=====Day 4====="
 
         do
             let input = Path.Combine (dir.FullName, "day4.txt") |> File.ReadAllText
@@ -107,7 +113,7 @@ module Program =
             Console.WriteLine (part2.ToString ())
             Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
 
-        printfn "=====Day 5====="
+        Console.WriteLine "=====Day 5====="
 
         do
             let input = Path.Combine (dir.FullName, "day5.txt") |> File.ReadAllText
@@ -122,7 +128,7 @@ module Program =
             Console.WriteLine (part2.ToString ())
             Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
 
-        printfn "=====Day 6====="
+        Console.WriteLine "=====Day 6====="
 
         do
             let input = Path.Combine (dir.FullName, "day6.txt") |> File.ReadAllText
@@ -137,7 +143,7 @@ module Program =
             Console.WriteLine (part2.ToString ())
             Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
 
-        printfn "=====Day 7====="
+        Console.WriteLine "=====Day 7====="
 
         do
             let input = Path.Combine (dir.FullName, "day7.txt") |> File.ReadAllText

AdventOfCode2023.FSharp/Test/TestDay7.fs

@@ -13,11 +13,11 @@ module TestDay7 =
 
     [<Test>]
     let part1Sample () =
-        sample |> Day7.part1 |> shouldEqual 6440
+        sample |> Day7.part1 |> shouldEqual 6440ul
 
     [<Test>]
     let part2Sample () =
-        sample |> Day7.part2 |> shouldEqual 5905
+        sample |> Day7.part2 |> shouldEqual 5905ul
 
     [<Test>]
     let part1Actual () =
@@ -30,7 +30,7 @@ module TestDay7 =
                 Assert.Inconclusive ()
                 failwith "unreachable"
 
-        Day7.part1 s |> shouldEqual 250058342
+        Day7.part1 s |> shouldEqual 250058342ul
 
     [<Test>]
     let part2Actual () =
@@ -43,4 +43,4 @@ module TestDay7 =
                 Assert.Inconclusive ()
                 failwith "unreachable"
 
-        Day7.part2 s |> shouldEqual 250506580
+        Day7.part2 s |> shouldEqual 250506580ul