Merge pull request fsharp#249 from jdh30/SetAndMapPerformanceTests

Set and map performance tests

tests/perf/MapSet/MapSet.sln

@@ -0,0 +1,20 @@
+
+Microsoft Visual Studio Solution File, Format Version 12.00
+# Visual Studio Express 2012 for Web
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MapSet", "MapSet\MapSet.fsproj", "{0EBC2550-A239-4FA2-96B3-D32130224109}"
+EndProject
+Global
+	GlobalSection(SolutionConfigurationPlatforms) = preSolution
+		Debug|Any CPU = Debug|Any CPU
+		Release|Any CPU = Release|Any CPU
+	EndGlobalSection
+	GlobalSection(ProjectConfigurationPlatforms) = postSolution
+		{0EBC2550-A239-4FA2-96B3-D32130224109}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{0EBC2550-A239-4FA2-96B3-D32130224109}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{0EBC2550-A239-4FA2-96B3-D32130224109}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{0EBC2550-A239-4FA2-96B3-D32130224109}.Release|Any CPU.Build.0 = Release|Any CPU
+	EndGlobalSection
+	GlobalSection(SolutionProperties) = preSolution
+		HideSolutionNode = FALSE
+	EndGlobalSection
+EndGlobal

tests/perf/MapSet/MapSet/App.config

@@ -0,0 +1,16 @@
+<?xml version="1.0" encoding="utf-8"?>
+<configuration>
+  <startup>
+    <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.5.1" />
+  </startup>
+  <runtime>
+    <assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
+      <dependentAssembly>
+        <assemblyIdentity name="FSharp.Core" publicKeyToken="b03f5f7f11d50a3a" culture="neutral" />
+        <bindingRedirect oldVersion="2.0.0.0" newVersion="4.3.0.0" />
+        <bindingRedirect oldVersion="2.3.5.0" newVersion="4.3.0.0" />
+        <bindingRedirect oldVersion="4.0.0.0" newVersion="4.3.0.0" />
+      </dependentAssembly>
+    </assemblyBinding>
+  </runtime>
+</configuration>

tests/perf/MapSet/MapSet/Charts.fsx

@@ -0,0 +1,173 @@
+// TODO: Filter out zeroes because they cause FSharp.Charting to crash
+// when using a log scale.
+
+#r "System.Windows.Forms.DataVisualization"
+#I "../packages/FSharp.Charting.0.90.5/lib/net40/"
+#r "FSharp.Charting"
+
+#load "NeighborShells.fs"
+#load "PrimsMinimumSpanningTree.fs"
+#load "SlidingMedian.fs"
+#load "KnightsTour.fs"
+#load "LZW.fs"
+#load "TopologicalSort.fs"
+#load "Types.fs"
+#load "Run.fs"
+#load "IO.fs"
+
+open FSharp.Charting
+open Types
+
+open System.Windows.Forms
+open FSharp.Charting.ChartTypes
+
+let Show (c:GenericChart) =
+  use cc = new ChartControl(c)
+  cc.Dock <- DockStyle.Fill
+  use f = new Form()
+  f.Size <- System.Drawing.Size(1280, 720) // 720p
+  f.Controls.Add cc
+  f.ShowDialog() |> ignore
+
+let Save filename (c:GenericChart) =
+  use cc = new ChartControl(c)
+  cc.Dock <- DockStyle.Fill
+  use f = new Form()
+  f.Size <- System.Drawing.Size(800, 600)
+  f.Controls.Add cc
+  f.Load |> Event.add (fun _ -> c.SaveChartAs(filename, ChartImageFormat.Png); f.Close()) // yay
+  f.Show()
+  //Application.Run f
+
+/// Charts for each benchmark.
+type AllCharts = AllBenchmarks<ChartTypes.GenericChart, ChartTypes.GenericChart>
+
+let chartMapResults name (results: (string * SeriesData) seq) =
+  (Chart.Combine
+    [ for name, series in results ->
+        Chart.Line(series, Name=name) ])
+    .WithTitle(Text=name)
+    .WithLegend(Enabled=true)
+    .WithXAxis(Log=true, Title="Number of key-value pairs in Map", Max=1e6)
+    .WithYAxis(Log=true, Title="Key-value pairs per second", Min=1e4, Max=1e9)
+
+let chartSetResults name (results: (string * SeriesData) seq) =
+  (Chart.Combine
+    [ for name, series in results ->
+        Chart.Line(series, Name=name) ])
+    .WithTitle(Text=name)
+    .WithLegend(Enabled=true)
+    .WithXAxis(Log=true, Title="Cardinality", Max=1e6)
+    .WithYAxis(Log=true, Title="Elements per second", Min=1e4, Max=1e9)
+
+let chartSetTheoreticOp name (results: (string * SeriesData) seq) =
+  (Chart.Combine
+    [ for name, series in results ->
+        Chart.Line(series, Name=name) ])
+    .WithTitle(Text="Set "+name+" performance")
+    .WithLegend(Enabled=true)
+    .WithXAxis(Log=true, Title="Elements", Max=1e6)
+    .WithYAxis(Log=true, Title="Operations per second")
+
+let chartMapSpeedups name (results: (string * SeriesData) seq) =
+  (Chart.Combine
+    [ for name, series in results ->
+        Chart.Line(series, Name=name) ])
+    .WithTitle(Text=name)
+    .WithLegend(Enabled=true)
+    .WithXAxis(Log=true, Title="Number of key-value pairs in Map", Max=1e6)
+    .WithYAxis(Title="Speedup")
+
+let chartSetSpeedups name (results: (string * SeriesData) seq) =
+  (Chart.Combine
+    [ for name, series in results ->
+        Chart.Line(series, Name=name) ])
+    .WithTitle(Text=name)
+    .WithLegend(Enabled=true)
+    .WithXAxis(Log=true, Title="Cardinality", Max=1e6)
+    .WithYAxis(Title="Speedup")
+
+let chartSetTheoreticSpeedup name (results: (string * SeriesData) seq) =
+  (Chart.Combine
+    [ for name, series in results ->
+        Chart.Line(series, Name=name) ])
+    .WithTitle(Text="Set "+name+" speedup")
+    .WithLegend(Enabled=true)
+    .WithXAxis(Log=true, Title="Elements", Max=1e6)
+    .WithYAxis(Title="Speedup")
+
+let createCharts (allResults: AllResults) =
+  { IntMap = chartMapResults "Map<int> performance" allResults.IntMap
+    StringMap = chartMapResults "Map<string> performance" allResults.StringMap
+    PairMap = chartMapResults "Map<int * int> map performance" allResults.PairMap
+
+    IntSet = chartSetResults "Set<int> performance" allResults.IntSet
+    StringSet = chartSetResults "Set<string> performance" allResults.StringSet
+    PairSet = chartSetResults "Set<int * int> performance" allResults.PairSet
+
+    SetUnion = chartSetTheoreticOp "union" allResults.SetUnion
+    SetIntersection = chartSetTheoreticOp "intersection" allResults.SetIntersection
+    SetDifference = chartSetTheoreticOp "difference" allResults.SetDifference
+
+    Tasks = Chart.Column(allResults.Tasks, Title="Set and Map task performance").WithYAxis(Title="Time (s)") }
+
+let createSpeedupCharts (allResults: AllResults) =
+  { IntMap = chartMapSpeedups "Map<int> speedup" allResults.IntMap
+    StringMap = chartMapSpeedups "Map<string> speedup" allResults.StringMap
+    PairMap = chartMapSpeedups "Map<int * int> map speedup" allResults.PairMap
+
+    IntSet = chartSetSpeedups "Set<int> speedup" allResults.IntSet
+    StringSet = chartSetSpeedups "Set<string> speedup" allResults.StringSet
+    PairSet = chartSetSpeedups "Set<int * int> speedup" allResults.PairSet
+
+    SetUnion = chartSetTheoreticSpeedup "union" allResults.SetUnion
+    SetIntersection = chartSetTheoreticSpeedup "intersection" allResults.SetIntersection
+    SetDifference = chartSetTheoreticSpeedup "difference" allResults.SetDifference
+
+    Tasks = Chart.Column(allResults.Tasks, Title="Set and Map task performance").WithYAxis(Title="Speedup") }
+
+let checkNames = false
+
+let compareResults (originalResults: AllResults) (newResults: AllResults) : AllResults =
+  let seriesSpeedup (name1, series1) (name2, series2) =
+    if checkNames && name1 <> name2 then
+      failwithf "Series name mismatch: '%s' <> '%s'" name1 name2
+    name1,
+    [ for (size1, time1), (size2, time2) in Seq.zip series1 series2 ->
+        if checkNames && size1 <> size2 then
+          failwithf "Size mismatch: %d <> %d" size1 size2
+        size1, time2 / time1 ]
+  let taskSpeedup (name1, time1) (name2, time2) =
+    if checkNames && name1 <> name2 then
+      failwithf "Task name mismatch: '%s' <> '%s'" name1 name2
+    name1, time2 / time1
+  let trends =
+    List.zip originalResults.Trends newResults.Trends
+    |> List.map (fun ((name1, trend1), (name2, trend2)) ->
+      if checkNames && name1 <> name2 then
+        failwithf "Trend name mismatch: '%s' <> '%s'" name1 name2
+      name1, List.map2 seriesSpeedup trend1 trend2)
+  let tasks = List.map2 taskSpeedup originalResults.Tasks newResults.Tasks
+  allBenchmarksOf trends tasks
+
+let showAndSaveSpeedups path originalResults newResults =
+  let speedups = compareResults originalResults newResults
+  for filename, chart in seqOf(createSpeedupCharts speedups) do
+    Save (System.IO.Path.Combine[|path; filename+".png"|]) chart
+    //chart.ShowChart()
+    //let format = ChartTypes.ChartImageFormat.Png
+    //chart.SaveChartAs(System.IO.Path.Combine[|path; filename+".png"|], format)
+
+let show results =
+  for _, chart in seqOf(createCharts results) do
+    Show chart
+    //chart.ShowChart()
+
+let showAndSave path results =
+  for filename, chart in seqOf(createCharts results) do
+    Save (System.IO.Path.Combine[|path; filename+".png"|]) chart
+(*
+    chart.ShowChart()
+    let format = ChartTypes.ChartImageFormat.Png
+    chart.SaveChartAs(System.IO.Path.Combine[|path; filename+".png"|], format)
+*)

tests/perf/MapSet/MapSet/IO.fs

@@ -0,0 +1,75 @@
+// FIXME: This file format sucks. Let's use grids in CSV instead.
+
+/// Load and save benchmark results.
+module IO
+
+open Types
+
+let saveResults path series =
+  let lines =
+    [ for name, seriesData in series do
+        yield name
+        for size, time in seriesData do
+          yield sprintf "%d %f" size time ]
+  System.IO.File.WriteAllLines(path, lines)
+
+let saveTaskResults path tasks =
+  let lines =
+    [ for name, time in tasks do
+        yield sprintf "%s %f" name time ]
+  System.IO.File.WriteAllLines(path, lines)
+
+let save dir (allResults: AllResults) =
+  let path filename = System.IO.Path.Combine[|__SOURCE_DIRECTORY__; dir; filename+".csv"|]
+  for name, results in allResults.Trends do
+    saveResults (path(string name)) results
+  saveTaskResults (path "Tasks") allResults.Tasks
+
+let isAlpha c =
+  ('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z')
+
+let loadTrend path filename =
+  let path = System.IO.Path.Combine[|path; filename+".csv"|]
+  let lines = System.IO.File.ReadAllLines path
+  let length =
+    Seq.skip 1 lines
+    |> Seq.findIndex (fun line -> line.Length > 0 && isAlpha line.[0])
+    |> (+) 1
+  [ for i in 0..lines.Length/length-1 ->
+      lines.[length*i],
+      [ for line in lines.[length*i+1..length*(i+1)-1] ->
+          let numbers = line.Split ' '
+          int numbers.[0], float numbers.[1] ] ]
+
+let loadTasks path filename =
+  let path = System.IO.Path.Combine[|path; filename+".csv"|]
+  [ for line in System.IO.File.ReadLines path ->
+      match line.Split ' ' with
+      | [|name; time|] -> name, float time
+      | _ -> failwith "Invalid tasks benchmark format" ]
+
+let load dir : AllResults =
+  let trends =
+    [ for name in [ "IntMap"; "StringMap"; "PairMap";
+                    "IntSet"; "StringSet"; "PairSet";
+                    "SetUnion"; "SetIntersection"; "SetDifference" ] ->
+        name, loadTrend dir name ]
+  let tasks = loadTasks dir "Tasks"
+  allBenchmarksOf trends tasks
+(*
+  { IntMap = loadTrend dir "IntMap"
+    StringMap = loadTrend dir "StringMap"
+    PairMap = loadTrend dir "PairMap"
+    IntSet = loadTrend dir "IntSet"
+    StringSet = loadTrend dir "StringSet"
+    PairSet = loadTrend dir "PairSet"
+    SetUnion = loadTrend dir "SetUnion"
+    SetIntersection = loadTrend dir "SetIntersection"
+    SetDifference = loadTrend dir "SetDifference"
+    Tasks = loadTasks dir "Tasks" }
+*)
+
+let pathFromSourceDirectory path =
+  [|yield __SOURCE_DIRECTORY__
+    yield! path|]
+  |> System.IO.Path.Combine

tests/perf/MapSet/MapSet/KnightsTour.fs

@@ -0,0 +1,76 @@
+/// Find the first knight's tour (if any) on a board of a given
+/// size.
+///
+/// 74% in Set.contains, 5% in Set.remove.
+///
+/// Heavy use of backtracking.
+///
+/// Most garbage is short lived.
+module KnightsTour
+
+// Takes ~10s.
+let problemSize = 292
+
+/// A 2D integer coordinate as a value type.
+[<Struct>]
+type Posn =
+  val x : byte
+  val y : byte
+  new(x, y) = {x=x; y=y}
+  new(x: int, y: int) = {x=byte x; y=byte y}
+  static member (+) (a: Posn, b: Posn) = Posn(a.x+b.x, a.y+b.y)
+
+/// The eight moves of a knight.
+let moves f a =
+  a
+  |> f (Posn(-1, 2))
+  |> f (Posn(1, 2))
+  |> f (Posn(2, 1))
+  |> f (Posn(2, -1))
+  |> f (Posn(1, -2))
+  |> f (Posn(-1, -2))
+  |> f (Posn(-2, -1))
+  |> f (Posn(-2, 1))
+
+/// Recursively search for a valid knight's tour, yielding
+/// solutions as they are found.
+let rec search free ps xy =
+  seq { if Set.isEmpty free then
+          yield ps
+        else
+          let freedom xy dxy a =
+            if Set.contains (xy + dxy) free then a+1 else a
+          let aux dxy t =
+            let p = xy + dxy
+            if Set.contains p free then (moves (freedom p) 0, p)::t else t
+          for _, p in List.sort (moves aux []) do
+            yield! search (Set.remove p free) (p::ps) p }
+
+let isSolvable n =
+  let p = Posn(1, 1)
+  let free =
+    set
+      [ for x in 1..n do
+          for y in 1..n do
+            if Posn(x, y) <> p then yield Posn(x, y) ]
+  search free [p] p
+  |> Seq.isEmpty
+  |> not
+
+let run() =
+  let timer = System.Diagnostics.Stopwatch.StartNew()
+  let _ =
+    seq { for n in 1..10 do
+            let p = Posn(1, 1)
+
+            let free =
+              set
+                [ for x in 1..n do
+                    for y in 1..n do
+                      if Posn(x, y) <> p then yield Posn(x, y) ]
+
+            yield! search free [p] p }
+    |> Seq.truncate problemSize
+    |> Seq.length
+  timer.Elapsed.TotalSeconds
+// Real: 00:00:09.714, CPU: 00:00:09.687, GC gen0: 375, gen1: 14, gen2: 0