[pure-lang-svn] SF.net SVN: pure-lang: [340] pure/trunk/examples/libor

[<ye...@us...>]

Revision: 340
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=340&view=rev
Author:   yes
Date:     2008-06-29 18:44:39 -0700 (Sun, 29 Jun 2008)

Log Message:
-----------
created subdir 'libor' in examples with two files: myutils.pure and queens.pure

Added Paths:
-----------
    pure/trunk/examples/libor/myutils.pure
    pure/trunk/examples/libor/queens.pure

Added: pure/trunk/examples/libor/myutils.pure
===================================================================
--- pure/trunk/examples/libor/myutils.pure	                        (rev 0)
+++ pure/trunk/examples/libor/myutils.pure	2008-06-30 01:44:39 UTC (rev 340)
@@ -0,0 +1,31 @@
+// Dr Libor Spacek, 21th May 2008
+
+//General mathematical iterators over one and two indices
+MathIter1 op i1 i2 f = foldl1 op (map f (i1..i2));
+MathIter2 op i1 i2 j1 j2 f = 
+		foldl1 op (map (uncurry f) [x,y; x = i1..i2; y = j1..j2]);
+//Examples on how to use the mathematical iterators
+Sigma i1 i2 f = MathIter1 (+) i1 i2 f;
+Pi i1 i2 f = MathIter1 (*) i1 i2 f;
+Factorial n = Pi 1L n id;
+//Binomial using (k, n-k) symmetry and bignum division
+Binomial n k = (Pi (k+1L) n id) div (Pi 2L (n-k) id) if n-k < k;
+	     = (Pi (n-k+1L) n id) div (Pi 2L k id);
+
+// Euclid's recursive greatest common factor algorithm for ints and bignums
+Gcf x 0 | Gcf x 0L = x;
+Gcf x y = Gcf y (x mod y);
+
+// take the head of a list and put it at the end	
+rotate (h:t) = reverse (h:(reverse t));
+// protate = rotate n items from the front: use when n is positive: 0<=n<=#n
+protate 0 l = l;
+protate n::int l = cat [(drop n l),(take n l)];
+// rotate n items, generalisation of "rotate the bits instruction"
+// example: head (nrotate (-33) (0..23)); 
+// what time is 33 hrs before midnight? 15 hrs. 
+// The clock was moved -33 mod 24 = -9 hours from midnight (0)
+nrotate  n::int l = protate nm l when ll = #l; nm = ll + (n mod ll) end if n<0;
+	          = protate nm l when nm = n mod #l end;
+
+

Added: pure/trunk/examples/libor/queens.pure
===================================================================
--- pure/trunk/examples/libor/queens.pure	                        (rev 0)
+++ pure/trunk/examples/libor/queens.pure	2008-06-30 01:44:39 UTC (rev 340)
@@ -0,0 +1,96 @@
+/* Several Solutions to the Queens Problem  Dr Libor Spacek, 21th May 2008
+   
+   (allqueens n) returns all solutions but is slow
+   (queens n) and (tailqueens n) return one different solution each
+   (thequeens n) does no search and is very fast even for large boards
+   
+Examples:
+ 
+    >allqueens 8; // returns all 92 solutions, as a list of lists
+    >queens 8;    // gives solution number 52 in the allqueens' list,
+    >tailqueens 8; // gives solution no. 89, which is a reflection of no. 52
+    >map succ (thequeens 8); // gives solution no. 56 */
+
+// increment and decrement general utility
+succ x::int = 1+x; pred x::int = x-1;
+
+// row j in current column not attacked by any queens in preceding columns? 
+safe _ _ [] = 1;
+safe id::int j::int (j2::int:l) =  // id is the column positions difference
+	if (j==j2) || (id==j2-j) || (id==j-j2) then 0 else safe (1+id) j l;
+
+allqueens n::int = list (searchall n n []) // returns all possible solutions
+  with
+  	searchall n::int 0 p = p;
+   searchall n::int i::int p = 
+		tuple [searchall n (i-1) (j:p); j = 1..n; safe 1 j p]
+  end;
+  
+// the solution is only the rows permutation, without the ordered columns (1..n) 
+// full 2D board coordinates can be reconstructed with zip (1..n) (queens n); 
+nullary failed;
+queens n::int = list (search n n n [])
+  with
+   search _ 0 _ p = ();  			// last i, solved
+   search _ _ 0 _ = failed;    	// failed, run out of alternative js
+   search n::int i::int j::int p = 
+     if (failed === solution) then search n i (j-1) p else j,solution
+     when solution = search n (i-1) n (j:p); end if safe 1 j p;   	          
+     = search n i (j-1) p	       // also try another j when unsafe
+  end;
+// this concise backtracking tailrecursive version throws a single solution
+tailqueens n::int = catch id (srch n n n []) 
+  with srch _ 0 _ p = throw p; 
+		 srch _ _ 0 _ = failed;
+       srch n::int i::int j::int p = if safe 1 j p then 
+         ( if failed === (srch n (i-1) n (j:p)) then srch n i (j-1) p else () ) 
+       else srch n i (j-1) p
+  end;
+  
+/*
+thequeens encodes my no search solution, which is to my knowledge the simplest 
+known algorithm for this problem.
+There always exists one fundamental centre-symmetrical solution of this form, 
+representing an orbit of just 4 reflected solutions, instead of the usual 8.
+These few lines of code are self-contained (not calling any square checking).
+The solutions had been tested exhaustively for board sizes 0 to 5000 and also
+individually for board size 50000x50000.
+
+Row numbering in 'thequeens' is changed for simplicity to 'C style'  0..n-1 
+Solution using 2D board coordinates (1..n)x(1..n) can be easily reconstructed 
+with: (fullboard (thequeens n)).
+*/
+
+fullboard simple = zip (1..(#simple)) (map succ simple);
+
+nullary nosolution; // returned for n=2 and n=3 when there are no solutions
+
+thequeens n::int = case n of
+	1 = [0];  // trivial solution to one square board
+	2 | 3 = nosolution;
+	n::int = map (newsquare n) (0..(n-1))   // rule for even sized boards n>3
+		with newsquare n::int x::int 
+			= (start+2*x) mod n if x < halfn; // right start square is crucial
+			= (start2+2*(x-halfn)) mod n // centre reflections fill the 2nd half
+		end
+		when 
+      	halfn::int = n div 2;  // local variable halfn 
+      	start::int = if (n mod 3) then (halfn-1) else 1;//(n mod 3) is special
+       	start2::int = n-((start + 2*(halfn-1)) mod n)-1 // start reflections
+		end if (n mod 2) == 0; 			  // even sized boards finished
+     = 0:(map succ (thequeens (n-1))) // corner start 0: solves odd size boards!    
+end; // end of case and thequeens
+  
+
+// The rest are test utilities for the queens problem:
+// checks one queens solution either in 0..7 encoding or in 1..8 encoding.
+// returns 1 for a correct result, including "nosolution" for sizes 2 and 3. 
+// returns 0 if a queen attack exists anywhere in the presented 'solution':
+checkqs [] = 1;
+checkqs (s::int:l) = if safe 1 s l then checkqs l else 0;
+checkqs (nosolution) = 1;
+
+// conducts an exhaustive test of solutions for boards of all listed sizes. 
+// examples of use: >queenstest (1..1000); >queenstest (5000,4999..4990);
+queenstest [] = 1;
+queenstest (h:l) = if checkqs (thequeens h) then queenstest l else 0;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.