(*-------------------------------------------------------- A Angg ----*)
(*		   On Her Majesty's Secret Service		      *)
val Log="qs.ml.txt"				  val Date="14 Dec 2006"
(*--------------------------------------------------------------------*)
exception Botq and Drop and Hunt and NoBoard and NoData and NoMatch and
	NotFull and OutofRange and See and Take and CM and Q18 and Q19

fun daT D = case D of  7 =>  40  |  11 =>   2680  |  15 =>   2279184
	|  4 =>  2  |  8 =>  92  |  12 =>  14200  |  16 =>  14772512
	|  5 => 10  |  9 => 352  |  13 =>  73712  |  17 =>  95815104
	|  6 =>  4  | 10 => 724  |  14 => 365596  |  18 => 666090624
	|  _ => raise NoData			  (* 19 = 4968057848 *)
fun length xs = let fun leng n(_::ys)= leng(n+1)ys
		    |   leng n  [ ]  = n
		in leng 0 xs
		end					val len = length
fun diM D = let val d = Int.toString D  in  (d^"x"^d)  end
fun chqed (q::qs) D = q<D+1  andalso  q>0  andalso chqed qs D
|   chqed   [ ]   D = true
fun it_is_a_full board D = length board = D
fun add_a_queen_on board = 1 :: board

fun kill (p, q, r, x::qs) = x=p orelse x=q orelse x=r orelse
   kill (p-1, q, r+1, qs)
|   kill (p, q,  r,  [ ]) = false

fun new_queen_safe_on (q::qs) = not (kill (q-1, q, q+1, qs))
|   new_queen_safe_on   [ ]   = true
fun all_queens_safe_on  [ ]   = true
|   all_queens_safe_on board  = new_queen_safe_on board  andalso
    all_queens_safe_on(tl board)
fun legal board D = all_queens_safe_on board  andalso  chqed board D
fun full board = legal board (length board)
fun Full board = if full board   then board   else raise NotFull

fun another(q::p::xs)D= if q=p-2  then
			if q<D-3  then q+4::p::xs  else another(p::xs)D
		  else  if  q<D   then q+1::p::xs  else another(p::xs)D
|   another   [ ]   D = [1]
|   another   [q]   D = if  q<D  then [q+1]  else [1]

fun legalise  board D = if new_queen_safe_on board   then board
			else legalise (another board D) D
							val l = legalise
fun Try board D = if new_queen_safe_on board
		  then  if it_is_a_full board D
			then board
			else Try (add_a_queen_on board) D
		  else Try (another board D) D

fun try board D = if it_is_a_full board D
		  then board
		  else try (legalise (add_a_queen_on board) D) D

fun unbuild (B,_) = B					  val pT = print
fun move (B,_) m = (B,m)				  val mov = move
fun pI x = pT (Int.toString x)				val unb =unbuild
fun pLi xs = let fun ptLisT  [x]  =  pI x			  (*58*)
		 |   ptLisT(x::xs) = (pI x; pT","; ptLisT xs)
		 |   ptLisT  [ ]  = ()
	     in  pT"["; ptLisT xs; pT"]"
	     end
fun ptBo(B,m) = (pT"\t  "; pLi B; pT"\t("; pI m; pT")\n")
fun ptB2(B,m,C,n) = (pT"\n"; ptBo(B,m); ptBo(C,n); pT"\n")
fun show(B,m) = (pT"\n"; ptBo (B,m); (B,m))
fun build B m = show (B,m)				 val bui = build
fun zb D = case D of 8 => [6,8,5,1]     | 12 => [12,10,8,5,3,1]
		  |  9 => [8,6,3,1]     | 13 => [12,9,2,5,3,1]
		  | 10 => [10,8,6,3,1]  |  _ => [3,1]
fun fb D = if D<4  then raise NoBoard  else 
	   if D>12 then show (try (zb D) D, 1)  else (try (zb D) D, 1)

fun neXt board D = try (legalise (another (tl board) D) D) D
fun next (board, m) = let val D = length (Full board)
			  val n = if m >= daT D  then 1  else m+1
			  val board2 = neXt board D
		      in if D>12 then(ptB2(board,m,board2,n);(board2,n))
				 else(board2,n)
		      end				   val nx = next
fun botq  [q]  = q
|   botq(_::qs)= botq qs
|   botq  [ ]  = raise Botq		   val t7 = "\t\t\t\t\t\t\t\t  "
fun coMpL (q::qs) D = D-q+1 :: coMpL qs D
|   coMpL   [ ]   D = [ ]		  val t8 = "\t\t\t\t\t\t\t\t   "

fun chqMid (board, m)  =	let	val D = length (Full board)
	val A = "\n\t"	  val n = m+1	val board2 = neXt board D
	val B = " Board of "		val M = A^"First Middle"^B
	val F = A^"The First"^B		val N = A^"Second Middle"^B
	val L = A^"The Last"^B	in
	if board2 = coMpL board D  then if botq board = D
	  then (ptB2(board,m,board2,1); pT L)
	  else (ptB2(board,m,board2,n);
	   if D=19 then pT(t7^"4000000000+\n")else();pT t8;pI(m*2);pT M)
	else if neXt(coMpL board D)D=board then (ptB2(board,m,board2,n);
	if m=1 then pT F else(if D=19 then pT(t7^"4000000000+\n")else();
		pT t8;pI((m-1)*2); pT N))  else pT (A^"Ordinary"^B);
	pT(diM D^" dimensions\n");   if D>12  then show(board,m)  else 
	(board,m)		end
							 val qm = chqMid
fun findfrom(board,m,N,D) = (ptBo(board,m);
	if m>=N then show(board,m) else findfrom(neXt board D, m+1,N,D))

fun ff (board, m) N = let val D = length (Full board)	   val T = daT D
			  val M = if N>T then T else N	   exception FF
	in  if D>12  then raise FF  else findfrom (board, m, M, D)
	end
fun seeing (board,m,D) = ( ptBo (board, m);
	let val board2 = neXt board D
	in if board2 <> coMpL board D  then seeing (board2, m+1, D)
					else chqMid (board, m)
	end )
fun see D = if D<4 orelse D>11  then raise See  else if D>6  then
	seeing (try(zb D)D, 1, D)  else ff (try(zb D)D, 1)(daT D)
(*--------------------------- Hunt and Push ------------------- 115 --*)

fun ee3 (m, c, T, t) = m<c+1 orelse m>T-c orelse (m>t-c andalso m<t+c+1)
fun ee4 (m, c, T, t) = m=c+1 orelse m=T-c orelse m=t-c  orelse  m=t+c+1

fun hunting(board, m, D, T) = ( if ee3(m,3,T,T div 2) then ptBo(board,m)
			   else if ee4(m,3,T,T div 2)then pT"\n" else();
	let val board2 = neXt board D	  val n = if m=T then 1 else m+1
	in  if board2 = coMpL board D   then chqMid (board,  m)
					else hunting(board2, n, D, T)
	end )
fun hunt D = if D<7 then see D  else hunting(try(zb D)D, 1, D, daT D)
fun huntfrom (board,m) = let val D = length (Full board)
			 in hunting (board, m, D, daT D)
			 end				 val hf=huntfrom

fun pushing (board, m, D) = ( if m<4  then ptBo (board,m)
				      else if m=4  then pT"\n"  else ();
	let val board2 = neXt board D		val n = m+1
	in  if board2 = coMpL board D  then (chqMid(board,m); (board,m))
				       else  pushing (board2, n, D)
	end )
fun push D = pushing (try(zb D)D, 1, D)

fun backOne(board,m) = let val D = length (Full board)
			   val n = if m=1  then daT D  else m-1
			   val board2 = coMpL(neXt(coMpL board D)D)D
		      in if D>12 then(ptB2(board,m,board2,n);(board2,n))
				 else(board2,n)
		      end				  val bb=backOne
(*-------------------------- Match and Search ------------------------*)

fun matcH (p::ps, q::qs) = p=q  andalso  matcH (ps, qs:int list)
|   matcH ( [ ],   [ ] ) = true
|   matcH (  _,     _  ) = raise NoMatch

fun maTch (board1, board, m, D) = if not( matcH (board1, board))
			then maTch (neXt board1 D, board, m+1, D)
			else m
fun match board  =  let val D = length (Full board)
			val q = botq board	 val H2 = q > (D+1)div 2
			val Board = if H2 then coMpL board D  else board
			val m = maTch (try(zb D)D, Board, 1, D)
		    in (board,  if H2  then 1 + daT D - m  else m)
		    end
							  val mm = match
fun sEaRcH (board,m,D,N) = if m=N  then board
				   else sEaRcH (neXt board D, m+1, D, N)

fun search m D = if D<4  then raise NoBoard  else
					let		val T = daT D
		val M = T div 2		val n = if m>M then T+1-m else m
		val board = sEaRcH (try(zb D)D, 1, D, n)
					in if m>T  then raise OutofRange
		else if m>M  then (coMpL board D, m)  else (board, m)
					end
val ss = search
(*------------------------------ Rotation --------------------- 172 --*)
fun inc x = x+1						fun dec x = x-1

fun position (F, p, q::qs, r) = if q=r  then p  else
   position (F, F p,  qs, r:int)
|   position (F, p,  [ ],  r) = raise NoBoard

fun clockwise(p, qs, row) = if row<p  then [ ]  else
			position(inc,p,qs,row) :: clockwise(p,qs,row-1)

fun anticlock(p, qs, row) = if row>p  then [ ]  else
			position(dec,p,qs,row) :: anticlock(p,qs,row+1)

fun cturn board = clockwise (1, board, length board)
fun aturn board = anticlock (length board, board, 1)

fun   turn (board, _) = match (cturn board)		 val tu = turn
fun antiturn (board,_) = match (aturn board)		val atu=antiturn

(*------------------------------- Group ------------------------------*)
fun fst (x,_) = x					fun snd(_,y) = y
fun fromto m N = if m<N+1 then m::fromto(m+1)N else [ ]
fun take 0    _   = [ ]
|   take n (x::xs)= x :: take (n-1) xs
|   take n   [ ]  = raise Take			  val from1to = fromto 1
fun drop 0   xs   = xs
|   drop n (_::xs)= drop (n-1) xs
|   drop n   [ ]  = raise Drop
fun rub  a (x::xs)= if a=x  then xs  else x :: rub (a:int) xs
|   rub  a   [ ]  = [ ]
fun minus(x::xs)ys= minus xs (rub x ys)
|   minus  [ ] ys = ys

fun group ( [ ],  Y, D)  =  [ ]
|   group (n::ns, Y, D)  =	let
	val(board,_) = search n D		val n7 = Y - n
	val(_,n2) = match(cturn board)		val n8 = Y - n2
	val(_,n3) = match(coMpL(rev board)D)	val n5 = Y - n3
	val(_,n4) = match(aturn board)		val n6 = Y - n4
	val qs = [n,n2,n3,n4,n5,n6,n7,n8]	val rs = minus qs(n::ns)
				in
			qs :: group(rs,Y,D)
				end
fun get D = group (from1to(daT D), 1+daT D, D)

fun coMpL2 D Y ((board1,m:int),(board2,n)) =
		((coMpL board2 D, Y-n), (coMpL board1 D, Y-m))

fun conset ps =			let		val rs = rev ps
	val((board,m),(_,n)) = hd rs		val D = length board
	val q = (botq o fst o fst o hd) ps	val board1 = try(zb D)D 
	val Y = m + n		in  if daT D<>Y-1   then ps   else
	let val qs = map (coMpL2 D Y)(tl rs)
	in  if q<>1  then (ps @ qs)
		     else (ps @ qs)@[((coMpL board1 D, Y-1),(board1,1))]
	end
				end
(*------------------------------------------------------------- 229 --*)

fun caseM D = case D of 9 => 46  |  7 =>  6  |  5 => 2  | 12 => 1787
	| 11 => 341  | 10 => 92  |  8 => 12  |  6 => 1  |  4 =>    1
							|  _ => raise CM
fun compl (board,m) = let val D = length (Full board)		
			  val board2 = coMpL board D
			  val n = 1 + daT D - m
		      in if D>12 then(ptB2(board,m,board2,n);(board2,n))
				 else(board2,n)
		      end				  val cc = compl

fun tot (board,m) =		let	val D = length(Full board)
		val T = daT D		val d = Int.toString D
				in
		pT("\tFor a "^d^"x"^d^" board, total number of differ");
		pT("ent boards = "^Int.toString T^"\n\n");
		if D>12  then ptBo(board,m)  else();   (board,m)
				end

fun ptqQ (m,B1,B2,n) = (pT"(";  pI m;  pT")\n\t";  pLi B1;  pT"\n\t";
			pLi B2;  pT"\t(";  pI n;  pT")\n")

fun qQ (m,B1,B2,n,D,T) = (   if ee3(m,3,T,T div 2) then ptqQ(m,B1,B2,n)
			else if ee4(m,3,T,T div 2) then pT"\n" else ();	
				let
	val B3 = coMpL(neXt(coMpL B1 D)D)D	val B4 = neXt B2 D
				in
	if B4=B1  then (pT"\n\t\tOK?\n"; chqMid (B1, m))
		  else  qQ (m-1, B3, B4, n+1, D, T)
				end   )			

fun qq (board, n)  =		let	val D = length (Full board)
	val board1 = coMpL board D	val T = daT D
	val m = if n=1  then daT D  else n-1
				in
	if neXt board1 D = board    then qQ (m, board1, board, n, D, T)
	else(pT"\tNot the Second Middle Board!  Nor the First Board!\n";
			 raise OutofRange)
				end

fun Show board = (pT"\n\t ";  pLi board;  pT"\n\n";  board)
fun pT2B (B1,B2) = (pT"\n\t ";  pLi B1;  pT"\n\t ";  pLi B2;  pT"\n\n")

fun Nx board  = let val board2 = neXt board (length (Full board))
		in pT"\t Forwards one board\n";  pT2B (board,board2);
			board2
		end
fun nnn (b,m) = (Nx b, m+1)

fun B1 board  = let val D = length (Full board)
		    val board1 = coMpL (neXt (coMpL board D) D) D
		in pT"\t Backwards one board\n";  pT2B (board,board1);
			board1
		end				fun odd x = x mod 2 <> 0
fun bbb (b,m) = (B1 b, m-1)

(*----------------------------- makeMid ----------------------- 286 --*)

fun chqM board = let val D = length (Full board)
		     val txt = "\tCorrect two middle boards\n\t"
		     val tx2 = "\n\tMiddle First Board\n"
		     val board2 = neXt board D
		 in if board2 = coMpL board D
			then (pT txt; pT2B(board,board2); pT tx2)
			else pT2B(board,board2);  board
		 end					   val qM = chqM
fun zmid D  =  if D>32  then let exception Zmid  in  raise Zmid  end
			else let val q = (D+1) div 2
	       val ps = if D < 9  then [q]  else
			if odd D  then [D,q-2,q]  else [D,q]
	       val qs = if D>11  then D-2 :: ps  else ps
	       val rs = if D=17  then [D-1,D-5] @ qs  else
			if D>14  then [D-1,D-4] @ qs  else qs
	       val ss = if D>19  then D-3 :: rs  else rs
	       val ts = if D=22  then D-8 :: ss  else
			if D=25 orelse D=28 orelse D=31
				 then [D-11,D-9] @ ss  else
			if D>22  then [D-10,D-8] @ ss  else ss
	       val us = if D=23 orelse D=24  then D-14 :: ts  else
			if D=25 orelse D=28 orelse D=31
				 then D-13 :: ts  else
			if D>25  then D-12 :: ts  else ts
	       val vs = if D=28 orelse D=29  then D-15 :: us  else
			if D=31  then D-16 :: us  else
			if D>25  then D-14 :: us  else us
	       val ws = if D=29 orelse D=32  then D-5 :: vs  else
			if D>27  then D-6 :: vs  else vs
	       val xs = if D=30  then D-21 :: ws  else
			if D=31  then D-19 :: ws  else
			if D=32  then [D-26,D-23,D-17] @ ws  else ws
	in  legalise xs D
	end						    val z = zmid
fun makeMid (board,D) = let val board2 = neXt board D
			in if coMpL board2 D = board  then chqM board
			   else makeMid (board2,D)
			end

fun mmi D = if D<4 orelse D>32  then raise OutofRange
				else makeMid (try(zmid D)D, D)

fun gobacktoZ (board0, board, D)  =	let
	val board1 = coMpL (neXt (coMpL board D) D) D
					in pT"\t "; pLi board1; pT"\n";
	if  board1 = board0
	then (pT"\t\t\t\t\t"; pLi(zmid D); pT"\n"; Show board1)
	else gobacktoZ (board0, board1, D)
					end

fun gbt board  =  ( pT"\t "; pLi board; pT"\n";
	let val D = length (Full board)     val board0 = try (zmid D) D
	in  if board0 = board   then board
				else gobacktoZ (board0, board, D)
	end )							 (*342*)
fun zmid2 D = case D of 5 =>					  [ 3] |
        7 =>							  [ 4] |
       9 =>						    [ 9, 3, 5] |
     11 =>						    [11, 4, 6] |
    13 =>					      [ D-2, 13, 5, 7] |
   15 =>				    [ D-1, D-4, D-2, 15, 6, 8] |
  17 =>					    [ D-1, D-5, D-2, 17, 7, 9] |
 19 =>					    [ D-1, D-4, D-2, 19, 8, 10]|
21 =>				       [ D-3, D-1, D-4, D-2, 21, 9, 11]|
23 =>		      [ D-14, D-10, D-8, D-3, D-1, D-4, D-2, 23, 10,12]|
25 =>		      [ D-13, D-11, D-9, D-3, D-1, D-4, D-2, 25, 11,13]|
27 =>		[ D-14, D-12, D-10, D-8, D-3, D-1, D-4, D-2, 27, 12,14]|
29 =>	   [ D-5, D-15, D-12, D-10, D-8, D-3, D-1, D-4, D-2, 29, 13,15]|
31 => [D-19, D-6, D-16, D-13, D-11, D-9, D-3, D-1, D-4, D-2, 31, 14,16]|
32 => [D-26,D-23,
       D-17, D-5, D-14, D-12, D-10, D-8, D-3, D-1, D-4, D-2, 32,    16]|
30 => [D-21, D-6, D-14, D-12, D-10, D-8, D-3, D-1, D-4, D-2, 30,    15]|
28 =>	   [ D-6, D-15, D-13, D-11, D-9, D-3, D-1, D-4, D-2, 28,   14]|
26 =>		[ D-14, D-12, D-10, D-8, D-3, D-1, D-4, D-2, 26,  13] |
24 =>		      [ D-14, D-10, D-8, D-3, D-1, D-4, D-2, 24, 12] |
22 =>				  [ D-8, D-3, D-1, D-4, D-2, 22, 11] |
 20 =>				       [ D-3, D-1, D-4, D-2, 20, 10] |
  18 =>					    [ D-1, D-4, D-2, 18,  9] |
   16 =>				    [ D-1, D-4, D-2, 16,  8] |
    14 =>					      [ D-2, 14,  7] |
      12 =>					      [ D-2, 12,  6] |
	10 =>						    [10,  5] |
	   8 =>							[ 4] |
	     6 =>						[ 3] |
		4 =>						[ 2] |
		  _ => let exception Zmid  in  raise Zmid  end
val z2 = zmid2
fun zz D = (pT2B(z D, z2 D); gbt(mmi D))

fun pusH00 (board, m, D, M) = ( if m<4 orelse m>M-3  then ptBo(board,m)
			else if m=4 orelse m=M-3  then pT"\n"  else ();
				if m>M  then show (board, m)  else
	let val board2 = neXt board D
	in  if board2 = coMpL board D   then chqMid (board, m)
					else pusH00 (board2, m+1, D, M)
	end )

fun p100 (board, m) = pusH00 (board, m, length(Full board), m+99999999)
fun p10 (board, m) = pusH00 (board, m, length(Full board), m+9999999)
fun push100 D = pusH00 (try(zb D)D, 1, D, 100000000)
fun push10 D = pusH00 (try(zb D)D, 1, D, 10000000)
						     val mX = 1073741823
fun q18 n = show( case n 
	of 1 => (try[10,5,13,17,3,7,2,15,1,9,11,14,18,4] 18, 100000001)
	|  2 => (try[9,16,2,4,15,11,8,17,13,6,18,1,10,7] 18, 200000001)
	|  3 => (try[17,2,4,8,15, 3,1,16,7,12,10,18,6,9] 18, 300000001)
	|  _ => raise Q18 )
						val err = "\t\tError!\n"
val vfi = "\t\tVerified\n"
fun v18 (board, m) = ( if q18(m div 100000000) = (board,m)
			then pT vfi  else pT err;   show (board,m) )
(*------------------------------------------------------------- 399 --*)
fun bot2q [q,p] = (q,p)
|   bot2q(_::qs)= bot2q qs
|   bot2q   _   = let exception Bot2Q  in  raise Bot2Q  end

fun looking (board, m, D) = ( if m<4  then ptBo(board,m)  else
			      if m=4  then pT"\n"
	else if m mod 100000 = 0   then ptBo(board,m)  else ();
				let
	val n = m + 1			val (p2,p1) = bot2q board
	val board2 = neXt board D	val (q2,q1) = bot2q board2
				in
	if p1=q1 andalso p2=q2   then looking (board2, n, D)  else
	if board2 = coMpL board D   then chqMid (board, m)   else
	if p1=q1  then (ptB2 (board,m,board2,n); pT"\n"; (board2,n))
		  else 	if p1<>q1 andalso p2<>q2
		  then (ptB2 (board,m,board2,n); pT"\n"; (board2,n))
		  else looking (board2, n, D)
				end )
					     val t6 = "\t\t\t\t\t\t\t\t"
fun look D = looking (try(zb D)D, 1, D)
fun ook (board, m) =		let
	val n = if m>1000000000  then m-1000000000  else m
				in
		looking (board, n, length(Full board))
				end
fun q19 n = show( case n 
	of 1 => (try[19,17,15,13,9,4,2,5,3,1] 19, 1)
	|  2 => (try[11,18,16,7,19,17,15,13,9,5,3,1,4,2] 19, 121956045)
	|  3 => (try[11,18,16,7,19,17,15,13,9,5,2,4,1,3] 19, 276414301)
	|  4 => (try[12,6,18,7,19,16,13,15,10,2,5,3,1,4] 19, 464269003)
	|  5 => (try[10, 8,2,19,17,14,18,13,9,3,6,4,1,5] 19, 694603615)
	|  6 => (try[18, 9,2,14,17,19,16,13,4,7,5,3,1,6] 19, 957926377)
	|  7 => 				   (pT (t6^"1000000000+"
	      );(try[10,4, 6,16,19,17,12,14,8,2,5,3,1,7] 19, 258285481))
	|  8 => 				   (pT (t6^"1000000000+"
	      );(try[5,18, 4,17,19,13,16,10,7,2,6,3,1,8] 19, 586628011))
	|  9 => 				   (pT (t6^"1000000000+"
	      );(try[6,17,19, 4,15,18,14,10,8,2,5,3,1,9] 19, 938444555))
	| 10 =>					   (pT (t6^"2000000000+"
	      );(try[7,19, 6,16,14,17,15,9,4,2,5,3,1,10] 19, 298796823))
	|  _ => raise Q19 )
fun v19 (board,m) =  let  val n = botq board
     in if n>10 then raise Q19 else
	if (board,m) = q19 n   then pT vfi  else pT err;  show (board,m)
     end
fun FindFRom(board,m,N,D)=(if m mod 10000 = 0 then ptBo(board,m) else();
	 if m>=N then show(board,m) else FindFRom(neXt board D,m+1,N,D))
fun ffr (board,m) N =
	( show (board, m); FindFRom (board, m, N, length(Full board)) )

fun seeking (board,m,N,D) =( if m<4 orelse m>N-3 then ptBo(board,m) else
	if m=4 orelse m=N-3  then pT"\n"  else ();
	if m<N  then seeking(neXt board D,m+1,N,D)  else show(board,m) )

fun seek (board, m) N = seeking (board, m, N, length(Full board))
;
(*------------------------------ qs ------------------------ A Angg --*)