Merge pull request #117 from shwestrick/nqueens

nqueens example

examples/Makefile

@@ -10,7 +10,8 @@ PROGRAMS= \
 	ray \
 	tokens \
 	nn \
-	dedup
+	dedup \
+	nqueens
 
 all: $(PROGRAMS)
 

examples/README.md

@@ -17,6 +17,17 @@ $ ./fib @mpl procs 4 -- -N 39
 ```
 This is not very practical but is a good demonstration of the basics of using MPL.
 
+## N Queens
+
+Calculate the number of unique solutions to the
+[N Queens problem](https://en.wikipedia.org/wiki/Eight_queens_puzzle).
+For example, the number of solutions on a board of size 13x13 using 4
+processors:
+```
+$ make nqueens
+$ ./nqueens @mpl procs 4 -- -N 13
+```
+
 ## Random Data
 
 Generate an array of pseudo-random 64-bit words. Seed the randomness with

examples/src/lib/FuncSequence.sml

@@ -0,0 +1,46 @@
+structure FuncSequence:
+sig
+  type 'a t
+  type 'a seq = 'a t
+
+  val empty: unit -> 'a seq
+  val length: 'a seq -> int
+  val take: 'a seq -> int -> 'a seq
+  val drop: 'a seq -> int -> 'a seq
+  val nth: 'a seq -> int -> 'a
+  val iterate: ('b * 'a -> 'b) -> 'b -> 'a seq -> 'b
+  val tabulate: (int -> 'a) -> int -> 'a seq
+  val reduce: ('a * 'a -> 'a) -> 'a -> 'a seq -> 'a
+end =
+struct
+  (* (i, j, f) defines the sequence [ f(k) : i <= k < j ] *)
+  type 'a t = int * int * (int -> 'a)
+  type 'a seq = 'a t
+
+  fun empty () = (0, 0, fn _ => raise Subscript)
+  fun length (i, j, _) = j - i
+  fun nth (i, j, f) k = f (i+k)
+  fun take (i, j, f) k = (i, i+k, f)
+  fun drop (i, j, f) k = (i+k, j, f)
+
+  fun tabulate f n = (0, n, f)
+
+  fun iterate f b s =
+    if length s = 0 then b
+    else iterate f (f (b, nth s 0)) (drop s 1)
+
+  fun reduce f b s =
+    case length s of
+      0 => b
+    | 1 => nth s 0
+    | n => let
+             val half = n div 2
+             val (l, r) =
+               ForkJoin.par (fn _ => reduce f b (take s half),
+                             fn _ => reduce f b (drop s half))
+           in
+             f (l, r)
+           end
+end
+
+

examples/src/lib/sources.mlb

@@ -5,6 +5,7 @@ CommandLineArgs.sml
 Util.sml
 SeqBasis.sml
 Seq.sml
+FuncSequence.sml
 BinarySearch.sml
 Merge.sml
 Quicksort.sml

examples/src/nqueens.mlb

@@ -0,0 +1,2 @@
+lib/sources.mlb
+nqueens.sml

examples/src/nqueens.sml

@@ -0,0 +1,38 @@
+type board = (int * int) list
+
+fun threatened (i,j) [] = false
+  | threatened (i,j) ((x,y)::Q) =
+    i = x orelse j = y orelse i-j = x-y orelse i+j = x+y
+    orelse threatened (i,j) Q
+
+structure Seq = FuncSequence
+
+fun countSol n =
+  let
+    fun search i b =
+      if i >= n then 1 else
+      let
+        fun tryCol j =
+          if threatened (i, j) b then 0 else search (i+1) ((i,j)::b)
+      in
+        if i >= 3 then
+          (* if we're already a few levels deep, then just go sequential *)
+          Seq.iterate op+ 0 (Seq.tabulate tryCol n)
+        else
+          Seq.reduce op+ 0 (Seq.tabulate tryCol n)
+      end
+  in
+    search 0 []
+  end
+
+val n = CommandLineArgs.parseInt "N" 13
+val _ = print ("counting number of " ^
+               Int.toString n ^ "x" ^ Int.toString n ^ " solutions\n")
+
+val t0 = Time.now ()
+val result = countSol n
+val t1 = Time.now ()
+
+val _ = print ("finished in " ^ Time.fmt 4 (Time.- (t1, t0)) ^ "s\n")
+
+val _ = print ("result " ^ Int.toString result ^ "\n")