Peaceful chess queen armies

In chess, a queen attacks positions from where it is, in straight lines up-down and left-right as well as on both its diagonals. It attacks only pieces not of its own colour.

	⇖	⇑	⇗
⇐	⇐	♛	⇒	⇒
	⇙	⇓	⇘
⇙		⇓		⇘
		⇓

The goal of Peaceful chess queen armies is to arrange m black queens and m white queens on an n-by-n square grid, (the board), so that no queen attacks another of a different colour.

Task

Create a routine to represent two-colour queens on a 2-D board. (Alternating black/white background colours, Unicode chess pieces and other embellishments are not necessary, but may be used at your discretion).
Create a routine to generate at least one solution to placing m equal numbers of black and white queens on an n square board.
Display here results for the m=4, n=5 case.

References

Peaceably Coexisting Armies of Queens (Pdf) by Robert A. Bosch. Optima, the Mathematical Programming Socity newsletter, issue 62.
A250000 OEIS

11l

Translation of: D

<lang 11l>T.enum Piece

  EMPTY
  BLACK
  WHITE

F isAttacking(queen, pos)

  R queen.x == pos.x
  | queen.y == pos.y
  | abs(queen.x - pos.x) == abs(queen.y - pos.y)

F place(m, n, &pBlackQueens, &pWhiteQueens)

  I m == 0
     R 1B

  V placingBlack = 1B
  L(i) 0 .< n
     L(j) 0 .< n
        V pos = (i, j)
        L(queen) pBlackQueens
           I queen == pos | (!placingBlack & isAttacking(queen, pos))
              L.break
        L.was_no_break
           L(queen) pWhiteQueens
              I queen == pos | (placingBlack & isAttacking(queen, pos))
                 L.break
           L.was_no_break
              I placingBlack
                 pBlackQueens [+]= pos
                 placingBlack = 0B
              E
                 pWhiteQueens [+]= pos
                 I place(m - 1, n, &pBlackQueens, &pWhiteQueens)
                    R 1B
                 pBlackQueens.pop()
                 pWhiteQueens.pop()
                 placingBlack = 1B

  I !placingBlack
     pBlackQueens.pop()
  R 0B

F printBoard(n, blackQueens, whiteQueens)

  V board = [Piece.EMPTY] * (n * n)

  L(queen) blackQueens
     board[queen.x * n + queen.y] = Piece.BLACK

  L(queen) whiteQueens
     board[queen.x * n + queen.y] = Piece.WHITE

  L(b) board
     V i = L.index
     I i != 0 & i % n == 0
        print()
     I b == BLACK
        print(‘B ’, end' ‘’)
     E I b == WHITE
        print(‘W ’, end' ‘’)
     E
        V j = i I/ n
        V k = i - j * n
        I j % 2 == k % 2
           print(‘x ’, end' ‘’)
        E
           print(‘o ’, end' ‘’)
  print("\n")

V nms = [

         (2, 1), (3, 1), (3, 2), (4, 1), (4, 2), (4, 3),
         (5, 1), (5, 2), (5, 3), (5, 4), (5, 5),
         (6, 1), (6, 2), (6, 3), (6, 4), (6, 5), (6, 6),
         (7, 1), (7, 2), (7, 3), (7, 4), (7, 5), (7, 6), (7, 7)
       ]

L(nm) nms

  print(‘#. black and #. white queens on a #. x #. board:’.format(nm[1], nm[1], nm[0], nm[0]))
  [(Int, Int)] blackQueens, whiteQueens
  I place(nm[1], nm[0], &blackQueens, &whiteQueens)
     printBoard(nm[0], blackQueens, whiteQueens)
  E
     print("No solution exists.\n")</lang>

Output:

1 black and 1 white queens on a 2 x 2 board:
No solution exists.

1 black and 1 white queens on a 3 x 3 board:
B o x
o x W
x o x

2 black and 2 white queens on a 3 x 3 board:
No solution exists.

1 black and 1 white queens on a 4 x 4 board:
B o x o
o x W x
x o x o
o x o x

2 black and 2 white queens on a 4 x 4 board:
B o x o
o x W x
B o x o
o x W x

3 black and 3 white queens on a 4 x 4 board:
No solution exists.

1 black and 1 white queens on a 5 x 5 board:
B o x o x
o x W x o
x o x o x
o x o x o
x o x o x

2 black and 2 white queens on a 5 x 5 board:
B o x o B
o x W x o
x W x o x
o x o x o
x o x o x

3 black and 3 white queens on a 5 x 5 board:
B o x o B
o x W x o
x W x o x
o x o B o
x W x o x

4 black and 4 white queens on a 5 x 5 board:
x B x B x
o x o x B
W o W o x
o x o x B
W o W o x

5 black and 5 white queens on a 5 x 5 board:
No solution exists.

1 black and 1 white queens on a 6 x 6 board:
B o x o x o
o x W x o x
x o x o x o
o x o x o x
x o x o x o
o x o x o x

2 black and 2 white queens on a 6 x 6 board:
B o x o B o
o x W x o x
x W x o x o
o x o x o x
x o x o x o
o x o x o x

3 black and 3 white queens on a 6 x 6 board:
B o x o B B
o x W x o x
x W x o x o
o x o x o x
x o W o x o
o x o x o x

4 black and 4 white queens on a 6 x 6 board:
B o x o B B
o x W x o x
x W x o x o
o x o x o B
x o W W x o
o x o x o x

5 black and 5 white queens on a 6 x 6 board:
x B x o B o
o x o B o B
W o x o x o
W x W x o x
x o x o x B
W x W x o x

6 black and 6 white queens on a 6 x 6 board:
No solution exists.

1 black and 1 white queens on a 7 x 7 board:
B o x o x o x
o x W x o x o
x o x o x o x
o x o x o x o
x o x o x o x
o x o x o x o
x o x o x o x

2 black and 2 white queens on a 7 x 7 board:
B o x o B o x
o x W x o x W
x o x o x o x
o x o x o x o
x o x o x o x
o x o x o x o
x o x o x o x

3 black and 3 white queens on a 7 x 7 board:
B o x o B o x
o x W x o x W
B o x o x o x
o x W x o x o
x o x o x o x
o x o x o x o
x o x o x o x

4 black and 4 white queens on a 7 x 7 board:
B o x o B o x
o x W x o x W
B o x o B o x
o x W x o x W
x o x o x o x
o x o x o x o
x o x o x o x

5 black and 5 white queens on a 7 x 7 board:
B o x o B o x
o x W x o x W
B o x o B o x
o x W x o x W
B o x o x o x
o x W x o x o
x o x o x o x

6 black and 6 white queens on a 7 x 7 board:
B o x o B o x
o x W x o x W
B o x o B o x
o x W x o x W
B o x o B o x
o x W x o x W
x o x o x o x

7 black and 7 white queens on a 7 x 7 board:
x B x o x B x
o B o x B x o
x B x o x B x
o x o x B x o
W o W o x o W
o x o W o x o
W o W W x o x

ATS

Translation of: Scheme

The program can print either all solutions or all solutions that are ‘inequivalent’, in the sense of https://oeis.org/A260680

The program also can stop after printing a specified number of solutions, although the default is to print all solutions.

(Commentary by the author: this program suffers similarly of slowness, in eliminating rotational equivalents, as does its Scheme ancestor. Some reasons: it uses backtracking and that is slow; it uses essentially the same inefficient storage format for solutions [one could for instance use integers], and it does not precompute rotational equivalents. However, it does satisfy the task requirements, and might be regarded as a good start. And it can solve the m=5, n=6 case in practical time on a fast machine. m=7, n=7 is a more annoying case.)

<lang ats>(********************************************************************)

define ATS_DYNLOADFLAG 0

include "share/atspre_define.hats"
include "share/atspre_staload.hats"

staload UN = "prelude/SATS/unsafe.sats"

define NIL list_vt_nil ()
define :: list_vt_cons

ifndef NDEBUG #then

 (* Safety is relatively unimportant in this program.
    Therefore I have made it so you can put ‘-DATS NDEBUG=1’ on
    your patscc command line, to skip some assertloc tests. *)
 #define NDEBUG 0

endif

(********************************************************************)

define EMPTY 0
define BLACK 1
define WHITE ~1

stadef is_color (c : int) : bool = (~1 <= c && c <= 1) stadef reverse_color (c : int) : int = ~c

typedef color_t (tk : tkind, c : int) =

   [is_color c]
   g1int (tk, c)

typedef color_t (tk : tkind) =

   [c : int | is_color c]
   g1int (tk, c)

fn {tk : tkind} reverse_color {c : int | is_color c}

             (c : g1int (tk, c)) :<>
   [c_rev : int | is_color c_rev;
                  c_rev == reverse_color c]
   g1int (tk, c_rev) =
 (* This template is a fancy way to say ‘minus’. *)
 ~c

(********************************************************************)

(* Matrix indices will run from 0..n-1 rather than 1..n. *)

define SIDE_MAX 16 (* The maximum side size. For

                                  efficiency, please make it a
                                  power of two. *)

define BOARD_SIZE 256 (* The storage size for a board. *)

prval _ = prop_verify {SIDE_MAX * SIDE_MAX == BOARD_SIZE} ()

fn {tk : tkind} row_index {k : int | 0 <= k; k < BOARD_SIZE}

         (k : g1int (tk, k)) :<>
   [i : int | 0 <= i; i < SIDE_MAX]
   g1int (tk, i) =
 (* Let the C compiler convert this to bitmasking. *)
 g1int_nmod (k, g1i2i SIDE_MAX)

fn {tk : tkind} column_index {k : int | 0 <= k; k < BOARD_SIZE}

            (k : g1int (tk, k)) :<>
   [i : int | 0 <= i; i < SIDE_MAX]
   g1int (tk, i) =
 (* Let the C compiler convert this to a shift. *)
 k / g1i2i SIDE_MAX

fn {tk : tkind} storage_index {i, j : int | 0 <= i; i < SIDE_MAX;

                           0 <= j; j < SIDE_MAX}
             (i : g1int (tk, i),
              j : g1int (tk, j)) :<>
   [k : int | 0 <= k; k < BOARD_SIZE]
   g1int (tk, k) =
 (* Let the C compiler convert this to a shift and add. *)
 i + (j * g1i2i SIDE_MAX)

(********************************************************************)

extern fn {tk_index : tkind} test_equiv$reindex_i

         {i, j : int | 0 <= i; 0 <= j}
         {n : int | 0 <= n; n <= SIDE_MAX;
                    i < n; j < n}
         (i : g1int (tk_index, i),
          j : g1int (tk_index, j),
          n : g1int (tk_index, n)) :<>
   [i1 : int | 0 <= i1; i1 < SIDE_MAX]
   g1int (tk_index, i1)

extern fn {tk_index : tkind} test_equiv$reindex_j

         {i, j : int | 0 <= i; 0 <= j}
         {n : int | 0 <= n; n <= SIDE_MAX;
                    i < n; j < n}
         (i : g1int (tk_index, i),
          j : g1int (tk_index, j),
          n : g1int (tk_index, n)) :<>
   [j1 : int | 0 <= j1; j1 < SIDE_MAX]
   g1int (tk_index, j1)

extern fn {tk_color : tkind} test_equiv$recolor

         {c : int | is_color c}
         (c : g1int (tk_color, c)) :<>
   [c1 : int | is_color c1]
   g1int (tk_color, c1)

fn {tk_index, tk_color : tkind} test_equiv {n : int | 0 <= n; n <= SIDE_MAX}

          (a : &(@[color_t tk_color][BOARD_SIZE]),
           b : &(@[color_t tk_color][BOARD_SIZE]),
           n : g1int (tk_index, n)) :
   bool =
 let
   macdef reindex_i = test_equiv$reindex_i<tk_index>
   macdef reindex_j = test_equiv$reindex_j<tk_index>
   macdef recolor = test_equiv$recolor<tk_color>

   fun
   loopj {j : int | ~1 <= j; j < n} .<j + 1>.
         (a : &(@[color_t tk_color][BOARD_SIZE]),
          b : &(@[color_t tk_color][BOARD_SIZE]),
          n : g1int (tk_index, n),
          j : g1int (tk_index, j)) :
       bool =
     if j < g1i2i 0 then
       true
     else
       let
         fun loopi {i : int | ~1 <= i; i < n} ..
                   (a : &(@[color_t tk_color][BOARD_SIZE]),
                    b : &(@[color_t tk_color][BOARD_SIZE]),
                    n : g1int (tk_index, n),
                    j : g1int (tk_index, j),
                    i : g1int (tk_index, i)) :
             bool =
               if i < g1i2i 0 then
                 true
               else
                 let
                   val ka = storage_index<tk_index> (i, j)
                   val color_a = a[ka]

val i1 = test_equiv$reindex_i<tk_index> (i, j, n) val j1 = test_equiv$reindex_j<tk_index> (i, j, n) val kb = storage_index<tk_index> (i1, j1) val color_b = recolor b[kb] in if color_a = color_b then loopi (a, b, n, j, pred i) else false end in if loopi (a, b, n, j, g1i2i (pred n)) then loopj (a, b, n, pred j) else false end in loopj (a, b, n, g1i2i (pred n)) end

fn {tk_index, tk_color : tkind} test_equiv_rotate0

{n : int | 0 <= n; n <= SIDE_MAX} (a : &(@[color_t tk_color][BOARD_SIZE]), b : &(@[color_t tk_color][BOARD_SIZE]), n : g1int (tk_index, n)) : bool = let (* No rotations or reflections. *) implement test_equiv$reindex_i<tk_index> (i, j, n) = i implement test_equiv$reindex_j<tk_index> (i, j, n) = j in test_equiv<tk_index, tk_color> (a, b, n) end

fn {tk_index, tk_color : tkind} test_equiv_rotate90

{n : int | 0 <= n; n <= SIDE_MAX} (a : &(@[color_t tk_color][BOARD_SIZE]), b : &(@[color_t tk_color][BOARD_SIZE]), n : g1int (tk_index, n)) : bool = let (* Matrix rotation counterclockwise by 90 degrees. *) implement test_equiv$reindex_i<tk_index> {i, j} {n} (i, j, n) = pred n - j implement test_equiv$reindex_j<tk_index> (i, j, n) = i in test_equiv<tk_index, tk_color> (a, b, n) end

fn {tk_index, tk_color : tkind} test_equiv_rotate180

{n : int | 0 <= n; n <= SIDE_MAX} (a : &(@[color_t tk_color][BOARD_SIZE]), b : &(@[color_t tk_color][BOARD_SIZE]), n : g1int (tk_index, n)) : bool = let (* Matrix rotation by 180 degrees. *) implement test_equiv$reindex_i<tk_index> {i, j} {n} (i, j, n) = pred n - i implement test_equiv$reindex_j<tk_index> {i, j} {n} (i, j, n) = pred n - j in test_equiv<tk_index, tk_color> (a, b, n) end

fn {tk_index, tk_color : tkind} test_equiv_rotate270

{n : int | 0 <= n; n <= SIDE_MAX} (a : &(@[color_t tk_color][BOARD_SIZE]), b : &(@[color_t tk_color][BOARD_SIZE]), n : g1int (tk_index, n)) : bool = let (* Matrix rotation counterclockwise by 270 degrees. *) implement test_equiv$reindex_i<tk_index> (i, j, n) = j implement test_equiv$reindex_j<tk_index> {i, j} {n} (i, j, n) = pred n - i in test_equiv<tk_index, tk_color> (a, b, n) end

fn {tk_index, tk_color : tkind} test_equiv_reflecti

{n : int | 0 <= n; n <= SIDE_MAX} (a : &(@[color_t tk_color][BOARD_SIZE]), b : &(@[color_t tk_color][BOARD_SIZE]), n : g1int (tk_index, n)) : bool = let (* Reverse the order of the rows. *) implement test_equiv$reindex_i<tk_index> {i, j} {n} (i, j, n) = pred n - i implement test_equiv$reindex_j<tk_index> (i, j, n) = j in test_equiv<tk_index, tk_color> (a, b, n) end

fn {tk_index, tk_color : tkind} test_equiv_reflectj

{n : int | 0 <= n; n <= SIDE_MAX} (a : &(@[color_t tk_color][BOARD_SIZE]), b : &(@[color_t tk_color][BOARD_SIZE]), n : g1int (tk_index, n)) : bool = let (* Reverse the order of the columns. *) implement test_equiv$reindex_i<tk_index> (i, j, n) = i implement test_equiv$reindex_j<tk_index> {i, j} {n} (i, j, n) = pred n - j in test_equiv<tk_index, tk_color> (a, b, n) end

fn {tk_index, tk_color : tkind} test_equiv_reflect_diag_down

{n : int | 0 <= n; n <= SIDE_MAX} (a : &(@[color_t tk_color][BOARD_SIZE]), b : &(@[color_t tk_color][BOARD_SIZE]), n : g1int (tk_index, n)) : bool = let (* Transpose the matrix around its main diagonal. *) implement test_equiv$reindex_i<tk_index> (i, j, n) = j implement test_equiv$reindex_j<tk_index> (i, j, n) = i in test_equiv<tk_index, tk_color> (a, b, n) end

fn {tk_index, tk_color : tkind} test_equiv_reflect_diag_up

{n : int | 0 <= n; n <= SIDE_MAX} (a : &(@[color_t tk_color][BOARD_SIZE]), b : &(@[color_t tk_color][BOARD_SIZE]), n : g1int (tk_index, n)) : bool = let (* Transpose the matrix around its main skew diagonal. *) implement test_equiv$reindex_i<tk_index> {i, j} {n} (i, j, n) = pred n - j implement test_equiv$reindex_j<tk_index> {i, j} {n} (i, j, n) = pred n - i in test_equiv<tk_index, tk_color> (a, b, n) end

fn {tk_index, tk_color : tkind} board_equiv {n : int | 0 <= n; n <= SIDE_MAX}

(a : &(@[color_t tk_color][BOARD_SIZE]), b : &(@[color_t tk_color][BOARD_SIZE]), n : g1int (tk_index, n), rotation_equiv_classes : bool) : bool = let (* Leave the colors unchanged. *) implement test_equiv$recolor<tk_color> (c) = c
(* Test without rotations or reflections. *) val equiv = test_equiv_rotate0<tk_index, tk_color> (a, b, n) in if ~rotation_equiv_classes then equiv else let (* Leave the colors unchanged. *) implement test_equiv$recolor<tk_color> (c) = c
val equiv = (equiv || test_equiv_rotate90<tk_index, tk_color> (a, b, n) || test_equiv_rotate180<tk_index, tk_color> (a, b, n) || test_equiv_rotate270<tk_index, tk_color> (a, b, n) || test_equiv_reflecti<tk_index, tk_color> (a, b, n) || test_equiv_reflectj<tk_index, tk_color> (a, b, n) || test_equiv_reflect_diag_down<tk_index, tk_color> (a, b, n) || test_equiv_reflect_diag_up<tk_index, tk_color> (a, b, n))
(* Reverse the colors of b in each test. *) implement test_equiv$recolor<tk_color> (c) = reverse_color c
val equiv = (equiv || test_equiv_rotate0<tk_index, tk_color> (a, b, n) || test_equiv_rotate90<tk_index, tk_color> (a, b, n) || test_equiv_rotate180<tk_index, tk_color> (a, b, n) || test_equiv_rotate270<tk_index, tk_color> (a, b, n) || test_equiv_reflecti<tk_index, tk_color> (a, b, n) || test_equiv_reflectj<tk_index, tk_color> (a, b, n) || test_equiv_reflect_diag_down<tk_index, tk_color> (a, b, n) || test_equiv_reflect_diag_up<tk_index, tk_color> (a, b, n)) in equiv end end

(********************************************************************)

fn {tk_index : tkind} fprint_rule {n : int | 0 <= n; n <= SIDE_MAX}

(f : FILEref, n : g1int (tk_index, n)) : void = let fun loop {j : int | 0 <= j; j <= n} .<n - j>. (j : g1int (tk_index, j)) : void = if j <> n then begin fileref_puts (f, "----+"); loop (succ j) end in fileref_puts (f, "+"); loop (g1i2i 0) end

fn {tk_index, tk_color : tkind} fprint_board {n : int | 0 <= n; n <= SIDE_MAX}

(f : FILEref, a : &(@[color_t tk_color][BOARD_SIZE]), n : g1int (tk_index, n)) : void = if n <> 0 then let fun loopi {i : int | ~1 <= i; i < n} .. (f : FILEref, a : &(@[color_t tk_color][BOARD_SIZE]), n : g1int (tk_index, n), i : g1int (tk_index, i)) : void = if i <> ~1 then let fun loopj {j : int | 0 <= j; j <= n} .<n - j>. (f : FILEref, a : &(@[color_t tk_color][BOARD_SIZE]), n : g1int (tk_index, n), i : g1int (tk_index, i), j : g1int (tk_index, j)) : void = if j <> n then let val k = storage_index<tk_index> (i, j) val color = a[k] val representation = if color = g1i2i BLACK then "| B " else if color = g1i2i WHITE then "| W " else "| " in fileref_puts (f, representation); loopj (f, a, n, i, succ j) end in fileref_puts (f, "\n"); loopj (f, a, n, i, g1i2i 0); fileref_puts (f, "|\n"); fprint_rule (f, n); loopi (f, a, n, pred i) end in fprint_rule (f, n); loopi (f, a, n, pred n) end

(********************************************************************)

(* M2_MAX equals the maximum number of queens of either color.

Thus it is the maximum of 2*m, where m is the number of queens in an army. *)
define M2_MAX BOARD_SIZE

(* The even-index queens are BLACK, the odd-index queens are WHITE. *)

vtypedef board_record_vt (tk_color : tkind,

p : addr) = @{ pf = @[color_t tk_color][BOARD_SIZE] @ p, pfgc = mfree_gc_v p | p = ptr p }

vtypedef board_record_vt (tk_color : tkind) =

[p : addr | null < p] board_record_vt (tk_color, p)

vtypedef board_record_list_vt (tk_color : tkind,

n : int) = list_vt (board_record_vt tk_color, n)

vtypedef board_record_list_vt (tk_color : tkind) =

[n : int] board_record_list_vt (tk_color, n)

fn board_record_vt_free

{tk_color : tkind} {p : addr} (record : board_record_vt (tk_color, p)) : void = let val @{ pf = pf, pfgc = pfgc | p = p } = record in array_ptr_free (pf, pfgc | p) end

overload free with board_record_vt_free

fn board_record_list_vt_free

{tk_color : tkind} {n : int} (lst : board_record_list_vt (tk_color, n)) : void = let fun loop {n : int | 0 <= n} .<n>. (lst : board_record_list_vt (tk_color, n)) : void = case+ lst of | ~ NIL => () | ~ head :: tail => begin free head; loop tail end
prval _ = lemma_list_vt_param lst in loop lst end

fn {tk_index, tk_color : tkind} any_board_equiv {n : int | 0 <= n; n <= SIDE_MAX}

(board : &(@[color_t tk_color][BOARD_SIZE]), lst : !board_record_list_vt tk_color, n : g1int (tk_index, n), rotation_equiv_classes : bool) : bool = let macdef board_equiv = board_equiv<tk_index, tk_color>
fun loop {k : int | 0 <= k} .<k>. (board : &(@[color_t tk_color][BOARD_SIZE]), lst : !board_record_list_vt (tk_color, k), n : g1int (tk_index, n)) : bool = case+ lst of | NIL => false | head :: tail => if board_equiv (!(head.p), board, n, rotation_equiv_classes) then true else loop (board, tail, n)
prval _ = lemma_list_vt_param lst in loop (board, lst, n) end

fn {tk_index, tk_color : tkind} queens_to_board

{count : int | 0 <= count; count <= M2_MAX} (queens : &(@[g1int tk_index][M2_MAX]), count : int count) : [p : addr | null < p] board_record_vt (tk_color, p) = let typedef color_t = color_t tk_color
fun loop {k : int | ~1 <= k; k < count} .<k + 1>. (queens : &(@[g1int tk_index][M2_MAX]), board : &(@[color_t tk_color][BOARD_SIZE]), k : int k) : void = if 0 <= k then let val [coords : int] coords = queens[k] #if NDEBUG <> 0 #then prval _ = $UN.prop_assert {0 <= coords} () prval _ = $UN.prop_assert {coords < BOARD_SIZE} () #else val _ = assertloc (g1i2i 0 <= coords) val _ = assertloc (coords < g1i2i BOARD_SIZE) #endif in if g1int_nmod (k, 2) = 0 then board[coords] := g1i2i BLACK else board[coords] := g1i2i WHITE; loop (queens, board, pred k) end
val @(pf, pfgc | p) = array_ptr_alloc<color_t> (i2sz BOARD_SIZE) val _ = array_initize_elt<color_t> (!p, i2sz BOARD_SIZE, g1i2i EMPTY) val _ = loop (queens, !p, pred count) in @{ pf = pf, pfgc = pfgc | p = p } end

fn {tk : tkind} queen_would_fit_in

{count : int | 0 <= count; count <= M2_MAX} {i, j : int | 0 <= i; i < SIDE_MAX; 0 <= j; j < SIDE_MAX} (queens : &(@[g1int tk][M2_MAX]), count : int count, i : g1int (tk, i), j : g1int (tk, j)) : bool = (* Would a new queen at (i,j) be feasible? *) if count = 0 then true else let fun loop {k : int | ~1 <= k; k < count} (queens : &(@[g1int tk][M2_MAX]), k : int k) : bool = if k < 0 then true else let val [coords : int] coords = queens[k] #if NDEBUG <> 0 #then prval _ = $UN.prop_assert {0 <= coords} () prval _ = $UN.prop_assert {coords < BOARD_SIZE} () #else val _ = assertloc (g1i2i 0 <= coords) val _ = assertloc (coords < g1i2i BOARD_SIZE) #endif
val i1 = row_index<tk> coords val j1 = column_index<tk> coords in if g1int_nmod (k, 2) = g1int_nmod (count, 2) then (* The two queens are of the same color. They may not share the same square. *) begin if i <> i1 || j <> j1 then loop (queens, pred k) else false end else (* The two queens are of different colors. They may not share the same square nor attack each other. *) begin if (i <> i1 && j <> j1 && i + j <> i1 + j1 && i - j <> i1 - j1) then loop (queens, pred k) else false end end in loop (queens, pred count) end

fn {tk : tkind} latest_queen_fits_in

{count : int | 1 <= count; count <= M2_MAX} (queens : &(@[g1int tk][M2_MAX]), count : int count) : bool = let val [coords : int] coords = queens[pred count] #if NDEBUG <> 0 #then prval _ = $UN.prop_assert {0 <= coords} () prval _ = $UN.prop_assert {coords < BOARD_SIZE} () #else val _ = assertloc (g1i2i 0 <= coords) val _ = assertloc (coords < g1i2i BOARD_SIZE) #endif
val i = row_index<tk> coords val j = column_index<tk> coords in queen_would_fit_in<tk> (queens, pred count, i, j) end

fn {tk_index, tk_color : tkind} find_solutions

{m : int | 0 <= m; 2 * m <= M2_MAX} {n : int | 0 <= n; n <= SIDE_MAX} {max_solutions : int | 0 <= max_solutions} (f : FILEref, m : int m, n : g1int (tk_index, n), rotation_equiv_classes : bool, max_solutions : int max_solutions) : [num_solutions : int | 0 <= num_solutions; num_solutions <= max_solutions] @(int num_solutions, board_record_list_vt (tk_color, num_solutions)) = (* This template function both prints the solutions and returns them as a linked list. *) if m = 0 then @(0, NIL) else if max_solutions = 0 then @(0, NIL) else let macdef latest_queen_fits_in = latest_queen_fits_in<tk_index> macdef queens_to_board = queens_to_board<tk_index, tk_color> macdef fprint_board = fprint_board<tk_index, tk_color> macdef any_board_equiv = any_board_equiv<tk_index, tk_color> macdef row_index = row_index<tk_index> macdef column_index = column_index<tk_index> macdef storage_index = storage_index<tk_index>
fnx loop {num_solutions : int | 0 <= num_solutions; num_solutions <= max_solutions} {num_queens : int | 0 <= num_queens; num_queens <= 2 * m} (solutions : board_record_list_vt (tk_color, num_solutions), num_solutions : int num_solutions, queens : &(@[g1int tk_index][M2_MAX]), num_queens : int num_queens) : [num_solutions1 : int | 0 <= num_solutions1; num_solutions1 <= max_solutions] @(int num_solutions1, board_record_list_vt (tk_color, num_solutions1)) = if num_queens = 0 then @(num_solutions, solutions) else if num_solutions = max_solutions then @(num_solutions, solutions) else if latest_queen_fits_in (queens, num_queens) then begin if num_queens = 2 * m then let val board = queens_to_board (queens, num_queens) val equiv_solution = any_board_equiv (!(board.p), solutions, n, rotation_equiv_classes) in if ~equiv_solution then begin fprintln! (f, "Solution ", succ num_solutions); fprint_board (f, !(board.p), n); fileref_puts (f, "\n\n"); move_a_queen (board :: solutions, succ num_solutions, queens, num_queens) end else begin free board; move_a_queen (solutions, num_solutions, queens, num_queens) end end else add_another_queen (solutions, num_solutions, queens, num_queens) end else move_a_queen (solutions, num_solutions, queens, num_queens) and add_another_queen {num_solutions : int | 0 <= num_solutions; num_solutions <= max_solutions} {num_queens : int | 0 <= num_queens; num_queens + 1 <= 2 * m} (solutions : board_record_list_vt (tk_color, num_solutions), num_solutions : int num_solutions, queens : &(@[g1int tk_index][M2_MAX]), num_queens : int num_queens) : [num_solutions1 : int | 0 <= num_solutions1; num_solutions1 <= max_solutions] @(int num_solutions1, board_record_list_vt (tk_color, num_solutions1)) = let val coords = storage_index (g1i2i 0, g1i2i 0) in queens[num_queens] := coords; loop (solutions, num_solutions, queens, succ num_queens) end and move_a_queen {num_solutions : int | 0 <= num_solutions; num_solutions <= max_solutions} {num_queens : int | 0 <= num_queens; num_queens <= 2 * m} (solutions : board_record_list_vt (tk_color, num_solutions), num_solutions : int num_solutions, queens : &(@[g1int tk_index][M2_MAX]), num_queens : int num_queens) : [num_solutions1 : int | 0 <= num_solutions1; num_solutions1 <= max_solutions] @(int num_solutions1, board_record_list_vt (tk_color, num_solutions1)) = if num_queens = 0 then loop (solutions, num_solutions, queens, num_queens) else let val [coords : int] coords = queens[pred num_queens] #if NDEBUG <> 0 #then prval _ = $UN.prop_assert {0 <= coords} () prval _ = $UN.prop_assert {coords < BOARD_SIZE} () #else val _ = assertloc (g1i2i 0 <= coords) val _ = assertloc (coords < g1i2i BOARD_SIZE) #endif
val [i : int] i = row_index coords val [j : int] j = column_index coords
prval _ = prop_verify {0 <= i} () prval _ = prop_verify {i < SIDE_MAX} ()
prval _ = prop_verify {0 <= j} () prval _ = prop_verify {j < SIDE_MAX} ()
#if NDEBUG <> 0 #then prval _ = $UN.prop_assert {i < n} () prval _ = $UN.prop_assert {j < n} () #else val _ = $effmask_exn assertloc (i < n) val _ = $effmask_exn assertloc (j < n) #endif in if j = pred n then begin if i = pred n then (* Backtrack. *) move_a_queen (solutions, num_solutions, queens, pred num_queens) else let val coords = storage_index (succ i, j) in queens[pred num_queens] := coords; loop (solutions, num_solutions, queens, num_queens) end end else let #if NDEBUG <> 0 #then prval _ = $UN.prop_assert {j < n - 1} () #else val _ = $effmask_exn assertloc (j < pred n) #endif in if i = pred n then let val coords = storage_index (g1i2i 0, succ j) in queens[pred num_queens] := coords; loop (solutions, num_solutions, queens, num_queens) end else let val coords = storage_index (succ i, j) in queens[pred num_queens] := coords; loop (solutions, num_solutions, queens, num_queens) end end end
var queens = @[g1int tk_index][M2_MAX] (g1i2i 0) in queens[0] := storage_index (g1i2i 0, g1i2i 0); loop (NIL, 0, queens, 1) end

(********************************************************************)

%{^

include <stdlib.h>

include <limits.h>

%}

implement main0 (argc, argv) =

let stadef tk_index = int_kind stadef tk_color = int_kind
macdef usage_error (status) = begin println! ("Usage: ", argv[0], " M N IGNORE_EQUIVALENTS [MAX_SOLUTIONS]"); exit (,(status)) end
val max_max_solutions = $extval ([i : int | 0 <= i] int i, "INT_MAX") in if 4 <= argc then let val m = $extfcall (int, "atoi", argv[1]) val m = g1ofg0 m val _ = if m < 0 then usage_error (2) val _ = assertloc (0 <= m) val _ = if M2_MAX < 2 * m then begin println! (argv[0], ": M cannot be larger than ", M2_MAX / 2); usage_error (2) end val _ = assertloc (2 * m <= M2_MAX)
val n = $extfcall (int, "atoi", argv[2]) val n = g1ofg0 n val _ = if n < 0 then usage_error (2) val _ = assertloc (0 <= n) val _ = if SIDE_MAX < n then begin println! (argv[0], ": N cannot be larger than ", SIDE_MAX); usage_error (2) end val _ = assertloc (n <= SIDE_MAX)
val ignore_equivalents = if argv[3] = "T" || argv[3] = "t" || argv[3] = "1" then true else if argv[3] = "F" || argv[3] = "f" || argv[3] = "0" then false else begin println! (argv[0], ": select T=t=1 or F=f=0 ", "for IGNORE_EQUIVALENTS"); usage_error (2); false end in if argc = 5 then let val max_solutions = $extfcall (int, "atoi", argv[4]) val max_solutions = g1ofg0 max_solutions val max_solutions = max (0, max_solutions)
val @(num_solutions, solutions) = find_solutions<tk_index, tk_color> (stdout_ref, m, n, ignore_equivalents, max_solutions) in board_record_list_vt_free solutions end else let val @(num_solutions, solutions) = find_solutions<tk_index, tk_color> (stdout_ref, m, n, ignore_equivalents, max_max_solutions) in board_record_list_vt_free solutions end end else usage_error (1) end

(********************************************************************)</lang>

Output:

$ patscc -DATS NDEBUG=1 -O3 -fno-stack-protector -march=native -DATS_MEMALLOC_LIBC -o peaceful_queens peaceful_queens.dats && ./peaceful_queens 4 5 T

Solution 1 +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ Solution 2 +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ Solution 3 +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+
C
Translation of: C#

<lang c>#include <math.h>

include <stdbool.h>

include <stdio.h>

include <stdlib.h>

enum Piece {

Empty, Black, White,

};

typedef struct Position_t {

int x, y;

} Position;

///////////////////////////////////////////////

struct Node_t {

Position pos; struct Node_t *next;

};

void releaseNode(struct Node_t *head) {

if (head == NULL) return;
releaseNode(head->next); head->next = NULL;
free(head);

}

typedef struct List_t {

struct Node_t *head; struct Node_t *tail; size_t length;

} List;

List makeList() {

return (List) { NULL, NULL, 0 };

}

void releaseList(List *lst) {

if (lst == NULL) return;
releaseNode(lst->head); lst->head = NULL; lst->tail = NULL;

}

void addNode(List *lst, Position pos) {

struct Node_t *newNode;
if (lst == NULL) { exit(EXIT_FAILURE); }
newNode = malloc(sizeof(struct Node_t)); if (newNode == NULL) { exit(EXIT_FAILURE); }
newNode->next = NULL; newNode->pos = pos;
if (lst->head == NULL) { lst->head = lst->tail = newNode; } else { lst->tail->next = newNode; lst->tail = newNode; }
lst->length++;

}

void removeAt(List *lst, size_t pos) {

if (lst == NULL) return;
if (pos == 0) { struct Node_t *temp = lst->head;
if (lst->tail == lst->head) { lst->tail = NULL; }
lst->head = lst->head->next; temp->next = NULL;
free(temp); lst->length--; } else { struct Node_t *temp = lst->head; struct Node_t *rem; size_t i = pos;
while (i-- > 1) { temp = temp->next; }
rem = temp->next; if (rem == lst->tail) { lst->tail = temp; }
temp->next = rem->next;
rem->next = NULL; free(rem);
lst->length--; }

}

///////////////////////////////////////////////

bool isAttacking(Position queen, Position pos) {

return queen.x == pos.x || queen.y == pos.y || abs(queen.x - pos.x) == abs(queen.y - pos.y);

}

bool place(int m, int n, List *pBlackQueens, List *pWhiteQueens) {

struct Node_t *queenNode; bool placingBlack = true; int i, j;
if (pBlackQueens == NULL || pWhiteQueens == NULL) { exit(EXIT_FAILURE); }
if (m == 0) return true; for (i = 0; i < n; i++) { for (j = 0; j < n; j++) { Position pos = { i, j };
queenNode = pBlackQueens->head; while (queenNode != NULL) { if ((queenNode->pos.x == pos.x && queenNode->pos.y == pos.y) || !placingBlack && isAttacking(queenNode->pos, pos)) { goto inner; } queenNode = queenNode->next; }
queenNode = pWhiteQueens->head; while (queenNode != NULL) { if ((queenNode->pos.x == pos.x && queenNode->pos.y == pos.y) || placingBlack && isAttacking(queenNode->pos, pos)) { goto inner; } queenNode = queenNode->next; }
if (placingBlack) { addNode(pBlackQueens, pos); placingBlack = false; } else { addNode(pWhiteQueens, pos); if (place(m - 1, n, pBlackQueens, pWhiteQueens)) { return true; } removeAt(pBlackQueens, pBlackQueens->length - 1); removeAt(pWhiteQueens, pWhiteQueens->length - 1); placingBlack = true; }
inner: {} } } if (!placingBlack) { removeAt(pBlackQueens, pBlackQueens->length - 1); } return false;

}

void printBoard(int n, List *pBlackQueens, List *pWhiteQueens) {

size_t length = n * n; struct Node_t *queenNode; char *board; size_t i, j, k;
if (pBlackQueens == NULL || pWhiteQueens == NULL) { exit(EXIT_FAILURE); }
board = calloc(length, sizeof(char)); if (board == NULL) { exit(EXIT_FAILURE); }
queenNode = pBlackQueens->head; while (queenNode != NULL) { board[queenNode->pos.x * n + queenNode->pos.y] = Black; queenNode = queenNode->next; }
queenNode = pWhiteQueens->head; while (queenNode != NULL) { board[queenNode->pos.x * n + queenNode->pos.y] = White; queenNode = queenNode->next; }
for (i = 0; i < length; i++) { if (i != 0 && i % n == 0) { printf("\n"); } switch (board[i]) { case Black: printf("B "); break; case White: printf("W "); break; default: j = i / n; k = i - j * n; if (j % 2 == k % 2) { printf(" "); } else { printf("# "); } break; } }
printf("\n\n");

}

void test(int n, int q) {

List blackQueens = makeList(); List whiteQueens = makeList();
printf("%d black and %d white queens on a %d x %d board:\n", q, q, n, n); if (place(q, n, &blackQueens, &whiteQueens)) { printBoard(n, &blackQueens, &whiteQueens); } else { printf("No solution exists.\n\n"); }
releaseList(&blackQueens); releaseList(&whiteQueens);

}

int main() {

test(2, 1);
test(3, 1); test(3, 2);
test(4, 1); test(4, 2); test(4, 3);
test(5, 1); test(5, 2); test(5, 3); test(5, 4); test(5, 5);
test(6, 1); test(6, 2); test(6, 3); test(6, 4); test(6, 5); test(6, 6);
test(7, 1); test(7, 2); test(7, 3); test(7, 4); test(7, 5); test(7, 6); test(7, 7);
return EXIT_SUCCESS;

}</lang>

Output:
1 black and 1 white queens on a 2 x 2 board: No solution exists. 1 black and 1 white queens on a 3 x 3 board: B # # W # 2 black and 2 white queens on a 3 x 3 board: No solution exists. 1 black and 1 white queens on a 4 x 4 board: B # # # W # # # # 2 black and 2 white queens on a 4 x 4 board: B # # # W B # # # W 3 black and 3 white queens on a 4 x 4 board: No solution exists. 1 black and 1 white queens on a 5 x 5 board: B # # # W # # # # # # # # 2 black and 2 white queens on a 5 x 5 board: B # # B # W # W # # # # # # 3 black and 3 white queens on a 5 x 5 board: B # # B # W # W # # # B # W # 4 black and 4 white queens on a 5 x 5 board: B B # # B W # W # # # B W # W # 5 black and 5 white queens on a 5 x 5 board: No solution exists. 1 black and 1 white queens on a 6 x 6 board: B # # # # W # # # # # # # # # # # # # 2 black and 2 white queens on a 6 x 6 board: B # # B # # W # W # # # # # # # # # # # 3 black and 3 white queens on a 6 x 6 board: B # # B B # W # W # # # # # # W # # # # # 4 black and 4 white queens on a 6 x 6 board: B # # B B # W # W # # # # # B # W W # # # # 5 black and 5 white queens on a 6 x 6 board: B # B # # # B # B W # # # W W # # # B W W # 6 black and 6 white queens on a 6 x 6 board: No solution exists. 1 black and 1 white queens on a 7 x 7 board: B # # # # W # # # # # # # # # # # # # # # # # # # 2 black and 2 white queens on a 7 x 7 board: B # # B # # W # W # # # # # # # # # # # # # # # # # 3 black and 3 white queens on a 7 x 7 board: B # # B # # W # W B # # # # W # # # # # # # # # # # # 4 black and 4 white queens on a 7 x 7 board: B # # B # # W # W B # # B # # W # W # # # # # # # # # # 5 black and 5 white queens on a 7 x 7 board: B # # B # # W # W B # # B # # W # W B # # # # W # # # # # 6 black and 6 white queens on a 7 x 7 board: B # # B # # W # W B # # B # # W # W B # # B # # W # W # # # 7 black and 7 white queens on a 7 x 7 board: B # B # B # B # B # B # # B # W # W # # W # # W # # W # W W #
C#
Translation of: D

<lang csharp>using System; using System.Collections.Generic;

namespace PeacefulChessQueenArmies {

using Position = Tuple<int, int>;
enum Piece { Empty, Black, White }
class Program { static bool IsAttacking(Position queen, Position pos) { return queen.Item1 == pos.Item1 || queen.Item2 == pos.Item2 || Math.Abs(queen.Item1 - pos.Item1) == Math.Abs(queen.Item2 - pos.Item2); }
static bool Place(int m, int n, List<Position> pBlackQueens, List<Position> pWhiteQueens) { if (m == 0) { return true; } bool placingBlack = true; for (int i = 0; i < n; i++) { for (int j = 0; j < n; j++) { var pos = new Position(i, j); foreach (var queen in pBlackQueens) { if (queen.Equals(pos) || !placingBlack && IsAttacking(queen, pos)) { goto inner; } } foreach (var queen in pWhiteQueens) { if (queen.Equals(pos) || placingBlack && IsAttacking(queen, pos)) { goto inner; } } if (placingBlack) { pBlackQueens.Add(pos); placingBlack = false; } else { pWhiteQueens.Add(pos); if (Place(m - 1, n, pBlackQueens, pWhiteQueens)) { return true; } pBlackQueens.RemoveAt(pBlackQueens.Count - 1); pWhiteQueens.RemoveAt(pWhiteQueens.Count - 1); placingBlack = true; } inner: { } } } if (!placingBlack) { pBlackQueens.RemoveAt(pBlackQueens.Count - 1); } return false; }
static void PrintBoard(int n, List<Position> blackQueens, List<Position> whiteQueens) { var board = new Piece[n * n];
foreach (var queen in blackQueens) { board[queen.Item1 * n + queen.Item2] = Piece.Black; } foreach (var queen in whiteQueens) { board[queen.Item1 * n + queen.Item2] = Piece.White; }
for (int i = 0; i < board.Length; i++) { if (i != 0 && i % n == 0) { Console.WriteLine(); } switch (board[i]) { case Piece.Black: Console.Write("B "); break; case Piece.White: Console.Write("W "); break; case Piece.Empty: int j = i / n; int k = i - j * n; if (j % 2 == k % 2) { Console.Write(" "); } else { Console.Write("# "); } break; } }
Console.WriteLine("\n"); }
static void Main() { var nms = new int[,] { {2, 1}, {3, 1}, {3, 2}, {4, 1}, {4, 2}, {4, 3}, {5, 1}, {5, 2}, {5, 3}, {5, 4}, {5, 5}, {6, 1}, {6, 2}, {6, 3}, {6, 4}, {6, 5}, {6, 6}, {7, 1}, {7, 2}, {7, 3}, {7, 4}, {7, 5}, {7, 6}, {7, 7}, }; for (int i = 0; i < nms.GetLength(0); i++) { Console.WriteLine("{0} black and {0} white queens on a {1} x {1} board:", nms[i, 1], nms[i, 0]); List<Position> blackQueens = new List<Position>(); List<Position> whiteQueens = new List<Position>(); if (Place(nms[i, 1], nms[i, 0], blackQueens, whiteQueens)) { PrintBoard(nms[i, 0], blackQueens, whiteQueens); } else { Console.WriteLine("No solution exists.\n"); } } } }

}</lang>

Output:
1 black and 1 white queens on a 2 x 2 board: No solution exists. 1 black and 1 white queens on a 3 x 3 board: B # # W # 2 black and 2 white queens on a 3 x 3 board: No solution exists. 1 black and 1 white queens on a 4 x 4 board: B # # # W # # # # 2 black and 2 white queens on a 4 x 4 board: B # # # W B # # # W 3 black and 3 white queens on a 4 x 4 board: No solution exists. 1 black and 1 white queens on a 5 x 5 board: B # # # W # # # # # # # # 2 black and 2 white queens on a 5 x 5 board: B # # B # W # W # # # # # # 3 black and 3 white queens on a 5 x 5 board: B # # B # W # W # # # B # W # 4 black and 4 white queens on a 5 x 5 board: B B # # B W # W # # # B W # W # 5 black and 5 white queens on a 5 x 5 board: No solution exists. 1 black and 1 white queens on a 6 x 6 board: B # # # # W # # # # # # # # # # # # # 2 black and 2 white queens on a 6 x 6 board: B # # B # # W # W # # # # # # # # # # # 3 black and 3 white queens on a 6 x 6 board: B # # B B # W # W # # # # # # W # # # # # 4 black and 4 white queens on a 6 x 6 board: B # # B B # W # W # # # # # B # W W # # # # 5 black and 5 white queens on a 6 x 6 board: B # B # # # B # B W # # # W W # # # B W W # 6 black and 6 white queens on a 6 x 6 board: No solution exists. 1 black and 1 white queens on a 7 x 7 board: B # # # # W # # # # # # # # # # # # # # # # # # # 2 black and 2 white queens on a 7 x 7 board: B # # B # # W # W # # # # # # # # # # # # # # # # # 3 black and 3 white queens on a 7 x 7 board: B # # B # # W # W B # # # # W # # # # # # # # # # # # 4 black and 4 white queens on a 7 x 7 board: B # # B # # W # W B # # B # # W # W # # # # # # # # # # 5 black and 5 white queens on a 7 x 7 board: B # # B # # W # W B # # B # # W # W B # # # # W # # # # # 6 black and 6 white queens on a 7 x 7 board: B # # B # # W # W B # # B # # W # W B # # B # # W # W # # # 7 black and 7 white queens on a 7 x 7 board: B # B # B # B # B # B # # B # W # W # # W # # W # # W # W W #
C++
Translation of: D

<lang cpp>#include <iostream>

include <vector>

enum class Piece {

empty, black, white

};

typedef std::pair<int, int> position;

bool isAttacking(const position &queen, const position &pos) {

return queen.first == pos.first || queen.second == pos.second || abs(queen.first - pos.first) == abs(queen.second - pos.second);

}

bool place(const int m, const int n, std::vector<position> &pBlackQueens, std::vector<position> &pWhiteQueens) {

if (m == 0) { return true; } bool placingBlack = true; for (int i = 0; i < n; i++) { for (int j = 0; j < n; j++) { auto pos = std::make_pair(i, j); for (auto queen : pBlackQueens) { if (queen == pos || !placingBlack && isAttacking(queen, pos)) { goto inner; } } for (auto queen : pWhiteQueens) { if (queen == pos || placingBlack && isAttacking(queen, pos)) { goto inner; } } if (placingBlack) { pBlackQueens.push_back(pos); placingBlack = false; } else { pWhiteQueens.push_back(pos); if (place(m - 1, n, pBlackQueens, pWhiteQueens)) { return true; } pBlackQueens.pop_back(); pWhiteQueens.pop_back(); placingBlack = true; }
inner: {} } } if (!placingBlack) { pBlackQueens.pop_back(); } return false;

}

void printBoard(int n, const std::vector<position> &blackQueens, const std::vector<position> &whiteQueens) {

std::vector<Piece> board(n * n); std::fill(board.begin(), board.end(), Piece::empty);
for (auto &queen : blackQueens) { board[queen.first * n + queen.second] = Piece::black; } for (auto &queen : whiteQueens) { board[queen.first * n + queen.second] = Piece::white; }
for (size_t i = 0; i < board.size(); ++i) { if (i != 0 && i % n == 0) { std::cout << '\n'; } switch (board[i]) { case Piece::black: std::cout << "B "; break; case Piece::white: std::cout << "W "; break; case Piece::empty: default: int j = i / n; int k = i - j * n; if (j % 2 == k % 2) { std::cout << "x "; } else { std::cout << "* "; } break; } }
std::cout << "\n\n";

}

int main() {

std::vector<position> nms = { {2, 1}, {3, 1}, {3, 2}, {4, 1}, {4, 2}, {4, 3}, {5, 1}, {5, 2}, {5, 3}, {5, 4}, {5, 5}, {6, 1}, {6, 2}, {6, 3}, {6, 4}, {6, 5}, {6, 6}, {7, 1}, {7, 2}, {7, 3}, {7, 4}, {7, 5}, {7, 6}, {7, 7}, };
for (auto nm : nms) { std::cout << nm.second << " black and " << nm.second << " white queens on a " << nm.first << " x " << nm.first << " board:\n"; std::vector<position> blackQueens, whiteQueens; if (place(nm.second, nm.first, blackQueens, whiteQueens)) { printBoard(nm.first, blackQueens, whiteQueens); } else { std::cout << "No solution exists.\n\n"; } }
return 0;

}</lang>

Output:
1 black and 1 white queens on a 2 x 2 board: No solution exists. 1 black and 1 white queens on a 3 x 3 board: B * x * x W x * x 2 black and 2 white queens on a 3 x 3 board: No solution exists. 1 black and 1 white queens on a 4 x 4 board: B * x * * x W x x * x * * x * x 2 black and 2 white queens on a 4 x 4 board: B * x * * x W x B * x * * x W x 3 black and 3 white queens on a 4 x 4 board: No solution exists. 1 black and 1 white queens on a 5 x 5 board: B * x * x * x W x * x * x * x * x * x * x * x * x 2 black and 2 white queens on a 5 x 5 board: B * x * B * x W x * x W x * x * x * x * x * x * x 3 black and 3 white queens on a 5 x 5 board: B * x * B * x W x * x W x * x * x * B * x W x * x 4 black and 4 white queens on a 5 x 5 board: x B x B x * x * x B W * W * x * x * x B W * W * x 5 black and 5 white queens on a 5 x 5 board: No solution exists. 1 black and 1 white queens on a 6 x 6 board: B * x * x * * x W x * x x * x * x * * x * x * x x * x * x * * x * x * x 2 black and 2 white queens on a 6 x 6 board: B * x * B * * x W x * x x W x * x * * x * x * x x * x * x * * x * x * x 3 black and 3 white queens on a 6 x 6 board: B * x * B B * x W x * x x W x * x * * x * x * x x * W * x * * x * x * x 4 black and 4 white queens on a 6 x 6 board: B * x * B B * x W x * x x W x * x * * x * x * B x * W W x * * x * x * x 5 black and 5 white queens on a 6 x 6 board: x B x * B * * x * B * B W * x * x * W x W x * x x * x * x B W x W x * x 6 black and 6 white queens on a 6 x 6 board: No solution exists. 1 black and 1 white queens on a 7 x 7 board: B * x * x * x * x W x * x * x * x * x * x * x * x * x * x * x * x * x * x * x * x * x * x * x * x 2 black and 2 white queens on a 7 x 7 board: B * x * B * x * x W x * x W x * x * x * x * x * x * x * x * x * x * x * x * x * x * x * x * x * x 3 black and 3 white queens on a 7 x 7 board: B * x * B * x * x W x * x W B * x * x * x * x W x * x * x * x * x * x * x * x * x * x * x * x * x 4 black and 4 white queens on a 7 x 7 board: B * x * B * x * x W x * x W B * x * B * x * x W x * x W x * x * x * x * x * x * x * x * x * x * x 5 black and 5 white queens on a 7 x 7 board: B * x * B * x * x W x * x W B * x * B * x * x W x * x W B * x * x * x * x W x * x * x * x * x * x 6 black and 6 white queens on a 7 x 7 board: B * x * B * x * x W x * x W B * x * B * x * x W x * x W B * x * B * x * x W x * x W x * x * x * x 7 black and 7 white queens on a 7 x 7 board: x B x * x B x * B * x B x * x B x * x B x * x * x B x * W * W * x * W * x * W * x * W * W W x * x
D
Translation of: Go

<lang d>import std.array; import std.math; import std.stdio; import std.typecons;

enum Piece {

empty, black, white,

}

alias position = Tuple!(int, "i", int, "j");

bool place(int m, int n, ref position[] pBlackQueens, ref position[] pWhiteQueens) {

if (m == 0) { return true; } bool placingBlack = true; foreach (i; 0..n) { inner: foreach (j; 0..n) { auto pos = position(i, j); foreach (queen; pBlackQueens) { if (queen == pos || !placingBlack && isAttacking(queen, pos)) { continue inner; } } foreach (queen; pWhiteQueens) { if (queen == pos || placingBlack && isAttacking(queen, pos)) { continue inner; } } if (placingBlack) { pBlackQueens ~= pos; placingBlack = false; } else { pWhiteQueens ~= pos; if (place(m - 1, n, pBlackQueens, pWhiteQueens)) { return true; } pBlackQueens.length--; pWhiteQueens.length--; placingBlack = true; } } } if (!placingBlack) { pBlackQueens.length--; } return false;

}

bool isAttacking(position queen, position pos) {

return queen.i == pos.i || queen.j == pos.j || abs(queen.i - pos.i) == abs(queen.j - pos.j);

}

void printBoard(int n, position[] blackQueens, position[] whiteQueens) {

auto board = uninitializedArray!(Piece[])(n * n); board[] = Piece.empty;
foreach (queen; blackQueens) { board[queen.i * n + queen.j] = Piece.black; } foreach (queen; whiteQueens) { board[queen.i * n + queen.j] = Piece.white; } foreach (i,b; board) { if (i != 0 && i % n == 0) { writeln; } final switch (b) { case Piece.black: write("B "); break; case Piece.white: write("W "); break; case Piece.empty: int j = i / n; int k = i - j * n;
if (j % 2 == k % 2) { write("• "w); } else { write("◦ "w); } break; } } writeln('\n');

}

void main() {

auto nms = [ [2, 1], [3, 1], [3, 2], [4, 1], [4, 2], [4, 3], [5, 1], [5, 2], [5, 3], [5, 4], [5, 5], [6, 1], [6, 2], [6, 3], [6, 4], [6, 5], [6, 6], [7, 1], [7, 2], [7, 3], [7, 4], [7, 5], [7, 6], [7, 7], ]; foreach (nm; nms) { writefln("%d black and %d white queens on a %d x %d board:", nm[1], nm[1], nm[0], nm[0]); position[] blackQueens; position[] whiteQueens; if (place(nm[1], nm[0], blackQueens, whiteQueens)) { printBoard(nm[0], blackQueens, whiteQueens); } else { writeln("No solution exists.\n"); } }

}</lang>

Output:
1 black and 1 white queens on a 2 x 2 board: No solution exists. 1 black and 1 white queens on a 3 x 3 board: B ◦ • ◦ • W • ◦ • 2 black and 2 white queens on a 3 x 3 board: No solution exists. 1 black and 1 white queens on a 4 x 4 board: B ◦ • ◦ ◦ • W • • ◦ • ◦ ◦ • ◦ • 2 black and 2 white queens on a 4 x 4 board: B ◦ • ◦ ◦ • W • B ◦ • ◦ ◦ • W • 3 black and 3 white queens on a 4 x 4 board: No solution exists. 1 black and 1 white queens on a 5 x 5 board: B ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and 2 white queens on a 5 x 5 board: B ◦ • ◦ B ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 3 black and 3 white queens on a 5 x 5 board: B ◦ • ◦ B ◦ • W • ◦ • W • ◦ • ◦ • ◦ B ◦ • W • ◦ • 4 black and 4 white queens on a 5 x 5 board: • B • B • ◦ • ◦ • B W ◦ W ◦ • ◦ • ◦ • B W ◦ W ◦ • 5 black and 5 white queens on a 5 x 5 board: No solution exists. 1 black and 1 white queens on a 6 x 6 board: B ◦ • ◦ • ◦ ◦ • W • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • 2 black and 2 white queens on a 6 x 6 board: B ◦ • ◦ B ◦ ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • 3 black and 3 white queens on a 6 x 6 board: B ◦ • ◦ B B ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ W ◦ • ◦ ◦ • ◦ • ◦ • 4 black and 4 white queens on a 6 x 6 board: B ◦ • ◦ B B ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ B • ◦ W W • ◦ ◦ • ◦ • ◦ • 5 black and 5 white queens on a 6 x 6 board: • B • ◦ B ◦ ◦ • ◦ B ◦ B W ◦ • ◦ • ◦ W • W • ◦ • • ◦ • ◦ • B W • W • ◦ • 6 black and 6 white queens on a 6 x 6 board: No solution exists. 1 black and 1 white queens on a 7 x 7 board: B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and 2 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 3 black and 3 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 4 black and 4 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 5 black and 5 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • 6 black and 6 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • 7 black and 7 white queens on a 7 x 7 board: • B • ◦ • B • ◦ B ◦ • B • ◦ • B • ◦ • B • ◦ • ◦ • B • ◦ W ◦ W ◦ • ◦ W ◦ • ◦ W ◦ • ◦ W ◦ W W • ◦ •
Fortran
Works with: gfortran version 11.2.1

The example demonstrates modern Fortran’s capabilities for integer bit manipulation, by using large machine integers (and their entire bitrange) as bitmaps to represent queen armies. Complicated (but nevertheless single-statement) expressions of such integers represent such operations as rotating a chessboard and checking for any attacks.

There are two Fortran programs and a driver script. One program generates a Fortran module for basic operations; the other program (which must be linked with the generated module) does the actual work. The driver script is for Unix shell.

For speed, armies are represented by 64-bit or 128-bit integers, depending on the value of n. A 1-bit represets a queen. Rotations and reflections of the board are elemental integer operations on an army. Checking for any attacks is an elemental integer-to-boolean operation on the two armies (though the program detects rook-like attacks by a different mechanism). Equivalence under interchange of the colors can be tested by reversing which army gets which integer value.

Here is the first program, peaceful_queens_elements_generator.f90, which generates code (specialized for given m and n) to deal with the representations of the armies as integers: <lang fortran>program peaceful_queens_elements_generator

use, intrinsic :: iso_fortran_env, only: int64 use, intrinsic :: iso_fortran_env, only: error_unit
implicit none
! 64-bit integers, for boards up to 8-by-8. integer, parameter :: kind8x8 = int64
! 128-bit integers, for boards up to 11-by-11. ! This value is correct for gfortran. integer, parameter :: kind11x11 = 16
integer(kind = kind11x11), parameter :: one = 1 integer(kind = kind11x11), parameter :: two = 2
integer, parameter :: n_max = 11
integer(kind = kind11x11) :: rook1_masks(0 : n_max - 1) integer(kind = kind11x11) :: rook2_masks(0 : n_max - 1) integer(kind = kind11x11) :: bishop1_masks(0 : (2 * n_max) - 4) integer(kind = kind11x11) :: bishop2_masks(0 : (2 * n_max) - 4)
! Combines rook1_masks and rook2_masks. integer(kind = kind11x11) :: rook_masks(0 : (2 * n_max) - 1)
! Combines bishop1_masks and bishop2_masks. integer(kind = kind11x11) :: bishop_masks(0 : (4 * n_max) - 7)
! Combines rook and bishop masks. integer(kind = kind11x11) :: queen_masks(0 : (6 * n_max) - 7)
character(len = 16), parameter :: s_kind8x8 = "kind8x8 " character(len = 16), parameter :: s_kind11x11 = "kind11x11 "
character(200) :: arg integer :: arg_count
integer :: m, n, max_solutions integer :: board_kind
arg_count = command_argument_count () if (arg_count /= 3) then call get_command_argument (0, arg) write (error_unit, '("Usage: ", A, " M N MAX_SOLUTIONS")') trim (arg) stop 1 end if
call get_command_argument (1, arg) read (arg, *) m if (m < 1) then write (error_unit, '("M must be between 1 or greater.")') stop 2 end if
call get_command_argument (2, arg) read (arg, *) n if (n < 3 .or. 11 < n) then write (error_unit, '("N must be between 3 and ", I0, ", inclusive.")') n_max stop 2 end if
call get_command_argument (3, arg) read (arg, *) max_solutions
write (*, '("module peaceful_queens_elements")') write (*, '()') write (*, '(" use, intrinsic :: iso_fortran_env, only: int64")') write (*, '()') write (*, '(" implicit none")') write (*, '(" private")') write (*, '()') write (*, '(" integer, parameter, public :: m = ", I0)') m write (*, '(" integer, parameter, public :: n = ", I0)') n write (*, '(" integer, parameter, public :: max_solutions = ", I0)') max_solutions write (*, '()') if (n <= 8) then write (*, '(" ! 64-bit integers, for boards up to 8-by-8.")') write (*, '(" integer, parameter, private :: kind8x8 = int64")') else write (*, '(" ! 128-bit integers, for boards up to 11-by-11.")') write (*, '(" integer, parameter, private :: kind11x11 = ", I0)') kind11x11 end if write (*, '(" integer, parameter, public :: board_kind = ", A)') trim (s_kindnxn (n)) write (*, '()') write (*, '()') write (*, '(" public :: rooks1_attack_check")') write (*, '(" public :: rooks2_attack_check")') write (*, '(" public :: rooks_attack_check")') write (*, '(" public :: bishops1_attack_check")') write (*, '(" public :: bishops2_attack_check")') write (*, '(" public :: bishops_attack_check")') write (*, '(" public :: queens_attack_check")') write (*, '()') write (*, '(" public :: board_rotate90")') write (*, '(" public :: board_rotate180")') write (*, '(" public :: board_rotate270")') write (*, '(" public :: board_reflect1")') write (*, '(" public :: board_reflect2")') write (*, '(" public :: board_reflect3")') write (*, '(" public :: board_reflect4")') write (*, '()')
call write_rook1_masks call write_rook2_masks call write_bishop1_masks call write_bishop2_masks call write_rook_masks call write_bishop_masks call write_queen_masks
write (*, '("contains")') write (*, '()')
call write_rooks1_attack_check call write_rooks2_attack_check call write_bishops1_attack_check call write_bishops2_attack_check call write_rooks_attack_check call write_bishops_attack_check call write_queens_attack_check
call write_board_rotate90 call write_board_rotate180 call write_board_rotate270 call write_board_reflect1 call write_board_reflect2 call write_board_reflect3 call write_board_reflect4
call write_insert_zeros call write_reverse_insert_zeros
write (*, '("end module peaceful_queens_elements")')

contains

subroutine write_rook1_masks integer :: i
call fill_masks (n) do i = 0, n - 1 write (*, '(" integer(kind = ", A, "), parameter :: rook1_mask_",& & I0, "x", I0, "_", I0, " = int (z", Z0.32, ", kind & &= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& & rook1_masks(i), trim (s_kindnxn (n)) end do write (*, '()') end subroutine write_rook1_masks
subroutine write_rook2_masks integer :: i
call fill_masks (n) do i = 0, n - 1 write (*, '(" integer(kind = ", A, "), parameter :: rook2_mask_",& & I0, "x", I0, "_", I0, " = int (z", Z0.32, ", kind & &= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& & rook2_masks(i), trim (s_kindnxn (n)) end do write (*, '()') end subroutine write_rook2_masks
subroutine write_bishop1_masks integer :: i
call fill_masks (n) do i = 0, (2 * n) - 4 write (*, '(" integer(kind = ", A, "), parameter :: bishop1_mask_",& & I0, "x", I0, "_", I0, " = int (z", Z0.32, ", kind & &= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& & bishop1_masks(i), trim (s_kindnxn (n)) end do write (*, '()') end subroutine write_bishop1_masks
subroutine write_bishop2_masks integer :: i
call fill_masks (n) do i = 0, (2 * n) - 4 write (*, '(" integer(kind = ", A, "), parameter :: bishop2_mask_",& & I0, "x", I0, "_", I0, " = int (z", Z0.32, ", kind & &= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& & bishop2_masks(i), trim (s_kindnxn (n)) end do write (*, '()') end subroutine write_bishop2_masks
subroutine write_rook_masks integer :: i
call fill_masks (n) do i = 0, (2 * n) - 1 write (*, '(" integer(kind = ", A, "), parameter :: rook_mask_",& & I0, "x", I0, "_", I0, " = int (z", Z0.32, ", kind & &= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& & rook_masks(i), trim (s_kindnxn (n)) end do write (*, '()') end subroutine write_rook_masks
subroutine write_bishop_masks integer :: i
call fill_masks (n) do i = 0, (4 * n) - 7 write (*, '(" integer(kind = ", A, "), parameter :: bishop_mask_",& & I0, "x", I0, "_", I0, " = int (z", Z0.32, ", kind & &= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& & bishop_masks(i), trim (s_kindnxn (n)) end do write (*, '()') end subroutine write_bishop_masks
subroutine write_queen_masks integer :: i
call fill_masks (n) do i = 0, (6 * n) - 7 write (*, '(" integer(kind = ", A, "), parameter :: queen_mask_",& & I0, "x", I0, "_", I0, " = int (z", Z0.32, ", kind & &= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& & queen_masks(i), trim (s_kindnxn (n)) end do write (*, '()') end subroutine write_queen_masks
subroutine write_rooks1_attack_check integer :: i
write (*, '(" elemental function rooks1_attack_check (army1, army2) result (attacking)")') write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) write (*, '(" logical :: attacking")') write (*, '()') write (*, '(" attacking = ((iand (army1, rook1_mask_", I0, "x", I0,& & "_0) /= 0) .and. (iand (army2, rook1_mask_", I0, "x", I0, "_0) /=& & 0)) .or. &")') n, n, n, n do i = 1, n - 1 write (*, '(" & ((iand (army1, rook1_mask_", I0, "x",& & I0, "_", I0, ") /= 0) .and. (iand (army2, rook1_mask_", I0,& & "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i if (i /= n - 1) then write (*, '(" .or. &")') else write (*, '()') end if end do write (*, '(" end function rooks1_attack_check")') write (*, '()') end subroutine write_rooks1_attack_check
subroutine write_rooks2_attack_check integer :: i
write (*, '(" elemental function rooks2_attack_check (army1, army2) result (attacking)")') write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) write (*, '(" logical :: attacking")') write (*, '()') write (*, '(" attacking = ((iand (army1, rook2_mask_", I0, "x", I0,& & "_0) /= 0) .and. (iand (army2, rook2_mask_", I0, "x", I0, "_0) /=& & 0)) .or. &")') n, n, n, n do i = 1, n - 1 write (*, '(" & ((iand (army1, rook2_mask_", I0, "x",& & I0, "_", I0, ") /= 0) .and. (iand (army2, rook2_mask_", I0,& & "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i if (i /= n - 1) then write (*, '(" .or. &")') else write (*, '()') end if end do write (*, '(" end function rooks2_attack_check")') write (*, '()') end subroutine write_rooks2_attack_check
subroutine write_bishops1_attack_check integer :: i
write (*, '(" elemental function bishops1_attack_check (army1, army2) result (attacking)")') write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) write (*, '(" logical :: attacking")') write (*, '()') write (*, '(" attacking = ((iand (army1, bishop1_mask_", I0, "x", I0,& & "_0) /= 0) .and. (iand (army2, bishop1_mask_", I0, "x", I0, "_0) /=& & 0)) .or. &")') n, n, n, n do i = 1, (2 * n) - 4 write (*, '(" & ((iand (army1, bishop1_mask_", I0, "x",& & I0, "_", I0, ") /= 0) .and. (iand (army2, bishop1_mask_", I0,& & "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i if (i /= (2 * n) - 4) then write (*, '(" .or. &")') else write (*, '()') end if end do write (*, '(" end function bishops1_attack_check")') write (*, '()') end subroutine write_bishops1_attack_check
subroutine write_bishops2_attack_check integer :: i
write (*, '(" elemental function bishops2_attack_check (army1, army2) result (attacking)")') write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) write (*, '(" logical :: attacking")') write (*, '()') write (*, '(" attacking = ((iand (army1, bishop2_mask_", I0, "x", I0,& & "_0) /= 0) .and. (iand (army2, bishop2_mask_", I0, "x", I0, "_0) /=& & 0)) .or. &")') n, n, n, n do i = 1, (2 * n) - 4 write (*, '(" & ((iand (army1, bishop2_mask_", I0, "x",& & I0, "_", I0, ") /= 0) .and. (iand (army2, bishop2_mask_", I0,& & "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i if (i /= (2 * n) - 4) then write (*, '(" .or. &")') else write (*, '()') end if end do write (*, '(" end function bishops2_attack_check")') write (*, '()') end subroutine write_bishops2_attack_check
subroutine write_rooks_attack_check integer :: i
write (*, '(" elemental function rooks_attack_check (army1, army2) result (attacking)")') write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) write (*, '(" logical :: attacking")') write (*, '()') write (*, '(" attacking = ((iand (army1, rook_mask_", I0, "x", I0,& & "_0) /= 0) .and. (iand (army2, rook_mask_", I0, "x", I0, "_0) /=& & 0)) .or. &")') n, n, n, n do i = 1, (2 * n) - 1 write (*, '(" & ((iand (army1, rook_mask_", I0, "x",& & I0, "_", I0, ") /= 0) .and. (iand (army2, rook_mask_", I0,& & "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i if (i /= (2 * n) - 1) then write (*, '(" .or. &")') else write (*, '()') end if end do write (*, '(" end function rooks_attack_check")') write (*, '()') end subroutine write_rooks_attack_check
subroutine write_bishops_attack_check integer :: i
write (*, '(" elemental function bishops_attack_check (army1, army2) result (attacking)")') write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) write (*, '(" logical :: attacking")') write (*, '()') write (*, '(" attacking = ((iand (army1, bishop_mask_", I0, "x", I0,& & "_0) /= 0) .and. (iand (army2, bishop_mask_", I0, "x", I0, "_0) /=& & 0)) .or. &")') n, n, n, n do i = 1, (4 * n) - 7 write (*, '(" & ((iand (army1, bishop_mask_", I0, "x",& & I0, "_", I0, ") /= 0) .and. (iand (army2, bishop_mask_", I0,& & "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i if (i /= (4 * n) - 7) then write (*, '(" .or. &")') else write (*, '()') end if end do write (*, '(" end function bishops_attack_check")') write (*, '()') end subroutine write_bishops_attack_check
subroutine write_queens_attack_check integer :: i
write (*, '(" elemental function queens_attack_check (army1, army2) result (attacking)")') write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) write (*, '(" logical :: attacking")') write (*, '()') write (*, '(" attacking = ((iand (army1, queen_mask_", I0, "x", I0,& & "_0) /= 0) .and. (iand (army2, queen_mask_", I0, "x", I0, "_0) /=& & 0)) .or. &")') n, n, n, n do i = 1, (6 * n) - 7 write (*, '(" & ((iand (army1, queen_mask_", I0, "x",& & I0, "_", I0, ") /= 0) .and. (iand (army2, queen_mask_", I0,& & "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i if (i /= (6 * n) - 7) then write (*, '(" .or. &")') else write (*, '()') end if end do write (*, '(" end function queens_attack_check")') write (*, '()') end subroutine write_queens_attack_check
subroutine write_board_rotate90 integer :: i, j
write (*, '(" elemental function board_rotate90 (a) result (b)")') write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) write (*, '()') write (*, '(" ! Rotation 90 degrees in one of the orientations.")') write (*, '()') do i = 0, n - 1 if (i == 0) then write (*, '(" b = ")', advance = 'no') else write (*, '(" & ")', advance = 'no') do j = 1, i write (*, '(" ")', advance = 'no') end do end if if (i /= n - 1) then write (*, '("ior (ishft (reverse_insert_zeros_", I0, " (ishft& & (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& & I0, ")), ", I0, "), &")') n, n, n, i, -i * n, i else write (*, '(" ishft (reverse_insert_zeros_", I0, " (ishft& & (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& & I0, ")), ", I0, ")")', advance = 'no') n, n, n, i, -i * n, i do j = 1, n - 1 write (*, '(")")', advance = 'no') end do write (*, '()') end if end do write (*, '(" end function board_rotate90")') write (*, '()') end subroutine write_board_rotate90
subroutine write_board_rotate180 write (*, '(" elemental function board_rotate180 (a) result (b)")') write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) write (*, '()') write (*, '(" ! Rotation 180 degrees.")') write (*, '()') write (*, '(" b = board_reflect1 (board_reflect2 (a))")') write (*, '(" end function board_rotate180")') write (*, '()') end subroutine write_board_rotate180
subroutine write_board_rotate270 integer :: i, j
write (*, '(" elemental function board_rotate270 (a) result (b)")') write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) write (*, '()') write (*, '(" ! Rotation 270 degrees in one of the orientations.")') write (*, '()') do i = 0, n - 1 if (i == 0) then write (*, '(" b = ")', advance = 'no') else write (*, '(" & ")', advance = 'no') do j = 1, i write (*, '(" ")', advance = 'no') end do end if if (i /= n - 1) then write (*, '("ior (ishft (insert_zeros_", I0, " (ishft& & (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& & I0, ")), ", I0, "), &")') n, n, n, i, -i * n, n - 1 - i else write (*, '(" ishft (insert_zeros_", I0, " (ishft& & (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& & I0, ")), ", I0, ")")', advance = 'no') n, n, n, i, -i * n, n - 1 - i do j = 1, n - 1 write (*, '(")")', advance = 'no') end do write (*, '()') end if end do write (*, '(" end function board_rotate270")') write (*, '()') end subroutine write_board_rotate270
subroutine write_board_reflect1 integer :: i, j
write (*, '(" elemental function board_reflect1 (a) result (b)")') write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) write (*, '()') write (*, '(" ! Reflection of rows or columns.")') write (*, '()') do i = 0, n - 1 if (i == 0) then write (*, '(" b = ")', advance = 'no') else write (*, '(" & ")', advance = 'no') do j = 1, i write (*, '(" ")', advance = 'no') end do end if if (i /= n - 1) then write (*, '("ior (ishft (iand (rook2_mask_", I0, "x", I0, "_", I0, ", a), ", I0, "), &")') & & n, n, i, (n - 1) - (2 * i) else write (*, '("ishft (iand (rook2_mask_", I0, "x", I0, "_", I0, ", a), ", I0, ")")', advance = 'no') & & n, n, i, (n - 1) - (2 * i) do j = 1, n - 1 write (*, '(")")', advance = 'no') end do write (*, '()') end if end do write (*, '(" end function board_reflect1")') write (*, '()') end subroutine write_board_reflect1
subroutine write_board_reflect2 integer :: i, j
write (*, '(" elemental function board_reflect2 (a) result (b)")') write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) write (*, '()') write (*, '(" ! Reflection of rows or columns.")') write (*, '()') do i = 0, n - 1 if (i == 0) then write (*, '(" b = ")', advance = 'no') else write (*, '(" & ")', advance = 'no') do j = 1, i write (*, '(" ")', advance = 'no') end do end if if (i /= n - 1) then write (*, '("ior (ishft (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ", I0, "), &")') & & n, n, i, n * ((n - 1) - (2 * i)) else write (*, '("ishft (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ", I0, ")")', advance = 'no') & & n, n, i, n * ((n - 1) - (2 * i)) do j = 1, n - 1 write (*, '(")")', advance = 'no') end do write (*, '()') end if end do write (*, '(" end function board_reflect2")') write (*, '()') end subroutine write_board_reflect2
subroutine write_board_reflect3 integer :: i, j
write (*, '(" elemental function board_reflect3 (a) result (b)")') write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) write (*, '()') write (*, '(" ! Reflection around one of the two main diagonals.")') write (*, '()') do i = 0, n - 1 if (i == 0) then write (*, '(" b = ")', advance = 'no') else write (*, '(" & ")', advance = 'no') do j = 1, i write (*, '(" ")', advance = 'no') end do end if if (i /= n - 1) then write (*, '("ior (ishft (insert_zeros_", I0, " (ishft& & (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& & I0, ")), ", I0, "), &")') n, n, n, i, -i * n, i else write (*, '(" ishft (insert_zeros_", I0, " (ishft& & (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& & I0, ")), ", I0, ")")', advance = 'no') n, n, n, i, -i * n, i do j = 1, n - 1 write (*, '(")")', advance = 'no') end do write (*, '()') end if end do write (*, '(" end function board_reflect3")') write (*, '()') end subroutine write_board_reflect3
subroutine write_board_reflect4 integer :: i, j
write (*, '(" elemental function board_reflect4 (a) result (b)")') write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) write (*, '()') write (*, '(" ! Reflection around one of the two main diagonals.")') write (*, '()') do i = 0, n - 1 if (i == 0) then write (*, '(" b = ")', advance = 'no') else write (*, '(" & ")', advance = 'no') do j = 1, i write (*, '(" ")', advance = 'no') end do end if if (i /= n - 1) then write (*, '("ior (ishft (reverse_insert_zeros_", I0, " (ishft& & (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& & I0, ")), ", I0, "), &")') n, n, n, i, -i * n, n - 1 - i else write (*, '(" ishft (reverse_insert_zeros_", I0, " (ishft& & (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& & I0, ")), ", I0, ")")', advance = 'no') n, n, n, i, -i * n, n - 1 - i do j = 1, n - 1 write (*, '(")")', advance = 'no') end do write (*, '()') end if end do write (*, '(" end function board_reflect4")') write (*, '()') end subroutine write_board_reflect4
subroutine write_insert_zeros integer :: i, j
write (*, '(" elemental function insert_zeros_", I0, " (a) result (b)")') n write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) write (*, '()') do i = 0, n - 1 if (i == 0) then write (*, '(" b = ")', advance = 'no') else write (*, '(" & ")', advance = 'no') do j = 1, i write (*, '(" ")', advance = 'no') end do end if if (i /= n - 1) then write (*, '("ior (ishft (ibits (a, ", I0, ", 1), ", I0, "), &")') i, i * n else write (*, '("ishft (ibits (a, ", I0, ", 1), ", I0, ")")', advance = 'no') i, i * n do j = 1, n - 1 write (*, '(")")', advance = 'no') end do write (*, '()') end if end do write (*, '(" end function insert_zeros_", I0)') n write (*, '()') end subroutine write_insert_zeros
subroutine write_reverse_insert_zeros integer :: i, j
write (*, '(" elemental function reverse_insert_zeros_", I0, " (a) result (b)")') n write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) write (*, '()') do i = 0, n - 1 if (i == 0) then write (*, '(" b = ")', advance = 'no') else write (*, '(" & ")', advance = 'no') do j = 1, i write (*, '(" ")', advance = 'no') end do end if if (i /= n - 1) then write (*, '("ior (ishft (ibits (a, ", I0, ", 1), ", I0, "), &")') n - 1 - i, i * n else write (*, '("ishft (ibits (a, ", I0, ", 1), ", I0, ")")', advance = 'no') n - 1 - i, i * n do j = 1, n - 1 write (*, '(")")', advance = 'no') end do write (*, '()') end if end do write (*, '(" end function reverse_insert_zeros_", I0)') n write (*, '()') end subroutine write_reverse_insert_zeros
function s_kindnxn (n) result (s) integer, intent(in) :: n character(len = 16) :: s
if (n <= 8) then s = s_kind8x8 else s = s_kind11x11 end if end function s_kindnxn
subroutine fill_masks (n) integer, intent(in) :: n
call fill_rook1_masks (n) call fill_rook2_masks (n) call fill_bishop1_masks (n) call fill_bishop2_masks (n) call fill_rook_masks (n) call fill_bishop_masks (n) call fill_queen_masks (n) end subroutine fill_masks
subroutine fill_rook1_masks (n) integer, intent(in) :: n
integer :: i integer(kind = kind11x11) :: mask
mask = (two ** n) - 1 do i = 0, n - 1 rook1_masks(i) = mask mask = ishft (mask, n) end do end subroutine fill_rook1_masks
subroutine fill_rook2_masks (n) integer, intent(in) :: n
integer :: i integer(kind = kind11x11) :: mask
mask = 0 do i = 0, n - 1 mask = ior (ishft (mask, n), one) end do do i = 0, n - 1 rook2_masks(i) = mask mask = ishft (mask, 1) end do end subroutine fill_rook2_masks subroutine fill_bishop1_masks (n) integer, intent(in) :: n
integer :: i, j, k integer(kind = kind11x11) :: mask0, mask1
! Masks for diagonals. Put them in order from most densely ! populated to least densely populated.
do k = 0, n - 2 mask0 = 0 mask1 = 0 do i = k, n - 1 j = i - k mask0 = ior (mask0, ishft (one, i + (j * n))) mask1 = ior (mask1, ishft (one, j + (i * n))) end do if (k == 0) then bishop1_masks(0) = mask0 else bishop1_masks((2 * k) - 1) = mask0 bishop1_masks(2 * k) = mask1 end if end do end subroutine fill_bishop1_masks
subroutine fill_bishop2_masks (n) integer, intent(in) :: n
integer :: i, j, k integer :: i1, j1 integer(kind = kind11x11) :: mask0, mask1
! Masks for skew diagonals. Put them in order from most densely ! populated to least densely populated.
do k = 0, n - 2 mask0 = 0 mask1 = 0 do i = k, n - 1 j = i - k i1 = n - 1 - i j1 = n - 1 - j mask0 = ior (mask0, ishft (one, j + (i1 * n))) mask1 = ior (mask1, ishft (one, i + (j1 * n))) end do if (k == 0) then bishop2_masks(0) = mask0 else bishop2_masks((2 * k) - 1) = mask0 bishop2_masks(2 * k) = mask1 end if end do end subroutine fill_bishop2_masks
subroutine fill_rook_masks (n) integer, intent(in) :: n
rook_masks(0 : n - 1) = rook1_masks rook_masks(n : (2 * n) - 1) = rook2_masks end subroutine fill_rook_masks
subroutine fill_bishop_masks (n) integer, intent(in) :: n
integer :: i
! Put the masks in order from most densely populated to least ! densely populated.
do i = 0, (2 * n) - 4 bishop_masks(2 * i) = bishop1_masks(i) bishop_masks((2 * i) + 1) = bishop2_masks(i) end do end subroutine fill_bishop_masks
subroutine fill_queen_masks (n) integer, intent(in) :: n
queen_masks(0 : (2 * n) - 1) = rook_masks queen_masks(2 * n : (6 * n) - 7) = bishop_masks end subroutine fill_queen_masks

end program peaceful_queens_elements_generator</lang>

Here is the second program, peaceful_queens.f90: <lang fortran>module peaceful_queens_support

use, non_intrinsic :: peaceful_queens_elements
implicit none private
public :: write_board public :: write_board_without_spaces public :: write_board_with_spaces
public :: save_a_solution
interface write_board module procedure write_board_without_spaces module procedure write_board_with_spaces end interface write_board

contains

subroutine write_board_without_spaces (unit, army_b, army_w) integer, intent(in) :: unit integer(kind = board_kind), intent(in) :: army_b, army_w
call write_board_with_spaces (unit, army_b, army_w, 0) end subroutine write_board_without_spaces
subroutine write_board_with_spaces (unit, army_b, army_w, num_spaces) integer, intent(in) :: unit integer(kind = board_kind), intent(in) :: army_b, army_w integer, intent(in) :: num_spaces
integer(kind = board_kind), parameter :: zero = 0 integer(kind = board_kind), parameter :: one = 1
integer :: i, j integer(kind = board_kind) :: rank_b, rank_w integer(kind = board_kind) :: mask
character(1), allocatable :: queens(:) character(4), allocatable :: rules(:) character(1), allocatable :: spaces(:)
allocate (queens(0 : n - 1)) allocate (rules(0 : n - 1)) allocate (spaces(1 : num_spaces))
rules = "----" if (0 < num_spaces) then spaces = " " ! For putting spaces after newlines. end if
mask = not (ishft (not (zero), n)) write (unit, '("+", 100(A4, "+"))') rules do i = 0, n - 1 rank_b = iand (mask, ishft (army_b, -i * n)) rank_w = iand (mask, ishft (army_w, -i * n)) do j = 0, n - 1 if (iand (rank_b, ishft (one, j)) /= 0) then queens(j) = "B" else if (iand (rank_w, ishft (one, j)) /= 0) then queens(j) = "W" else queens(j) = " " end if end do write (unit, '(100A1)', advance = 'no') spaces write (unit, '("|", 100(A3, " |"))') queens write (unit, '(100A1)', advance = 'no') spaces if (i /= n - 1) then write (unit, '("+", 100(A4, "+"))') rules else write (unit, '("+", 100(A4, "+"))', advance = 'no') rules end if end do end subroutine write_board_with_spaces
subroutine save_a_solution (army1, army2, num_solutions, armies1, armies2) integer(kind = board_kind), intent(in) :: army1, army2 integer, intent(inout) :: num_solutions integer(kind = board_kind), intent(inout) :: armies1(1:8, 1:max_solutions) integer(kind = board_kind), intent(inout) :: armies2(1:8, 1:max_solutions)
! A sanity check. if (queens_attack_check (army1, army2)) then error stop end if
num_solutions = num_solutions + 1
armies1(1, num_solutions) = army1 armies1(2, num_solutions) = board_rotate90 (army1) armies1(3, num_solutions) = board_rotate180 (army1) armies1(4, num_solutions) = board_rotate270 (army1) armies1(5, num_solutions) = board_reflect1 (army1) armies1(6, num_solutions) = board_reflect2 (army1) armies1(7, num_solutions) = board_reflect3 (army1) armies1(8, num_solutions) = board_reflect4 (army1)
armies2(1, num_solutions) = army2 armies2(2, num_solutions) = board_rotate90 (army2) armies2(3, num_solutions) = board_rotate180 (army2) armies2(4, num_solutions) = board_rotate270 (army2) armies2(5, num_solutions) = board_reflect1 (army2) armies2(6, num_solutions) = board_reflect2 (army2) armies2(7, num_solutions) = board_reflect3 (army2) armies2(8, num_solutions) = board_reflect4 (army2) end subroutine save_a_solution

end module peaceful_queens_support

module peaceful_queens_solver

use, non_intrinsic :: peaceful_queens_elements use, non_intrinsic :: peaceful_queens_support
implicit none private
public :: solve_peaceful_queens
integer(kind = board_kind), parameter :: zero = 0_board_kind integer(kind = board_kind), parameter :: one = 1_board_kind integer(kind = board_kind), parameter :: two = 2_board_kind

contains

subroutine solve_peaceful_queens (unit, show_equivalents, & & num_solutions, armies1, armies2) integer, intent(in) :: unit logical, intent(in) :: show_equivalents integer, intent(out) :: num_solutions integer(kind = board_kind), intent(out) :: armies1(1:8, 1:max_solutions) integer(kind = board_kind), intent(out) :: armies2(1:8, 1:max_solutions)
call solve (zero, 0, 0, zero, 0, 0, 0)
contains
recursive subroutine solve (army1, rooklike11, rooklike12, & & army2, rooklike21, rooklike22, index) integer(kind = board_kind), value :: army1 integer, value :: rooklike11, rooklike12 integer(kind = board_kind), value :: army2 integer, value :: rooklike21, rooklike22 integer, value :: index
integer :: num_queens1 integer :: num_queens2 integer(kind = board_kind) :: new_army integer(kind = board_kind) :: new_army_reversed integer :: bit1, bit2 logical :: skip
num_queens1 = popcnt (army1) num_queens2 = popcnt (army2)
if (num_queens1 + num_queens2 == 2 * m) then if (.not. is_a_duplicate (army1, army2, num_solutions, armies1, armies2)) then call save_a_solution (army1, army2, num_solutions, armies1, armies2) write (unit, '("Solution ", I0)') num_solutions call write_board (unit, army1, army2) write (unit, '()') write (unit, '()') call optionally_write_equivalents end if else if (num_queens1 - num_queens2 == 0) then ! It is time to add a queen to army1. do while (num_solutions < max_solutions .and. index /= n**2) skip = .false. new_army = ior (army1, ishft (one, index)) if (new_army == army1) then skip = .true. else if (index < n) then new_army_reversed = board_reflect1 (new_army) if (new_army_reversed < new_army) then ! Skip a bunch of board_reflect1 equivalents. skip = .true. end if end if if (skip) then index = index + 1 else bit1 = ishft (1, index / n) bit2 = ishft (1, mod (index, n)) if (iand (rooklike21, bit1) /= 0) then index = round_up_to_multiple (index + 1, n) else if (iand (rooklike22, bit2) /= 0) then index = index + 1 else if (bishops_attack_check (new_army, army2)) then index = index + 1 else call solve (new_army, & & ior (rooklike11, bit1), & & ior (rooklike12, bit2), & & army2, rooklike21, rooklike22, & & n) index = index + 1 end if end if end do else ! It is time to add a queen to army2. do while (num_solutions < max_solutions .and. index /= n**2) new_army = ior (army2, ishft (one, index)) skip = (new_army == army2) if (skip) then index = index + 1 else bit1 = ishft (1, index / n) bit2 = ishft (1, mod (index, n)) if (iand (rooklike11, bit1) /= 0) then index = round_up_to_multiple (index + 1, n) else if (iand (rooklike12, bit2) /= 0) then index = index + 1 else if (bishops_attack_check (army1, new_army)) then index = index + 1 else call solve (army1, rooklike11, rooklike12, & & new_army, & & ior (rooklike21, bit1), & & ior (rooklike22, bit2), & & 0) index = index + 1 end if end if end do end if end subroutine solve
subroutine optionally_write_equivalents integer :: i
if (show_equivalents) then write (unit, '(5X)', advance = 'no') write (unit, '("Equivalents")')
write (unit, '(5X)', advance = 'no') call write_board (unit, armies2(1, num_solutions), armies1(1, num_solutions), 5) write (unit, '()') write (unit, '()')
do i = 2, 5 if (all ((armies1(i, num_solutions) /= armies1(1 : i - 1, num_solutions) .or. & & armies2(i, num_solutions) /= armies2(1 : i - 1, num_solutions)) .and. & & (armies2(i, num_solutions) /= armies1(1 : i - 1, num_solutions) .or. & & armies1(i, num_solutions) /= armies2(1 : i - 1, num_solutions)))) then write (unit, '(5X)', advance = 'no') call write_board (unit, armies1(i, num_solutions), armies2(i, num_solutions), 5) write (unit, '()') write (unit, '()') write (unit, '(5X)', advance = 'no') call write_board (unit, armies2(i, num_solutions), armies1(i, num_solutions), 5) write (unit, '()') write (unit, '()') end if end do end if end subroutine optionally_write_equivalents
end subroutine solve_peaceful_queens
elemental function round_up_to_multiple (x, n) result (y) integer, value :: x, n integer :: y
y = x + mod (n - mod (x, n), n) end function round_up_to_multiple
pure function is_a_duplicate (army1, army2, num_solutions, armies1, armies2) result (is_dup) integer(kind = board_kind), intent(in) :: army1, army2 integer, intent(in) :: num_solutions integer(kind = board_kind), intent(in) :: armies1(1:8, 1:max_solutions) integer(kind = board_kind), intent(in) :: armies2(1:8, 1:max_solutions) logical :: is_dup
is_dup = any ((army1 == armies1(:, 1:num_solutions) .and. & & army2 == armies2(:, 1:num_solutions)) .or. & & (army2 == armies1(:, 1:num_solutions) .and. & & army1 == armies2(:, 1:num_solutions))) end function is_a_duplicate

end module peaceful_queens_solver

program peaceful_queens

use, intrinsic :: iso_fortran_env, only: output_unit use, non_intrinsic :: peaceful_queens_elements use, non_intrinsic :: peaceful_queens_support use, non_intrinsic :: peaceful_queens_solver
implicit none
integer :: num_solutions logical :: show_equivalents integer(kind = board_kind) :: armies1(1:8, 1:max_solutions) integer(kind = board_kind) :: armies2(1:8, 1:max_solutions)
integer :: arg_count character(len = 200) :: arg
show_equivalents = .false.
arg_count = command_argument_count () if (1 <= arg_count) then call get_command_argument (1, arg) select case (trim (arg)) case ('1', 't', 'T', 'true', 'y', 'Y', 'yes') show_equivalents = .true. end select end if
call solve_peaceful_queens (output_unit, show_equivalents, & & num_solutions, armies1, armies2)

end program peaceful_queens</lang>

Here is the driver script: <lang sh>#!/bin/sh

Driver script for peaceful_queens in Fortran.

if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1; then

emulate sh

fi

if test $# -ne 3 && test $# -ne 4; then

echo "Usage: $0 M N MAX_SOLUTIONS [SHOW_EQUIVALENTS]" exit 1

fi

M=${1} N=${2} MAX_SOLUTIONS=${3} SHOW_EQUIVALENTS=${4}

RM_GENERATED_SRC=yes CHECK=no

case ${CHECK} in

0 | f | F | false | N | n | no) FCCHECK="" ;; 1 | t | T | true | Y | y | yes) FCCHECK="-fcheck=all" ;; *) echo 'CHECK is set incorrectly'; exit 1 ;;

esac

FC="gfortran" FCFLAGS="-std=f2018 -g -O3 -march=native -fno-stack-protector -Wall -Wextra ${FCCHECK}"

If you have the graphite optimizer, here are some marginally helpful

flags. They barely make a difference, for me.

FCFLAGS="${FCFLAGS} -funroll-loops -floop-nest-optimize"

RUN_IT="yes"

${FC} -o peaceful_queens_elements_generator peaceful_queens_elements_generator.f90 &&

./peaceful_queens_elements_generator ${M} ${N} ${MAX_SOLUTIONS} > peaceful_queens_elements.f90 && ${FC} ${FCFLAGS} -c peaceful_queens_elements.f90 && if test x"${RM_GENERATED_SRC}" != xno; then rm -f peaceful_queens_elements.f90; fi && ${FC} ${FCFLAGS} -c peaceful_queens.f90 && ${FC} ${FCFLAGS} -o peaceful_queens peaceful_queens_elements.o peaceful_queens.o && if test x"${RUN_IT}" = xyes; then time ./peaceful_queens ${SHOW_EQUIVALENTS}; else :; fi</lang>

Output:

$ ./peaceful_queens-fortran-driver.sh 4 5 1000 T

Solution 1 +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ Equivalents +----+----+----+----+----+ | W | | | | W | +----+----+----+----+----+ | | | B | | | +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ | | | B | | | +----+----+----+----+----+ | W | | | | W | +----+----+----+----+----+ Solution 2 +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ Equivalents +----+----+----+----+----+ | W | | | | W | +----+----+----+----+----+ | | | B | | | +----+----+----+----+----+ | W | | | | W | +----+----+----+----+----+ | | | B | | | +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ +----+----+----+----+----+ | W | | W | | | +----+----+----+----+----+ | | | | | B | +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ | | | | | B | +----+----+----+----+----+ | W | | W | | | +----+----+----+----+----+ +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ | | | B | | | +----+----+----+----+----+ | W | | | | W | +----+----+----+----+----+ | | | B | | | +----+----+----+----+----+ | W | | | | W | +----+----+----+----+----+ +----+----+----+----+----+ | | | B | | B | +----+----+----+----+----+ | W | | | | | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | W | | | | | +----+----+----+----+----+ | | | B | | B | +----+----+----+----+----+ +----+----+----+----+----+ | | | W | | W | +----+----+----+----+----+ | B | | | | | +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ | B | | | | | +----+----+----+----+----+ | | | W | | W | +----+----+----+----+----+ Solution 3 +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ Equivalents +----+----+----+----+----+ | W | | W | | | +----+----+----+----+----+ | | | | | B | +----+----+----+----+----+ | W | | W | | | +----+----+----+----+----+ | | | | | B | +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ | | | | | B | +----+----+----+----+----+ | W | | W | | | +----+----+----+----+----+ | | | | | B | +----+----+----+----+----+ | W | | W | | | +----+----+----+----+----+ +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | W | | | | | +----+----+----+----+----+ | | | B | | B | +----+----+----+----+----+ | W | | | | | +----+----+----+----+----+ | | | B | | B | +----+----+----+----+----+ +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ | B | | | | | +----+----+----+----+----+ | | | W | | W | +----+----+----+----+----+ | B | | | | | +----+----+----+----+----+ | | | W | | W | +----+----+----+----+----+ +----+----+----+----+----+ | | | B | | B | +----+----+----+----+----+ | W | | | | | +----+----+----+----+----+ | | | B | | B | +----+----+----+----+----+ | W | | | | | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ +----+----+----+----+----+ | | | W | | W | +----+----+----+----+----+ | B | | | | | +----+----+----+----+----+ | | | W | | W | +----+----+----+----+----+ | B | | | | | +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+

On my computer, the program can find all the solutions of m=5, n=6, and eliminate any other possibilities, in under 5 seconds. The m=7, n=7 case took about 4.25 hours, mostly eliminating other possibilities. The next thing to try would be m=9, n=8, but probably a faster program is called for, there.

It would be instructive to save and examine the generated peaceful_queens_elements.f90 files. I leave that as an exercise for the reader. :)

Go

This is based on the C# code here.

Textual rather than HTML output. Whilst the unicode symbols for the black and white queens are recognized by the Ubuntu 16.04 terminal, I found it hard to visually distinguish between them so I've used 'B' and 'W' instead. <lang go>package main

import "fmt"

const (

empty = iota black white

)

const (

bqueen = 'B' wqueen = 'W' bbullet = '•' wbullet = '◦'

)

type position struct{ i, j int }

func iabs(i int) int {

if i < 0 { return -i } return i

}

func place(m, n int, pBlackQueens, pWhiteQueens *[]position) bool {

if m == 0 { return true } placingBlack := true for i := 0; i < n; i++ { inner: for j := 0; j < n; j++ { pos := position{i, j} for _, queen := range *pBlackQueens { if queen == pos || !placingBlack && isAttacking(queen, pos) { continue inner } } for _, queen := range *pWhiteQueens { if queen == pos || placingBlack && isAttacking(queen, pos) { continue inner } } if placingBlack { *pBlackQueens = append(*pBlackQueens, pos) placingBlack = false } else { *pWhiteQueens = append(*pWhiteQueens, pos) if place(m-1, n, pBlackQueens, pWhiteQueens) { return true } *pBlackQueens = (*pBlackQueens)[0 : len(*pBlackQueens)-1] *pWhiteQueens = (*pWhiteQueens)[0 : len(*pWhiteQueens)-1] placingBlack = true } } } if !placingBlack { *pBlackQueens = (*pBlackQueens)[0 : len(*pBlackQueens)-1] } return false

}

func isAttacking(queen, pos position) bool {

if queen.i == pos.i { return true } if queen.j == pos.j { return true } if iabs(queen.i-pos.i) == iabs(queen.j-pos.j) { return true } return false

}

func printBoard(n int, blackQueens, whiteQueens []position) {

board := make([]int, n*n) for _, queen := range blackQueens { board[queen.i*n+queen.j] = black } for _, queen := range whiteQueens { board[queen.i*n+queen.j] = white }
for i, b := range board { if i != 0 && i%n == 0 { fmt.Println() } switch b { case black: fmt.Printf("%c ", bqueen) case white: fmt.Printf("%c ", wqueen) case empty: if i%2 == 0 { fmt.Printf("%c ", bbullet) } else { fmt.Printf("%c ", wbullet) } } } fmt.Println("\n")

}

func main() {

nms := [][2]int{ {2, 1}, {3, 1}, {3, 2}, {4, 1}, {4, 2}, {4, 3}, {5, 1}, {5, 2}, {5, 3}, {5, 4}, {5, 5}, {6, 1}, {6, 2}, {6, 3}, {6, 4}, {6, 5}, {6, 6}, {7, 1}, {7, 2}, {7, 3}, {7, 4}, {7, 5}, {7, 6}, {7, 7}, } for _, nm := range nms { n, m := nm[0], nm[1] fmt.Printf("%d black and %d white queens on a %d x %d board:\n", m, m, n, n) var blackQueens, whiteQueens []position if place(m, n, &blackQueens, &whiteQueens) { printBoard(n, blackQueens, whiteQueens) } else { fmt.Println("No solution exists.\n") } }

}</lang>

Output:

1 black and 1 white queens on a 2 x 2 board: No solution exists. 1 black and 1 white queens on a 3 x 3 board: B ◦ • ◦ • W • ◦ • 2 black and 2 white queens on a 3 x 3 board: No solution exists. 1 black and 1 white queens on a 4 x 4 board: B ◦ • ◦ • ◦ W ◦ • ◦ • ◦ • ◦ • ◦ 2 black and 2 white queens on a 4 x 4 board: B ◦ • ◦ • ◦ W ◦ B ◦ • ◦ • ◦ W ◦ 3 black and 3 white queens on a 4 x 4 board: No solution exists. 1 black and 1 white queens on a 5 x 5 board: B ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and 2 white queens on a 5 x 5 board: B ◦ • ◦ B ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 3 black and 3 white queens on a 5 x 5 board: B ◦ • ◦ B ◦ • W • ◦ • W • ◦ • ◦ • ◦ B ◦ • W • ◦ • 4 black and 4 white queens on a 5 x 5 board: • B • B • ◦ • ◦ • B W ◦ W ◦ • ◦ • ◦ • B W ◦ W ◦ • 5 black and 5 white queens on a 5 x 5 board: No solution exists. 1 black and 1 white queens on a 6 x 6 board: B ◦ • ◦ • ◦ • ◦ W ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ 2 black and 2 white queens on a 6 x 6 board: B ◦ • ◦ B ◦ • ◦ W ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ 3 black and 3 white queens on a 6 x 6 board: B ◦ • ◦ B B • ◦ W ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ W ◦ • ◦ • ◦ • ◦ • ◦ 4 black and 4 white queens on a 6 x 6 board: B ◦ • ◦ B B • ◦ W ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • B • ◦ W W • ◦ • ◦ • ◦ • ◦ 5 black and 5 white queens on a 6 x 6 board: • B • ◦ B ◦ • ◦ • B • B W ◦ • ◦ • ◦ W ◦ W ◦ • ◦ • ◦ • ◦ • B W ◦ W ◦ • ◦ 6 black and 6 white queens on a 6 x 6 board: No solution exists. 1 black and 1 white queens on a 7 x 7 board: B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and 2 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 3 black and 3 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 4 black and 4 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 5 black and 5 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • 6 black and 6 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • 7 black and 7 white queens on a 7 x 7 board: • B • ◦ • B • ◦ B ◦ • B • ◦ • B • ◦ • B • ◦ • ◦ • B • ◦ W ◦ W ◦ • ◦ W ◦ • ◦ W ◦ • ◦ W ◦ W W • ◦ •

Java
Translation of: Kotlin

<lang java>import java.util.ArrayList; import java.util.Arrays; import java.util.List;

public class Peaceful {

enum Piece { Empty, Black, White, }
public static class Position { public int x, y;
public Position(int x, int y) { this.x = x; this.y = y; }
@Override public boolean equals(Object obj) { if (obj instanceof Position) { Position pos = (Position) obj; return pos.x == x && pos.y == y; } return false; } }
private static boolean place(int m, int n, List<Position> pBlackQueens, List<Position> pWhiteQueens) { if (m == 0) { return true; } boolean placingBlack = true; for (int i = 0; i < n; ++i) { inner: for (int j = 0; j < n; ++j) { Position pos = new Position(i, j); for (Position queen : pBlackQueens) { if (pos.equals(queen) || !placingBlack && isAttacking(queen, pos)) { continue inner; } } for (Position queen : pWhiteQueens) { if (pos.equals(queen) || placingBlack && isAttacking(queen, pos)) { continue inner; } } if (placingBlack) { pBlackQueens.add(pos); placingBlack = false; } else { pWhiteQueens.add(pos); if (place(m - 1, n, pBlackQueens, pWhiteQueens)) { return true; } pBlackQueens.remove(pBlackQueens.size() - 1); pWhiteQueens.remove(pWhiteQueens.size() - 1); placingBlack = true; } } } if (!placingBlack) { pBlackQueens.remove(pBlackQueens.size() - 1); } return false; }
private static boolean isAttacking(Position queen, Position pos) { return queen.x == pos.x || queen.y == pos.y || Math.abs(queen.x - pos.x) == Math.abs(queen.y - pos.y); }
private static void printBoard(int n, List<Position> blackQueens, List<Position> whiteQueens) { Piece[] board = new Piece[n * n]; Arrays.fill(board, Piece.Empty);
for (Position queen : blackQueens) { board[queen.x + n * queen.y] = Piece.Black; } for (Position queen : whiteQueens) { board[queen.x + n * queen.y] = Piece.White; } for (int i = 0; i < board.length; ++i) { if ((i != 0) && i % n == 0) { System.out.println(); }
Piece b = board[i]; if (b == Piece.Black) { System.out.print("B "); } else if (b == Piece.White) { System.out.print("W "); } else { int j = i / n; int k = i - j * n; if (j % 2 == k % 2) { System.out.print("• "); } else { System.out.print("◦ "); } } } System.out.println('\n'); }
public static void main(String[] args) { List<Position> nms = List.of( new Position(2, 1), new Position(3, 1), new Position(3, 2), new Position(4, 1), new Position(4, 2), new Position(4, 3), new Position(5, 1), new Position(5, 2), new Position(5, 3), new Position(5, 4), new Position(5, 5), new Position(6, 1), new Position(6, 2), new Position(6, 3), new Position(6, 4), new Position(6, 5), new Position(6, 6), new Position(7, 1), new Position(7, 2), new Position(7, 3), new Position(7, 4), new Position(7, 5), new Position(7, 6), new Position(7, 7) ); for (Position nm : nms) { int m = nm.y; int n = nm.x; System.out.printf("%d black and %d white queens on a %d x %d board:\n", m, m, n, n); List<Position> blackQueens = new ArrayList<>(); List<Position> whiteQueens = new ArrayList<>(); if (place(m, n, blackQueens, whiteQueens)) { printBoard(n, blackQueens, whiteQueens); } else { System.out.println("No solution exists.\n"); } } }

}</lang>

Output:
1 black and 1 white queens on a 2 x 2 board: No solution exists. 1 black and 1 white queens on a 3 x 3 board: B ◦ • ◦ • ◦ • W • 2 black and 2 white queens on a 3 x 3 board: No solution exists. 1 black and 1 white queens on a 4 x 4 board: B ◦ • ◦ ◦ • ◦ • • W • ◦ ◦ • ◦ • 2 black and 2 white queens on a 4 x 4 board: B ◦ B ◦ ◦ • ◦ • • W • W ◦ • ◦ • 3 black and 3 white queens on a 4 x 4 board: No solution exists. 1 black and 1 white queens on a 5 x 5 board: B ◦ • ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and 2 white queens on a 5 x 5 board: B ◦ • ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ B ◦ • ◦ • 3 black and 3 white queens on a 5 x 5 board: B ◦ • ◦ • ◦ • W • W • W • ◦ • ◦ • ◦ B ◦ B ◦ • ◦ • 4 black and 4 white queens on a 5 x 5 board: • ◦ W ◦ W B • ◦ • ◦ • ◦ W ◦ W B • ◦ • ◦ • B • B • 5 black and 5 white queens on a 5 x 5 board: No solution exists. 1 black and 1 white queens on a 6 x 6 board: B ◦ • ◦ • ◦ ◦ • ◦ • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • 2 black and 2 white queens on a 6 x 6 board: B ◦ • ◦ • ◦ ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ • B ◦ • ◦ • ◦ ◦ • ◦ • ◦ • 3 black and 3 white queens on a 6 x 6 board: B ◦ • ◦ • ◦ ◦ • W • ◦ • • W • ◦ W ◦ ◦ • ◦ • ◦ • B ◦ • ◦ • ◦ B • ◦ • ◦ • 4 black and 4 white queens on a 6 x 6 board: B ◦ • ◦ • ◦ ◦ • W • ◦ • • W • ◦ W ◦ ◦ • ◦ • W • B ◦ • ◦ • ◦ B • ◦ B ◦ • 5 black and 5 white queens on a 6 x 6 board: • ◦ W W • W B • ◦ • ◦ • • ◦ • W • W ◦ B ◦ • ◦ • B ◦ • ◦ • ◦ ◦ B ◦ • B • 6 black and 6 white queens on a 6 x 6 board: No solution exists. 1 black and 1 white queens on a 7 x 7 board: B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and 2 white queens on a 7 x 7 board: B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • 3 black and 3 white queens on a 7 x 7 board: B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • W • ◦ • ◦ • ◦ • ◦ • ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • 4 black and 4 white queens on a 7 x 7 board: B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • W • ◦ • ◦ • ◦ • ◦ • ◦ B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • W • ◦ • 5 black and 5 white queens on a 7 x 7 board: B ◦ B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • W • W • W • ◦ • ◦ • ◦ • ◦ B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • W • ◦ • 6 black and 6 white queens on a 7 x 7 board: B ◦ B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • W • W • W • ◦ • ◦ • ◦ • ◦ B ◦ B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • W • W • W • 7 black and 7 white queens on a 7 x 7 board: • ◦ • ◦ W ◦ W B B B • ◦ • ◦ • ◦ • ◦ W ◦ W ◦ • ◦ • ◦ W W • B • B • ◦ • B • B • ◦ • ◦ • ◦ • ◦ W ◦ •
Julia

GUI version, uses the Gtk library. The place! function is condensed from the C# example. <lang julia>using Gtk

struct Position

row::Int col::Int

end

function place!(numeach, bsize, bqueens, wqueens)

isattack(q, pos) = (q.row == pos.row || q.col == pos.col || abs(q.row - pos.row) == abs(q.col - pos.col)) noattack(qs, pos) = !any(x -> isattack(x, pos), qs) positionopen(bqs, wqs, p) = !any(x -> x == p, bqs) && !any(x -> x == p, wqs)
placingbqueens = true if numeach < 1 return true end for i in 1:bsize, j in 1:bsize bpos = Position(i, j) if positionopen(bqueens, wqueens, bpos) if placingbqueens && noattack(wqueens, bpos) push!(bqueens, bpos) placingbqueens = false elseif !placingbqueens && noattack(bqueens, bpos) push!(wqueens, bpos) if place!(numeach - 1, bsize, bqueens, wqueens) return true end pop!(bqueens) pop!(wqueens) placingbqueens = true end end end if !placingbqueens pop!(bqueens) end false

end

function peacefulqueenapp()

win = GtkWindow("Peaceful Chess Queen Armies", 800, 800) |> (GtkFrame() |> (box = GtkBox(:v))) boardsize = 5 numqueenseach = 4 hbox = GtkBox(:h) boardscale = GtkScale(false, 2:16) set_gtk_property!(boardscale, :hexpand, true) blabel = GtkLabel("Choose Board Size") nqueenscale = GtkScale(false, 1:24) set_gtk_property!(nqueenscale, :hexpand, true) qlabel = GtkLabel("Choose Number of Queens Per Side") solveit = GtkButton("Solve") set_gtk_property!(solveit, :label, " Solve ") solvequeens(wid) = (boardsize = Int(GAccessor.value(boardscale)); numqueenseach = Int(GAccessor.value(nqueenscale)); update!()) signal_connect(solvequeens, solveit, :clicked) map(w->push!(hbox, w),[blabel, boardscale, qlabel, nqueenscale, solveit]) scrwin = GtkScrolledWindow() grid = GtkGrid() push!(scrwin, grid) map(w -> push!(box, w),[hbox, scrwin]) piece = (white = "\u2655", black = "\u265B", blank = " ") stylist = GtkStyleProvider(Gtk.CssProviderLeaf(data=""" label {background-image: image(cornsilk); font-size: 48px;} button {background-image: image(tan); font-size: 48px;}"""))
function update!() bqueens, wqueens = Vector{Position}(), Vector{Position}() place!(numqueenseach, boardsize, bqueens, wqueens) if length(bqueens) == 0 warn_dialog("No solution for board size $boardsize and $numqueenseach queens each.", win) return end empty!(grid) labels = Array{Gtk.GtkLabelLeaf, 2}(undef, (boardsize, boardsize)) buttons = Array{GtkButtonLeaf, 2}(undef, (boardsize, boardsize)) for i in 1:boardsize, j in 1:boardsize if isodd(i + j) grid[i, j] = buttons[i, j] = GtkButton(piece.blank) set_gtk_property!(buttons[i, j], :expand, true) push!(Gtk.GAccessor.style_context(buttons[i, j]), stylist, 600) else grid[i, j] = labels[i, j] = GtkLabel(piece.blank) set_gtk_property!(labels[i, j], :expand, true) push!(Gtk.GAccessor.style_context(labels[i, j]), stylist, 600) end pos = Position(i, j) if pos in bqueens set_gtk_property!(grid[i, j], :label, piece.black) elseif pos in wqueens set_gtk_property!(grid[i, j], :label, piece.white) end end showall(win) end
update!() cond = Condition() endit(w) = notify(cond) signal_connect(endit, win, :destroy) showall(win) wait(cond)

end

peacefulqueenapp() </lang>

Kotlin
Translation of: D

<lang scala>import kotlin.math.abs

enum class Piece {

Empty, Black, White,

}

typealias Position = Pair<Int, Int>

fun place(m: Int, n: Int, pBlackQueens: MutableList<Position>, pWhiteQueens: MutableList<Position>): Boolean {

if (m == 0) { return true } var placingBlack = true for (i in 0 until n) { inner@ for (j in 0 until n) { val pos = Position(i, j) for (queen in pBlackQueens) { if (queen == pos || !placingBlack && isAttacking(queen, pos)) { continue@inner } } for (queen in pWhiteQueens) { if (queen == pos || placingBlack && isAttacking(queen, pos)) { continue@inner } } placingBlack = if (placingBlack) { pBlackQueens.add(pos) false } else { pWhiteQueens.add(pos) if (place(m - 1, n, pBlackQueens, pWhiteQueens)) { return true } pBlackQueens.removeAt(pBlackQueens.lastIndex) pWhiteQueens.removeAt(pWhiteQueens.lastIndex) true } } } if (!placingBlack) { pBlackQueens.removeAt(pBlackQueens.lastIndex) } return false

}

fun isAttacking(queen: Position, pos: Position): Boolean {

return queen.first == pos.first || queen.second == pos.second || abs(queen.first - pos.first) == abs(queen.second - pos.second)

}

fun printBoard(n: Int, blackQueens: List<Position>, whiteQueens: List<Position>) {

val board = MutableList(n * n) { Piece.Empty }
for (queen in blackQueens) { board[queen.first * n + queen.second] = Piece.Black } for (queen in whiteQueens) { board[queen.first * n + queen.second] = Piece.White } for ((i, b) in board.withIndex()) { if (i != 0 && i % n == 0) { println() } if (b == Piece.Black) { print("B ") } else if (b == Piece.White) { print("W ") } else { val j = i / n val k = i - j * n if (j % 2 == k % 2) { print("• ") } else { print("◦ ") } } } println('\n')

}

fun main() {

val nms = listOf( Pair(2, 1), Pair(3, 1), Pair(3, 2), Pair(4, 1), Pair(4, 2), Pair(4, 3), Pair(5, 1), Pair(5, 2), Pair(5, 3), Pair(5, 4), Pair(5, 5), Pair(6, 1), Pair(6, 2), Pair(6, 3), Pair(6, 4), Pair(6, 5), Pair(6, 6), Pair(7, 1), Pair(7, 2), Pair(7, 3), Pair(7, 4), Pair(7, 5), Pair(7, 6), Pair(7, 7) ) for ((n, m) in nms) { println("$m black and $m white queens on a $n x $n board:") val blackQueens = mutableListOf<Position>() val whiteQueens = mutableListOf<Position>() if (place(m, n, blackQueens, whiteQueens)) { printBoard(n, blackQueens, whiteQueens) } else { println("No solution exists.\n") } }

}</lang>

Output:
1 black and 1 white queens on a 2 x 2 board: No solution exists. 1 black and 1 white queens on a 3 x 3 board: B ◦ • ◦ • W • ◦ • 2 black and 2 white queens on a 3 x 3 board: No solution exists. 1 black and 1 white queens on a 4 x 4 board: B ◦ • ◦ ◦ • W • • ◦ • ◦ ◦ • ◦ • 2 black and 2 white queens on a 4 x 4 board: B ◦ • ◦ ◦ • W • B ◦ • ◦ ◦ • W • 3 black and 3 white queens on a 4 x 4 board: No solution exists. 1 black and 1 white queens on a 5 x 5 board: B ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and 2 white queens on a 5 x 5 board: B ◦ • ◦ B ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 3 black and 3 white queens on a 5 x 5 board: B ◦ • ◦ B ◦ • W • ◦ • W • ◦ • ◦ • ◦ B ◦ • W • ◦ • 4 black and 4 white queens on a 5 x 5 board: • B • B • ◦ • ◦ • B W ◦ W ◦ • ◦ • ◦ • B W ◦ W ◦ • 5 black and 5 white queens on a 5 x 5 board: No solution exists. 1 black and 1 white queens on a 6 x 6 board: B ◦ • ◦ • ◦ ◦ • W • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • 2 black and 2 white queens on a 6 x 6 board: B ◦ • ◦ B ◦ ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • 3 black and 3 white queens on a 6 x 6 board: B ◦ • ◦ B B ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ W ◦ • ◦ ◦ • ◦ • ◦ • 4 black and 4 white queens on a 6 x 6 board: B ◦ • ◦ B B ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ B • ◦ W W • ◦ ◦ • ◦ • ◦ • 5 black and 5 white queens on a 6 x 6 board: • B • ◦ B ◦ ◦ • ◦ B ◦ B W ◦ • ◦ • ◦ W • W • ◦ • • ◦ • ◦ • B W • W • ◦ • 6 black and 6 white queens on a 6 x 6 board: No solution exists. 1 black and 1 white queens on a 7 x 7 board: B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and 2 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 3 black and 3 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 4 black and 4 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 5 black and 5 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • 6 black and 6 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • 7 black and 7 white queens on a 7 x 7 board: • B • ◦ • B • ◦ B ◦ • B • ◦ • B • ◦ • B • ◦ • ◦ • B • ◦ W ◦ W ◦ • ◦ W ◦ • ◦ W ◦ • ◦ W ◦ W W • ◦ •
Mathematica/Wolfram Language

<lang Mathematica>ClearAll[ValidSpots, VisibleByQueen, SolveQueen, GetSolution] VisualizeState[state_] := Module[{q, cells},

q = MapIndexed[If[#["q"] == -1, {}, Text[Style[#["q"], 24], #2]] &, state, {2}]; cells = MapIndexed[{If[OddQ[Total[#2]], FaceForm[], FaceForm[GrayLevel[0.8]]], EdgeForm[Black], Rectangle[#2 - 0.5, #2 + 0.5]} &, state, {2}]; Graphics[{cells, q}] ]

ValidSpots[state_, tp_Integer] := Module[{vals},

vals = Catenate@MapIndexed[If[#1["q"] == -1 \[And] DeleteCases[#1["v"], tp] == {}, #2, Missing[]] &, state, {2}]; DeleteMissing[vals] ]

VisibleByQueen[{i_, j_}, {a_, b_}] := i == a \[Or] j == b \[Or] i + j == a + b \[Or] i - j == a - b PlaceQueen[state_, pos : {i_Integer, j_Integer}, tp_Integer] := Module[{vals, out},

out = state; outi, j = Association[outi, j, "q" -> tp]; out = MapIndexed[If[VisibleByQueen[{i, j}, #2], <|#1, "v" -> Append[#1["v"], tp]|>, #1] &, out, {2}]; out ]

SolveQueen[state_, toplace_List] :=

Module[{len = Length[toplace], next, valid, newstate}, If[len == 0, Print[VisualizeState@state]; Print[StringRiffle[StringJoin /@ Map[ToString, stateAll, All, "q" /. -1 -> ".", {2}], "\n"]]; Abort[]; , next = First[toplace]; valid = ValidSpots[state, next]; Do[ newstate = PlaceQueen[state, v, next]; SolveQueen[newstate, Rest[toplace]] , {v, valid} ] ] ]

GetSolution[n_Integer?Positive, m_Integer?Positive, numcol_ : 2] :=

Module[{state, tp}, state = ConstantArray[<|"q" -> -1, "v" -> {}|>, {n, n}]; tp = Flatten[Transpose[ConstantArray[#, m] & /@ Range[numcol]]]; SolveQueen[state, tp] ]

GetSolution[8, 4, 3](* Solves placing 3 armies of each 4 queens on an 8*8 board*) GetSolution[5, 4, 2](* Solves placing 2 armies of each 4 queens on an 5*5 board*)</lang>

Output:
[Graphical object] 1....1.. ..2....2 ....3... .3....3. ...1.... 1....... ..2....2 ....3... [Graphical object] 1...1 ..2.. .2.2. ..2.. 1...1
Nim
Translation of: Kotlin

Almost a direct translation except for "printBoard" where we have chosen to use a sequence of sequences to simplify the code.

<lang Nim>import sequtils, strformat

type

Piece {.pure.} = enum Empty, Black, White Position = tuple[x, y: int]

func isAttacking(queen, pos: Position): bool =

queen.x == pos.x or queen.y == pos.y or abs(queen.x - pos.x) == abs(queen.y - pos.y)

func place(m, n: int; blackQueens, whiteQueens: var seq[Position]): bool =

if m == 0: return true
var placingBlack = true for i in 0..<n: for j in 0..<n:
block inner: let pos: Position = (i, j) for queen in blackQueens: if queen == pos or not placingBlack and queen.isAttacking(pos): break inner for queen in whiteQueens: if queen == pos or placingBlack and queen.isAttacking(pos): break inner
if placingBlack: blackQueens.add pos else: whiteQueens.add pos if place(m - 1, n, blackQueens, whiteQueens): return true discard blackQueens.pop() discard whiteQueens.pop() placingBlack = not placingBlack
if not placingBlack: discard blackQueens.pop()

proc printBoard(n: int; blackQueens, whiteQueens: seq[Position]) =

var board = newSeqWith(n, newSeq[Piece](n)) # Initialized to Empty.
for queen in blackQueens: board[queen.x][queen.y] = Black for queen in whiteQueens: board[queen.x][queen.y] = White
for i in 0..<n: for j in 0..<n: stdout.write case board[i][j] of Black: "B " of White: "W " of Empty: (if (i and 1) == (j and 1): "• " else: "◦ ") stdout.write '\n'
echo ""

const Nms = [(2, 1), (3, 1), (3, 2), (4, 1), (4, 2), (4, 3),

(5, 1), (5, 2), (5, 3), (5, 4), (5, 5), (6, 1), (6, 2), (6, 3), (6, 4), (6, 5), (6, 6), (7, 1), (7, 2), (7, 3), (7, 4), (7, 5), (7, 6), (7, 7)]

for (n, m) in Nms:

echo &"{m} black and {m} white queens on a {n} x {n} board:" var blackQueens, whiteQueens: seq[Position] if place(m, n, blackQueens, whiteQueens): printBoard(n, blackQueens, whiteQueens) else: echo "No solution exists.\n"</lang>

Output:
1 black and 1 white queens on a 2 x 2 board: No solution exists. 1 black and 1 white queens on a 3 x 3 board: B ◦ • ◦ • W • ◦ • 2 black and 2 white queens on a 3 x 3 board: No solution exists. 1 black and 1 white queens on a 4 x 4 board: B ◦ • ◦ ◦ • W • • ◦ • ◦ ◦ • ◦ • 2 black and 2 white queens on a 4 x 4 board: B ◦ • ◦ ◦ • W • B ◦ • ◦ ◦ • W • 3 black and 3 white queens on a 4 x 4 board: No solution exists. 1 black and 1 white queens on a 5 x 5 board: B ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and 2 white queens on a 5 x 5 board: B ◦ • ◦ B ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 3 black and 3 white queens on a 5 x 5 board: B ◦ • ◦ B ◦ • W • ◦ • W • ◦ • ◦ • ◦ B ◦ • W • ◦ • 4 black and 4 white queens on a 5 x 5 board: • B • B • ◦ • ◦ • B W ◦ W ◦ • ◦ • ◦ • B W ◦ W ◦ • 5 black and 5 white queens on a 5 x 5 board: No solution exists. 1 black and 1 white queens on a 6 x 6 board: B ◦ • ◦ • ◦ ◦ • W • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • 2 black and 2 white queens on a 6 x 6 board: B ◦ • ◦ B ◦ ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • 3 black and 3 white queens on a 6 x 6 board: B ◦ • ◦ B B ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ W ◦ • ◦ ◦ • ◦ • ◦ • 4 black and 4 white queens on a 6 x 6 board: B ◦ • ◦ B B ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ B • ◦ W W • ◦ ◦ • ◦ • ◦ • 5 black and 5 white queens on a 6 x 6 board: • B • ◦ B ◦ ◦ • ◦ B ◦ B W ◦ • ◦ • ◦ W • W • ◦ • • ◦ • ◦ • B W • W • ◦ • 6 black and 6 white queens on a 6 x 6 board: No solution exists. 1 black and 1 white queens on a 7 x 7 board: B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and 2 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 3 black and 3 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 4 black and 4 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 5 black and 5 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • 6 black and 6 white queens on a 7 x 7 board: B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • 7 black and 7 white queens on a 7 x 7 board: • B • ◦ • B • ◦ B ◦ • B • ◦ • B • ◦ • B • ◦ • ◦ • B • ◦ W ◦ W ◦ • ◦ W ◦ • ◦ W ◦ • ◦ W ◦ W W • ◦ •
Perl
Terse

<lang perl>use strict; use warnings;

my $m = shift // 4; my $n = shift // 5; my %seen; my $gaps = join '|', qr/-*/, map qr/.{$_}(?:-.{$_})*/s, $n-1, $n, $n+1; my $attack = qr/(\w)(?:$gaps)(?!\1)\w/;

place( scalar ('-' x $n . "\n") x $n ); print "No solution to $m $n\n";

sub place

{ local $_ = shift; $seen{$_}++ || /$attack/ and return; # previously or attack (my $have = tr/WB//) < $m * 2 or exit !print "Solution to $m $n\n\n$_"; place( s/-\G/ qw(W B)[$have % 2] /er ) while /-/g; # place next queen }</lang>

Output:
Solution to 4 5 W---W --B-- -B-B- --B-- W---W
Verbose

A refactored version of the same code, with fancier output. <lang perl>use strict; use warnings; use feature 'say'; use feature 'state'; use utf8; binmode(STDOUT, ':utf8');

recursively place the next queen

sub place {

my($board, $n, $m, $empty_square) = @_; state(%seen,$attack,$solution);
# logic of 'attack' regex: queen ( ... paths between queens containing only empty squares ... ) queen of other color unless ($attack) { $attack = '([WB])' . # 1st queen '(?:' . join('|', "[$empty_square]*", map { "(?^s:.{$_}(?:[$empty_square].{$_})*)" } $n-1, $n, $n+1 ) . ')' . '(?!\1)[WB]'; # 2nd queen }
# pass first result found back up the stack (omit this line to get last result found) return $solution if $solution;
# bail out if seen this configuration previously, or attack detected return if $seen{$board}++ or $board =~ /$attack/;
# success if queen count is m×2 $solution = $board and return if $m * 2 == (my $have = $board =~ tr/WB//);
# place the next queen (alternating colors each time) place( $board =~ s/[$empty_square]\G/ qw<W B>[$have % 2] /er, $n, $m, $empty_square ) while $board =~ /[$empty_square]/g;
return $solution

}

my($m, $n) = $#ARGV == 1 ? @ARGV : (4, 5); my $empty_square = '◦•'; my $board = join "\n", map { substr $empty_square x $n, $_%2, $n } 1..$n;

my $solution = place $board, $n, $m, $empty_square;

say $solution

? sprintf "Solution to $m $n\n\n%s", map { s/(.)/$1 /gm; s/B /♛/gm; s/W /♕/gmr } $solution : "No solution to $m $n";</lang>

Output:
Solution to 4 5 ♕◦ • ◦ ♕ ◦ • ♛• ◦ • ♛• ♛• ◦ • ♛• ◦ ♕◦ • ◦ ♕
Phix
Translation of: Go
Translation of: Python

<lang Phix>-- demo\rosetta\Queen_Armies.exw string html = "" constant as_html = true constant queens = {``,

`♛`, `♕`, `?`}

procedure showboard(integer n, sequence blackqueens, whitequeens)

sequence board = repeat(repeat('-',n),n) for i=1 to length(blackqueens) do integer {qi,qj} = blackqueens[i] board[qi,qj] = 'B' {qi,qj} = whitequeens[i] board[qi,qj] = 'W' end for if as_html then string out = sprintf("
## %d black and %d white queens on a %d-by-%d board
\n", {length(blackqueens),length(whitequeens),n,n}), tbl = ""

out &= "

\n " for x=1 to n do for y=1 to n do if y=1 then tbl &= " \n \n" end if integer xw = find({x,y},blackqueens)!=0, xb = find({x,y},whitequeens)!=0, dx = xw+xb*2+1 string ch = queens[dx], bg = iff(mod(x+y,2)?"":` bgcolor="silver"`) tbl &= sprintf(" \n",{bg,ch})
end for end for out &= tbl[11..$]
out &= " \n
%s

\n
\n"

html &= out else integer b = length(blackqueens), w = length(whitequeens) printf(1,"%d black and %d white queens on a %d x %d board:\n", {b, w, n, n}) puts(1,join(board,"\n")&"\n")

-- ?{n,blackqueens, whitequeens}

end if

end procedure

function isAttacking(sequence queen, pos)

integer {qi,qj} = queen, {pi,pj} = pos return qi=pi or qj=pj or abs(qi-pi)=abs(qj-pj)

end function

function place(integer m, n, sequence blackqueens = {}, whitequeens = {})

if m == 0 then showboard(n,blackqueens,whitequeens) return true end if bool placingBlack := true for i=1 to n do for j=1 to n do sequence pos := {i, j} for q=1 to length(blackqueens) do sequence queen := blackqueens[q] if queen == pos or ((not placingBlack) and isAttacking(queen, pos)) then pos = {} exit end if end for if pos!={} then for q=1 to length(whitequeens) do sequence queen := whitequeens[q] if queen == pos or (placingBlack and isAttacking(queen, pos)) then pos = {} exit end if end for if pos!={} then if placingBlack then blackqueens = append(blackqueens, pos) placingBlack = false else whitequeens = append(whitequeens, pos) if place(m-1, n, blackqueens, whitequeens) then return true end if blackqueens = blackqueens[1..$-1] whitequeens = whitequeens[1..$-1] placingBlack = true end if end if end if end for end for return false

end function

for n=2 to 7 do

for m=1 to n-(n<5) do if not place(m,n) then string no = sprintf("Cannot place %d+ queen armies on a %d-by-%d board",{m,n,n}) if as_html then html &= sprintf("# %s

\n\n",{no}) else printf(1,"%s.\n", {no}) end if end if end for

end for

constant html_header = """ <!DOCTYPE html> <html lang="en">

<head> <meta charset="utf-8" /> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> <title>Rosettacode Rank Languages by popularity</title> </head> <body>
queen armies

""", -- or

html_footer = """ </body>

</html>
""" -- or

if as_html then

integer fn = open("queen_armies.html","w") puts(fn,html_header) puts(fn,html) puts(fn,html_footer) close(fn) printf(1,"See queen_armies.html\n")

end if

?"done" {} = wait_key()</lang>

Output:

with as_html = false

Cannot place 1+ queen armies on a 2-by-2 board. 1 black and 1 white queens on a 3 x 3 board: B-- --W --- Cannot place 2+ queen armies on a 3-by-3 board. <snip> 7 black and 7 white queens on a 7 x 7 board: -B---B- -B--B-- -B---B- ----B-- W-W---W ---W--- W-WW---

Output:

with as_html = true

# Cannot place 1+ queen armies on a 2-by-2 board

## 1 black and 1 white queens on a 3-by-3 board

♛

♕

# Cannot place 2+ queen armies on a 3-by-3 board

<snip>

## 7 black and 7 white queens on a 7-by-7 board

♛ ♛

♛ ♛

♛ ♛

♛

♕ ♕ ♕

♕

♕ ♕ ♕

Python
Python: Textual output

<lang python>from itertools import combinations, product, count from functools import lru_cache, reduce

_bbullet, _wbullet = '\u2022\u25E6' _or = set.__or__

def place(m, n):

"Place m black and white queens, peacefully, on an n-by-n board" board = set(product(range(n), repeat=2)) # (x, y) tuples placements = {frozenset(c) for c in combinations(board, m)} for blacks in placements: black_attacks = reduce(_or, (queen_attacks_from(pos, n) for pos in blacks), set()) for whites in {frozenset(c) # Never on blsck attacking squares for c in combinations(board - black_attacks, m)}: if not black_attacks & whites: return blacks, whites return set(), set()

@lru_cache(maxsize=None) def queen_attacks_from(pos, n):

x0, y0 = pos a = set([pos]) # Its position a.update((x, y0) for x in range(n)) # Its row a.update((x0, y) for y in range(n)) # Its column # Diagonals for x1 in range(n): # l-to-r diag y1 = y0 -x0 +x1 if 0 <= y1 < n: a.add((x1, y1)) # r-to-l diag y1 = y0 +x0 -x1 if 0 <= y1 < n: a.add((x1, y1)) return a

def pboard(black_white, n):

"Print board" if black_white is None: blk, wht = set(), set() else: blk, wht = black_white print(f"## {len(blk)} black and {len(wht)} white queens " f"on a {n}-by-{n} board:", end=) for x, y in product(range(n), repeat=2): if y == 0: print() xy = (x, y) ch = ('?' if xy in blk and xy in wht else 'B' if xy in blk else 'W' if xy in wht else _bbullet if (x + y)%2 else _wbullet) print('%s' % ch, end=) print()

if __name__ == '__main__':

n=2 for n in range(2, 7): print() for m in count(1): ans = place(m, n) if ans[0]: pboard(ans, n) else: print (f"# Can't place {m} queens on a {n}-by-{n} board") break # print('\n') m, n = 5, 7 ans = place(m, n) pboard(ans, n)</lang>

Output:

# Can't place 1 queens on a 2-by-2 board ## 1 black and 1 white queens on a 3-by-3 board: ◦•◦ B◦• ◦•W # Can't place 2 queens on a 3-by-3 board ## 1 black and 1 white queens on a 4-by-4 board: ◦•W• B◦•◦ ◦•◦• •◦•◦ ## 2 black and 2 white queens on a 4-by-4 board: ◦B◦• •B•◦ ◦•◦• W◦W◦ # Can't place 3 queens on a 4-by-4 board ## 1 black and 1 white queens on a 5-by-5 board: ◦•◦•◦ W◦•◦• ◦•◦•◦ •◦•◦B ◦•◦•◦ ## 2 black and 2 white queens on a 5-by-5 board: ◦•◦•W •◦B◦• ◦•◦•◦ •◦•B• ◦W◦•◦ ## 3 black and 3 white queens on a 5-by-5 board: ◦W◦•◦ •◦•◦W B•B•◦ B◦•◦• ◦•◦W◦ ## 4 black and 4 white queens on a 5-by-5 board: ◦•B•B W◦•◦• ◦W◦W◦ W◦•◦• ◦•B•B # Can't place 5 queens on a 5-by-5 board ## 1 black and 1 white queens on a 6-by-6 board: ◦•◦•◦• W◦•◦•◦ ◦•◦•◦• •◦•◦B◦ ◦•◦•◦• •◦•◦•◦ ## 2 black and 2 white queens on a 6-by-6 board: ◦•◦•◦• •◦B◦•◦ ◦•◦•◦• •◦•B•◦ ◦•◦•◦• W◦•◦W◦ ## 3 black and 3 white queens on a 6-by-6 board: ◦•B•◦• •B•◦•◦ ◦•◦W◦W •◦•◦•◦ W•◦•◦• •◦•◦B◦ ## 4 black and 4 white queens on a 6-by-6 board: WW◦•W• •W•◦•◦ ◦•◦•◦B •◦B◦•◦ ◦•◦B◦• •◦•B•◦ ## 5 black and 5 white queens on a 6-by-6 board: ◦•W•W• B◦•◦•◦ ◦•W•◦W B◦•◦•◦ ◦•◦•◦W BB•B•◦ # Can't place 6 queens on a 6-by-6 board ## 5 black and 5 white queens on a 7-by-7 board: ◦•◦•B•◦ •W•◦•◦W ◦•◦•B•◦ B◦•◦•◦• ◦•B•◦•◦ •◦•B•◦• ◦W◦•◦WW

Python: HTML output

Uses the solver function place from the above textual output case. <lang python>from peaceful_queen_armies_simpler import place from itertools import product, count

_bqueenh, _wqueenh = '♛', '♕'

def hboard(black_white, n):

"HTML board generator" if black_white is None: blk, wht = set(), set() else: blk, wht = black_white out = (f"
## {len(blk)} black and {len(wht)} white queens " f"on a {n}-by-{n} board
\n")

out += '

\n ' tbl = for x, y in product(range(n), repeat=2): if y == 0: tbl += ' \n \n' xy = (x, y) ch = ('?' if xy in blk and xy in wht else _bqueenh if xy in blk else _wqueenh if xy in wht else "") bg = "" if (x + y)%2 else ' bgcolor="silver"' tbl += f' \n'
out += tbl[7:]
out += ' \n
{ch}

\n
\n'

return out

if __name__ == '__main__':

n=2 html = for n in range(2, 7): print() for m in count(1): ans = place(m, n) if ans[0]: html += hboard(ans, n) else: html += (f"# Can't place {m} queen armies on a " f"{n}-by-{n} board

\n\n" ) break # html += '
\n' m, n = 6, 7 ans = place(m, n) html += hboard(ans, n) with open('peaceful_queen_armies.htm', 'w') as f: f.write(html)</lang>

Output:

# Can't place 1 queen armies on a 2-by-2 board

## 1 black and 1 white queens on a 3-by-3 board

♛

♕

# Can't place 2 queen armies on a 3-by-3 board

## 1 black and 1 white queens on a 4-by-4 board

♕

♛

## 2 black and 2 white queens on a 4-by-4 board

♛

♛

♕ ♕

# Can't place 3 queen armies on a 4-by-4 board

## 1 black and 1 white queens on a 5-by-5 board

♕

♛

## 2 black and 2 white queens on a 5-by-5 board

♕

♛

♛

♕

## 3 black and 3 white queens on a 5-by-5 board

♕

♕

♛ ♛

♛

♕

## 4 black and 4 white queens on a 5-by-5 board

♛ ♛

♕

♕ ♕

♕

♛ ♛

# Can't place 5 queen armies on a 5-by-5 board

## 1 black and 1 white queens on a 6-by-6 board

♕

♛

## 2 black and 2 white queens on a 6-by-6 board

♛

♛

♕ ♕

## 3 black and 3 white queens on a 6-by-6 board

♛

♛

♕ ♕

♕

♛

## 4 black and 4 white queens on a 6-by-6 board

♕ ♕ ♕

♕

♛

♛

♛

♛

## 5 black and 5 white queens on a 6-by-6 board

♕ ♕

♛

♕ ♕

♛

♕

♛ ♛ ♛

# Can't place 6 queen armies on a 6-by-6 board

## 6 black and 6 white queens on a 7-by-7 board

♛ ♛

♕

♕ ♕ ♕

♕

♛ ♛

♕

♛ ♛

Raku

(formerly Perl 6)

Translation of: Perl

<lang perl6># recursively place the next queen sub place ($board, $n, $m, $empty-square) {

my $cnt; state (%seen,$attack); state $solution = False;
# logic of regex: queen ( ... paths between queens containing only empty squares ... ) queen of other color once { my %Q = 'WBBW'.comb; # return the queen of alternate color my $re = '(<[WB]>)' ~ # 1st queen '[' ~ join(' |', qq/<[$empty-square]>*/, map { qq/ . ** {$_}[<[$empty-square]> . ** {$_}]*/ }, $n-1, $n, $n+1 ) ~ ']' ~ '<{%Q{$0}}>'; # 2nd queen $attack = "rx/$re/".EVAL; }
# return first result found (omit this line to get last result found) return $solution if $solution;
# bail out if seen this configuration previously, or attack detected return if %seen{$board}++ or $board ~~ $attack;
# success if queen count is m×2, set state variable and return from recursion $solution = $board and return if $m * 2 == my $queens = $board.comb.Bag{<W B>}.sum;
# place the next queen (alternating colors each time) place( $board.subst( /<[◦•]>/, {<W B>[$queens % 2]}, :nth($cnt) ), $n, $m, $empty-square ) while $board ~~ m:nth(++$cnt)/<[◦•]>/;
return $solution

}

my ($m, $n) = @*ARGS == 2 ?? @*ARGS !! (4, 5); my $empty-square = '◦•'; my $board = ($empty-square x $n**2).comb.rotor($n)>>.join[^$n].join: "\n";

my $solution = place $board, $n, $m, $empty-square;

say $solution

?? "Solution to $m $n\n\n{S:g/(\N)/$0 / with $solution}" !! "No solution to $m $n";</lang>

Output:
W • ◦ • W • ◦ B ◦ • ◦ B ◦ B ◦ • ◦ B ◦ • W • ◦ • W
Ruby
Translation of: Java

<lang ruby>class Position

attr_reader :x, :y
def initialize(x, y) @x = x @y = y end
def ==(other) self.x == other.x && self.y == other.y end
def to_s '(%d, %d)' % [@x, @y] end
def to_str to_s end

end

def isAttacking(queen, pos)

return queen.x == pos.x || queen.y == pos.y || (queen.x - pos.x).abs() == (queen.y - pos.y).abs()

end

def place(m, n, blackQueens, whiteQueens)

if m == 0 then return true end placingBlack = true for i in 0 .. n-1 for j in 0 .. n-1 catch :inner do pos = Position.new(i, j) for queen in blackQueens if pos == queen || !placingBlack && isAttacking(queen, pos) then throw :inner end end for queen in whiteQueens if pos == queen || placingBlack && isAttacking(queen, pos) then throw :inner end end if placingBlack then blackQueens << pos placingBlack = false else whiteQueens << pos if place(m - 1, n, blackQueens, whiteQueens) then return true end blackQueens.pop whiteQueens.pop placingBlack = true end end end end if !placingBlack then blackQueens.pop end return false

end

def printBoard(n, blackQueens, whiteQueens)

# initialize the board board = Array.new(n) { Array.new(n) { ' ' } } for i in 0 .. n-1 for j in 0 .. n-1 if i % 2 == j % 2 then board[i][j] = '•' else board[i][j] = '◦' end end end
# insert the queens for queen in blackQueens board[queen.y][queen.x] = 'B' end for queen in whiteQueens board[queen.y][queen.x] = 'W' end
# print the board for row in board for cell in row print cell, ' ' end print "\n" end print "\n"

end

nms = [

[2, 1], [3, 1], [3, 2], [4, 1], [4, 2], [4, 3], [5, 1], [5, 2], [5, 3], [5, 4], [5, 5], [6, 1], [6, 2], [6, 3], [6, 4], [6, 5], [6, 6], [7, 1], [7, 2], [7, 3], [7, 4], [7, 5], [7, 6], [7, 7]

] for nm in nms

m = nm[1] n = nm[0] print "%d black and %d white queens on a %d x %d board:\n" % [m, m, n, n]
blackQueens = [] whiteQueens = [] if place(m, n, blackQueens, whiteQueens) then printBoard(n, blackQueens, whiteQueens) else print "No solution exists.\n\n" end

end</lang>

Output:
1 black and 1 white queens on a 2 x 2 board: No solution exists. 1 black and 1 white queens on a 3 x 3 board: B ◦ • ◦ • ◦ • W • 2 black and 2 white queens on a 3 x 3 board: No solution exists. 1 black and 1 white queens on a 4 x 4 board: B ◦ • ◦ ◦ • ◦ • • W • ◦ ◦ • ◦ • 2 black and 2 white queens on a 4 x 4 board: B ◦ B ◦ ◦ • ◦ • • W • W ◦ • ◦ • 3 black and 3 white queens on a 4 x 4 board: No solution exists. 1 black and 1 white queens on a 5 x 5 board: B ◦ • ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and 2 white queens on a 5 x 5 board: B ◦ • ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ B ◦ • ◦ • 3 black and 3 white queens on a 5 x 5 board: B ◦ • ◦ • ◦ • W • W • W • ◦ • ◦ • ◦ B ◦ B ◦ • ◦ • 4 black and 4 white queens on a 5 x 5 board: • ◦ W ◦ W B • ◦ • ◦ • ◦ W ◦ W B • ◦ • ◦ • B • B • 5 black and 5 white queens on a 5 x 5 board: No solution exists. 1 black and 1 white queens on a 6 x 6 board: B ◦ • ◦ • ◦ ◦ • ◦ • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • 2 black and 2 white queens on a 6 x 6 board: B ◦ • ◦ • ◦ ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ • B ◦ • ◦ • ◦ ◦ • ◦ • ◦ • 3 black and 3 white queens on a 6 x 6 board: B ◦ • ◦ • ◦ ◦ • W • ◦ • • W • ◦ W ◦ ◦ • ◦ • ◦ • B ◦ • ◦ • ◦ B • ◦ • ◦ • 4 black and 4 white queens on a 6 x 6 board: B ◦ • ◦ • ◦ ◦ • W • ◦ • • W • ◦ W ◦ ◦ • ◦ • W • B ◦ • ◦ • ◦ B • ◦ B ◦ • 5 black and 5 white queens on a 6 x 6 board: • ◦ W W • W B • ◦ • ◦ • • ◦ • W • W ◦ B ◦ • ◦ • B ◦ • ◦ • ◦ ◦ B ◦ • B • 6 black and 6 white queens on a 6 x 6 board: No solution exists. 1 black and 1 white queens on a 7 x 7 board: B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and 2 white queens on a 7 x 7 board: B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • 3 black and 3 white queens on a 7 x 7 board: B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • W • ◦ • ◦ • ◦ • ◦ • ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • 4 black and 4 white queens on a 7 x 7 board: B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • W • ◦ • ◦ • ◦ • ◦ • ◦ B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • W • ◦ • 5 black and 5 white queens on a 7 x 7 board: B ◦ B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • W • W • W • ◦ • ◦ • ◦ • ◦ B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • W • W • ◦ • 6 black and 6 white queens on a 7 x 7 board: B ◦ B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • W • W • W • ◦ • ◦ • ◦ • ◦ B ◦ B ◦ B ◦ • ◦ • ◦ • ◦ • ◦ • W • W • W • 7 black and 7 white queens on a 7 x 7 board: • ◦ • ◦ W ◦ W B B B • ◦ • ◦ • ◦ • ◦ W ◦ W ◦ • ◦ • ◦ W W • B • B • ◦ • B • B • ◦ • ◦ • ◦ • ◦ W ◦ •
Scheme
All solutions
Works with: CHICKEN version 5.3.0
Library: srfi-132

<lang scheme>;;;

Solutions to the Peaceful Chess Queen Armies puzzle, in R7RS

Scheme (using also SRFI-132).

https://rosettacode.org/wiki/Peaceful_chess_queen_armies

(cond-expand

(r7rs) (chicken (import (r7rs))))

(import (scheme process-context)) (import (only (srfi 132) list-sort))

(define-record-type <&fail>

(make-the-one-unique-&fail-that-you-must-not-make-twice) do-not-use-this:&fail?)

(define &fail

(make-the-one-unique-&fail-that-you-must-not-make-twice))

(define (failure? f)

(eq? f &fail))

(define (success? f)

(not (failure? f)))

(define *suspend*

(make-parameter (lambda (x) x)))

(define (suspend v)

((*suspend*) v))

(define (fail-forever)

(let loop () (suspend &fail) (loop)))

(define (make-generator-procedure thunk)

;; ;; Make a suspendable procedure that takes no arguments. It is a ;; simple generator of values. (One can elaborate on this to have ;; the procedure accept an argument upon resumption, like an Icon ;; co-expression.) ;; (define (next-run return) (define (my-suspend v) (set! return (call/cc (lambda (resumption-point) (set! next-run resumption-point) (return v))))) (parameterize ((*suspend* my-suspend)) (suspend (thunk)) (fail-forever))) (lambda () (call/cc next-run)))

(define BLACK 'B) (define WHITE 'W)

(define (flip-color c)

(if (eq? c BLACK) WHITE BLACK))

(define-record-type <queen>

(make-queen color rank file) queen? (color queen-color) (rank queen-rank) (file queen-file))

(define (serialize-queen queen)

(string-append (if (eq? (queen-color queen) BLACK) "B" "W") "(" (number->string (queen-rank queen)) "," (number->string (queen-file queen)) ")"))

(define (serialize-queens queens)

(apply string-append (list-sort string<? (map serialize-queen queens))))

(define (queens->string n queens)

(define board (let ((board (make-vector (* n n) #f))) (do ((q queens (cdr q))) ((null? q)) (let* ((color (queen-color (car q))) (i (queen-rank (car q))) (j (queen-file (car q)))) (vector-set! board (ij->index n i j) color))) board))
(define rule (let ((str "+")) (do ((j 1 (+ j 1))) ((= j (+ n 1))) (set! str (string-append str "----+"))) str))
(define str "")
(when (< 0 n) (set! str rule) (do ((i n (- i 1))) ((= i 0)) (set! str (string-append str "\n")) (do ((j 1 (+ j 1))) ((= j (+ n 1))) (let* ((color (vector-ref board (ij->index n i j))) (representation (cond ((eq? color #f) " ") ((eq? color BLACK) " B ") ((eq? color WHITE) " W ") (else " ?? ")))) (set! str (string-append str "|" representation)))) (set! str (string-append str "|\n" rule)))) str)

(define (queen-fits-in? queen other-queens)

(or (null? other-queens) (let ((other (car other-queens))) (let ((colorq (queen-color queen)) (rankq (queen-rank queen)) (fileq (queen-file queen)) (coloro (queen-color other)) (ranko (queen-rank other)) (fileo (queen-file other))) (if (eq? colorq coloro) (and (or (not (= rankq ranko)) (not (= fileq fileo))) (queen-fits-in? queen (cdr other-queens))) (and (not (= rankq ranko)) (not (= fileq fileo)) (not (= (+ rankq fileq) (+ ranko fileo))) (not (= (- rankq fileq) (- ranko fileo))) (queen-fits-in? queen (cdr other-queens))))))))

(define (latest-queen-fits-in? queens)

(or (null? (cdr queens)) (queen-fits-in? (car queens) (cdr queens))))

(define (make-peaceful-queens-generator m n)

(make-generator-procedure (lambda () (define solutions '())
(let loop ((queens (list (make-queen BLACK 1 1))) (num-queens 1))
(define (add-another-queen) (let ((color (flip-color (queen-color (car queens))))) (loop (cons (make-queen color 1 1) queens) (+ num-queens 1))))
(define (move-a-queen) (let drop-one ((queens queens) (num-queens num-queens)) (if (zero? num-queens) (loop '() 0) (let* ((latest (car queens)) (color (queen-color latest)) (rank (queen-rank latest)) (file (queen-file latest))) (if (and (= rank n) (= file n)) (drop-one (cdr queens) (- num-queens 1)) (let-values (((rank^ file^) (advance-ij n rank file))) (loop (cons (make-queen color rank^ file^) (cdr queens)) num-queens)))))))
(cond ((zero? num-queens) ;; There are no more solutions. &fail)
((latest-queen-fits-in? queens) (if (= num-queens (* 2 m)) (let ((str (serialize-queens queens))) ;; The current "queens" is a solution. (unless (member str solutions) ;; The current "queens" is a *new* solution. (set! solutions (cons str solutions)) (suspend queens)) (move-a-queen)) (add-another-queen)))
(else (move-a-queen)))))))

(define (ij->index n i j)

(let ((i1 (- i 1)) (j1 (- j 1))) (+ i1 (* n j1))))

(define (index->ij n index)

(let-values (((q r) (floor/ index n))) (values (+ r 1) (+ q 1))))

(define (advance-ij n i j)

(index->ij n (+ (ij->index n i j) 1)))

(define args (command-line)) (unless (or (= (length args) 3)

(= (length args) 4)) (display "Usage: ") (display (list-ref args 0)) (display " M N [MAX_SOLUTIONS]") (newline) (exit 1))

(define m (string->number (list-ref args 1))) (define n (string->number (list-ref args 2))) (define max-solutions

(if (= (length args) 4) (string->number (list-ref args 3)) +inf.0))

(define generate-peaceful-queens

(make-peaceful-queens-generator m n))

(let loop ((next-solution-number 1))

(when (<= next-solution-number max-solutions) (let ((solution (generate-peaceful-queens))) (when (success? solution) (display "Solution ") (display next-solution-number) (newline) (display (queens->string n solution)) (newline) (newline) (loop (+ next-solution-number 1))))))</lang>

Output:

$ csc -O3 peaceful_queens.scm && ./peaceful_queens 4 5

Solution 1 +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ Solution 2 +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ Solution 3 +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ Solution 4 +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ Solution 5 +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ | B | | | | | +----+----+----+----+----+ | | | W | | W | +----+----+----+----+----+ | B | | | | | +----+----+----+----+----+ | | | W | | W | +----+----+----+----+----+ Solution 6 +----+----+----+----+----+ | | | W | | W | +----+----+----+----+----+ | B | | | | | +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ | B | | | | | +----+----+----+----+----+ | | | W | | W | +----+----+----+----+----+ Solution 7 +----+----+----+----+----+ | | | W | | W | +----+----+----+----+----+ | B | | | | | +----+----+----+----+----+ | | | W | | W | +----+----+----+----+----+ | B | | | | | +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ Solution 8 +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ Solution 9 +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ Solution 10 +----+----+----+----+----+ | W | | | | W | +----+----+----+----+----+ | | | B | | | +----+----+----+----+----+ | W | | | | W | +----+----+----+----+----+ | | | B | | | +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ Solution 11 +----+----+----+----+----+ | W | | W | | | +----+----+----+----+----+ | | | | | B | +----+----+----+----+----+ | W | | W | | | +----+----+----+----+----+ | | | | | B | +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ Solution 12 +----+----+----+----+----+ | W | | | | W | +----+----+----+----+----+ | | | B | | | +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ | | | B | | | +----+----+----+----+----+ | W | | | | W | +----+----+----+----+----+ Solution 13 +----+----+----+----+----+ | W | | W | | | +----+----+----+----+----+ | | | | | B | +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ | | | | | B | +----+----+----+----+----+ | W | | W | | | +----+----+----+----+----+ Solution 14 +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ | | | B | | | +----+----+----+----+----+ | W | | | | W | +----+----+----+----+----+ | | | B | | | +----+----+----+----+----+ | W | | | | W | +----+----+----+----+----+ Solution 15 +----+----+----+----+----+ | | B | | B | | +----+----+----+----+----+ | | | | | B | +----+----+----+----+----+ | W | | W | | | +----+----+----+----+----+ | | | | | B | +----+----+----+----+----+ | W | | W | | | +----+----+----+----+----+ Solution 16 +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | W | | | | | +----+----+----+----+----+ | | | B | | B | +----+----+----+----+----+ | W | | | | | +----+----+----+----+----+ | | | B | | B | +----+----+----+----+----+ Solution 17 +----+----+----+----+----+ | | | B | | B | +----+----+----+----+----+ | W | | | | | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | W | | | | | +----+----+----+----+----+ | | | B | | B | +----+----+----+----+----+ Solution 18 +----+----+----+----+----+ | | | B | | B | +----+----+----+----+----+ | W | | | | | +----+----+----+----+----+ | | | B | | B | +----+----+----+----+----+ | W | | | | | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+
All non-equivalent solutions
Works with: CHICKEN version 5.3.0

<lang scheme>;;;

Solutions to the Peaceful Chess Queen Armies puzzle, in R7RS

Scheme. This implementation returns only one of each equivalent

solution. See https://oeis.org/A260680

I weed out equivalent solutions by comparing them tediously

against solutions already found.

(At least when compiled with CHICKEN 5.3.0, this program gets kind

of slow for m=5, n=6, once you get past having found the 35

non-equivalent solutions. There are still other, equivalent

solutions to eliminate.)

https://rosettacode.org/wiki/Peaceful_chess_queen_armies

(cond-expand

(r7rs) (chicken (import (r7rs))))

(import (scheme process-context))

(define-record-type <&fail>

(make-the-one-unique-&fail-that-you-must-not-make-twice) do-not-use-this:&fail?)

(define &fail

(make-the-one-unique-&fail-that-you-must-not-make-twice))

(define (failure? f)

(eq? f &fail))

(define (success? f)

(not (failure? f)))

(define *suspend*

(make-parameter (lambda (x) x)))

(define (suspend v)

((*suspend*) v))

(define (fail-forever)

(let loop () (suspend &fail) (loop)))

(define (make-generator-procedure thunk)

;; ;; Make a suspendable procedure that takes no arguments. It is a ;; simple generator of values. (One can elaborate on this to have ;; the procedure accept an argument upon resumption, like an Icon ;; co-expression.) ;; (define (next-run return) (define (my-suspend v) (set! return (call/cc (lambda (resumption-point) (set! next-run resumption-point) (return v))))) (parameterize ((*suspend* my-suspend)) (suspend (thunk)) (fail-forever))) (lambda () (call/cc next-run)))

(define (isqrt m)

;; Integer Newton’s method. See ;; https://en.wikipedia.org/w/index.php?title=Integer_square_root&oldid=1074473475#Using_only_integer_division (let ((k (truncate-quotient m 2))) (if (zero? k) m (let loop ((k k) (k^ (truncate-quotient (+ k (truncate-quotient m k)) 2))) (if (< k^ k) (loop k^ (truncate-quotient (+ k^ (truncate-quotient m k^)) 2)) k)))))

(define (ij->index n i j)

(let ((i1 (- i 1)) (j1 (- j 1))) (+ i1 (* n j1))))

(define (index->ij n index)

(let-values (((q r) (floor/ index n))) (values (+ r 1) (+ q 1))))

(define (advance-ij n i j)

(index->ij n (+ (ij->index n i j) 1)))

(define (index-rotate90 n index)

(let-values (((i j) (index->ij n index))) (ij->index n (- n j -1) i)))

(define (index-rotate180 n index)

(let-values (((i j) (index->ij n index))) (ij->index n (- n i -1) (- n j -1))))

(define (index-rotate270 n index)

(let-values (((i j) (index->ij n index))) (ij->index n j (- n i -1))))

(define (index-reflecti n index)

(let-values (((i j) (index->ij n index))) (ij->index n (- n i -1) j)))

(define (index-reflectj n index)

(let-values (((i j) (index->ij n index))) (ij->index n i (- n j -1))))

(define (index-reflect-diag-down n index)

(let-values (((i j) (index->ij n index))) (ij->index n j i)))

(define (index-reflect-diag-up n index)

(let-values (((i j) (index->ij n index))) (ij->index n (- n j -1) (- n i -1))))

(define BLACK 'B) (define WHITE 'W)

(define (reverse-color c)

(cond ((eq? c WHITE) BLACK) ((eq? c BLACK) WHITE) (else c)))

(define (pick-color-adjuster c)

(if (eq? c WHITE) reverse-color (lambda (x) x)))

(define-record-type <queen>

(make-queen color rank file) queen? (color queen-color) (rank queen-rank) (file queen-file))

(define (queens->board queens)

(let ((board (make-vector (* n n) #f))) (do ((q queens (cdr q))) ((null? q)) (let* ((color (queen-color (car q))) (i (queen-rank (car q))) (j (queen-file (car q)))) (vector-set! board (ij->index n i j) color))) board))

(define-syntax board-partial-equiv?

(syntax-rules () ((_ board1 board2 n*n n reindex recolor) (let loop ((i 0)) (or (= i n*n) (let ((color1 (vector-ref board1 i)) (color2 (recolor (vector-ref board2 (reindex n i))))) (and (eq? color1 color2) (loop (+ i 1)))))))))

(define (board-equiv? board1 board2)

(define (identity x) x) (define (2nd-argument n i) i) (let ((n*n (vector-length board1))) (or (board-partial-equiv? board1 board2 n*n #f 2nd-argument identity) (board-partial-equiv? board1 board2 n*n #f 2nd-argument reverse-color) (let ((n (isqrt n*n))) (or (board-partial-equiv? board1 board2 n*n n index-rotate90 identity) (board-partial-equiv? board1 board2 n*n n index-rotate90 reverse-color) (board-partial-equiv? board1 board2 n*n n index-rotate180 identity) (board-partial-equiv? board1 board2 n*n n index-rotate180 reverse-color) (board-partial-equiv? board1 board2 n*n n index-rotate270 identity) (board-partial-equiv? board1 board2 n*n n index-rotate270 reverse-color) (board-partial-equiv? board1 board2 n*n n index-reflecti identity) (board-partial-equiv? board1 board2 n*n n index-reflecti reverse-color) (board-partial-equiv? board1 board2 n*n n index-reflectj identity) (board-partial-equiv? board1 board2 n*n n index-reflectj reverse-color) (board-partial-equiv? board1 board2 n*n n index-reflect-diag-down identity) (board-partial-equiv? board1 board2 n*n n index-reflect-diag-down reverse-color) (board-partial-equiv? board1 board2 n*n n index-reflect-diag-up identity) (board-partial-equiv? board1 board2 n*n n index-reflect-diag-up reverse-color) )))))

(define (queens->string n queens)

(define board (queens->board queens))
(define rule (let ((str "+")) (do ((j 1 (+ j 1))) ((= j (+ n 1))) (set! str (string-append str "----+"))) str))
(define str "")
(when (< 0 n) (set! str rule) (do ((i n (- i 1))) ((= i 0)) (set! str (string-append str "\n")) (do ((j 1 (+ j 1))) ((= j (+ n 1))) (let* ((color (vector-ref board (ij->index n i j))) (representation (cond ((eq? color #f) " ") ((eq? color BLACK) " B ") ((eq? color WHITE) " W ") (else " ?? ")))) (set! str (string-append str "|" representation)))) (set! str (string-append str "|\n" rule)))) str)

(define (queen-fits-in? queen other-queens)

(or (null? other-queens) (let ((other (car other-queens))) (let ((colorq (queen-color queen)) (rankq (queen-rank queen)) (fileq (queen-file queen)) (coloro (queen-color other)) (ranko (queen-rank other)) (fileo (queen-file other))) (if (eq? colorq coloro) (and (or (not (= rankq ranko)) (not (= fileq fileo))) (queen-fits-in? queen (cdr other-queens))) (and (not (= rankq ranko)) (not (= fileq fileo)) (not (= (+ rankq fileq) (+ ranko fileo))) (not (= (- rankq fileq) (- ranko fileo))) (queen-fits-in? queen (cdr other-queens))))))))

(define (latest-queen-fits-in? queens)

(or (null? (cdr queens)) (queen-fits-in? (car queens) (cdr queens))))

(define (make-peaceful-queens-generator m n)

(make-generator-procedure (lambda () (define solutions '())
(let loop ((queens (list (make-queen BLACK 1 1))) (num-queens 1))
(define (add-another-queen) (let ((color (reverse-color (queen-color (car queens))))) (loop (cons (make-queen color 1 1) queens) (+ num-queens 1))))
(define (move-a-queen) (let drop-one ((queens queens) (num-queens num-queens)) (if (zero? num-queens) (loop '() 0) (let* ((latest (car queens)) (color (queen-color latest)) (rank (queen-rank latest)) (file (queen-file latest))) (if (and (= rank n) (= file n)) (drop-one (cdr queens) (- num-queens 1)) (let-values (((rank^ file^) (advance-ij n rank file))) (loop (cons (make-queen color rank^ file^) (cdr queens)) num-queens)))))))
(cond ((zero? num-queens) ;; There are no more solutions. &fail)
((latest-queen-fits-in? queens) (if (= num-queens (* 2 m)) (let ((board (queens->board queens))) ;; The current "queens" is a solution. (unless (member board solutions board-equiv?) ;; The current "queens" is a *new* solution. (set! solutions (cons board solutions)) (suspend queens)) (move-a-queen)) (add-another-queen)))
(else (move-a-queen)))))))

(define args (command-line)) (unless (or (= (length args) 3)

(= (length args) 4)) (display "Usage: ") (display (list-ref args 0)) (display " M N [MAX_SOLUTIONS]") (newline) (exit 1))

(define m (string->number (list-ref args 1))) (define n (string->number (list-ref args 2))) (define max-solutions

(if (= (length args) 4) (string->number (list-ref args 3)) +inf.0))

(define generate-peaceful-queens

(make-peaceful-queens-generator m n))

(let loop ((next-solution-number 1))

(when (<= next-solution-number max-solutions) (let ((solution (generate-peaceful-queens))) (when (success? solution) (display "Solution ") (display next-solution-number) (newline) (display (queens->string n solution)) (newline) (newline) (loop (+ next-solution-number 1))))))</lang>

Output:

$ csc -O5 peaceful_queens2.scm && ./peaceful_queens2 4 5

Solution 1 +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | W | | | +----+----+----+----+----+ | B | | | | B | +----+----+----+----+----+ Solution 2 +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ Solution 3 +----+----+----+----+----+ | | W | | W | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+ | | | | | W | +----+----+----+----+----+ | B | | B | | | +----+----+----+----+----+
Swift
Translation of: Kotlin

<lang swift>enum Piece {

case empty, black, white

}

typealias Position = (Int, Int)

func place(_ m: Int, _ n: Int, pBlackQueens: inout [Position], pWhiteQueens: inout [Position]) -> Bool {

guard m != 0 else { return true }
var placingBlack = true
for i in 0..<n { inner: for j in 0..<n { let pos = (i, j)
for queen in pBlackQueens where queen == pos || !placingBlack && isAttacking(queen, pos) { continue inner }
for queen in pWhiteQueens where queen == pos || placingBlack && isAttacking(queen, pos) { continue inner }
if placingBlack { pBlackQueens.append(pos) placingBlack = false } else { placingBlack = true
pWhiteQueens.append(pos)
if place(m - 1, n, pBlackQueens: &pBlackQueens, pWhiteQueens: &pWhiteQueens) { return true } else { pBlackQueens.removeLast() pWhiteQueens.removeLast() } } } }
if !placingBlack { pBlackQueens.removeLast() }
return false

}

func isAttacking(_ queen: Position, _ pos: Position) -> Bool {

queen.0 == pos.0 || queen.1 == pos.1 || abs(queen.0 - pos.0) == abs(queen.1 - pos.1)

}

func printBoard(n: Int, pBlackQueens: [Position], pWhiteQueens: [Position]) {

var board = Array(repeating: Piece.empty, count: n * n)
for queen in pBlackQueens { board[queen.0 * n + queen.1] = .black }
for queen in pWhiteQueens { board[queen.0 * n + queen.1] = .white }
for (i, p) in board.enumerated() { if i != 0 && i % n == 0 { print() }
switch p { case .black: print("B ", terminator: "") case .white: print("W ", terminator: "") case .empty: let j = i / n let k = i - j * n
if j % 2 == k % 2 { print("• ", terminator: "") } else { print("◦ ", terminator: "") } } }
print("\n")

}

let nms = [

(2, 1), (3, 1), (3, 2), (4, 1), (4, 2), (4, 3), (5, 1), (5, 2), (5, 3), (5, 4), (5, 5), (6, 1), (6, 2), (6, 3), (6, 4), (6, 5), (6, 6), (7, 1), (7, 2), (7, 3), (7, 4), (7, 5), (7, 6), (7, 7)

]

for (n, m) in nms {

print("\(m) black and white queens on \(n) x \(n) board")
var blackQueens = [Position]() var whiteQueens = [Position]()
if place(m, n, pBlackQueens: &blackQueens, pWhiteQueens: &whiteQueens) { printBoard(n: n, pBlackQueens: blackQueens, pWhiteQueens: whiteQueens) } else { print("No solution") }

}</lang>

Output:
1 black and white queens on 2 x 2 board No solution 1 black and white queens on 3 x 3 board B ◦ • ◦ • W • ◦ • 2 black and white queens on 3 x 3 board No solution 1 black and white queens on 4 x 4 board B ◦ • ◦ ◦ • W • • ◦ • ◦ ◦ • ◦ • 2 black and white queens on 4 x 4 board B ◦ • ◦ ◦ • W • B ◦ • ◦ ◦ • W • 3 black and white queens on 4 x 4 board No solution 1 black and white queens on 5 x 5 board B ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and white queens on 5 x 5 board B ◦ • ◦ B ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 3 black and white queens on 5 x 5 board B ◦ • ◦ B ◦ • W • ◦ • W • ◦ • ◦ • ◦ B ◦ • W • ◦ • 4 black and white queens on 5 x 5 board • B • B • ◦ • ◦ • B W ◦ W ◦ • ◦ • ◦ • B W ◦ W ◦ • 5 black and white queens on 5 x 5 board No solution 1 black and white queens on 6 x 6 board B ◦ • ◦ • ◦ ◦ • W • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • 2 black and white queens on 6 x 6 board B ◦ • ◦ B ◦ ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ • ◦ • ◦ ◦ • ◦ • ◦ • 3 black and white queens on 6 x 6 board B ◦ • ◦ B B ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ • • ◦ W ◦ • ◦ ◦ • ◦ • ◦ • 4 black and white queens on 6 x 6 board B ◦ • ◦ B B ◦ • W • ◦ • • W • ◦ • ◦ ◦ • ◦ • ◦ B • ◦ W W • ◦ ◦ • ◦ • ◦ • 5 black and white queens on 6 x 6 board • B • ◦ B ◦ ◦ • ◦ B ◦ B W ◦ • ◦ • ◦ W • W • ◦ • • ◦ • ◦ • B W • W • ◦ • 6 black and white queens on 6 x 6 board No solution 1 black and white queens on 7 x 7 board B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 2 black and white queens on 7 x 7 board B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 3 black and white queens on 7 x 7 board B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 4 black and white queens on 7 x 7 board B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • ◦ • 5 black and white queens on 7 x 7 board B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ • ◦ • ◦ • W • ◦ • ◦ • ◦ • ◦ • ◦ • 6 black and white queens on 7 x 7 board B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W B ◦ • ◦ B ◦ • ◦ • W • ◦ • W • ◦ • ◦ • ◦ • 7 black and white queens on 7 x 7 board • B • ◦ • B • ◦ B ◦ • B • ◦ • B • ◦ • B • ◦ • ◦ • B • ◦ W ◦ W ◦ • ◦ W ◦ • ◦ W ◦ • ◦ W ◦ W W • ◦ •
Wren
Translation of: Kotlin
Library: Wren-dynamic

<lang ecmascript>import "/dynamic" for Enum, Tuple

var Piece = Enum.create("Piece", ["empty", "black", "white"])

var Pos = Tuple.create("Pos", ["x", "y"])

var isAttacking = Fn.new { |q, pos|

return q.x == pos.x || q.y == pos.y || (q.x - pos.x).abs == (q.y - pos.y).abs

}

var place // recursive place = Fn.new { |m, n, blackQueens, whiteQueens|

if (m == 0) return true var placingBlack = true for (i in 0...n) { for (j in 0...n) { var pos = Pos.new(i, j) var inner = false for (queen in blackQueens) { var equalPos = queen.x == pos.x && queen.y == pos.y if (equalPos || !placingBlack && isAttacking.call(queen, pos)) { inner = true break } } if (!inner) { for (queen in whiteQueens) { var equalPos = queen.x == pos.x && queen.y == pos.y if (equalPos || placingBlack && isAttacking.call(queen, pos)) { inner = true break } } if (!inner) { if (placingBlack) { blackQueens.add(pos) placingBlack = false } else { whiteQueens.add(pos) if (place.call(m-1, n, blackQueens, whiteQueens)) return true blackQueens.removeAt(-1) whiteQueens.removeAt(-1) placingBlack = true } } } } } if (!placingBlack) blackQueens.removeAt(-1) return false

}

var printBoard = Fn.new { |n, blackQueens, whiteQueens|

var board = List.filled(n * n, 0) for (queen in blackQueens) board[queen.x * n + queen.y] = Piece.black for (queen in whiteQueens) board[queen.x * n + queen.y] = Piece.white var i = 0 for (b in board) { if (i != 0 && i%n == 0) System.print() if (b == Piece.black) { System.write("B ") } else if (b == Piece.white) { System.write("W ") } else { var j = (i/n).floor var k = i - j*n if (j%2 == k%2) { System.write("• ") } else { System.write("◦ ") } } i = i + 1 } System.print("\n")

}

var nms = [

Pos.new(2, 1), Pos.new(3, 1), Pos.new(3, 2), Pos.new(4, 1), Pos.new(4, 2), Pos.new(4, 3), Pos.new(5, 1), Pos.new(5, 2), Pos.new(5, 3), Pos.new(5, 4), Pos.new(5, 5), Pos.new(6, 1), Pos.new(6, 2), Pos.new(6, 3), Pos.new(6, 4), Pos.new(6, 5), Pos.new(6, 6), Pos.new(7, 1), Pos.new(7, 2), Pos.new(7, 3), Pos.new(7, 4), Pos.new(7, 5), Pos.new(7, 6), Pos.new(7, 7)

] for (p in nms) {

System.print("%(p.y) black and %(p.y) white queens on a %(p.x) x %(p.x) board:") var blackQueens = [] var whiteQueens = [] if (place.call(p.y, p.x, blackQueens, whiteQueens)) { printBoard.call(p.x, blackQueens, whiteQueens) } else { System.print("No solution exists.\n") }

}</lang>

Output:
Same as Kotlin entry.
zkl

<lang zkl>fcn isAttacked(q, x,y) // ( (r,c), x,y ) : is queen at r,c attacked by q@(x,y)?

{ r,c:=q; (r==x or c==y or r+c==x+y or r-c==x-y) }

fcn isSafe(r,c,qs) // queen safe at (r,c)?, qs=( (r,c),(r,c)..)

{ ( not qs.filter1(isAttacked,r,c) ) }

fcn isEmpty(r,c,qs){ (not (qs and qs.filter1('wrap([(x,y)]){ r==x and c==y })) ) } fcn _peacefulQueens(N,M,qa,qb){ //--> False | (True,((r,c)..),((r,c)..) )

// qa,qb --> // ( (r,c),(r,c).. ), solution so far to last good spot if(qa.len()==M==qb.len()) return(True,qa,qb); n, x,y := N, 0,0; if(qa) x,y = qa[-1]; else n=(N+1)/2; // first queen, first quadrant only foreach r in ([x..n-1]){ foreach c in ([y..n-1]){

if(isEmpty(r,c,qa) and isSafe(r,c,qb)){ qc,qd := qa.append(T(r,c)), self.fcn(N,M, qb,qc); if(qd) return( if(qd[0]==True) qd else T(qc,qd) ); }

} y=0 } False

}

fcn peacefulQueens(N=5,M=4){ # NxN board, M white and black queens

qs:=_peacefulQueens(N,M, T,T); println("Solution for %dx%d board with %d black and %d white queens:".fmt(N,N,M,M)); if(not qs)println("None"); else{ z:=Data(Void,"-"*N*N); foreach r,c in (qs[1]){ z[r*N + c]="W" } foreach r,c in (qs[2]){ z[r*N + c]="B" } z.text.pump(Void,T(Void.Read,N-1),"println"); }

}</lang> <lang zkl>peacefulQueens(); foreach n in ([4..10]){ peacefulQueens(n,n) }</lang>

Output:
Solution for 5x5 board with 4 black and 4 white queens: W---W --B-- -B-B- --B-- W---W Solution for 4x4 board with 4 black and 4 white queens: None Solution for 5x5 board with 5 black and 5 white queens: None Solution for 6x6 board with 6 black and 6 white queens: None Solution for 7x7 board with 7 black and 7 white queens: W---W-W --B---- -B-B-B- --B---- W-----W --BB--- W-----W Solution for 8x8 board with 8 black and 8 white queens: W---W--- --B---BB W---W--- --B---B- ---B---B -W---W-- W---W--- --B----- Solution for 9x9 board with 9 black and 9 white queens: W---W---W --B---B-- -B---B--- ---W---W- -B---B--- ---W---W- -B---B--- ---W---W- -B------- Solution for 10x10 board with 10 black and 10 white queens: W---W---WW --B---B--- -B-B------ -----W-W-W -BBB------ -----W-W-W -B-------- ------B--- ---B------ ----------