September 2017 Update
This commit is contained in:
Ingy döt Net
parent
bba7bfd280
commit
ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
|
|
@ -10,10 +10,12 @@ You can extend the problem to solve the puzzle with a board of size <big>
|
|||
For the number of solutions for small values of '''N''', see [http://oeis.org/A000170 oeis.org sequence A170].
|
||||
|
||||
|
||||
;See also:
|
||||
* [[Knight's tour]]
|
||||
* [[Solve a Hidato puzzle]]
|
||||
* [[Solve a Holy Knight's tour]]
|
||||
* [[Solve a Numbrix puzzle]]
|
||||
* [[Solve a Hopido puzzle]]
|
||||
;Related tasks:
|
||||
* [[A* search algorithm]]
|
||||
* [[Solve a Hidato puzzle]]
|
||||
* [[Solve a Holy Knight's tour]]
|
||||
* [[Knight's tour]]
|
||||
* [[Solve a Hopido puzzle]]
|
||||
* [[Solve a Numbrix puzzle]]
|
||||
* [[Solve the no connection puzzle]]
|
||||
<br><br>
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
* N-QUEENS PROBLEM 04/09/2015
|
||||
PRINT NOGEN
|
||||
MACRO
|
||||
&LAB XDECO ®,&TARGET
|
||||
&LAB B I&SYSNDX branch around work area
|
||||
|
|
@ -12,16 +11,21 @@ I&SYSNDX CVD ®,P&SYSNDX convert to decimal
|
|||
MVC 0(1,R1),W&SYSNDX+12 move the sign
|
||||
MVC &TARGET.(12),W&SYSNDX move to target
|
||||
MEND
|
||||
PRINT NOGEN
|
||||
NQUEENS CSECT
|
||||
SAVE (14,12) save registers on entry
|
||||
PRINT NOGEN
|
||||
BALR R12,0 establish addressability
|
||||
USING *,R12 set base register
|
||||
ST R13,SAVEA+4 link mySA->prevSA
|
||||
LA R11,SAVEA mySA
|
||||
ST R11,8(R13) link prevSA->mySA
|
||||
LR R13,R11 set mySA pointer
|
||||
LA R7,LL l
|
||||
LA R6,1 i=1
|
||||
LOOPI LR R1,R6 do i=1 to l
|
||||
SLA R1,1 i*2
|
||||
STH R6,A-2(R1) a(i)=i
|
||||
LA R6,1(R6) i=i+1
|
||||
BCT R7,LOOPI loop do i
|
||||
OPENEM OPEN (OUTDCB,OUTPUT) open the printer file
|
||||
LA R9,1 n=1 start of loop
|
||||
LOOPN CH R9,L do n=1 to l
|
||||
|
|
@ -126,13 +130,13 @@ ELOOPN CLOSE (OUTDCB) close output
|
|||
LTORG
|
||||
SAVEA DS 18F save area for chaining
|
||||
OUTDCB DCB DSORG=PS,MACRF=PM,DDNAME=OUTDD use OUTDD in jcl
|
||||
L DC H'13' input value
|
||||
A DC H'01',H'02',H'03',H'04',H'05',H'06'
|
||||
DC H'07',H'08',H'09',H'10',H'11',H'12'
|
||||
U DC 46H'0'
|
||||
S DS 12H
|
||||
LL EQU 14 ll<=16
|
||||
L DC AL2(LL) input value
|
||||
A DS (LL)H
|
||||
S DS (LL)H
|
||||
Z DS H
|
||||
Y DS H
|
||||
PG DS CL24 buffer
|
||||
REGS make sure to incld copybook jcl
|
||||
U DC (4*LL-2)H'0' stack
|
||||
REGS make sure to include copybook jcl
|
||||
END NQUEENS
|
||||
|
|
|
|||
|
|
@ -9,146 +9,156 @@ property Test_Count : 0
|
|||
property Rotated : {}
|
||||
|
||||
on run
|
||||
local diff
|
||||
local endTime
|
||||
local msg
|
||||
local rows
|
||||
local startTime
|
||||
|
||||
set Patterns to {}
|
||||
set Solutions to {}
|
||||
set Rotated to {}
|
||||
|
||||
set Test_Count to 0
|
||||
|
||||
set rows to Make_Empty_List(Grid_Size)
|
||||
|
||||
set startTime to current date
|
||||
Solve(1, rows)
|
||||
set endTime to current date
|
||||
set diff to endTime - startTime
|
||||
|
||||
set msg to ("Found " & (count Solutions) & " solutions with " & (count Patterns) & " patterns in " & diff & " seconds.") as text
|
||||
display alert msg
|
||||
local diff
|
||||
local endTime
|
||||
local msg
|
||||
local rows
|
||||
local startTime
|
||||
|
||||
set Patterns to {}
|
||||
set Solutions to {}
|
||||
set Rotated to {}
|
||||
|
||||
set Test_Count to 0
|
||||
|
||||
set rows to Make_Empty_List(Grid_Size)
|
||||
|
||||
set startTime to current date
|
||||
Solve(1, rows)
|
||||
set endTime to current date
|
||||
set diff to endTime - startTime
|
||||
|
||||
set msg to ("Found " & (count Solutions) & " solutions with " & (count Patterns) & " patterns in " & diff & " seconds.") as text
|
||||
display alert msg
|
||||
|
||||
return Solutions
|
||||
end run
|
||||
|
||||
on Solve(row as integer, rows as list)
|
||||
if row is greater than (count rows) then
|
||||
Append_Solution(rows)
|
||||
return
|
||||
end if
|
||||
|
||||
repeat with column from 1 to Grid_Size
|
||||
set Test_Count to Test_Count + 1
|
||||
if Place_Queen(column, row, rows) then
|
||||
Solve(row + 1, rows)
|
||||
end if
|
||||
end repeat
|
||||
if row is greater than (count rows) then
|
||||
Append_Solution(rows)
|
||||
return
|
||||
end if
|
||||
|
||||
repeat with column from 1 to Grid_Size
|
||||
set Test_Count to Test_Count + 1
|
||||
if Place_Queen(column, row, rows) then
|
||||
Solve(row + 1, rows)
|
||||
end if
|
||||
end repeat
|
||||
end Solve
|
||||
|
||||
on abs(n)
|
||||
if n < 0 then
|
||||
-n
|
||||
else
|
||||
n
|
||||
end if
|
||||
end abs
|
||||
|
||||
on Place_Queen(column as integer, row as integer, rows as list)
|
||||
local colDiff
|
||||
local previousRow
|
||||
local rowDiff
|
||||
local testColumn
|
||||
|
||||
repeat with previousRow from 1 to (row - 1)
|
||||
set testColumn to item previousRow of rows
|
||||
|
||||
if testColumn is equal to column then
|
||||
return false
|
||||
end if
|
||||
|
||||
set colDiff to abs (testColumn - column) as integer
|
||||
set rowDiff to row - previousRow
|
||||
if colDiff is equal to rowDiff then
|
||||
return false
|
||||
end if
|
||||
end repeat
|
||||
|
||||
set item row of rows to column
|
||||
return true
|
||||
local colDiff
|
||||
local previousRow
|
||||
local rowDiff
|
||||
local testColumn
|
||||
|
||||
repeat with previousRow from 1 to (row - 1)
|
||||
set testColumn to item previousRow of rows
|
||||
|
||||
if testColumn is equal to column then
|
||||
return false
|
||||
end if
|
||||
|
||||
set colDiff to abs(testColumn - column) as integer
|
||||
set rowDiff to row - previousRow
|
||||
if colDiff is equal to rowDiff then
|
||||
return false
|
||||
end if
|
||||
end repeat
|
||||
|
||||
set item row of rows to column
|
||||
return true
|
||||
end Place_Queen
|
||||
|
||||
on Append_Solution(rows as list)
|
||||
local column
|
||||
local rowsCopy
|
||||
local testReflection
|
||||
local testReflectionText
|
||||
local testRotation
|
||||
local testRotationText
|
||||
local testRotations
|
||||
|
||||
copy rows to rowsCopy
|
||||
set end of Solutions to rowsCopy
|
||||
local rowsCopy
|
||||
|
||||
copy rows to testRotation
|
||||
set testRotations to {}
|
||||
repeat 3 times
|
||||
set testRotation to Rotate(testRotation)
|
||||
set testRotationText to testRotation as text
|
||||
if Rotated contains testRotationText then
|
||||
return
|
||||
end if
|
||||
set end of testRotations to testRotationText
|
||||
|
||||
set testReflection to Reflect(testRotation)
|
||||
set testReflectionText to testReflection as text
|
||||
if Rotated contains testReflectionText then
|
||||
return
|
||||
end if
|
||||
set end of testRotations to testReflectionText
|
||||
end repeat
|
||||
|
||||
repeat with testRotationText in testRotations
|
||||
set end of Rotated to (contents of testRotationText)
|
||||
end repeat
|
||||
set end of Rotated to (rowsCopy as text)
|
||||
set end of Rotated to (Reflect(rowsCopy) as text)
|
||||
|
||||
set end of Patterns to rowsCopy
|
||||
local column
|
||||
local rowsCopy
|
||||
local testReflection
|
||||
local testReflectionText
|
||||
local testRotation
|
||||
local testRotationText
|
||||
local testRotations
|
||||
|
||||
copy rows to rowsCopy
|
||||
set end of Solutions to rowsCopy
|
||||
local rowsCopy
|
||||
|
||||
copy rows to testRotation
|
||||
set testRotations to {}
|
||||
repeat 3 times
|
||||
set testRotation to Rotate(testRotation)
|
||||
set testRotationText to testRotation as text
|
||||
if Rotated contains testRotationText then
|
||||
return
|
||||
end if
|
||||
set end of testRotations to testRotationText
|
||||
|
||||
set testReflection to Reflect(testRotation)
|
||||
set testReflectionText to testReflection as text
|
||||
if Rotated contains testReflectionText then
|
||||
return
|
||||
end if
|
||||
set end of testRotations to testReflectionText
|
||||
end repeat
|
||||
|
||||
repeat with testRotationText in testRotations
|
||||
set end of Rotated to (contents of testRotationText)
|
||||
end repeat
|
||||
set end of Rotated to (rowsCopy as text)
|
||||
set end of Rotated to (Reflect(rowsCopy) as text)
|
||||
|
||||
set end of Patterns to rowsCopy
|
||||
end Append_Solution
|
||||
|
||||
on Make_Empty_List(depth as integer)
|
||||
local i
|
||||
local emptyList
|
||||
|
||||
set emptyList to {}
|
||||
repeat with i from 1 to depth
|
||||
set end of emptyList to missing value
|
||||
end repeat
|
||||
return emptyList
|
||||
local i
|
||||
local emptyList
|
||||
|
||||
set emptyList to {}
|
||||
repeat with i from 1 to depth
|
||||
set end of emptyList to missing value
|
||||
end repeat
|
||||
return emptyList
|
||||
end Make_Empty_List
|
||||
|
||||
on Rotate(rows as list)
|
||||
local column
|
||||
local newColumn
|
||||
local newRow
|
||||
local newRows
|
||||
local row
|
||||
local rowCount
|
||||
|
||||
set rowCount to (count rows)
|
||||
set newRows to Make_Empty_List(rowCount)
|
||||
repeat with row from 1 to rowCount
|
||||
set column to (contents of item row of rows)
|
||||
set newRow to column
|
||||
set newColumn to rowCount - row + 1
|
||||
set item newRow of newRows to newColumn
|
||||
end repeat
|
||||
|
||||
return newRows
|
||||
local column
|
||||
local newColumn
|
||||
local newRow
|
||||
local newRows
|
||||
local row
|
||||
local rowCount
|
||||
|
||||
set rowCount to (count rows)
|
||||
set newRows to Make_Empty_List(rowCount)
|
||||
repeat with row from 1 to rowCount
|
||||
set column to (contents of item row of rows)
|
||||
set newRow to column
|
||||
set newColumn to rowCount - row + 1
|
||||
set item newRow of newRows to newColumn
|
||||
end repeat
|
||||
|
||||
return newRows
|
||||
end Rotate
|
||||
|
||||
on Reflect(rows as list)
|
||||
local column
|
||||
local newRows
|
||||
|
||||
set newRows to {}
|
||||
repeat with column in rows
|
||||
set end of newRows to (count rows) - column + 1
|
||||
end repeat
|
||||
|
||||
return newRows
|
||||
local column
|
||||
local newRows
|
||||
|
||||
set newRows to {}
|
||||
repeat with column in rows
|
||||
set end of newRows to (count rows) - column + 1
|
||||
end repeat
|
||||
|
||||
return newRows
|
||||
end Reflect
|
||||
|
|
|
|||
42
Task/N-queens-problem/F-Sharp/n-queens-problem-1.fs
Normal file
42
Task/N-queens-problem/F-Sharp/n-queens-problem-1.fs
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
let rec iterate f value = seq {
|
||||
yield value
|
||||
yield! iterate f (f value) }
|
||||
|
||||
let up i = i + 1
|
||||
let right i = i
|
||||
let down i = i - 1
|
||||
|
||||
let noCollisionGivenDir solution number dir =
|
||||
Seq.forall2 (<>) solution (Seq.skip 1 (iterate dir number))
|
||||
|
||||
let goodAddition solution number =
|
||||
List.forall (noCollisionGivenDir solution number) [ up; right; down ]
|
||||
|
||||
let rec extendSolution n ps =
|
||||
[0..n - 1]
|
||||
|> List.filter (goodAddition ps)
|
||||
|> List.map (fun num -> num :: ps)
|
||||
|
||||
let allSolutions n =
|
||||
iterate (List.collect (extendSolution n)) [[]]
|
||||
|
||||
// Print one solution for the 8x8 case
|
||||
let printOneSolution () =
|
||||
allSolutions 8
|
||||
|> Seq.item 8
|
||||
|> Seq.head
|
||||
|> List.iter (fun rowIndex ->
|
||||
printf "|"
|
||||
[0..8] |> List.iter (fun i -> printf (if i = rowIndex then "X|" else " |"))
|
||||
printfn "")
|
||||
|
||||
// Print number of solution for the other cases
|
||||
let printNumberOfSolutions () =
|
||||
printfn "Size\tNr of solutions"
|
||||
[1..11]
|
||||
|> List.map ((fun i -> Seq.item i (allSolutions i)) >> List.length)
|
||||
|> List.iteri (fun i cnt -> printfn "%d\t%d" (i+1) cnt)
|
||||
|
||||
printOneSolution()
|
||||
|
||||
printNumberOfSolutions()
|
||||
21
Task/N-queens-problem/F-Sharp/n-queens-problem-2.fs
Normal file
21
Task/N-queens-problem/F-Sharp/n-queens-problem-2.fs
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
| | | |X| | | | | |
|
||||
| |X| | | | | | | |
|
||||
| | | | | | |X| | |
|
||||
| | |X| | | | | | |
|
||||
| | | | | |X| | | |
|
||||
| | | | | | | |X| |
|
||||
| | | | |X| | | | |
|
||||
|X| | | | | | | | |
|
||||
|
||||
Size Nr of solutions
|
||||
1 1
|
||||
2 0
|
||||
3 0
|
||||
4 2
|
||||
5 10
|
||||
6 4
|
||||
7 40
|
||||
8 92
|
||||
9 352
|
||||
10 724
|
||||
11 2680
|
||||
56
Task/N-queens-problem/FreeBASIC/n-queens-problem.freebasic
Normal file
56
Task/N-queens-problem/FreeBASIC/n-queens-problem.freebasic
Normal file
|
|
@ -0,0 +1,56 @@
|
|||
' version 13-04-2017
|
||||
' compile with: fbc -s console
|
||||
Dim Shared As ULong count, c()
|
||||
|
||||
Sub n_queens(row As ULong, n As ULong, show As ULong = 0)
|
||||
|
||||
Dim As ULong x, y
|
||||
|
||||
For x = 1 To n
|
||||
|
||||
For y = 1 To row -1
|
||||
If c(y) = x OrElse ((row - y) - Abs(x - c(y))) = 0 Then
|
||||
Continue For, For
|
||||
End If
|
||||
Next
|
||||
|
||||
c(row) = x
|
||||
If row < n Then
|
||||
n_queens(row +1 , n, show)
|
||||
Else
|
||||
count += 1
|
||||
|
||||
If show <> 0 Then
|
||||
For y = 1 To n
|
||||
Print Using "###"; c(y);
|
||||
Next
|
||||
Print
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
Next
|
||||
|
||||
End Sub
|
||||
|
||||
' ------=< MAIN >=------
|
||||
|
||||
Dim As ULong n = 5
|
||||
ReDim c(n)
|
||||
' n_queens(1, n, show = 0 only show total | show <> 0 show every solution
|
||||
n_queens(1, n, 1)
|
||||
Print Using "## x ## board, ##### solutions"; n; n; count
|
||||
Print
|
||||
|
||||
For n = 1 To 14
|
||||
ReDim c(n)
|
||||
count = 0
|
||||
n_queens(1, n)
|
||||
Print Using "A ## x ## board has ######## solutions"; n; n; count
|
||||
Next
|
||||
|
||||
' empty keyboard buffer
|
||||
While Inkey <> "" : Wend
|
||||
Print : Print "hit any key to end program"
|
||||
Sleep
|
||||
End
|
||||
50
Task/N-queens-problem/Haskell/n-queens-problem-4.hs
Normal file
50
Task/N-queens-problem/Haskell/n-queens-problem-4.hs
Normal file
|
|
@ -0,0 +1,50 @@
|
|||
import Data.List (transpose, intercalate)
|
||||
|
||||
queenPuzzle :: Int -> Int -> [[Int]]
|
||||
queenPuzzle nRows nCols
|
||||
| nRows <= 0 = [[]]
|
||||
| otherwise =
|
||||
foldr
|
||||
(\solution a ->
|
||||
a ++
|
||||
foldr
|
||||
(\iCol b ->
|
||||
if safe (nRows - 1) iCol solution
|
||||
then b ++ [solution ++ [iCol]]
|
||||
else b)
|
||||
[]
|
||||
[1 .. nCols])
|
||||
[]
|
||||
(queenPuzzle (nRows - 1) nCols)
|
||||
where
|
||||
safe iRow iCol solution =
|
||||
True `notElem`
|
||||
zipWith
|
||||
(\sc sr ->
|
||||
(iCol == sc) || (sc + sr == iCol + iRow) || (sc - sr == iCol - iRow))
|
||||
solution
|
||||
[0 .. iRow - 1]
|
||||
|
||||
-- TEST ------------------------------------------------------------------------
|
||||
-- 10 columns of solutions for the 7*7 board:
|
||||
showSolutions :: Int -> Int -> [String]
|
||||
showSolutions nCols nBoardSize =
|
||||
unlines <$>
|
||||
(((intercalate " " <$>) . transpose . (boardLines <$>)) <$>
|
||||
chunksOf nCols (queenPuzzle nBoardSize nBoardSize))
|
||||
where
|
||||
boardLines rows =
|
||||
(\r -> foldMap (\c -> if_ (c == r) "♛" ".") [1 .. (length rows)]) <$> rows
|
||||
|
||||
chunksOf :: Int -> [a] -> [[a]]
|
||||
chunksOf i xs = take i <$> ($ (:)) (splits xs) []
|
||||
where
|
||||
splits [] _ n = []
|
||||
splits l c n = l `c` splits (drop i l) c n
|
||||
|
||||
if_ :: Bool -> a -> a -> a
|
||||
if_ True x _ = x
|
||||
if_ False _ y = y
|
||||
|
||||
main :: IO ()
|
||||
main = mapM_ putStrLn $ showSolutions 10 7
|
||||
33
Task/N-queens-problem/JavaScript/n-queens-problem-1.js
Normal file
33
Task/N-queens-problem/JavaScript/n-queens-problem-1.js
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
function queenPuzzle(rows, columns) {
|
||||
if (rows <= 0) {
|
||||
return [[]];
|
||||
} else {
|
||||
return addQueen(rows - 1, columns);
|
||||
}
|
||||
}
|
||||
|
||||
function addQueen(newRow, columns, prevSolution) {
|
||||
var newSolutions = [];
|
||||
var prev = queenPuzzle(newRow, columns);
|
||||
for (var i = 0; i < prev.length; i++) {
|
||||
var solution = prev[i];
|
||||
for (var newColumn = 0; newColumn < columns; newColumn++) {
|
||||
if (!hasConflict(newRow, newColumn, solution))
|
||||
newSolutions.push(solution.concat([newColumn]))
|
||||
}
|
||||
}
|
||||
return newSolutions;
|
||||
}
|
||||
|
||||
function hasConflict(newRow, newColumn, solution) {
|
||||
for (var i = 0; i < newRow; i++) {
|
||||
if (solution[i] == newColumn ||
|
||||
solution[i] + i == newColumn + newRow ||
|
||||
solution[i] - i == newColumn - newRow) {
|
||||
return true;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
console.log(queenPuzzle(8,8));
|
||||
101
Task/N-queens-problem/JavaScript/n-queens-problem-2.js
Normal file
101
Task/N-queens-problem/JavaScript/n-queens-problem-2.js
Normal file
|
|
@ -0,0 +1,101 @@
|
|||
(() => {
|
||||
'use strict';
|
||||
|
||||
// N QUEENS PROBLEM ------------------------------------------------------
|
||||
|
||||
// queenPuzzle :: Int -> Int -> [[Int]]
|
||||
const queenPuzzle = (nRows, nCols) =>
|
||||
nRows <= 0 ? [
|
||||
[]
|
||||
] : queenPuzzle(nRows - 1, nCols)
|
||||
.reduce((a, solution) =>
|
||||
append(a, enumFromTo(0, nCols - 1)
|
||||
.reduce((b, iCol) =>
|
||||
safe(nRows - 1, iCol, solution) ? (
|
||||
b.concat([solution.concat(iCol)])
|
||||
) : b, [])
|
||||
), []);
|
||||
|
||||
// safe : Int -> Int -> [Int] -> Bool
|
||||
const safe = (iRow, iCol, solution) => !any(
|
||||
([sc, sr]) =>
|
||||
(iCol === sc) || (sc + sr === iCol + iRow) || (sc - sr === iCol - iRow),
|
||||
zip(solution, enumFromTo(0, iRow - 1))
|
||||
);
|
||||
|
||||
// GENERIC FUNCTIONS -----------------------------------------------------
|
||||
|
||||
// abs :: Num a => a -> a
|
||||
const abs = Math.abs
|
||||
|
||||
// any :: (a -> Bool) -> [a] -> Bool
|
||||
const any = (f, xs) => xs.some(f);
|
||||
|
||||
// (++) :: [a] -> [a] -> [a]
|
||||
const append = (xs, ys) => xs.concat(ys);
|
||||
|
||||
// chunksOf :: Int -> [a] -> [[a]]
|
||||
const chunksOf = (n, xs) =>
|
||||
xs.reduce((a, _, i, xs) =>
|
||||
i % n ? a : a.concat([xs.slice(i, i + n)]), []);
|
||||
|
||||
// concat :: [[a]] -> [a] | [String] -> String
|
||||
const concat = xs => {
|
||||
if (xs.length > 0) {
|
||||
const unit = typeof xs[0] === 'string' ? '' : [];
|
||||
return unit.concat.apply(unit, xs);
|
||||
} else return [];
|
||||
};
|
||||
|
||||
// concatMap :: (a -> [b]) -> [a] -> [b]
|
||||
const concatMap = (f, xs) => [].concat.apply([], xs.map(f));
|
||||
|
||||
// 2 or more arguments
|
||||
// curry :: Function -> Function
|
||||
const curry = (f, ...args) => {
|
||||
const go = xs => xs.length >= f.length ? (f.apply(null, xs)) :
|
||||
function () {
|
||||
return go(xs.concat([].slice.apply(arguments)));
|
||||
};
|
||||
return go([].slice.call(args, 1));
|
||||
};
|
||||
|
||||
// enumFromTo :: Int -> Int -> [Int]
|
||||
const enumFromTo = (m, n) =>
|
||||
Array.from({
|
||||
length: Math.floor(n - m) + 1
|
||||
}, (_, i) => m + i);
|
||||
|
||||
// intercalate :: String -> [a] -> String
|
||||
const intercalate = curry((s, xs) => xs.join(s));
|
||||
|
||||
// map :: (a -> b) -> [a] -> [b]
|
||||
const map = (f, xs) => xs.map(f)
|
||||
|
||||
// transpose :: [[a]] -> [[a]]
|
||||
const transpose = xs =>
|
||||
xs[0].map((_, iCol) => xs.map(row => row[iCol]));
|
||||
|
||||
// unlines :: [String] -> String
|
||||
const unlines = xs => xs.join('\n');
|
||||
|
||||
// zip :: [a] -> [b] -> [(a,b)]
|
||||
const zip = (xs, ys) =>
|
||||
xs.slice(0, Math.min(xs.length, ys.length))
|
||||
.map((x, i) => [x, ys[i]]);
|
||||
|
||||
// TEST ------------------------------------------------------------------
|
||||
// Ten columns of solutions to the 7*7 board
|
||||
|
||||
// showSolutions :: Int -> Int -> String
|
||||
const showSolutions = (nCols, nBoardSize) =>
|
||||
intercalate('\n\n', map(unlines,
|
||||
map(col => map(intercalate(" "), transpose(map(rows =>
|
||||
map(r => concat(concatMap(c =>
|
||||
c === r ? '♛' : '.',
|
||||
enumFromTo(1, rows.length))), rows), col))),
|
||||
chunksOf(nCols, queenPuzzle(nBoardSize, nBoardSize))
|
||||
)));
|
||||
|
||||
return showSolutions(10, 7);
|
||||
})();
|
||||
30
Task/N-queens-problem/Kotlin/n-queens-problem.kotlin
Normal file
30
Task/N-queens-problem/Kotlin/n-queens-problem.kotlin
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
// version 1.1.3
|
||||
|
||||
var count = 0
|
||||
var c = IntArray(0)
|
||||
var f = ""
|
||||
|
||||
fun nQueens(row: Int, n: Int) {
|
||||
outer@ for (x in 1..n) {
|
||||
for (y in 1..row - 1) {
|
||||
if (c[y] == x) continue@outer
|
||||
if (row - y == Math.abs(x - c[y])) continue@outer
|
||||
}
|
||||
c[row] = x
|
||||
if (row < n) nQueens(row + 1, n)
|
||||
else if (++count == 1) f = c.drop(1).map { it - 1 }.toString()
|
||||
}
|
||||
}
|
||||
|
||||
fun main(args: Array<String>) {
|
||||
for (n in 1..14) {
|
||||
count = 0
|
||||
c = IntArray(n + 1)
|
||||
f = ""
|
||||
nQueens(1, n)
|
||||
println("For a $n x $n board:")
|
||||
println(" Solutions = $count")
|
||||
if (count > 0) println(" First is $f")
|
||||
println()
|
||||
}
|
||||
}
|
||||
54
Task/N-queens-problem/Phix/n-queens-problem.phix
Normal file
54
Task/N-queens-problem/Phix/n-queens-problem.phix
Normal file
|
|
@ -0,0 +1,54 @@
|
|||
--
|
||||
-- demo\rosetta\n_queens.exw
|
||||
-- =========================
|
||||
--
|
||||
sequence co, -- columns occupied
|
||||
-- (ro is implicit)
|
||||
fd, -- forward diagonals
|
||||
bd, -- backward diagonals
|
||||
board
|
||||
|
||||
atom count
|
||||
|
||||
procedure solve(integer row, integer N, integer show)
|
||||
for col=1 to N do
|
||||
if not co[col] then
|
||||
integer fdi = col+row-1,
|
||||
bdi = row-col+N
|
||||
if not fd[fdi]
|
||||
and not bd[bdi] then
|
||||
board[row][col] = 'Q'
|
||||
co[col] = 1
|
||||
fd[fdi] = 1
|
||||
bd[bdi] = 1
|
||||
if row=N then
|
||||
if show then
|
||||
puts(1,join(board,"\n")&"\n")
|
||||
puts(1,repeat('=',N)&"\n")
|
||||
end if
|
||||
count += 1
|
||||
else
|
||||
solve(row+1,N,show)
|
||||
end if
|
||||
board[row][col] = '.'
|
||||
co[col] = 0
|
||||
fd[fdi] = 0
|
||||
bd[bdi] = 0
|
||||
end if
|
||||
end if
|
||||
end for
|
||||
end procedure
|
||||
|
||||
procedure n_queens(integer N=8, integer show=1)
|
||||
co = repeat(0,N)
|
||||
fd = repeat(0,N*2-1)
|
||||
bd = repeat(0,N*2-1)
|
||||
board = repeat(repeat('.',N),N)
|
||||
count = 0
|
||||
solve(1,N,show)
|
||||
printf(1,"%d queens: %d solutions\n",{N,count})
|
||||
end procedure
|
||||
|
||||
for N=1 to 14 do
|
||||
n_queens(N,N<5)
|
||||
end for
|
||||
19
Task/N-queens-problem/Pure/n-queens-problem.pure
Normal file
19
Task/N-queens-problem/Pure/n-queens-problem.pure
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
/*
|
||||
n-queens.pure
|
||||
Tectonics:
|
||||
pure -c queens.pure -o queens
|
||||
or
|
||||
pure -q -i queens.pure
|
||||
*/
|
||||
using system;
|
||||
|
||||
queens n = search n 1 [] with
|
||||
search n i p = [reverse p] if i>n;
|
||||
= cat [search n (i+1) ((i,j):p) | j = 1..n; safe (i,j) p];
|
||||
safe (i,j) p = ~any (check (i,j)) p;
|
||||
check (i1,j1) (i2,j2)
|
||||
= i1==i2 || j1==j2 || i1+j1==i2+j2 || i1-j1==i2-j2;
|
||||
end;
|
||||
|
||||
compiling || (puts("queens 4: " + str(queens 4)) $$
|
||||
puts("Solutions to queens 7: " + str(#queens 7)));
|
||||
|
|
@ -1,49 +1,48 @@
|
|||
/*REXX program places N queens on an NxN chessboard (the eight queens problem). */
|
||||
parse arg N . /*obtain optional argument from the CL.*/
|
||||
if N=='' | N=="," then N=8 /*Not specified: Then use the default.*/
|
||||
if N<1 then call noSol /*display a message, the board is bad. */
|
||||
if N<1 then signal nOK /*display a message, the board is bad. */
|
||||
rank=1; file=1; #=0 /*starting rank&file; #≡number queens.*/
|
||||
@.=0; pad=left('', 9* (N<18)) /*define empty board; set indentation.*/
|
||||
|
||||
do while #<N; @.file.rank=1 /*keep placing queens until we're done.*/
|
||||
if ok(file,rank) then do; #=#+1 /*Queen not being attacked? Then eureka*/
|
||||
file=1 /*use another attempt at another file. */
|
||||
rank=rank+1 /*and also bump the rank counter. */
|
||||
iterate /*go and try another queen placement. */
|
||||
end /* [↑] found a good queen placement. */
|
||||
/* [↓] rank&file ≡ chessboard row&cols*/
|
||||
do while #<N; @.file.rank=1 /*keep placing queens until we're done.*/
|
||||
if ok(file, rank) then do; #=#+1; rank=rank+1 /*Queen not being attacked? Then eureka*/
|
||||
file=1 /*use another attempt at another file. */
|
||||
iterate /*go and try another queen placement. */
|
||||
end /* [↑] found a good queen placement. */
|
||||
@.file.rank=0 /*It isn't safe. So remove this queen.*/
|
||||
file=file+1 /*So, try the next (higher) file. */
|
||||
do while file>N; rank=rank-1; if rank==0 then call noSol
|
||||
do j=1 for N; if \@.j.rank then iterate /*occupied?*/
|
||||
file=j; @.file.rank=0; #=#-1; file=j+1; leave /*j*/
|
||||
file=file+1 /*So, try the next (higher) chess file.*/
|
||||
do while file>N; rank=rank-1; if rank==0 then call nOK
|
||||
do j=1 for N; if \@.j.rank then iterate /*¿ocupado?*/
|
||||
@.j.rank=0; #=#-1; file=j+1; leave
|
||||
end /*j*/
|
||||
end /*while file>N*/
|
||||
end /*while #<N*/
|
||||
|
||||
say 'A solution for' N "queens:"; a = substr( copies("┼───", N) ,2); say
|
||||
say pad translate('┌'a"┐", '┬', "┼") /*display the top rank (of the board).*/
|
||||
line = '├'a"┤"; dither='░' /*define a line (bar) for cell boundry.*/
|
||||
bar = '│' ; queen='Q' /*kinds: horizontal, vertical, salad. */
|
||||
Bqueen = dither || queen || dither /*glyph befitting a black-square queen.*/
|
||||
Wqueen = ' 'queen" " /* " " " white-square " */
|
||||
say 'A solution for ' N " queens:"; g=substr( copies("╬═══", N) ,2); say
|
||||
say pad translate('╔'g"╗", '╦', "╬") /*display the top rank (of the board).*/
|
||||
line = '╠'g"╣"; dither='░' /*define a line (bar) for cell boundry.*/
|
||||
bar = '║' ; queen='Q' /*kinds: horizontal, vertical, salad. */
|
||||
Bqueen = dither || queen || dither /*glyph befitting a black─square queen.*/
|
||||
Wqueen = ' 'queen" " /* " " " white─square " */
|
||||
|
||||
do rank=1 for N; if rank\==1 then say pad line; _= /*display sep for rank.*/
|
||||
do file=1 for N; B=(file+rank)//2 /*is the square black? */
|
||||
Qgylph=Wqueen; if B then Qgylph=Bqueen /*use a dithered queen.*/
|
||||
if @.file.rank then _=_ || bar || Qgylph /*3-char queen symbol. */
|
||||
do rank=1 for N; if rank\==1 then say pad line; _= /*display sep for rank.*/
|
||||
do file=1 for N; B = (file+rank) // 2 /*is the square black? */
|
||||
Qgylph=Wqueen; if B then Qgylph=Bqueen /*use a dithered queen.*/
|
||||
if @.file.rank then _=_ || bar || Qgylph /*3─char queen symbol. */
|
||||
else if B then _=_ || bar || copies(dither,3) /*use dithering for sq.*/
|
||||
else _=_ || bar || copies(' ' ,3) /* " 3 blanks " " */
|
||||
end /*file*/ /* [↑] preserve square-ish chessboard.*/
|
||||
end /*file*/ /* [↑] preserve square─ish chessboard.*/
|
||||
say pad _ || bar /*show a single rank of the chessboard.*/
|
||||
end /*rank*/ /*80 cols can view a 19x19 chessboard.*/
|
||||
|
||||
say pad translate('└'a"┘", '┴', "┼") /*display the last rank (of the board).*/
|
||||
say pad translate('╚'g"╝", '╩', "╬") /*display the last rank (of the board).*/
|
||||
exit 1 /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
noSol: say; say "No solution for" N 'queens.'; say; exit 0
|
||||
nOK: say; say "No solution for" N 'queens.'; say; exit 0
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
ok: parse arg f,r; rm=r-1; fm=f-1; fp=f+1
|
||||
do k=1 for rm; if @.f.k then return 0; end
|
||||
f=fm; do k=rm by -1 for rm while f\==0; if @.f.k then return 0; f=f-1; end
|
||||
f=fp; do k=rm by -1 for rm while f <=N; if @.f.k then return 0; f=f+1; end
|
||||
return 1 /* ↑↑↑↑↑↑↑↑ is queen under attack?*/
|
||||
ok: parse arg f,r; fp=f+1; rm=r-1 /*if return≡0, then queen isn't safe. */
|
||||
do k=1 for rm; if @.f.k then return 0; end
|
||||
f=f-1; do k=rm by -1 for rm while f\==0; if @.f.k then return 0; f=f-1; end
|
||||
f=fp; do k=rm by -1 for rm while f <=N; if @.f.k then return 0; f=f+1; end
|
||||
return 1 /*1≡queen is safe. */ /* ↑↑↑↑↑↑↑↑ is queen under attack? */
|
||||
|
|
|
|||
5
Task/N-queens-problem/Scala/n-queens-problem-3.scala
Normal file
5
Task/N-queens-problem/Scala/n-queens-problem-3.scala
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
for(v<-(0 to 7).permutations.filter(v=>(0 to 7).forall(i=>(i+1 to 7).
|
||||
forall(j=>j-i!=Math.abs(v(i)-v(j)))))){
|
||||
println("_"*15)
|
||||
v.map(i=>println("_|"*i+"Q"+"|_"*(7-i)))
|
||||
}
|
||||
74
Task/N-queens-problem/Scheme/n-queens-problem.ss
Normal file
74
Task/N-queens-problem/Scheme/n-queens-problem.ss
Normal file
|
|
@ -0,0 +1,74 @@
|
|||
(import (scheme base)
|
||||
(scheme write)
|
||||
(srfi 1))
|
||||
|
||||
;; return list of solutions to n-queens problem
|
||||
(define (n-queens n) ; breadth-first solution
|
||||
(define (place-initial-row) ; puts a queen on each column of row 0
|
||||
(list-tabulate n (lambda (col) (list (cons 0 col)))))
|
||||
(define (place-on-row soln-so-far row)
|
||||
(define (invalid? col)
|
||||
(any (lambda (posn)
|
||||
(or (= col (cdr posn)) ; on same column
|
||||
(= (abs (- row (car posn))) ; on same diagonal
|
||||
(abs (- col (cdr posn))))))
|
||||
soln-so-far))
|
||||
;
|
||||
(do ((col 0 (+ 1 col))
|
||||
(res '() (if (invalid? col)
|
||||
res
|
||||
(cons (cons (cons row col) soln-so-far)
|
||||
res))))
|
||||
((= col n) res)))
|
||||
;
|
||||
(do ((res (place-initial-row)
|
||||
(apply append
|
||||
(map (lambda (soln-so-far) (place-on-row soln-so-far row))
|
||||
res)))
|
||||
(row 1 (+ 1 row)))
|
||||
((= row n) res)))
|
||||
|
||||
;; display solutions in 2-d array form
|
||||
(define (pretty-print solutions n)
|
||||
(define (posn->index posn)
|
||||
(+ (* n (cdr posn))
|
||||
(car posn)))
|
||||
(define (pp solution)
|
||||
(let ((board (make-vector (square n) ".")))
|
||||
(for-each (lambda (queen) (vector-set! board
|
||||
(posn->index queen)
|
||||
"Q"))
|
||||
solution)
|
||||
(let loop ((row 0)
|
||||
(col 0))
|
||||
(cond ((= row n)
|
||||
(newline))
|
||||
((= col n)
|
||||
(newline)
|
||||
(loop (+ 1 row) 0))
|
||||
(else
|
||||
(display (vector-ref board (posn->index (cons row col))))
|
||||
(loop row (+ 1 col)))))))
|
||||
;
|
||||
(display (string-append "Found "
|
||||
(number->string (length solutions))
|
||||
" solutions for n="
|
||||
(number->string n)
|
||||
"\n\n"))
|
||||
(for-each pp solutions))
|
||||
|
||||
;; create table of number of solutions
|
||||
(do ((n 1 (+ 1 n)))
|
||||
((> n 10) )
|
||||
(display n)
|
||||
(display " ")
|
||||
(display (length (n-queens n)))
|
||||
(newline))
|
||||
|
||||
;; show some examples
|
||||
(pretty-print (n-queens 1) 1)
|
||||
(pretty-print (n-queens 2) 2)
|
||||
(pretty-print (n-queens 3) 3)
|
||||
(pretty-print (n-queens 4) 4)
|
||||
(pretty-print (n-queens 5) 5)
|
||||
(pretty-print (n-queens 8) 8)
|
||||
142
Task/N-queens-problem/Scilab/n-queens-problem.scilab
Normal file
142
Task/N-queens-problem/Scilab/n-queens-problem.scilab
Normal file
|
|
@ -0,0 +1,142 @@
|
|||
//Length of board side
|
||||
Board_size = 8;
|
||||
|
||||
function flag_out = no_attack(side, board, pos)
|
||||
//Evaluates (pos(1),pos(2)) in board if it's not on any queen attacking range
|
||||
//side (scalar): board's side length
|
||||
//board (sidexside matrix): matrix of 0s and 1s representing queens on a board
|
||||
//pos (1x2 matrix): postition on board to be evaluated
|
||||
//flag_out (bool): %T if position is available, and %F otherwise
|
||||
|
||||
//Counting queens on rows and columns
|
||||
row_col = sum(board(pos(1),:)) + sum(board(:,pos(2)));
|
||||
|
||||
//Counting queens on first diagonal
|
||||
diag_1 = sum(...
|
||||
diag(board, 0 +...
|
||||
(pos(2)>pos(1))*(pos(2)-pos(1)) +...
|
||||
(pos(1)>pos(2))*(pos(2)-pos(1))...
|
||||
)...
|
||||
);
|
||||
|
||||
//Counting queens on second diagonal
|
||||
a = pos(1) + pos(2);
|
||||
if a<=side+1 then
|
||||
rows = [1:a-1]
|
||||
cols = a - rows;
|
||||
else
|
||||
d = 2*(side+1)-a-1;
|
||||
rows = [side:-1:side-d+1]
|
||||
cols = a - rows;
|
||||
end
|
||||
|
||||
diag_2 = 0;
|
||||
for i = 1:length(rows)
|
||||
diag_2 = diag_2 + board(rows(i),cols(i));
|
||||
end
|
||||
|
||||
//Check if there's any queen
|
||||
flag_out = ( ~(row_col | diag_1 | diag_2) );
|
||||
endfunction
|
||||
|
||||
//Solution counter
|
||||
Sol_count = 0;
|
||||
|
||||
//"Soltion found" flag
|
||||
Sol_found = %F;
|
||||
|
||||
//Empty board
|
||||
Board = zeros(Board_size,Board_size);
|
||||
|
||||
//Matrix for backtracking
|
||||
Queens= zeros(Board_size,2);
|
||||
|
||||
//Queens counter
|
||||
N_queens = Board_size;
|
||||
|
||||
//Row and column counters
|
||||
i = 1; j = 1;
|
||||
|
||||
//Start counting time
|
||||
tic();
|
||||
|
||||
//Begin search
|
||||
while i <= Board_size
|
||||
while j <= Board_size
|
||||
//Availability flag: check position (i,j)
|
||||
flag = %F;
|
||||
if (0 < i & 0 < j) & (i <= Board_size & j <= Board_size) then
|
||||
flag = no_attack(Board_size,Board,[i j]);
|
||||
end
|
||||
|
||||
//Reset solution flag
|
||||
Sol_found = %F;
|
||||
|
||||
if flag then
|
||||
//Put a queen on the board if position is available
|
||||
Board(i,j) = 1;
|
||||
|
||||
//Update number of remaining queens
|
||||
N_queens = N_queens - 1;
|
||||
|
||||
//Keep track of queens positions
|
||||
Queens(Board_size - N_queens,:) = [i j];
|
||||
|
||||
//Jump to next row end of line is reached
|
||||
if i+1<=Board_size
|
||||
i = i + 1;
|
||||
end
|
||||
//Start over from the begining of new line
|
||||
j = 0;
|
||||
|
||||
//Count and flag a solution if all queens have
|
||||
//been placed on the board
|
||||
if N_queens == 0 then
|
||||
Sol_count = Sol_count + 1;
|
||||
Sol_found = %T;
|
||||
break
|
||||
end
|
||||
end
|
||||
|
||||
//Increment column number
|
||||
j = j + 1;
|
||||
end
|
||||
|
||||
//Increment row number and start from first column
|
||||
if ~Sol_found then
|
||||
i = i + 1;
|
||||
j = 1;
|
||||
|
||||
//Limiting placement of the first queen to the first row
|
||||
//Stop searching solutions if columns of first row
|
||||
//have been tested
|
||||
if i == 2 & j == 1 & sum(Board) == 0 then
|
||||
break
|
||||
end
|
||||
end
|
||||
|
||||
//Backtracking: if (i,j) reaches the and of the board
|
||||
//and there are queens left to be placed on it
|
||||
if ~Sol_found & i == Board_size + 1 & j == 1 then
|
||||
ind = Board_size - N_queens;
|
||||
if ind > 0 then
|
||||
//Recover last queen's position
|
||||
i = Queens(ind,1);
|
||||
j = Queens(ind,2);
|
||||
|
||||
//Remove it from the board and from the counter
|
||||
Board(i,j) = 0;
|
||||
Queens(ind,:) = [0 0];
|
||||
N_queens = N_queens + 1;
|
||||
|
||||
//Move to next column
|
||||
j = j + 1;
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
//Printing result on console
|
||||
disp("There are "+string(Sol_count)+" solutions for a "+...
|
||||
string(Board_size)+"x"+string(Board_size)+" board.");
|
||||
//Time elapsed
|
||||
disp("Time: "+string(toc())+"s.");
|
||||
60
Task/N-queens-problem/Stata/n-queens-problem-1.stata
Normal file
60
Task/N-queens-problem/Stata/n-queens-problem-1.stata
Normal file
|
|
@ -0,0 +1,60 @@
|
|||
mata
|
||||
real matrix queens(real scalar n) {
|
||||
real scalar i, j, k, p, q
|
||||
real rowvector a, s, u, v
|
||||
real matrix m
|
||||
|
||||
m = J(0, n, .)
|
||||
a = 1..n
|
||||
s = J(1, n, 0)
|
||||
u = J(1, 2*n-1, 1)
|
||||
v = J(1, 2*n-1, 1)
|
||||
i = j = 1
|
||||
L1: k = a[j]
|
||||
a[j] = a[i]
|
||||
a[i] = k
|
||||
p = i-k+n
|
||||
q = i+k-1
|
||||
if (u[p] & v[q]) {
|
||||
s[i++] = j
|
||||
u[p] = v[q] = 0
|
||||
if (i > n) {
|
||||
m = m\a
|
||||
goto L3
|
||||
}
|
||||
j = i
|
||||
goto L1
|
||||
}
|
||||
L2: if (++j <= n) goto L1
|
||||
while (--j > i) {
|
||||
k = a[i]
|
||||
a[i] = a[j]
|
||||
a[j] = k
|
||||
}
|
||||
L3: if (--i == 0) return(m)
|
||||
p = i-a[i]+n
|
||||
q = i+a[i]-1
|
||||
j = s[i]
|
||||
u[p] = v[q] = 1
|
||||
goto L2
|
||||
}
|
||||
|
||||
a = queens(8)
|
||||
e = I(8)
|
||||
1:/e[a[1,.],.]
|
||||
1 2 3 4 5 6 7 8
|
||||
+---------------------------------+
|
||||
1 | 1 . . . . . . . |
|
||||
2 | . . . . 1 . . . |
|
||||
3 | . . . . . . . 1 |
|
||||
4 | . . . . . 1 . . |
|
||||
5 | . . 1 . . . . . |
|
||||
6 | . . . . . . 1 . |
|
||||
7 | . 1 . . . . . . |
|
||||
8 | . . . 1 . . . . |
|
||||
+---------------------------------+
|
||||
|
||||
|
||||
rows(a)
|
||||
92
|
||||
end
|
||||
4
Task/N-queens-problem/Stata/n-queens-problem-2.stata
Normal file
4
Task/N-queens-problem/Stata/n-queens-problem-2.stata
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
clear
|
||||
mata: a=queens(8)
|
||||
getmata (a*)=a
|
||||
save queens, replace
|
||||
58
Task/N-queens-problem/Stata/n-queens-problem-3.stata
Normal file
58
Task/N-queens-problem/Stata/n-queens-problem-3.stata
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
mata
|
||||
real matrix queens(real scalar n) {
|
||||
real rowvector a, u, v
|
||||
real matrix m
|
||||
|
||||
a = 1..n
|
||||
u = J(1, 2*n-1, 1)
|
||||
v = J(1, 2*n-1, 1)
|
||||
m = J(0, n, .)
|
||||
queens_aux(n, 1, a, u, v, m)
|
||||
return(m)
|
||||
}
|
||||
|
||||
void queens_aux(real scalar n, real scalar i, real rowvector a,
|
||||
real rowvector u, real rowvector v, real matrix m) {
|
||||
|
||||
real scalar j, k, s
|
||||
|
||||
if (i > n) {
|
||||
m = m\a
|
||||
} else {
|
||||
for (k = i; k <= n; k++) {
|
||||
j = a[k]
|
||||
p = i+j-1
|
||||
q = i-j+n
|
||||
if (u[p] & v[q]) {
|
||||
u[p] = v[q] = 0
|
||||
s = a[i]
|
||||
a[i] = a[k]
|
||||
a[k] = s
|
||||
queens_aux(n, i+1, a, u, v, m)
|
||||
u[p] = v[q] = 1
|
||||
s = a[i]
|
||||
a[i] = a[k]
|
||||
a[k] = s
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
a = queens(8)
|
||||
e = I(8)
|
||||
1:/e[a[1,.],.]
|
||||
1 2 3 4 5 6 7 8
|
||||
+---------------------------------+
|
||||
1 | 1 . . . . . . . |
|
||||
2 | . . . . 1 . . . |
|
||||
3 | . . . . . . . 1 |
|
||||
4 | . . . . . 1 . . |
|
||||
5 | . . 1 . . . . . |
|
||||
6 | . . . . . . 1 . |
|
||||
7 | . 1 . . . . . . |
|
||||
8 | . . . 1 . . . . |
|
||||
+---------------------------------+
|
||||
|
||||
rows(a)
|
||||
92
|
||||
end
|
||||
58
Task/N-queens-problem/VBA/n-queens-problem.vba
Normal file
58
Task/N-queens-problem/VBA/n-queens-problem.vba
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
'N-queens problem - non recursive & structured - vba - 26/02/2017
|
||||
Sub n_queens()
|
||||
Const l = 15 'number of queens
|
||||
Const b = False 'print option
|
||||
Dim a(l), s(l), u(4 * l - 2)
|
||||
Dim n, m, i, j, p, q, r, k, t, z
|
||||
For i = 1 To UBound(a): a(i) = i: Next i
|
||||
For n = 1 To l
|
||||
m = 0
|
||||
i = 1
|
||||
j = 0
|
||||
r = 2 * n - 1
|
||||
Do
|
||||
i = i - 1
|
||||
j = j + 1
|
||||
p = 0
|
||||
q = -r
|
||||
Do
|
||||
i = i + 1
|
||||
u(p) = 1
|
||||
u(q + r) = 1
|
||||
z = a(j): a(j) = a(i): a(i) = z 'Swap a(i), a(j)
|
||||
p = i - a(i) + n
|
||||
q = i + a(i) - 1
|
||||
s(i) = j
|
||||
j = i + 1
|
||||
Loop Until j > n Or u(p) Or u(q + r)
|
||||
If u(p) = 0 Then
|
||||
If u(q + r) = 0 Then
|
||||
m = m + 1 'm: number of solutions
|
||||
If b Then
|
||||
Debug.Print "n="; n; "m="; m
|
||||
For k = 1 To n
|
||||
For t = 1 To n
|
||||
Debug.Print IIf(a(n - k + 1) = t, "Q", ".");
|
||||
Next t
|
||||
Debug.Print
|
||||
Next k
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
j = s(i)
|
||||
Do While j >= n And i <> 0
|
||||
Do
|
||||
z = a(j): a(j) = a(i): a(i) = z 'Swap a(i), a(j)
|
||||
j = j - 1
|
||||
Loop Until j < i
|
||||
i = i - 1
|
||||
p = i - a(i) + n
|
||||
q = i + a(i) - 1
|
||||
j = s(i)
|
||||
u(p) = 0
|
||||
u(q + r) = 0
|
||||
Loop
|
||||
Loop Until i = 0
|
||||
Debug.Print n, m 'number of queens, number of solutions
|
||||
Next n
|
||||
End Sub 'n_queens
|
||||
46
Task/N-queens-problem/VBScript/n-queens-problem.vb
Normal file
46
Task/N-queens-problem/VBScript/n-queens-problem.vb
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
'N-queens problem - non recursive & structured - vbs - 24/02/2017
|
||||
const l=15
|
||||
dim a(),s(),u(): redim a(l),s(l),u(4*l-2)
|
||||
for i=1 to l: a(i)=i: next
|
||||
for n=1 to l
|
||||
m=0
|
||||
i=1
|
||||
j=0
|
||||
r=2*n-1
|
||||
Do
|
||||
i=i-1
|
||||
j=j+1
|
||||
p=0
|
||||
q=-r
|
||||
Do
|
||||
i=i+1
|
||||
u(p)=1
|
||||
u(q+r)=1
|
||||
z=a(j): a(j)=a(i): a(i)=z 'swap a(i),a(j)
|
||||
p=i-a(i)+n
|
||||
q=i+a(i)-1
|
||||
s(i)=j
|
||||
j=i+1
|
||||
Loop Until j>n Or u(p)<>0 Or u(q+r)<>0
|
||||
If u(p)=0 Then
|
||||
If u(q+r)=0 Then
|
||||
m=m+1 'm: number of solutions
|
||||
'x="": for k=1 to n: x=x&" "&a(k): next: msgbox x,,m
|
||||
End If
|
||||
End If
|
||||
j=s(i)
|
||||
Do While j>=n And i<>0
|
||||
Do
|
||||
z=a(j): a(j)=a(i): a(i)=z 'swap a(i),a(j)
|
||||
j=j-1
|
||||
Loop Until j<i
|
||||
i=i-1
|
||||
p=i-a(i)+n
|
||||
q=i+a(i)-1
|
||||
j=s(i)
|
||||
u(p)=0
|
||||
u(q+r)=0
|
||||
Loop
|
||||
Loop Until i=0
|
||||
wscript.echo n &":"& m
|
||||
next 'n
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
'N-queens problem - non recursive & structured - vb.net - 26/02/2017
|
||||
Module Mod_n_queens
|
||||
Sub n_queens()
|
||||
Const l = 15 'number of queens
|
||||
Const b = False 'print option
|
||||
Dim a(l), s(l), u(4 * l - 2)
|
||||
Dim n, m, i, j, p, q, r, k, t, z
|
||||
Dim w As String
|
||||
For i = 1 To UBound(a) : a(i) = i : Next i
|
||||
For n = 1 To l
|
||||
m = 0
|
||||
i = 1
|
||||
j = 0
|
||||
r = 2 * n - 1
|
||||
Do
|
||||
i = i - 1
|
||||
j = j + 1
|
||||
p = 0
|
||||
q = -r
|
||||
Do
|
||||
i = i + 1
|
||||
u(p) = 1
|
||||
u(q + r) = 1
|
||||
z = a(j) : a(j) = a(i) : a(i) = z 'Swap a(i), a(j)
|
||||
p = i - a(i) + n
|
||||
q = i + a(i) - 1
|
||||
s(i) = j
|
||||
j = i + 1
|
||||
Loop Until j > n Or u(p) Or u(q + r)
|
||||
If u(p) = 0 Then
|
||||
If u(q + r) = 0 Then
|
||||
m = m + 1 'm: number of solutions
|
||||
If b Then
|
||||
Debug.Print("n=" & n & " m=" & m) : w = ""
|
||||
For k = 1 To n
|
||||
For t = 1 To n
|
||||
w = w & If(a(n - k + 1) = t, "Q", ".")
|
||||
Next t
|
||||
Debug.Print(w)
|
||||
Next k
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
j = s(i)
|
||||
Do While j >= n And i <> 0
|
||||
Do
|
||||
z = a(j) : a(j) = a(i) : a(i) = z 'Swap a(i), a(j)
|
||||
j = j - 1
|
||||
Loop Until j < i
|
||||
i = i - 1
|
||||
p = i - a(i) + n
|
||||
q = i + a(i) - 1
|
||||
j = s(i)
|
||||
u(p) = 0
|
||||
u(q + r) = 0
|
||||
Loop
|
||||
Loop Until i = 0
|
||||
Debug.Print(n & vbTab & m) 'number of queens, number of solutions
|
||||
Next n
|
||||
End Sub 'n_queens
|
||||
End Module
|
||||
58
Task/N-queens-problem/Visual-Basic/n-queens-problem.vb
Normal file
58
Task/N-queens-problem/Visual-Basic/n-queens-problem.vb
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
'N-queens problem - non recursive & structured - vb6 - 25/02/2017
|
||||
Sub n_queens()
|
||||
Const l = 15 'number of queens
|
||||
Const b = False 'print option
|
||||
Dim a(l), s(l), u(4 * l - 2)
|
||||
Dim n, m, i, j, p, q, r, k, t, z
|
||||
For i = 1 To UBound(a): a(i) = i: Next i
|
||||
For n = 1 To l
|
||||
m = 0
|
||||
i = 1
|
||||
j = 0
|
||||
r = 2 * n - 1
|
||||
Do
|
||||
i = i - 1
|
||||
j = j + 1
|
||||
p = 0
|
||||
q = -r
|
||||
Do
|
||||
i = i + 1
|
||||
u(p) = 1
|
||||
u(q + r) = 1
|
||||
z = a(j): a(j) = a(i): a(i) = z 'Swap a(i), a(j)
|
||||
p = i - a(i) + n
|
||||
q = i + a(i) - 1
|
||||
s(i) = j
|
||||
j = i + 1
|
||||
Loop Until j > n Or u(p) Or u(q + r)
|
||||
If u(p) = 0 Then
|
||||
If u(q + r) = 0 Then
|
||||
m = m + 1 'm: number of solutions
|
||||
If b Then
|
||||
Debug.Print "n="; n; "m="; m
|
||||
For k = 1 To n
|
||||
For t = 1 To n
|
||||
Debug.Print IIf(a(n - k + 1) = t, "Q", ".");
|
||||
Next t
|
||||
Debug.Print
|
||||
Next k
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
j = s(i)
|
||||
Do While j >= n And i <> 0
|
||||
Do
|
||||
z = a(j): a(j) = a(i): a(i) = z 'Swap a(i), a(j)
|
||||
j = j - 1
|
||||
Loop Until j < i
|
||||
i = i - 1
|
||||
p = i - a(i) + n
|
||||
q = i + a(i) - 1
|
||||
j = s(i)
|
||||
u(p) = 0
|
||||
u(q + r) = 0
|
||||
Loop
|
||||
Loop Until i = 0
|
||||
Debug.Print n, m 'number of queens, number of solutions
|
||||
Next n
|
||||
End Sub 'n_queens
|
||||
9
Task/N-queens-problem/Zkl/n-queens-problem-1.zkl
Normal file
9
Task/N-queens-problem/Zkl/n-queens-problem-1.zkl
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
fcn isAttacked([(x,y)],a,b) // explode list (x,y) into args x & y
|
||||
{ (x==a or y==b or x+y==a+b or x-y==a-b) }
|
||||
fcn isSafe(a,b,qs){(not qs.filter1(isAttacked,a,b))} // stop at first attack
|
||||
fcn queensN(N=8,row=1,queens=T){ // T is read only list
|
||||
qs := [1..N].filter(isSafe.fpM("101",row,queens)) // fpM makes r&q first & third args
|
||||
.apply(fcn(c,r,qs){qs+T(r,c)},row,queens);
|
||||
if (row == N) return(qs);
|
||||
return(qs.apply(self.fcn.fp(N,row+1)).flatten()); // recurse
|
||||
}
|
||||
6
Task/N-queens-problem/Zkl/n-queens-problem-2.zkl
Normal file
6
Task/N-queens-problem/Zkl/n-queens-problem-2.zkl
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
queens := queensN(4);
|
||||
println(queens.len()," solution(s):");
|
||||
queens.apply2(Console.println);
|
||||
--> 2 solution(s):
|
||||
L(L(1,2),L(2,4),L(3,1),L(4,3))
|
||||
L(L(1,3),L(2,1),L(3,4),L(4,2))
|
||||
Loading…
Add table
Add a link
Reference in a new issue