From 9697bb5311839f3890def385c21ea3bba55adfbe Mon Sep 17 00:00:00 2001 From: Smaug123 Date: Mon, 16 Jan 2023 13:43:16 +0000 Subject: [PATCH] A bit of productionising --- ConsoleApp2/Seq.fs | 16 --- .../Reactivation.Test.fsproj | 7 +- .../TestSeq.fs | 8 +- ConsoleApp2.sln => Reactivation.sln | 4 +- {ConsoleApp2 => Reactivation}/BondSet.fs | 29 ++--- {ConsoleApp2 => Reactivation}/Program.fs | 104 ++++++++---------- .../Reactivation.fsproj | 0 Reactivation/Seq.fs | 20 ++++ Solve.Test/Program.fs | 4 - 9 files changed, 86 insertions(+), 106 deletions(-) delete mode 100644 ConsoleApp2/Seq.fs rename Solve.Test/Solve.Test.fsproj => Reactivation.Test/Reactivation.Test.fsproj (78%) rename Solve.Test/UnitTest1.fs => Reactivation.Test/TestSeq.fs (70%) rename ConsoleApp2.sln => Reactivation.sln (76%) rename {ConsoleApp2 => Reactivation}/BondSet.fs (75%) rename {ConsoleApp2 => Reactivation}/Program.fs (63%) rename ConsoleApp2/ConsoleApp2.fsproj => Reactivation/Reactivation.fsproj (100%) create mode 100644 Reactivation/Seq.fs delete mode 100644 Solve.Test/Program.fs diff --git a/ConsoleApp2/Seq.fs b/ConsoleApp2/Seq.fs deleted file mode 100644 index c25a7d3..0000000 --- a/ConsoleApp2/Seq.fs +++ /dev/null @@ -1,16 +0,0 @@ -namespace Solve - -[] -module Seq = - - let range (s : int seq) : int = - use e = s.GetEnumerator () - if not (e.MoveNext ()) then 0 else - - let mutable min = e.Current - let mutable max = e.Current - while e.MoveNext () do - if e.Current < min then min <- e.Current - if e.Current > max then max <- e.Current - max - min - diff --git a/Solve.Test/Solve.Test.fsproj b/Reactivation.Test/Reactivation.Test.fsproj similarity index 78% rename from Solve.Test/Solve.Test.fsproj rename to Reactivation.Test/Reactivation.Test.fsproj index fbfbb05..8f3ad12 100644 --- a/Solve.Test/Solve.Test.fsproj +++ b/Reactivation.Test/Reactivation.Test.fsproj @@ -4,12 +4,11 @@ net7.0 false - false + Reactivation.Test - - + @@ -23,7 +22,7 @@ - + diff --git a/Solve.Test/UnitTest1.fs b/Reactivation.Test/TestSeq.fs similarity index 70% rename from Solve.Test/UnitTest1.fs rename to Reactivation.Test/TestSeq.fs index 7ac18bc..ffecda2 100644 --- a/Solve.Test/UnitTest1.fs +++ b/Reactivation.Test/TestSeq.fs @@ -1,8 +1,8 @@ -namespace Solve.Test +namespace Reactivation.Test open FsUnitTyped open NUnit.Framework -open Solve +open Reactivation open FsCheck [] @@ -10,11 +10,11 @@ module TestSeq = [] let ``Seq.range works`` () : unit = - Seq.range Seq.empty |> shouldEqual 0 + Seq.rangeOrZero Seq.empty |> shouldEqual 0 let prop (i : int) (s : int list) = let s = i :: s - Seq.range s + Seq.rangeOrZero s |> (=) (Seq.max s - Seq.min s) prop diff --git a/ConsoleApp2.sln b/Reactivation.sln similarity index 76% rename from ConsoleApp2.sln rename to Reactivation.sln index b23efc3..14540ee 100644 --- a/ConsoleApp2.sln +++ b/Reactivation.sln @@ -1,8 +1,8 @@  Microsoft Visual Studio Solution File, Format Version 12.00 -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ConsoleApp2", "ConsoleApp2\ConsoleApp2.fsproj", "{D18D6A10-3AAB-4F2A-8CE6-C0D598A8E144}" +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Reactivation", "Reactivation\Reactivation.fsproj", "{D18D6A10-3AAB-4F2A-8CE6-C0D598A8E144}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Solve.Test", "Solve.Test\Solve.Test.fsproj", "{A4D67E0D-4DE2-4F6F-A443-6BE3B735C173}" +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Reactivation.Test", "Reactivation.Test\Reactivation.Test.fsproj", "{A4D67E0D-4DE2-4F6F-A443-6BE3B735C173}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution diff --git a/ConsoleApp2/BondSet.fs b/Reactivation/BondSet.fs similarity index 75% rename from ConsoleApp2/BondSet.fs rename to Reactivation/BondSet.fs index a1db4c6..a54cb97 100644 --- a/ConsoleApp2/BondSet.fs +++ b/Reactivation/BondSet.fs @@ -1,8 +1,10 @@ -namespace Solve +namespace Reactivation + +open System.Collections.Immutable type BondSet = private - | BondSet of ((int * int) * (int * int)) Set + | BondSet of ((int * int) * (int * int)) ImmutableHashSet [] module BondSet = @@ -16,46 +18,41 @@ module BondSet = if bonds.Contains (sort (sourceX + 1, sourceY) (sourceX, sourceY + 1)) then None else - bonds - |> Set.add (sort source dest) + bonds.Add (sort source dest) |> BondSet |> Some elif sourceX > destX && sourceY > destY then if bonds.Contains (sort (sourceX - 1, sourceY) (sourceX, sourceY - 1)) then None else - bonds - |> Set.add (sort source dest) + bonds.Add (sort source dest) |> BondSet |> Some elif sourceX < destX then if bonds.Contains (sort (sourceX, sourceY - 1) (sourceX + 1, sourceY)) then None else - bonds - |> Set.add (sort source dest) + bonds.Add (sort source dest) |> BondSet |> Some else if bonds.Contains (sort (sourceX - 1, sourceY) (sourceX, sourceY + 1)) then None else - bonds - |> Set.add (sort source dest) + bonds.Add (sort source dest) |> BondSet |> Some else if distance <> 1 then failwith "bad assumption" - bonds - |> Set.add (sort source dest) + bonds.Add (sort source dest) |> BondSet |> Some - let empty = BondSet Set.empty + let empty = BondSet ImmutableHashSet.Empty let directionList (BondSet s) = - let rec go (acc : _ list) (start : int * int) (s : Set<_>) = + let rec go (acc : _ list) (start : int * int) (s : ImmutableHashSet<_>) = if s.IsEmpty then List.rev (start :: acc) else let next, toRem = s @@ -65,8 +62,6 @@ module BondSet = else None ) |> Seq.exactlyOne - go (start :: acc) next (Set.remove toRem s) + go (start :: acc) next (s.Remove toRem) go [] (0, 0) s - - diff --git a/ConsoleApp2/Program.fs b/Reactivation/Program.fs similarity index 63% rename from ConsoleApp2/Program.fs rename to Reactivation/Program.fs index 83615e3..138b72b 100644 --- a/ConsoleApp2/Program.fs +++ b/Reactivation/Program.fs @@ -1,4 +1,13 @@ -namespace Solve +namespace Reactivation + +open System.Collections.Generic +open System.Collections.Immutable + +type Instruction = + | Horizontal = 1 + | Vertical = 2 + | UpAndRight = 3 + | DownAndRight = 4 module Program = @@ -40,20 +49,21 @@ module Program = start.[i - 1] <> next.[i - 1] ) |> List.exactlyOne + |> enum start, instruction ) - let restrict (board : Map) = - if Seq.range (board.Keys |> Seq.map snd) > 5 then false - elif Seq.range (board.Keys |> Seq.map fst) > 7 then false + let restrict (board : IReadOnlyDictionary) = + if Seq.rangeOrZero (board.Keys |> Seq.map snd) > 5 then false + elif Seq.rangeOrZero (board.Keys |> Seq.map fst) > 7 then false else true let rec go (currX : int) (currY : int) (bonds : BondSet) - (board : Map) - (instructions : (string * int) list) + (board : ImmutableDictionary) + (instructions : (string * Instruction) list) : _ list = if not (restrict board) then [] else @@ -62,81 +72,63 @@ module Program = | (word, i) :: rest -> // Place this word. let newBoard = - board - |> Map.add (currX, currY) word + board.Add ((currX, currY), word) match i with - | 1 -> + | Instruction.Horizontal -> // horizontal, i.e. change X [ - match Map.tryFind (currX + 1, currY) newBoard with - | None -> + if not (newBoard.ContainsKey (currX + 1, currY)) then match bonds |> BondSet.addIfOk (currX + 1, currY) (currX, currY) with | None -> () | Some bonds -> yield! go (currX + 1) currY bonds newBoard rest - | Some _ -> () - match Map.tryFind (currX - 1, currY) newBoard with - | None -> + + if not (newBoard.ContainsKey (currX - 1, currY)) then match bonds |> BondSet.addIfOk (currX - 1, currY) (currX, currY) with | None -> () | Some bonds -> yield! go (currX - 1) currY bonds newBoard rest - | Some _ -> () ] - | 2 -> + | Instruction.Vertical -> // vertical, i.e. change Y [ - match Map.tryFind (currX, currY + 1) newBoard with - | None -> + if not (newBoard.ContainsKey (currX, currY + 1)) then match bonds |> BondSet.addIfOk (currX, currY + 1) (currX, currY) with | None -> () | Some bonds -> yield! go currX (currY + 1) bonds newBoard rest - | Some _ -> () - match Map.tryFind (currX, currY - 1) newBoard with - | None -> + if not (newBoard.ContainsKey (currX, currY - 1)) then match bonds |> BondSet.addIfOk (currX, currY - 1) (currX, currY) with | None -> () | Some bonds -> yield! go currX (currY - 1) bonds newBoard rest - | Some _ -> () ] - | 3 -> - // Bottom left to top right + | Instruction.UpAndRight -> [ - match Map.tryFind (currX + 1, currY + 1) newBoard with - | None -> + if not (newBoard.ContainsKey (currX + 1, currY + 1)) then match bonds |> BondSet.addIfOk (currX + 1, currY + 1) (currX, currY) with | None -> () | Some bonds -> yield! go (currX + 1) (currY + 1) bonds newBoard rest - | Some _ -> () - match Map.tryFind (currX - 1, currY - 1) newBoard with - | None -> + if not (newBoard.ContainsKey (currX - 1, currY - 1)) then match bonds |> BondSet.addIfOk (currX - 1, currY - 1) (currX, currY) with | None -> () | Some bonds -> yield! go (currX - 1) (currY - 1) bonds newBoard rest - | Some _ -> () ] - | 4 -> - // Top left to bottom right + | Instruction.DownAndRight -> [ - match Map.tryFind (currX - 1, currY + 1) newBoard with - | None -> + if not (newBoard.ContainsKey (currX - 1, currY + 1)) then match bonds |> BondSet.addIfOk (currX - 1, currY + 1) (currX, currY) with | None -> () | Some bonds -> yield! go (currX - 1) (currY + 1) bonds newBoard rest - | Some _ -> () - match Map.tryFind (currX + 1, currY - 1) newBoard with - | None -> + if not (newBoard.ContainsKey (currX + 1, currY - 1)) then match bonds |> BondSet.addIfOk (currX + 1, currY - 1) (currX, currY) with | None -> () | Some bonds -> yield! go (currX + 1) (currY - 1) bonds newBoard rest - | Some _ -> () ] | _ -> failwith "bad direction" @@ -145,54 +137,48 @@ module Program = [] let main _ = + let sw = System.Diagnostics.Stopwatch.StartNew () let after = instructions - |> go 0 0 BondSet.empty Map.empty + |> go 0 0 BondSet.empty ImmutableDictionary.Empty |> List.map (fun (examplePlacement, exampleBonds) -> let munged = exampleBonds |> List.choose (fun (srcX, srcY) -> - match examplePlacement.TryFind (srcX, srcY) with - | Some w -> + match examplePlacement.TryGetValue ((srcX, srcY)) with + | true, w -> Some ((srcX, srcY), w) - | None -> + | false, _ -> None ) munged ) - |> List.distinct - printfn "Before filtering, %i options" after.Length - let after = + let positions = after - |> List.sortBy (fun l -> + |> List.minBy (fun l -> let (x, y), _ = List.last l abs x + abs y ) + |> List.map fst - if after.Length = 0 then 1 else + sw.Stop () + printfn "%i" sw.ElapsedMilliseconds - let l = after.[1] - let positions = l |> List.map fst - let minX = positions |> List.map fst |> List.min - let maxX = positions |> List.map fst |> List.max - let minY = positions |> List.map snd |> List.min - let maxY = positions |> List.map snd |> List.max + let struct (minX, maxX) = positions |> Seq.map fst |> Seq.minMax |> ValueOption.get + let struct (minY, maxY) = positions |> Seq.map snd |> Seq.minMax |> ValueOption.get let arr = Array2D.zeroCreate (maxY - minY + 1) (maxX - minX + 1) let mutable i = 0 for x, y in positions do - if i >= instructions.Length then - arr.[y - minY, x - minX] <- ValueSome 'M' - else - arr.[y - minY, x - minX] <- ValueSome words.[i].[snd instructions.[i] - 1] + arr.[y - minY, x - minX] <- words.[i].[int (snd instructions.[i]) - 1] i <- i + 1 for row in maxY .. -1 .. minY do for col in minX..maxX do match arr.[row - minY, col - minX] with - | ValueNone -> printf "." - | ValueSome c -> printf "O" + | '\000' -> printf "." + | _ -> printf "O" printfn "" 0 \ No newline at end of file diff --git a/ConsoleApp2/ConsoleApp2.fsproj b/Reactivation/Reactivation.fsproj similarity index 100% rename from ConsoleApp2/ConsoleApp2.fsproj rename to Reactivation/Reactivation.fsproj diff --git a/Reactivation/Seq.fs b/Reactivation/Seq.fs new file mode 100644 index 0000000..ba1299c --- /dev/null +++ b/Reactivation/Seq.fs @@ -0,0 +1,20 @@ +namespace Reactivation + +[] +module Seq = + + let minMax (s : int seq) : struct (int * int) voption = + use e = s.GetEnumerator () + if not (e.MoveNext ()) then ValueNone else + + let mutable min = e.Current + let mutable max = e.Current + while e.MoveNext () do + if e.Current < min then min <- e.Current + if e.Current > max then max <- e.Current + ValueSome (struct (min, max)) + + let rangeOrZero (s : int seq) : int = + match minMax s with + | ValueNone -> 0 + | ValueSome (min, max) -> max - min \ No newline at end of file diff --git a/Solve.Test/Program.fs b/Solve.Test/Program.fs deleted file mode 100644 index 176a7b6..0000000 --- a/Solve.Test/Program.fs +++ /dev/null @@ -1,4 +0,0 @@ -module Program = - - [] - let main _ = 0