Add a GUI. Use FAKE to manage the build and paket for dependencies. master
authorUmmon <greg.burri@gmail.com>
Mon, 18 Jul 2016 22:09:38 +0000 (00:09 +0200)
committerUmmon <greg.burri@gmail.com>
Mon, 18 Jul 2016 22:09:38 +0000 (00:09 +0200)
33 files changed:
.gitignore [new file with mode: 0644]
SudokuSolver.sln [deleted file]
SudokuSolver/GUI.fs [new file with mode: 0644]
SudokuSolver/Program.fs
SudokuSolver/SudokuSolver.fsproj
SudokuSolver/Version1.fs
SudokuSolver/Version2.fs
build.fsx [new file with mode: 0755]
build_debug.sh [new file with mode: 0755]
build_release.sh [new file with mode: 0755]
build_run.sh [new file with mode: 0755]
dependencies.sh [new file with mode: 0755]
paket.dependencies [new file with mode: 0644]
sudokus/empty.txt [new file with mode: 0644]
sudokus/level_9_page_5.txt [new file with mode: 0644]
sudokus/mm_2016_01.txt [new file with mode: 0644]
sudokus/mm_2016_02.txt [new file with mode: 0644]
sudokus/mm_2016_07.txt [new file with mode: 0644]
sudokus/mm_2016_25.txt [new file with mode: 0644]
sudokus/mm_26.txt [new file with mode: 0644]
sudokus/mm_27.txt [new file with mode: 0644]
sudokus/mm_33.txt [new file with mode: 0644]
sudokus/mm_37.txt [new file with mode: 0644]
sudokus/mm_38.txt [new file with mode: 0644]
sudokus/mm_39.txt [new file with mode: 0644]
sudokus/mm_40.txt [new file with mode: 0644]
sudokus/mm_41.txt [new file with mode: 0644]
sudokus/mm_43.txt [new file with mode: 0644]
sudokus/mm_44.txt [new file with mode: 0644]
sudokus/mm_45.txt [new file with mode: 0644]
sudokus/mm_46.txt [new file with mode: 0644]
sudokus/mm_48.txt [new file with mode: 0644]
sudokus/mm_49.txt [new file with mode: 0644]

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..d032f5e
--- /dev/null
@@ -0,0 +1,10 @@
+bin/
+obj/
+*.pub
+*.priv
+*.userprefs
+*.lock
+.fake/
+.paket/
+build/
+packages/
\ No newline at end of file
diff --git a/SudokuSolver.sln b/SudokuSolver.sln
deleted file mode 100644 (file)
index 3e0c525..0000000
+++ /dev/null
@@ -1,17 +0,0 @@
-\r
-Microsoft Visual Studio Solution File, Format Version 12.00\r
-# Visual Studio 2012\r
-Project("{f2a71f9b-5d33-465a-a702-920d77279786}") = "SudokuSolver", "SudokuSolver\SudokuSolver.fsproj", "{244C26E9-4AA3-42E2-BFD9-4CFB848C7230}"\r
-EndProject\r
-Global\r
-       GlobalSection(SolutionConfigurationPlatforms) = preSolution\r
-               Debug|x86 = Debug|x86\r
-               Release|x86 = Release|x86\r
-       EndGlobalSection\r
-       GlobalSection(ProjectConfigurationPlatforms) = postSolution\r
-               {244C26E9-4AA3-42E2-BFD9-4CFB848C7230}.Debug|x86.ActiveCfg = Debug|x86\r
-               {244C26E9-4AA3-42E2-BFD9-4CFB848C7230}.Debug|x86.Build.0 = Debug|x86\r
-               {244C26E9-4AA3-42E2-BFD9-4CFB848C7230}.Release|x86.ActiveCfg = Release|x86\r
-               {244C26E9-4AA3-42E2-BFD9-4CFB848C7230}.Release|x86.Build.0 = Release|x86\r
-       EndGlobalSection\r
-EndGlobal\r
diff --git a/SudokuSolver/GUI.fs b/SudokuSolver/GUI.fs
new file mode 100644 (file)
index 0000000..8da775a
--- /dev/null
@@ -0,0 +1,145 @@
+module SudokuSolver.GUI
+
+open System
+open System.Threading
+open System.Collections.ObjectModel
+
+open Eto
+open Eto.Forms
+open Eto.Drawing
+
+module Solver = Version1
+
+type DigitBox() as this =
+    inherit Panel()
+    let unselectedBgColor = Colors.LightSkyBlue
+    let selectedBgColor = Colors.Blue
+    let digitChanged = new Event<unit>()
+    let mutable manuallyAssigned = false
+    let mutable value = 0
+    let label =
+        new Label(
+            BackgroundColor = Colors.White,
+            Text = " ",
+            TextAlignment = TextAlignment.Center,
+            VerticalAlignment = VerticalAlignment.Center,
+            Font = new Font("Monospace", 18.f))
+
+    do
+        this.Padding <- Padding(2)
+        this.BackgroundColor <- unselectedBgColor
+        this.Content <- label
+
+    member this.Selected
+        with set (value: bool) =
+            this.BackgroundColor <- if value then selectedBgColor else unselectedBgColor
+
+    member this.ManuallyAssigned
+        with get () : bool = manuallyAssigned
+        and private set (value: bool) =
+            label.BackgroundColor <- if value then Colors.Orange else Colors.White
+            manuallyAssigned <- value
+
+    member this.DigitChanged = digitChanged.Publish
+
+    member this.Value = value
+
+    member this.SetValue(v, manuallyAssigned) =
+        if manuallyAssigned || not this.ManuallyAssigned || v = 0 then
+            let changed = value <> v
+            value <- v
+            label.Text <- if value > 0 && value <= 9 then string value else " "
+            this.ManuallyAssigned <- v <> 0 && manuallyAssigned
+            if manuallyAssigned && changed then
+                digitChanged.Trigger()
+
+type Grid() =
+    inherit TableLayout()
+
+type MainForm() as this =
+    inherit Form()
+    do
+        let mutable currentAsync : Async<Solver.Board> option = None
+        let mutable cancellation = new CancellationTokenSource()
+
+        this.Title <- "Sudoku Solver - gburri"
+        this.Size <- Size(400, 400)
+        let digitBoxes = Array2D.init 9 9 (fun _ _ -> new DigitBox())
+
+        let clearComputedDigits () =
+            digitBoxes |> Array2D.iter
+                (fun d ->
+                    if not d.ManuallyAssigned then
+                        d.SetValue(0, false))
+
+        let computeSolution () =
+            cancellation.Cancel()
+            cancellation.Dispose()
+            cancellation <- new CancellationTokenSource()
+            let board =
+                Solver.Board(
+                    digitBoxes
+                    |> Array2D.map (fun d -> if d.ManuallyAssigned then d.Value else 0))
+
+            clearComputedDigits ()
+
+            let token = cancellation.Token
+            async {
+                let! result = board.SolveAsync(token)
+                if not token.IsCancellationRequested then
+                    Application.Instance.Invoke(
+                        fun () ->
+                            if result then
+                                Array2D.iteri (fun i j v -> digitBoxes.[i, j].SetValue(v, false)) board.Values
+                            else
+                                clearComputedDigits ()) }
+            |> Async.Start
+
+        let mutable currentDigitBox = digitBoxes.[0,0]
+        digitBoxes.[0,0].Selected <- true
+        this.KeyDown.Add(
+            fun e ->
+                if e.Key = Keys.Backspace || e.Key = Keys.Delete then
+                    currentDigitBox.SetValue(0, true)
+                else
+                    match Int32.TryParse(e.KeyChar.ToString()) with
+                    | (true, digit) when digit >= 0 && digit <= 9 -> currentDigitBox.SetValue(digit, true)
+                    | _ -> ())
+
+        let setCurrentDigitBox db =
+            if db <> currentDigitBox then
+                currentDigitBox.Selected <- false
+                db.Selected <- true
+                currentDigitBox <- db
+
+        digitBoxes
+        |> Array2D.iter
+            (fun digitBox ->
+                digitBox.MouseDown.Add(fun _ -> setCurrentDigitBox digitBox)
+                digitBox.DigitChanged.Add (fun _ -> computeSolution ()))
+
+        let gridLayout = new Grid()
+
+        for i = 0 to 8 do
+            // Horizontal separations.
+            if i = 3 || i = 6 then
+                let rowSeparation = new TableRow()
+                gridLayout.Rows.Add(rowSeparation)
+                for j = 0 to 10 do
+                    rowSeparation.Cells.Add(new TableCell(new Panel(BackgroundColor = Colors.Black)))
+            let row = new TableRow(ScaleHeight = true)
+            gridLayout.Rows.Add(row)
+            for j = 0 to 8 do
+                // Vertical separations.
+                if j = 3 || j = 6 then
+                    row.Cells.Add(new TableCell(new Panel(BackgroundColor = Colors.Black)))
+                row.Cells.Add(new TableCell(digitBoxes.[i, j], true))
+
+        this.Content <- gridLayout
+        computeSolution ()
+
+let showMainWindow () =
+    use app = new Application()
+    use form = new MainForm()
+    form.Show()
+    app.Run(form) |> ignore
\ No newline at end of file
index 3402bc5..b45930f 100644 (file)
@@ -5,24 +5,37 @@ module Solver = Version1
 open System
 open System.IO
 
-[<EntryPoint>]
-let main argv = 
-    use fs = new FileStream ("../../../sudokus/mm_22.txt", FileMode.Open, FileAccess.Read)
-    use sr = new StreamReader (fs)
-
-    while sr.Peek () <> -1 do
-        let b = Solver.Board sr
-        b.Show System.Console.Out
-
-        printfn "vvvvvvvvvvv"
+let printUsage () =
+    printfn "Usage: %s <suduko file>" System.AppDomain.CurrentDomain.FriendlyName
 
-        let timer = System.Diagnostics.Stopwatch ()
-        timer.Start ()
-
-        if b.Solve () 
-        then b.Show System.Console.Out
-        else printfn "No solution"
-
-        timer.Stop ()
-        printfn "Time: %A ms" timer.ElapsedMilliseconds
-    0
\ No newline at end of file
+[<EntryPoint>]
+let main args =
+    if args.Length = 0 then
+        GUI.showMainWindow ()
+        0
+    elif Array.exists (fun arg -> arg = "-h" || arg = "--help") args then
+        printUsage ()
+        0
+    else
+        for filepath in args do
+            use fs = new FileStream(filepath, FileMode.Open, FileAccess.Read)
+            use sr = new StreamReader(fs)
+
+            printfn "%s" filepath
+            while sr.Peek() <> -1 do
+                let b = Solver.Board sr
+                b.Show System.Console.Out
+
+                printfn "vvvvvvvvvvv"
+
+                let timer = System.Diagnostics.Stopwatch()
+                timer.Start()
+
+                if b.Solve ()
+                then b.Show System.Console.Out
+                else printfn "No solution"
+
+                timer.Stop()
+                printfn "Time: %A ms" timer.ElapsedMilliseconds
+                printfn ""
+        0
\ No newline at end of file
index 631f372..811a75b 100644 (file)
@@ -1,46 +1,93 @@
-<?xml version="1.0" encoding="utf-8"?>\r
-<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">\r
-  <PropertyGroup>\r
-    <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>\r
-    <Platform Condition=" '$(Platform)' == '' ">x86</Platform>\r
-    <ProjectGuid>{244C26E9-4AA3-42E2-BFD9-4CFB848C7230}</ProjectGuid>\r
-    <OutputType>Exe</OutputType>\r
-    <RootNamespace>SudokuSolver</RootNamespace>\r
-    <AssemblyName>SudokuSolver</AssemblyName>\r
-  </PropertyGroup>\r
-  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|x86' ">\r
-    <DebugSymbols>true</DebugSymbols>\r
-    <DebugType>full</DebugType>\r
-    <Optimize>false</Optimize>\r
-    <OutputPath>bin\Debug</OutputPath>\r
-    <DefineConstants>DEBUG</DefineConstants>\r
-    <ErrorReport>prompt</ErrorReport>\r
-    <Externalconsole>true</Externalconsole>\r
-    <Tailcalls>false</Tailcalls>\r
-    <PlatformTarget>x86</PlatformTarget>\r
-  </PropertyGroup>\r
-  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|x86' ">\r
-    <DebugSymbols>false</DebugSymbols>\r
-    <DebugType>none</DebugType>\r
-    <Optimize>true</Optimize>\r
-    <OutputPath>bin\Release</OutputPath>\r
-    <ErrorReport>prompt</ErrorReport>\r
-    <PlatformTarget>x86</PlatformTarget>\r
-    <Externalconsole>true</Externalconsole>\r
-    <Tailcalls>true</Tailcalls>\r
-  </PropertyGroup>\r
-  <ItemGroup>\r
-    <Reference Include="mscorlib" />\r
-    <Reference Include="FSharp.Core" />\r
-    <Reference Include="System" />\r
-    <Reference Include="System.Core" />\r
-    <Reference Include="System.Numerics" />\r
-  </ItemGroup>\r
-  <ItemGroup>\r
-    <Compile Include="AssemblyInfo.fs" />\r
-    <Compile Include="Version1.fs" />\r
-    <Compile Include="Version2.fs" />\r
-    <Compile Include="Program.fs" />\r
-  </ItemGroup>\r
-  <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.1\Framework\v4.0\Microsoft.FSharp.Targets" />\r
+<?xml version="1.0" encoding="utf-8" standalone="yes"?>
+<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+  <PropertyGroup>
+    <Name />
+    <AssemblyName>SudokuSolver</AssemblyName>
+    <RootNamespace>SudokuSolver</RootNamespace>
+    <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+    <Platform Condition=" '$(Platform)' == '' ">x86</Platform>
+    <SchemaVersion>2.0</SchemaVersion>
+    <ProjectGuid>{244C26E9-4AA3-42E2-BFD9-4CFB848C7230}</ProjectGuid>
+    <ProjectType />
+    <OutputType>Exe</OutputType>
+    <TargetFrameworkVersion>v4.5</TargetFrameworkVersion>
+    <TargetFrameworkProfile />
+    <AutoGenerateBindingRedirects />
+    <TargetFSharpCoreVersion />
+    <DocumentationFile />
+    <ProductVersion>8.0.30703</ProductVersion>
+  </PropertyGroup>
+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|x86' ">
+    <DebugSymbols>true</DebugSymbols>
+    <DebugType>Full</DebugType>
+    <Optimize>false</Optimize>
+    <Tailcalls>false</Tailcalls>
+    <OutputPath>bin\Debug</OutputPath>
+    <DefineConstants>DEBUG</DefineConstants>
+    <WarningLevel>
+    </WarningLevel>
+    <PlatformTarget>x86</PlatformTarget>
+    <Prefer32Bit>
+    </Prefer32Bit>
+    <OtherFlags>
+    </OtherFlags>
+  </PropertyGroup>
+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|x86' ">
+    <DebugType>None</DebugType>
+    <Optimize>true</Optimize>
+    <Tailcalls>true</Tailcalls>
+    <OutputPath>bin\Release</OutputPath>
+    <DefineConstants>
+    </DefineConstants>
+    <WarningLevel>
+    </WarningLevel>
+    <PlatformTarget>x86</PlatformTarget>
+    <Prefer32Bit>
+    </Prefer32Bit>
+    <OtherFlags>
+    </OtherFlags>
+  </PropertyGroup>
+  <ItemGroup>
+    <Reference Include="mscorlib" />
+    <Reference Include="FSharp.Core" />
+    <Reference Include="System" />
+    <Reference Include="System.Core" />
+    <Reference Include="System.Numerics" />
+    <Reference Include="Eto">
+      <HintPath>..\packages\Eto.Forms\lib\net45\Eto.dll</HintPath>
+    </Reference>
+    <Reference Include="Eto.Gtk3">
+      <HintPath>..\packages\Eto.Platform.Gtk3\lib\net45\Eto.Gtk3.dll</HintPath>
+    </Reference>
+    <Reference Include="atk-sharp">
+      <HintPath>..\packages\GtkSharp\lib\net45\atk-sharp.dll</HintPath>
+    </Reference>
+    <Reference Include="cairo-sharp">
+      <HintPath>..\packages\GtkSharp\lib\net45\cairo-sharp.dll</HintPath>
+    </Reference>
+    <Reference Include="gdk-sharp">
+      <HintPath>..\packages\GtkSharp\lib\net45\gdk-sharp.dll</HintPath>
+    </Reference>
+    <Reference Include="gio-sharp">
+      <HintPath>..\packages\GtkSharp\lib\net45\gio-sharp.dll</HintPath>
+    </Reference>
+    <Reference Include="glib-sharp">
+      <HintPath>..\packages\GtkSharp\lib\net45\glib-sharp.dll</HintPath>
+    </Reference>
+    <Reference Include="gtk-sharp">
+      <HintPath>..\packages\GtkSharp\lib\net45\gtk-sharp.dll</HintPath>
+    </Reference>
+    <Reference Include="pango-sharp">
+      <HintPath>..\packages\GtkSharp\lib\net45\pango-sharp.dll</HintPath>
+    </Reference>
+  </ItemGroup>
+  <ItemGroup>
+    <Compile Include="AssemblyInfo.fs" />
+    <Compile Include="Version1.fs" />
+    <Compile Include="Version2.fs" />
+    <Compile Include="GUI.fs" />
+    <Compile Include="Program.fs" />
+  </ItemGroup>
+  <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.1\Framework\v4.0\Microsoft.FSharp.Targets" />
+  <Import Project="..\packages\GtkSharp\build\net45\GtkSharp.targets" Condition="Exists('..\packages\GtkSharp.3.1.3\build\net45\GtkSharp.targets')" />
 </Project>
\ No newline at end of file
index f0216ad..86f50d0 100644 (file)
 module SudokuSolver.Version1
 
 open System
+open System.Threading
 open System.IO
 open System.Collections.Generic
 
-let printUsage progname = 
+let printUsage progname =
     printfn "Usage: %A <filename>" progname
 
-type Pos = 
-    { i: int; j: int }
-    member this.Next : Pos option = 
-        match this with
-        | { i = 8; j = 8 } -> None
-        | { i = i; j = 8 } -> Some { i = i + 1; j = 0 }
-        | { i = _; j = j } -> Some { this with j = j + 1 }
-
-let zoneRange c = 
+[<Struct>]
+type Pos (i: int, j: int) =
+    member this.I = i
+    member this.J = j
+    member this.Next : Pos option =
+        match this.I, this.J with
+        | 8, 8 -> None
+        | _, 8 -> Some (Pos(this.I + 1, 0))
+        | _ -> Some (Pos(this.I, this.J + 1))
+    override this.ToString() =
+        sprintf "Pos(i = %i, j = %i)" this.I this.J
+
+let zoneRange c =
     match c with
-    | 0 | 1 | 2 -> [0 .. 2]
-    | 3 | 4 | 5 -> [3 .. 5]
-    | _ -> [6 .. 8]
+    | 0 | 1 | 2 -> [ 0 .. 2 ]
+    | 3 | 4 | 5 -> [ 3 .. 5 ]
+    | _ -> [ 6 .. 8 ]
 
 // All possible positions.
-let AllPos = seq {
+let allPos = [
     for i in 0 .. 8 do
-       for j in 0 .. 8 -> { i = i; j = j } }
+       for j in 0 .. 8 -> Pos(i, j) ]
+
+let size = 9
 
-type Board (values : seq<int>) =
-    let size = 9
+type Board (values: int [,]) =
     let board = Array2D.create size size 0
 
     do
-        Seq.take (size * size) values |> Seq.zip AllPos |> Seq.iter (fun ({ i = iVal; j = jVal}, value) -> 
-            board.[iVal, jVal] <- value)
+        Array2D.blit values 0 0 board 0 0 size size
 
-    let get pos = board.[pos.i, pos.j]
-    let set pos value = board.[pos.i, pos.j] <- value
+    let get (pos: Pos) = board.[pos.I, pos.J]
+    let set (pos: Pos) (value: int) = board.[pos.I, pos.J] <- value
 
-    let rec nextFree (pos : Pos) : Pos option =
+    let rec nextFree (pos: Pos) : Pos option =
         match pos.Next with
         | Some pos -> if get pos = 0 then Some pos else nextFree pos
         | _ -> None
 
-    let isValid pos n =
-        List.forall (fun j -> get { pos with j = j } <> n) [0 .. 8] && 
-        List.forall (fun i -> get { pos with i = i } <> n) [0 .. 8] &&
-        List.forall (fun (i, j) -> get { i = i; j = j } <> n) [ 
-            for i' in zoneRange pos.i do
-                for j' in zoneRange pos.j -> i', j' ]
+    let isValid (pos: Pos) (n: int) =
+        List.forall (fun j -> if j = pos.J then true else get (Pos(pos.I, j)) <> n) [ 0 .. 8 ] &&
+        List.forall (fun i -> if i = pos.I then true else get (Pos(i, pos.J)) <> n) [ 0 .. 8 ] &&
+        List.forall (fun (i, j) -> if i = pos.I && j = pos.J then true else get (Pos(i, j)) <> n) [
+            for i' in zoneRange pos.I do
+                for j' in zoneRange pos.J -> i', j' ]
 
-    let validNumbers pos =
-        [
-            let valid = isValid pos
-            for n in 1 .. 9 do
-                if valid n then yield n ]
+    let validNumbers pos = seq {
+        let valid = isValid pos
+        for n in 1 .. 9 do
+            if valid n then yield n }
 
-    let show (output : TextWriter) =
+    let show (output: TextWriter) =
         for i in 0 .. size - 1 do
             for j in 0 .. size - 1 do
-                if board.[i, j] = 0
-                then output.Write '.' 
+                if board.[i, j] = 0 then output.Write '.'
                 else output.Write board.[i, j]
                 if (j + 1) % 3 = 0 && j <> size - 1 then
                     output.Write '|'
-            output.WriteLine ()
+            output.WriteLine()
             if (i + 1) % 3 = 0 && i <> size - 1 then
-                output.WriteLine "-----------"         
-
+                output.WriteLine "-----------"
 
     let presolve () =
         let (|OnlyOneNumber|_|) (pos : Pos) =
-            if get pos <> 0
-            then None
+            if get pos <> 0 then
+                None
             else
                 let numbers = Array.create 10 false
-                let nb = ref 0
-                let add n = 
-                    if not numbers.[n]
-                    then
+                let mutable nb = 0
+                let add n =
+                    if not numbers.[n] then
                         numbers.[n] <- true
-                        nb := !nb + 1
+                        nb <- nb + 1
 
-                for i in 0 .. 8 do get { pos with i = i } |> add
-                for j in 0 .. 8 do get { pos with j = j } |> add
-                for i in zoneRange pos.i do
-                    for j in zoneRange pos.j do
-                        get { i = i; j = j } |> add
+                for i in 0 .. 8 do get (Pos(i, pos.J)) |> add
+                for j in 0 .. 8 do get (Pos(pos.I, j)) |> add
+                for i in zoneRange pos.I do
+                    for j in zoneRange pos.J do
+                        get (Pos(i, j)) |> add
 
-                match !nb with
-                | 9 -> try Some (Array.findIndex not numbers) with _ -> None
+                match nb with
+                | 9 -> Array.tryFindIndex not numbers
                 | 10 -> None
                 | _ ->
                     // For all remaining numbers.
-                    let remainingNumbers = Array.mapi (fun i p -> i, p) numbers 
-                                            |> Array.fold (fun acc (i, p) -> if not p then i :: acc else acc) []
+                    let remainingNumbers = Array.mapi(fun i p -> i, p) numbers
+                                            |> Array.fold(fun acc (i, p) -> if not p then i :: acc else acc) []
 
                     let rec findNumber numbers =
                         match numbers with
@@ -102,18 +103,18 @@ type Board (values : seq<int>) =
                             // If there is no other valid position, then the current is the only one.
                             if seq {
                                     for i in 0 .. 8 do
-                                        let pos' = { pos with i = i }
-                                        if i <> pos.i && get pos' = 0
+                                        let pos' = Pos(i, pos.J)
+                                        if i <> pos.I && get pos' = 0
                                         then yield not (isValid pos' n) } |> Seq.forall id ||
                                seq {
                                     for j in 0 .. 8 do
-                                        let pos' = { pos with j = j }
-                                        if j <> pos.j && get pos' = 0
+                                        let pos' = Pos(pos.I, j)
+                                        if j <> pos.J && get pos' = 0
                                         then yield not (isValid pos' n) } |> Seq.forall id ||
                                seq {
-                                    for i in zoneRange pos.i do
-                                        for j in zoneRange pos.j do
-                                            let pos' = { i = i; j = j }
+                                    for i in zoneRange pos.I do
+                                        for j in zoneRange pos.J do
+                                            let pos' = Pos(i, j)
                                             if pos' <> pos && get pos' = 0
                                             then yield not (isValid pos' n) } |> Seq.forall id
                             then Some n
@@ -121,31 +122,54 @@ type Board (values : seq<int>) =
 
                     findNumber remainingNumbers
 
-        while Seq.exists (fun pos -> 
+        while allPos |> List.exists (fun pos ->
             match pos with
             | OnlyOneNumber n -> set pos n; true
-            | _ -> false) AllPos do ()
-
-    new (input : TextReader) =
-        Board (seq {
-            while input.Peek () <> -1 do
-                match char (input.Read ()) with
-                | ' ' | '.' | '0' -> yield 0
-                | a when Char.IsDigit a -> yield int (Char.GetNumericValue a)
-                | _ -> () } |> Seq.take 81)
+            | _ -> false) do ()
+
+    new (input: TextReader) =
+        let matrix = Array2D.create size size 0
+        [ while input.Peek () <> -1 do
+                    match char (input.Read()) with
+                    | ' ' | '.' | '0' -> yield 0
+                    | a when Char.IsDigit a -> yield int (Char.GetNumericValue a)
+                    | _ -> () ]
+        |> List.take (size * size)
+        |> List.zip allPos
+        |> List.iter(fun (pos, value) -> matrix.[pos.I, pos.J] <- value)
+        Board(matrix)
 
     member this.Show = show
-    
-    member this.Solve () =
-        let rec solveFrom pos : bool = // Returns true if the solution is valid and complete.
-            match nextFree pos with
-            | Some pos' -> 
-                if List.exists (fun n -> set pos' n; solveFrom pos') (validNumbers pos')
-                then true
-                else 
-                    set pos' 0
+
+    member this.Values : int [,] =
+        Array2D.copy board
+
+    member this.SolveAsync (token: CancellationToken) : Async<bool> =
+        async {
+            let rec solveFrom pos : bool = // Returns true if the solution is valid and complete.
+                if token.IsCancellationRequested then
+                    false
+                else
+                    match nextFree pos with
+                    | Some pos' ->
+                        if validNumbers pos' |> Seq.exists (fun n -> set pos' n; solveFrom pos') then
+                            true
+                        else
+                            set pos' 0
+                            false
+                    | _ -> true
+            let valid =
+                allPos |> List.forall (
+                    fun p ->
+                        let n = get p
+                        if n = 0 then true else isValid p n)
+            return
+                if not valid then
                     false
-            | _ -> true
-        presolve ()
-        solveFrom { i = 0; j = -1 }
+                else
+                    presolve ()
+                    solveFrom (Pos(0, -1)) }
 
+    member this.Solve () : bool =
+        let cancellation = new CancellationTokenSource()
+        this.SolveAsync(cancellation.Token) |> Async.RunSynchronously
\ No newline at end of file
index a05d072..bf57411 100644 (file)
@@ -1,150 +1 @@
 module SudokuSolver.Version2
-
-open System
-open System.IO
-open System.Collections.Generic
-
-let printUsage progname = 
-    printfn "Usage: %A <filename>" progname
-
-type Pos = 
-    { i: int; j: int }
-    member this.Next : Pos option = 
-        match this with
-        | { i = 8; j = 8 } -> None
-        | { i = i; j = 8 } -> Some { i = i + 1; j = 0 }
-        | { i = _; j = j } -> Some { this with j = j + 1 }
-
-let zoneRange c = 
-    match c with
-    | 0 | 1 | 2 -> [0 .. 2]
-    | 3 | 4 | 5 -> [3 .. 5]
-    | _ -> [6 .. 8]
-
-// All possible positions.
-let AllPos = seq {
-    for i in 0 .. 8 do
-       for j in 0 .. 8 -> { i = i; j = j } }
-
-type Board (values : seq<int>) =
-    let size = 9
-    let board = Array2D.create size size 0
-
-    do
-        Seq.take (size * size) values |> Seq.zip AllPos |> Seq.iter (fun ({ i = iVal; j = jVal}, value) -> 
-            board.[iVal, jVal] <- value)
-
-    let get pos = board.[pos.i, pos.j]
-    let set pos value = board.[pos.i, pos.j] <- value
-
-    let rec nextFree (pos : Pos) : Pos option =
-        match pos.Next with
-        | Some pos -> if get pos = 0 then Some pos else nextFree pos
-        | _ -> None
-
-    let isValid pos n =
-        List.forall (fun j -> get { pos with j = j } <> n) [0 .. 8] && 
-        List.forall (fun i -> get { pos with i = i } <> n) [0 .. 8] &&
-        List.forall (fun (i, j) -> get { i = i; j = j } <> n) [ 
-            for i' in zoneRange pos.i do
-                for j' in zoneRange pos.j -> i', j' ]
-
-    let validNumbers pos =
-        [
-            let valid = isValid pos
-            for n in 1 .. 9 do
-                if valid n then yield n ]
-
-    let show (output : TextWriter) =
-        for i in 0 .. size - 1 do
-            for j in 0 .. size - 1 do
-                if board.[i, j] = 0
-                then output.Write '.' 
-                else output.Write board.[i, j]
-                if (j + 1) % 3 = 0 && j <> size - 1 then
-                    output.Write '|'
-            output.WriteLine ()
-            if (i + 1) % 3 = 0 && i <> size - 1 then
-                output.WriteLine "-----------"         
-
-
-    let presolve () =
-        let (|OnlyOneNumber|_|) (pos : Pos) =
-            if get pos <> 0
-            then None
-            else
-                let numbers = Array.create 10 false
-                let nb = ref 0
-                let add n = 
-                    if not numbers.[n]
-                    then
-                        numbers.[n] <- true
-                        nb := !nb + 1
-
-                for i in 0 .. 8 do get { pos with i = i } |> add
-                for j in 0 .. 8 do get { pos with j = j } |> add
-                for i in zoneRange pos.i do
-                    for j in zoneRange pos.j do
-                        get { i = i; j = j } |> add
-
-                match !nb with
-                | 9 -> try Some (Array.findIndex not numbers) with _ -> None
-                | 10 -> None
-                | _ ->
-                    // For all remaining numbers.
-                    let remainingNumbers = Array.mapi (fun i p -> i, p) numbers 
-                                            |> Array.fold (fun acc (i, p) -> if not p then i :: acc else acc) []
-
-                    let rec findNumber numbers =
-                        match numbers with
-                        | [] -> None
-                        | n :: tail ->
-                            // If there is no other valid position, then the current is the only one.
-                            if seq {
-                                    for i in 0 .. 8 do
-                                        let pos' = { pos with i = i }
-                                        if i <> pos.i && get pos' = 0
-                                        then yield not (isValid pos' n) } |> Seq.forall id ||
-                               seq {
-                                    for j in 0 .. 8 do
-                                        let pos' = { pos with j = j }
-                                        if j <> pos.j && get pos' = 0
-                                        then yield not (isValid pos' n) } |> Seq.forall id ||
-                               seq {
-                                    for i in zoneRange pos.i do
-                                        for j in zoneRange pos.j do
-                                            let pos' = { i = i; j = j }
-                                            if pos' <> pos && get pos' = 0
-                                            then yield not (isValid pos' n) } |> Seq.forall id
-                            then Some n
-                            else findNumber tail
-
-                    findNumber remainingNumbers
-
-        while Seq.exists (fun pos -> 
-            match pos with
-            | OnlyOneNumber n -> set pos n; true
-            | _ -> false) AllPos do ()
-
-    new (input : TextReader) =
-        Board (seq {
-            while input.Peek () <> -1 do
-                match char (input.Read ()) with
-                | ' ' | '.' | '0' -> yield 0
-                | a when Char.IsDigit a -> yield int (Char.GetNumericValue a)
-                | _ -> () } |> Seq.take 81)
-
-    member this.Show = show
-    
-    member this.Solve () =
-        let rec solveFrom pos : bool = // Returns true if the solution is valid and complete.
-            match nextFree pos with
-            | Some pos' -> 
-                if List.exists (fun n -> set pos' n; solveFrom pos') (validNumbers pos')
-                then true
-                else 
-                    set pos' 0
-                    false
-            | _ -> true
-        presolve ()
-        solveFrom { i = 0; j = -1 }
diff --git a/build.fsx b/build.fsx
new file mode 100755 (executable)
index 0000000..e0e2d12
--- /dev/null
+++ b/build.fsx
@@ -0,0 +1,37 @@
+#!/usr/bin/fsharpi
+
+#I "packages/FAKE/tools/"
+#r @"packages/FSharp.Compiler.Service/lib/net45/FSharp.Compiler.Service.dll"
+#r @"packages/FAKE/tools/FakeLib.dll"
+
+open System.Diagnostics
+open Fake
+open Fake.EnvironmentHelper
+
+let buildDirDebug = "./build/Debug/"
+let buildDirRelease = "./build/Release/"
+
+Target "Clean" (fun _ ->
+    trace "Cleaning..."
+    CleanDir buildDirDebug
+    CleanDir buildDirRelease
+)
+
+Target "Debug" (fun _ ->
+    trace "Building in Debug mode..."
+    !! "**/*.fsproj" |> MSBuildDebug buildDirDebug "Build" |> Log "Debug-Output:"
+)
+
+Target "Release" (fun _ ->
+    trace "Building in Release mode..."
+    !! "**/*.fsproj" |> MSBuildRelease buildDirRelease "Build" |> Log "Release-Output:"
+)
+
+Target "Deploy" (fun _ ->
+    trace "Deployement..."
+)
+
+"Clean" ==> "Release"
+"Release" ==> "Deploy"
+
+RunTargetOrDefault "Debug"
diff --git a/build_debug.sh b/build_debug.sh
new file mode 100755 (executable)
index 0000000..723ef96
--- /dev/null
@@ -0,0 +1,3 @@
+#!/usr/bin/env bash
+
+packages/FAKE/tools/FAKE.exe build.fsx debug
diff --git a/build_release.sh b/build_release.sh
new file mode 100755 (executable)
index 0000000..cc0440d
--- /dev/null
@@ -0,0 +1,7 @@
+#!/usr/bin/env bash
+
+./dependencies.sh
+
+chmod u+x packages/FAKE/tools/FAKE.exe
+
+packages/FAKE/tools/FAKE.exe build.fsx release
diff --git a/build_run.sh b/build_run.sh
new file mode 100755 (executable)
index 0000000..190cda6
--- /dev/null
@@ -0,0 +1,3 @@
+#!/usr/bin/env bash
+
+./build_debug.sh && mono build/Debug/SudokuSolver.exe #sudokus/mm_2016_25.txt
diff --git a/dependencies.sh b/dependencies.sh
new file mode 100755 (executable)
index 0000000..b0dbb0e
--- /dev/null
@@ -0,0 +1,19 @@
+#!/usr/bin/env bash
+
+if [ ! -d .paket ]; then
+    echo "Installing Paket"
+    mkdir .paket
+    curl https://github.com/fsprojects/Paket/releases/download/1.4.0/paket.bootstrapper.exe -L --insecure -o .paket/paket.bootstrapper.exe
+    chmod u+x .paket/paket.bootstrapper.exe
+    .paket/paket.bootstrapper.exe
+    chmod u+x .paket/paket.exe
+    chmod u+x packages/FAKE/tools/FAKE.exe
+fi
+
+if [ ! -f paket.lock ]; then
+    echo "Installing dependencies"
+    .paket/paket.exe install
+else
+    echo "Restoring dependencies"
+    .paket/paket.exe restore
+fi
diff --git a/paket.dependencies b/paket.dependencies
new file mode 100644 (file)
index 0000000..207bf3e
--- /dev/null
@@ -0,0 +1,7 @@
+source https://www.nuget.org/api/v2
+
+nuget FSharp.Compiler.Service
+nuget FAKE
+nuget Eto.Forms
+nuget Eto.Platform.Gtk3
+nuget GtkSharp
\ No newline at end of file
diff --git a/sudokus/empty.txt b/sudokus/empty.txt
new file mode 100644 (file)
index 0000000..3e854c4
--- /dev/null
@@ -0,0 +1,11 @@
+...|...|...
+...|...|...
+...|...|...
+-----------
+...|...|...
+...|...|...
+...|...|...
+-----------
+...|...|...
+...|...|...
+...|...|...
\ No newline at end of file
diff --git a/sudokus/level_9_page_5.txt b/sudokus/level_9_page_5.txt
new file mode 100644 (file)
index 0000000..2d3e47a
--- /dev/null
@@ -0,0 +1,11 @@
+.84|...|..5
+3..|.9.|6..
+2..|4..|.1.
+-----------
+..5|...|...
+.6.|.1.|.8.
+...|...|9..
+-----------
+.9.|..8|..2
+..3|.2.|..7
+4..|...|36.
\ No newline at end of file
diff --git a/sudokus/mm_2016_01.txt b/sudokus/mm_2016_01.txt
new file mode 100644 (file)
index 0000000..89d9e71
--- /dev/null
@@ -0,0 +1,11 @@
+...|1..|3..
+.8.|4..|.7.
+9.1|.6.|5..
+-----------
+...|7.8|.62
+..8|...|9..
+52.|3.4|...
+-----------
+..7|.8.|6.3
+.1.|..7|.4.
+..2|..6|...
\ No newline at end of file
diff --git a/sudokus/mm_2016_02.txt b/sudokus/mm_2016_02.txt
new file mode 100644 (file)
index 0000000..e99af02
--- /dev/null
@@ -0,0 +1,11 @@
+2..|...|..4
+..5|298|1..
+.6.|...|.7.
+-----------
+.2.|.1.|.8.
+.9.|6.3|.1.
+.4.|.7.|.9.
+-----------
+.5.|...|.3.
+..9|834|5..
+7..|...|..9
\ No newline at end of file
diff --git a/sudokus/mm_2016_07.txt b/sudokus/mm_2016_07.txt
new file mode 100644 (file)
index 0000000..7de755e
--- /dev/null
@@ -0,0 +1,11 @@
+.51|7.9|84.
+..3|...|7..
+...|3.4|...
+-----------
+7.6|.1.|3.2
+...|2.3|...
+3.5|.6.|9.4
+-----------
+...|9.1|...
+..4|...|1..
+.67|5.8|42.
\ No newline at end of file
diff --git a/sudokus/mm_2016_25.txt b/sudokus/mm_2016_25.txt
new file mode 100644 (file)
index 0000000..96afcd8
--- /dev/null
@@ -0,0 +1,11 @@
+.4.|2..|1..
+..8|..5|..4
+3..|.9.|.2.
+-----------
+.3.|9.1|..7
+..7|.5.|2..
+5..|6.4|.1.
+-----------
+.7.|.4.|..2
+1..|8..|5..
+..3|..7|.8.
\ No newline at end of file
diff --git a/sudokus/mm_26.txt b/sudokus/mm_26.txt
new file mode 100644 (file)
index 0000000..c9232b9
--- /dev/null
@@ -0,0 +1,11 @@
+   |1 2|   
+5  |8 7| 4 
+  4|  6|7  
+-----------
+641|   | 32
+   |   |   
+72 |   |916
+-----------
+  6|5  |1  
+ 8 |7 4| 5 
+   |2 3|   
\ No newline at end of file
diff --git a/sudokus/mm_27.txt b/sudokus/mm_27.txt
new file mode 100644 (file)
index 0000000..2464847
--- /dev/null
@@ -0,0 +1,11 @@
+   | 1 |   
+17 |   | 24
+  9|7 3|1  
+-----------
+  5| 4 |8  
+3  |621|  9
+  1| 7 |2  
+-----------
+  2|4 8|3  
+91 |   | 87
+   | 6 |   
\ No newline at end of file
diff --git a/sudokus/mm_33.txt b/sudokus/mm_33.txt
new file mode 100644 (file)
index 0000000..9af391c
--- /dev/null
@@ -0,0 +1,11 @@
+ 48|   |7 2
+7  |94 |   
+9  |   |  6
+-----------
+ 3 | 9 |   
+ 9 |168| 3 
+   | 2 | 5 
+-----------
+1  |   |  9
+   | 83|  1
+2 7|   |86 
\ No newline at end of file
diff --git a/sudokus/mm_37.txt b/sudokus/mm_37.txt
new file mode 100644 (file)
index 0000000..7b11859
--- /dev/null
@@ -0,0 +1,11 @@
+  7| 8 |92 
+ 51|   | 86
+49 | 6 |  3
+-----------
+   |2  |   
+8 4|   |5 9
+   |  1|   
+-----------
+5  | 9 | 71
+78 |   |46 
+ 13| 2 |8  
\ No newline at end of file
diff --git a/sudokus/mm_38.txt b/sudokus/mm_38.txt
new file mode 100644 (file)
index 0000000..8f0e7d0
--- /dev/null
@@ -0,0 +1,11 @@
+ 6 |1 2| 3 
+54 |   | 82
+   | 7 |   
+-----------
+6  | 3 |  8
+  9|7 8|2  
+3  | 5 |  4
+-----------
+   | 9 |   
+72 |   | 19
+ 8 |4 1| 5 
\ No newline at end of file
diff --git a/sudokus/mm_39.txt b/sudokus/mm_39.txt
new file mode 100644 (file)
index 0000000..1ff483b
--- /dev/null
@@ -0,0 +1,11 @@
+.4.|2..|...
+...|.5.|2.6
+.1.|9.3|...
+-----------
+..2|.4.|9.3
+.3.|1.6|.5.
+4.7|.2.|8..
+-----------
+...|4.1|.3.
+5.4|.3.|...
+...|..2|.8.
\ No newline at end of file
diff --git a/sudokus/mm_40.txt b/sudokus/mm_40.txt
new file mode 100644 (file)
index 0000000..bf5936c
--- /dev/null
@@ -0,0 +1,11 @@
+..7|...|3..
+...|5.1|...
+1..|687|..9
+-----------
+.38|...|41.
+..1|...|7..
+.54|...|62.
+-----------
+8..|793|..4
+...|2.4|...
+..2|...|1..
\ No newline at end of file
diff --git a/sudokus/mm_41.txt b/sudokus/mm_41.txt
new file mode 100644 (file)
index 0000000..35dcb09
--- /dev/null
@@ -0,0 +1,11 @@
+..3|1.5|...
+.9.|..6|...
+76.|...|.91
+-----------
+...|.8.|2.5
+..8|9.4|1..
+6.4|.1.|...
+-----------
+94.|...|.38
+...|8..|.6.
+...|2.7|5..
\ No newline at end of file
diff --git a/sudokus/mm_43.txt b/sudokus/mm_43.txt
new file mode 100644 (file)
index 0000000..afd1098
--- /dev/null
@@ -0,0 +1,11 @@
+.2.|.5.|.4.
+...|9.7|...
+.9.|81.|.5.
+-----------
+.3.|...|16.
+8.6|...|9.4
+.74|...|.3.
+-----------
+.6.|.24|.9.
+...|5.3|...
+.5.|.7.|.8.
\ No newline at end of file
diff --git a/sudokus/mm_44.txt b/sudokus/mm_44.txt
new file mode 100644 (file)
index 0000000..117934d
--- /dev/null
@@ -0,0 +1,11 @@
+...|2..|...
+4..|6.3|..5
+52.|..7|.34
+-----------
+.65|...|.27
+...|4.9|...
+71.|...|38.
+-----------
+24.|8..|.51
+6..|3.5|..2
+...|..1|...
\ No newline at end of file
diff --git a/sudokus/mm_45.txt b/sudokus/mm_45.txt
new file mode 100644 (file)
index 0000000..ba475b6
--- /dev/null
@@ -0,0 +1,11 @@
+.7.|...|34.
+4..|..5|..8
+...|8.6|..9
+-----------
+..8|6.3|17.
+...|...|...
+.23|9.1|6..
+-----------
+7..|5.2|...
+3..|4..|..1
+.12|...|.5.
\ No newline at end of file
diff --git a/sudokus/mm_46.txt b/sudokus/mm_46.txt
new file mode 100644 (file)
index 0000000..f777f65
--- /dev/null
@@ -0,0 +1,11 @@
+..6|...|...
+.7.|81.|43.
+.3.|..5|..2
+-----------
+..8|164|.7.
+.2.|...|.4.
+.5.|328|1..
+-----------
+9..|6..|.1.
+.12|.43|.6.
+...|...|8..
\ No newline at end of file
diff --git a/sudokus/mm_48.txt b/sudokus/mm_48.txt
new file mode 100644 (file)
index 0000000..5b4f772
--- /dev/null
@@ -0,0 +1,11 @@
+.1.|...|...
+...|2.8|7.5
+.83|4..|2..
+-----------
+.6.|3.1|87.
+...|9.6|...
+.35|8.7|.6.
+-----------
+..7|..9|64.
+4.6|7.2|...
+...|...|.8.
\ No newline at end of file
diff --git a/sudokus/mm_49.txt b/sudokus/mm_49.txt
new file mode 100644 (file)
index 0000000..0bf82dd
--- /dev/null
@@ -0,0 +1,11 @@
+..2|.5.|8..
+...|..9|...
+81.|.37|.96
+-----------
+.53|...|...
+9.6|...|2.3
+...|...|17.
+-----------
+26.|39.|.48
+...|1..|...
+..5|.7.|6..
\ No newline at end of file