N-queens minimum and knights and bishops: Difference between revisions

(→‎{{header|Phix}}: updated, much faster)
Line 9:
=={{header|F_Sharp|F#}}==
<lang fsharp>
// N-QueensMinimum minimumknights andto Knightsattack andall Bishopssquares not occupied on an NxN chess board. Nigel Galloway: AprilMay 19th12th., 2022
type att={n:uint64; g:uint64}
open Microsoft.SolverFoundation.Services
static member att n g=let g=g|>Seq.fold(fun n g->n ||| (1UL<<<g)) 0UL in {n=n|>Seq.fold(fun n g->n ||| (1UL<<<g)) 0UL; g=g}
open Microsoft.SolverFoundation.Common
static member (+) (n,g)=let x=n.g ||| g.g in {n=n.n ||| g.n; g=x}
 
let fN g=let fG n g l=([0..n-g-g-1]@[;n-g-g+1..l;n-g+2;n-g-2;n+g+g-1;n+g+g+1;n+g-2;n+g+2]|>List.mapfilter(fun nx->sprintf0<=x "N_%02d_%02d"&& nx<g*g && abs(x%g-n%g))@+abs([0..x/g-1]@[n/g+1)=3)|>List..l-1]distinct|>List.map(fun gn->sprintf "N_%02d_%02d" n g)/2)
let n,g=Array.init(g*g)(fun n->att.att [n/2] (fG n g)), Array.init(g*g)(fun n->att.att (fG n g) [n/2]) in (fun g->n.[g]),(fun n->g.[n])
let fG n g l=List.unfold(fun(n,g)->if n>l-2||g>l-2 then None else let n,g=n+1,g+1 in Some(sprintf "N_%02d_%02d" n g,(n,g)))(n,g)@
type cand={att:att; n:int; g:int}
List.unfold(fun(n,g)->if n<1||g>l-2 then None else let n,g=n-1,g+1 in Some(sprintf "N_%02d_%02d" n g,(n,g)))(n,g)@
type Solver={n:cand seq; i:int[]; g:(int -> att) * (int -> att); e:att; l:int[]}
List.unfold(fun(n,g)->if n<1||g<1 then None else let n,g=n-1,g-1 in Some(sprintf "N_%02d_%02d" n g,(n,g)))(n,g)@
member Listthis.unfold(funtest()=let rec test n, i g) e l=match g with 0UL->(if n>l-2||g<1i=this.e then NoneSome(n,e) else letNone)|g when n,g%2UL=n+1,g1UL-1>test inn Some(sprintf "N_%02d_%02d" ni+((snd this.g,)(n,gthis.i.[l])))(g/2UL)(e+1)(l+1) |_->test n, i (g/2UL) e (l+1)
let n=this.n|>Seq.choose(fun n->test n n.att (this.e.g^^^n.att.g) 0 0) in if Seq.isEmpty n then None else Some(n|>Seq.minBy snd)
let fK n g l=[(1,-2);(2,-1);(1,2);(2,1);(-1,2);(-2,1);(-1,-2);(-2,-1)]|>List.choose(fun(x,y)->match n+x,g+y with p,q when p>=0 && q>=0 && p<=l-1 && q<=l-1->Some(sprintf "N_%02d_%02d" p q) |_->None)
member this.xP() ={this with n=this.n|>Seq.collect(fun n->[for g in n.n..n.g do let att=n.att+((fst this.g)(this.l.[g])) in yield {n with att=att; n=g}])}
let sln f size=
let rec slvK (n:Solver) i g l = match n.test() with Some(r,ta)->match min l (g+ta) with t when t>2*(g+1) || l<t->slvK (n.xP()) (if t<l then Some(r,ta) else i) (g+1) (min t l) |t->Some(min t l,r)
let context=SolverContext.GetContext()
|_->slvK (n.xP()) i (g+1) l
context.ClearModel()
let tC bw s (att:att)=let n=Array2D.init s s (fun n g->if (n+g)%2=bw then (if att.n &&& pown 2UL ((n*s+g)/2) > 0UL then "X" else ".") else (if att.g &&& pown 2UL ((n*s+g)/2) > 0UL then "~" else "o"))
let model=context.CreateModel()
for n in 0..size-1 do for g in 0..sizes-1 do modeln.AddDecision(new Decision(Domain[g,0.IntegerRange(Rational.Zero,Rationals-1]|>Seq.One),iter(fun sprintfg->printf "N_%02d_%02ds" n g)); printfn ""
let solveK g=printfn "\nSolving for %dx%d board" g g
for n in 0..size-1 do for g in 0..size-1 do model.AddConstraint(sprintf "G_%02d_%02d" n g,([sprintf "0<%d*N_%02d_%02d" (size*size) n g]@f n g size|>String.concat "+")+sprintf "<%d" (size*size+1))
let bs,ws=[|for n in g..g+g..(g*g-1)/2 do for z in 0..g+1..(g*g-1)/2-n->((n+z)/g,(n+z)%g)|],[|for n in 0..g+g..(g*g-1)/2 do for z in 0..g+1..(g*g-1)/2-n->((n+z)/g,(n+z)%g)|]
model.AddGoal("Goal0", GoalKind.Minimize, [for n in 0..size-1 do for g in 0..size-1->sprintf "N_%02d_%02d" n g]|>String.concat "+")
let i,l=let n,i=[|for n in 0..g-1 do for g in 0..g-1->(n,g)|]|>Array.partition(fun(n,g)->(n+g)%2=1) in n|>Array.map(fun(n,i)->n*g+i), i|>Array.map(fun(n,i)->n*g+i)
context.Solve()
let t,f=System.DateTime.UtcNow,fN g
let Bishops,Queens,Knights=sln fG, sln (fun n g l->fG n g l@fN n g l), sln fK
let bK={l=Array.concat[bs|>Array.map(fun(n,i)->n*g+i);i]|>Array.distinct; i=l; e=att.att [0..i.Length-1] [0..l.Length-1]; n=bs|>Array.mapi(fun l (n,e)->let att=((fst f)(n*g+e)) in {att=att; n=l+1; g=i.Length-1}); g=fN g}
let printSol(n:Solution)=n.Decisions|>Seq.filter(fun n->n.GetDouble()=1.0)|>Seq.iteri(fun n g->let g=g.Name in printfn "Place Piece %d in row %d column %d" (n+1) (int(g.[2..3])) (int(g.[5..6]))); printfn ""
let wK={l=Array.concat[ws|>Array.map(fun(n,i)->n*g+i);l]|>Array.distinct; i=i; e=att.att [0..l.Length-1] [0..i.Length-1]; n=ws|>Array.mapi(fun i (n,e)->let att=((fst f)(n*g+e)) in {att=att; n=i+1; g=l.Length-1}); g=fN g}
let pieces(n:Solution)=n.Decisions|>Seq.filter(fun n->n.GetDouble()=1.0)|>Seq.length
let (rn,rb),tc=match g with 1|2->(slvK wK None 1 (g*g/2+g%2)).Value, tC 0 g
 
|x when x%2=0->(slvK bK None 1 (g*g/2)).Value, tC 1 g
printfn "%10s%10s%10s%10s" "Squares" "Queens" "Bishops" "Knights"
|_->let x,y=(slvK bK None 1 (g*g/2)).Value, (slvK wK None 1 (g*g/2+1)).Value in if (fst x)<(fst y) then x,tC 1 g else y,tC 0 g
[1..10]|>List.iter(fun n->printfn "%10d%10d%10d%10d" (n*n) (pieces(Queens n)) (pieces(Bishops n)) (pieces(Knights n)))
printfn "Solution found using %d knights in %A:" rn (System.DateTime.UtcNow-t); tc rb.att
printfn "Queens on a 8x8 Board"; printSol(Queens 8)
for n in 1..10 do solveK n
printfn "Knights on a 8x8 Board"; printSol(Knights 8)
</lang>
{{out}}
<pre>
Solving for 1x1 board
Squares Queens Bishops Knights
Solution found using 1 knights in 00:00:00.0331768:
1 1 1 1
X
4 1 2 4
 
9 1 3 4
Solving for 2x2 board
16 3 4 4
Solution found using 2 knights in 00:00:00:
25 3 5 5
Xo
36 4 6 8
oX
49 4 7 13
 
64 5 8 14
Solving for 3x3 board
81 5 9 14
Solution found using 4 knights in 00:00:00.0156191:
100 5 10 16
Xo.
oX~
.~.
 
Solving for 4x4 board
Solution found using 4 knights in 00:00:00:
~.~.
XoXo
~.~.
.~.~
 
Solving for 5x5 board
Solution found using 5 knights in 00:00:00:
.o.~.
~X~.~
.o.~.
~X~.~
.o.~.
 
Solving for 6x6 board
Solution found using 8 knights in 00:00:00:
~.~.~.
.~.~.~
oX~.oX
Xo.~Xo
~.~.~.
.~.~.~
 
Solving for 7x7 board
Solution found using 13 knights in 00:00:00.1426817:
X~.~.o.
oX~.~.~
X~.~.o.
~.~.~Xo
.~.~.~.
o.oX~.~
.~.o.~X
 
Solving for 8x8 board
Solution found using 14 knights in 00:00:00.2655969:
o.~X~.~.
X~.~.~.~
o.~.~Xo.
.~.~.o.~
~.o.~.~.
.oX~.~.o
~.~.~.~X
.~.~X~.o
 
Solving for 9x9 board
Queens on a 8x8 Board
Solution found using 14 knights in 00:00:10.2331055:
Place Piece 1 in row 0 column 4
.~.~.~.~.
Place Piece 2 in row 3 column 0
~.o.~.o.~
Place Piece 3 in row 4 column 7
.~Xo.oX~.
Place Piece 4 in row 6 column 1
~.~.~.~.~
Place Piece 5 in row 7 column 3
X~.~.~.~X
~.~.~.~.~
.~Xo.oX~.
~.o.~.o.~
.~.~.~.~.
 
Solving for 10x10 board
Knights on a 8x8 Board
Solution found using 16 knights in 00:04:44.0573668:
Place Piece 1 in row 0 column 0
~.~.~.~.~.
Place Piece 2 in row 0 column 3
.~.~.~Xo.~
Place Piece 3 in row 1 column 0
~Xo.~.oX~.
Place Piece 4 in row 2 column 0
.oX~.~.~.~
Place Piece 5 in row 2 column 5
~.~.~.~.~.
Place Piece 6 in row 2 column 6
.~.~.~.~.~
Place Piece 7 in row 3 column 5
~.~.~.~Xo.
Place Piece 8 in row 4 column 2
.~Xo.~.oX~
Place Piece 9 in row 5 column 1
~.oX~.~.~.
Place Piece 10 in row 5 column 2
.~.~.~.~.~
Place Piece 11 in row 5 column 7
Place Piece 12 in row 6 column 7
Place Piece 13 in row 7 column 4
Place Piece 14 in row 7 column 7
</pre>
 
2,172

edits