Program: save solution metadata

Icfpc2023.Visualizer/ViewModels/FieldViewModel.fs

@@ -2,10 +2,10 @@
 
 open Icfpc2023
 
-type FieldViewModel(problemId: int, problem: Problem, solution: Solution, score: double) =
+type FieldViewModel(problemId: int, problem: Problem, solution: Solution, solutionMetadata: SolutionMetadata) =
     member val ProblemId = problemId
     member val Problem = problem
     member val Solution = solution
-    member val Score = score
+    member val SolutionMetadata = solutionMetadata
 
     member val Scale = 0.1 with get, set

Icfpc2023.Visualizer/ViewModels/MainWindowViewModel.fs

@@ -1,15 +1,15 @@
 namespace Icfpc2023.Visualizer.ViewModels
 
+open Icfpc2023
 open ReactiveUI
 
 type MainWindowViewModel() =
     inherit ViewModelBase()
 
     static member LoadProblem(problemId: int): FieldViewModel =
         let problem = Program.readProblem problemId
-        let solution = Program.readSolution problemId
-        let score = Program.readScoreOrCompute problemId problem
-        FieldViewModel(problemId, problem, solution, score)
+        let (Some (solution, solutionMetadata)) = Program.tryReadSolution problemId // TODO: unsafe. gsomix
+        FieldViewModel(problemId, problem, solution, solutionMetadata)
 
     member val Field =
         MainWindowViewModel.LoadProblem(1)
@@ -19,11 +19,15 @@ type MainWindowViewModel() =
 
     member this.MusiciansCount = string this.Field.Problem.Musicians.Length
 
-    member this.Score = string this.Field.Score
+    member this.Score = string this.Field.SolutionMetadata.Score
+    member this.Solver = string this.Field.SolutionMetadata.SolverName
 
     member private this.LoadProblemById(problemId: int) =
         this.Field <- MainWindowViewModel.LoadProblem(problemId)
         this.RaisePropertyChanged(nameof this.ProblemId)
+        this.RaisePropertyChanged(nameof this.MusiciansCount)
+        this.RaisePropertyChanged(nameof this.Score)
+        this.RaisePropertyChanged(nameof this.Solver)
         this.RaisePropertyChanged(nameof this.Field)
 
     member this.LoadPrev(): unit =

Icfpc2023.Visualizer/Views/MainWindow.axaml

@@ -31,6 +31,10 @@
                     <Label Content="Score:"/>
                     <Label Content="{Binding Score}"/>
                 </StackPanel>
+                <StackPanel Orientation="Horizontal">
+                    <Label Content="Solver:"/>
+                    <Label Content="{Binding Solver}"/>
+                </StackPanel>
             </StackPanel>
             <Button Content="← Prev" Command="{Binding LoadPrev}" />
             <Button Content="Next →" Command="{Binding LoadNext}" />

Icfpc2023/Domain.fs

@@ -19,3 +19,11 @@ type Problem = {
 type Solution = {
     Placements: PointD[]
 }
+
+type Score = double
+type SolverName = string
+
+type SolutionMetadata = {
+    Score: Score
+    SolverName: SolverName
+}

Icfpc2023/Icfpc2023.fsproj

@@ -9,7 +9,7 @@
     <Compile Include="Geometry.fs" />
     <Compile Include="Domain.fs" />
     <Compile Include="Scoring.fs" />
-    <Compile Include="DummySolver.fs" />
+    <Compile Include="Solvers\DummySolver.fs" />
     <Compile Include="JsonDefs.fs" />
     <Compile Include="HttpApi.fs" />
     <Compile Include="LambdaScoring.fs" />

Icfpc2023/JsonDefs.fs

@@ -32,8 +32,9 @@ type SolutionJson = {
     placements: PlacementJson[]
 }
 
-type SolutionScoreJson = {
-    score: SolutionScore
+type SolutionMetadataJson = {
+    score: Score
+    solver: SolverName
 }
 
 #nowarn "25"
@@ -63,14 +64,19 @@ let ReadSolutionFromJson(json: string): Solution =
         Placements = solJson.placements |> Array.map(fun p -> PointD(p.x, p.y))
     }
 
-let WriteSolutionScoreToJson(score: SolutionScore): string =
-    let scoreJson = {
-        score = score
+let WriteSolutionMetadataToJson(metadata: SolutionMetadata): string =
+    let metadataJson = {
+        score = metadata.Score
+        solver = metadata.SolverName
     }
-    JsonConvert.SerializeObject(scoreJson)
+    JsonConvert.SerializeObject(metadataJson)
 
-let ReadSolutionScoreFromJson(json: string): SolutionScore =
-    JsonConvert.DeserializeObject<SolutionScoreJson>(json).score
+let ReadSolutionMetadataFromJson(json: string): SolutionMetadata =
+    let metadataJson = JsonConvert.DeserializeObject<SolutionMetadataJson>(json)
+    {
+        Score = metadataJson.score
+        SolverName = metadataJson.solver
+    }
 
 let ReadProblemFromFile(filePath: string): Problem =
     let json = File.ReadAllText(filePath)
@@ -80,6 +86,6 @@ let ReadSolutionFromFile(filePath: string): Solution =
     let json = File.ReadAllText(filePath)
     ReadSolutionFromJson json
 
-let ReadSolutionScoreFromFile(filePath: string): SolutionScore =
+let ReadSolutionMetadataFromFile(filePath: string): SolutionMetadata =
     let json = File.ReadAllText(filePath)
-    ReadSolutionScoreFromJson json
+    ReadSolutionMetadataFromJson json

Icfpc2023/Program.fs

@@ -6,6 +6,12 @@ open System.Threading.Tasks
 open Icfpc2023
 open Icfpc2023.HttpApi
 
+let inline (|Parse|_|) (str: string) : 'a option =
+    let mutable value = Unchecked.defaultof<'a>
+    let result = (^a: (static member TryParse: string * byref< ^a> -> bool) str, &value)
+    if result then Some value
+    else None
+
 let solutionDirectory =
     let mutable directory = Environment.CurrentDirectory
     while not(isNull directory) && not <| File.Exists(Path.Combine(directory, "Icfpc2023.sln")) do
@@ -30,39 +36,88 @@ let readToken() =
     File.ReadAllText(tokenFile).Trim()
 
 let solvers = Map [
-    "dummy", DummySolver.Solve
+    "dummyV1", DummySolver.SolveV1
+    "dummyV2", DummySolver.SolveV2
 ]
 
-let writeScore i score =
-    let solutionScoreFile = Path.Combine(solutionsDir, $"{i}.score.json")
-    let solutionScoreText = JsonDefs.WriteSolutionScoreToJson score
-    File.WriteAllText(solutionScoreFile, solutionScoreText)
-
-let readProblem i =
-    let problemFile = Path.Combine(problemsDir, $"{i}.json")
+let readProblem (problemId: int) =
+    let problemFile = Path.Combine(problemsDir, $"{problemId}.json")
     JsonDefs.ReadProblemFromFile problemFile
 
-let readSolution i =
-    let solutionFile = Path.Combine(solutionsDir, $"{i}.json")
-    JsonDefs.ReadSolutionFromFile solutionFile
-
-let writeSolution i solution score =
-    let solutionFile = Path.Combine(solutionsDir, $"{i}.json")
+let tryReadSolution (problemId: int): (Solution * SolutionMetadata) option =
+    let solutionFile = Path.Combine(solutionsDir, $"{problemId}.json")
+    let solutionMetadataFile = Path.Combine(solutionsDir, $"{problemId}.meta.json")
+    try
+        let solution = JsonDefs.ReadSolutionFromFile solutionFile
+        let solutionMetadata = JsonDefs.ReadSolutionMetadataFromFile solutionMetadataFile
+        Some (solution, solutionMetadata)
+    with :? FileNotFoundException ->
+        None
+
+let writeSolution (problemId: int) solution solutionMetadata =
+    let solutionFile = Path.Combine(solutionsDir, $"{problemId}.json")
+    let solutionMetadataFile = Path.Combine(solutionsDir, $"{problemId}.meta.json")
     let solutionText = JsonDefs.WriteSolutionToJson solution
+    let solutionMetadataText = JsonDefs.WriteSolutionMetadataToJson solutionMetadata
     File.WriteAllText(solutionFile, solutionText)
+    File.WriteAllText(solutionMetadataFile, solutionMetadataText)
+
+let solve (problemId: int) (solverName: SolverName) =
+    let solveWithSolver (problemId: int) (solverName: SolverName) =
+        printf $"Trying solver {solverName}... "
+        let problem = readProblem problemId
+        let solver = solvers[solverName]
+        let solution = solver problem
+        let score = Scoring.CalculateScore problem solution
+        printfn $"Score: {score}"
+        let solutionMetadata = {
+            Score = score
+            SolverName = solverName
+        }
+        solution, solutionMetadata
+
+    match solverName with
+    | "best" ->
+        solvers
+        |> Map.toSeq
+        |> Seq.map (fun (solverName, _) -> solveWithSolver problemId solverName)
+        |> Seq.maxBy (fun (_, solutionMetadata) -> solutionMetadata.Score)
+    | _ ->
+        solveWithSolver problemId solverName
+
+let solveCommand (problemId: int) (solverName: SolverName) (preserveBest: bool) =
+    printfn $"Solving problem {problemId}..."
+    let solution, solutionMetadata = solve problemId solverName
+    let newSolver = solutionMetadata.SolverName
+
+    match tryReadSolution problemId with
+    | Some (_, oldSolutionMetadata) ->
+        let newScore = solutionMetadata.Score
+        let oldScore = oldSolutionMetadata.Score
+        let oldSolver = oldSolutionMetadata.SolverName
+        let diff = newScore - oldScore
+        let diff_percent = 100.0 * (diff / oldScore)
+        printfn $"Score for problem {problemId}: {oldScore} ({oldSolver}) -> {newScore} ({newSolver}) (%+f{diff} / %+.0f{diff_percent}%%)"
+
+        if not preserveBest then
+            printfn $"Writing solution for problem {problemId}..."
+            writeSolution problemId solution solutionMetadata
+        elif preserveBest && (newScore > oldScore) then
+            printfn $"Writing best solution for problem {problemId}..."
+            writeSolution problemId solution solutionMetadata
+        else
+            printfn $"Do nothing!"
 
-    writeScore i score
+    | None ->
+        printfn $"Score for problem {problemId}: {solutionMetadata.Score}"
+        printfn $"Writing solution for problem {problemId}..."
+        writeSolution problemId solution solutionMetadata
 
-let readScoreOrCompute i problem =
-    let solutionScoreFile = Path.Combine(solutionsDir, $"{i}.score.json")
-    try
-        JsonDefs.ReadSolutionScoreFromFile solutionScoreFile
-    with
-    | :? FileNotFoundException ->
-        let oldSolution = readSolution i
-        let score = Scoring.CalculateScore problem oldSolution
-        writeScore i score
-        score
+let solveAllCommand (solverName: SolverName) (preserveBest: bool) =
+    let problems = Directory.GetFiles(problemsDir, "*.json")
+    for problem in problems do
+        let problemId = Path.GetFileNameWithoutExtension problem |> int
+        solveCommand problemId solverName preserveBest
 
 [<EntryPoint>]
 let main(args: string[]): int =
@@ -79,55 +134,37 @@ let main(args: string[]): int =
                 printfn $"Downloading problem {i} to \"{filePath}\"…"
                 File.WriteAllText(filePath, content)
         }
-    | [|"download"; numStr|] ->
-        let num = int numStr
+
+    | [| "download"; Parse(problemId) |] ->
         Directory.CreateDirectory problemsDir |> ignore
-        let content = runSynchronously <| DownloadProblem num
-        let filePath = Path.Combine(problemsDir, $"{string num}.json")
-        printfn $"Downloading problem {num} to \"{filePath}\"…"
+        let content = runSynchronously <| DownloadProblem problemId
+        let filePath = Path.Combine(problemsDir, $"{string problemId}.json")
+        printfn $"Downloading problem {problemId} to \"{filePath}\"…"
         File.WriteAllText(filePath, content)
 
-    | [| "solve"; numStr; solverStr |] ->
-        let num = int numStr
-        let problem = readProblem num
-        let solver = solvers[solverStr]
-        let solution = solver problem
-        let score = Scoring.CalculateScore problem solution
-        writeSolution num solution score
-
-    | [| "solveBest"; numStr; solverStr |] ->
-        let num = int numStr
-        let problem = readProblem num
+    | [| "solve"; Parse(problemId); solverName |] ->
+        solveCommand problemId solverName false
 
-        let oldSolution = readSolution num
-        let oldScore = readScoreOrCompute num problem
+    | [| "solve"; Parse(problemId); solverName; "--preserve-best" |] ->
+        solveCommand problemId solverName true
 
-        let solver = solvers[solverStr]
-        let newSolution = solver problem
-        let newScore = Scoring.CalculateScore problem newSolution
+    | [| "solve"; "all"; solverName |] ->
+        solveAllCommand solverName false
 
-        let diff = newScore - oldScore
-        let diff_percent = 100.0 * (diff / oldScore)
-        printfn $"Score for problem {num}: {oldScore} -> {newScore} (%+f{diff} / %+.0f{diff_percent}%%)"
-        if newScore > oldScore then
-            printfn $"Writing solution..."
-            writeSolution num newSolution newScore
-        else
-            printfn "Do nothing!"
+    | [| "solve"; "all"; solverName; "--preserve-best" |] ->
+        solveAllCommand solverName true
 
-    | [| "score"; numStr |] ->
-        let num = int numStr
-        let problem = readProblem num
-        let solution = readSolution num
-        let score = Scoring.CalculateScore problem solution
-        printfn $"Score: {string score}"
+    | [| "score"; Parse(problemId) |] ->
+        match tryReadSolution problemId with
+        | Some(_, solutionMetadata) -> printfn $"Score: {string solutionMetadata.Score}"
+        | _ -> printfn $"Problem {problemId} is not solved yet!"
 
-    | [|"upload"; "all"|] ->
+    | [| "upload"; "all" |] ->
         let token = readToken()
         let solutions = Directory.GetFiles(solutionsDir, "*.json")
         for solution in solutions do
             let filename = Path.GetFileName solution
-            if not(filename.EndsWith(".score.json")) then
+            if not(filename.EndsWith(".meta.json")) then
                 printfn $"Uploading solution \"{filename}\"…"
                 let problemNumber = Path.GetFileNameWithoutExtension solution |> int
                 let submission = { ProblemId = problemNumber; Contents = File.ReadAllText(solution) }

Icfpc2023/Scoring.fs

@@ -6,9 +6,7 @@ type private Musician = {
     Location: PointD
 }
 
-type SolutionScore = double
-
-let private CalculateAttendeeMusicianScore (attendee: Attendee) (musician: Musician): SolutionScore =
+let private CalculateAttendeeMusicianScore (attendee: Attendee) (musician: Musician): Score =
     let d_squared = (attendee.X - musician.Location.X) ** 2.0 + (attendee.Y - musician.Location.Y) ** 2.0
     ceil(1_000_000.0 * attendee.Tastes[musician.Instrument] / d_squared)
 
@@ -21,14 +19,14 @@ let private AnyOtherMusicianBlocksSound (musicians: Musician[]) (attendee: Atten
     |> Seq.filter(fun (i, _) -> i <> mIndex)
     |> Seq.exists(fun (_, m) -> blockZone.Contains(m.Location))
 
-let private CalculateAttendeeScore (musicians: Musician[]) (attendee: Attendee): SolutionScore =
+let private CalculateAttendeeScore (musicians: Musician[]) (attendee: Attendee): Score =
     Seq.indexed musicians
     |> Seq.sumBy(fun (i, musician) ->
         if AnyOtherMusicianBlocksSound musicians attendee i then 0.0
         else CalculateAttendeeMusicianScore attendee musician
     )
 
-let CalculateScore(problem: Problem) (solution: Solution): SolutionScore =
+let CalculateScore(problem: Problem) (solution: Solution): Score =
     let musicians =
         problem.Musicians
         |> Seq.zip solution.Placements

Icfpc2023/DummySolver.fs → Icfpc2023/Solvers/DummySolver.fs

@@ -1,6 +1,17 @@
 module Icfpc2023.DummySolver
 
-let Solve(problem: Problem): Solution =
+let SolveV1(problem: Problem): Solution =
+    let vacantRadius = 10.0
+    let grid = seq {
+        for x in vacantRadius .. vacantRadius .. problem.StageWidth-vacantRadius do
+            for y in vacantRadius .. vacantRadius .. problem.StageHeight-vacantRadius ->
+                problem.StageBottomLeft + PointD(x, y)
+    }
+    {
+        Placements = Seq.take problem.Musicians.Length grid |> Seq.toArray
+    }
+
+let SolveV2(problem: Problem): Solution =
     let vacantRadius = 10.0
     let xStep = vacantRadius
     let yStep = vacantRadius * sqrt 3.0

solutions/1.meta.json

@@ -0,0 +1 @@
+{"score":1190163.0,"solver":"dummyV2"}

solutions/10.meta.json

@@ -0,0 +1 @@
+{"score":-7098444.0,"solver":"dummyV1"}

solutions/11.meta.json

@@ -0,0 +1 @@
+{"score":-2011438.0,"solver":"dummyV1"}

solutions/12.meta.json

@@ -0,0 +1 @@
+{"score":243443061.0,"solver":"dummyV2"}