import Control.Monad
import Data.List

-- given n, "queens n" solves the n-queens problem, returning a list of all the
-- safe arrangements. each solution is a list of the columns where the queens are
-- located for each row
queens :: Int -> [[Int]]
queens n = map fst $ foldM oneMoreQueen ([],[1..n]) [1..n]  where

  -- foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
  -- foldM folds (from left to right) in the list monad, which is convenient for
  -- "nondeterminstically" finding "all possible solutions" of something. the
  -- initial value [] corresponds to the only safe arrangement of queens in 0 rows

  -- given a safe arrangement y of queens in the first i rows, and a list of
  -- possible choices, "oneMoreQueen y _" returns a list of all the safe
  -- arrangements of queens in the first (i+1) rows along with remaining choices
  oneMoreQueen (y,d) _ = [(x:y, delete x d) | x <- d, safe x]  where

    -- "safe x" tests whether a queen at column x is safe from previous queens
    safe x = and [x /= c + n && x /= c - n | (n,c) <- zip [1..] y]

-- prints what the board looks like for a solution; with an extra newline
printSolution y = do
     let n = length y
     mapM_ (\x -> putStrLn [if z == x then 'Q' else '.' | z <- [1..n]]) y
     putStrLn ""

-- prints all the solutions for 6 queens
main = mapM_ printSolution $ queens 6


/*REXX program mimics a bind operation when trying to perform addition upon arguments.  */
call add 1, 2
call add 1, 2.0
call add 1, 2.0, -6
call add self, 2
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
add:   void= 'VOID';                       f=    /*define in terms of a function&binding*/
                     do j=1  for arg()           /*process, classify, bind each argument*/
                     call bind( arg(j) );  f= f arg(j)
                     end   /*j*/
       say
       say 'adding'  f;    call sum f            /*telegraph what's being performed next*/
       return                                    /*Note: REXX treats INT & FLOAT as num.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
bind:  arg a;  type.a= datatype(a);  return      /*bind argument's kind with its "type".*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
sum:   parse arg a;  $= 0                        /*sum all arguments that were specified*/
                             do k=1  for words(a);  ?= word(a, k)
                             if type.?==num & $\==void  then $= ($ + word(a, k)) / 1
                                                        else $= void
                             end   /*k*/
       say 'sum='  $
       return $


class Maybe
  def initialize(value)
    @value = value
  end

  def map
    if @value.nil?
      self
    else
      Maybe.new(yield @value)
    end
  end
end

Maybe.new(3).map { |n| 2*n }.map { |n| n+1 }
#=> #<Maybe @value=7>

Maybe.new(nil).map { |n| 2*n }.map { |n| n+1 }
#=> #<Maybe @value=nil>

Maybe.new(3).map { |n| nil }.map { |n| n+1 }
#=> #<Maybe @value=nil>

# alias Maybe#new and write bind to be in line with task

class Maybe
  class << self
    alias :unit :new
  end

  def initialize(value)
    @value = value
  end

  def bind
    if @value.nil?
      self
    else
      yield @value
    end
  end
end

Maybe.unit(3).bind { |n| Maybe.unit(2*n) }.bind { |n| Maybe.unit(n+1) }
#=> #<Maybe @value=7>

Maybe.unit(nil).bind { |n| Maybe.unit(2*n) }.bind { |n| Maybe.unit(n+1) }
#=> #<Maybe @value=nil>


module NQueens {
    inherits {
        Heron.Windows.Console;
    }
    fields {
        n : Int = 4;
        sols : List = new List();
    }
    methods {
        PosToString(row : Int, col : Int) : String {
            return "row " + row.ToString() + ", col " + col.ToString();
        }
        AddQueen(b : Board, row : Int, col : Int)
        {
            if (!b.TryAddQueen(row, col))
                return;
            if (row < n - 1)
                foreach (i in 0..n-1)
                   AddQueen(new Board(b), row + 1, i);
            else
                sols.Add(b);
        }
        Main() {
            foreach (i in 0..n-1)
                AddQueen(new Board(), 0, i);
            foreach (b in sols) {
                b.Output();
                WriteLine("");
            }
            WriteLine("Found " + sols.Count().ToString() + " solutions");
        }
    }
}

class Board {
    fields {
        rows = new List();
    }
    methods {
        Constructor() {
            foreach (r in 0..n-1) {
                var col = new List();
                foreach (c in 0..n-1)
                    col.Add(false);
                rows.Add(col);
            }
        }
        Constructor(b : Board) {
            Constructor();
            foreach (r in 0..n-1)
                foreach (c in 0..n-1)
                    SetSpaceOccupied(r, c, b.SpaceOccupied(r, c));
        }
        SpaceOccupied(row : Int, col : Int) : Bool {
            return rows[row][col];
        }
        SetSpaceOccupied(row : Int, col : Int, b : Bool)  {
            rows[row][col] = b;
        }
        ValidPos(row : Int, col : Int) : Bool {
            return ((row >= 0) && (row < n)) && ((col >= 0) && (col < n));
        }
        VectorOccupied(row : Int, col : Int, rowDir : Int, colDir : Int) : Bool {
            var nextRow = row + rowDir;
            var nextCol = col + colDir;
            if (!ValidPos(nextRow, nextCol))
                return false;
            if (SpaceOccupied(nextRow, nextCol))
                return true;
            return VectorOccupied(nextRow, nextCol, rowDir, colDir);
        }
        TryAddQueen(row : Int, col : Int) : Bool {
            foreach (rowDir in -1..1)
                foreach (colDir in -1..1)
                    if (rowDir != 0 || colDir != 0)
                        if (VectorOccupied(row, col, rowDir, colDir))
                            return false;
            SetSpaceOccupied(row, col, true);
            return true;
        }
        Output() {
            foreach (row in 0..n-1) {
                foreach (col in 0..n-1) {
                    if (SpaceOccupied(row, col)) {
                        Write("Q");
                    }
                    else {
                        Write(".");
                    }
                }
                WriteLine("");
            }
        }
    }
}


import "/fmt" for Fmt

class Maybe {
    construct new(value) {
        _value = value
    }

    value { _value }

    bind(f) { f.call(_value) }

    static unit(i) { Maybe.new(i) }
}

var decrement = Fn.new { |i|
    if (!i) return Maybe.unit(null)
    return Maybe.unit(i - 1)
}

var triple = Fn.new { |i|
    if (!i) return Maybe.unit(null)
    return Maybe.unit(3 * i)
}

for (i in [3, 4, null, 5]) {
    var m1 = Maybe.unit(i)
    var m2 = m1.bind(decrement).bind(triple)
    var s1 = (m1.value) ? "%(m1.value)" : "none"
    var s2 = (m2.value) ? "%(m2.value)" : "none"
    System.print("%(Fmt.s(4, s1)) -> %(s2)")
}


fcn bind(a,type,b){ if(type.isType(a)) b else Void }
fcn just(x){ if(Deferred.isType(x)) x() else x }  // force lazy evaluation
fcn rtn(x) { just(x) }


procedure main()
    write(q(1), " ", q(2), " ", q(3), " ", q(4), " ", q(5), " ", q(6), " ", q(7), " ", q(8))
end

procedure q(c)
    static udiag, ddiag, row

    initial {
        udiag := list(15, 0)
        ddiag := list(15, 0)
        row := list(8, 0)
    }

    every 0 = row[r := 1 to 8] = ddiag[r + c - 1] = udiag[8 + r - c] do   # test if free
        suspend row[r] <- ddiag[r + c - 1] <- udiag[8 + r - c] <- r       # place and yield
end


100 PROGRAM "NQueens.bas"
110 TEXT 80
120 DO
130   INPUT PROMPT "Size of board (2-12): ":N$
140   LET N=VAL(N$)
150 LOOP UNTIL N>1 AND N<13
160 NUMERIC A(1 TO N),X(1 TO N),B(2 TO 2*N),C(-N+1 TO N-1)
170 LET SOL=0
180 CALL INIT(A):CALL INIT(B):CALL INIT(C)
190 CALL TRY(1)
200 PRINT SOL;"solutions."
210 END
220 DEF WRITE
230   LET S$="":LET SOL=SOL+1
240   FOR K=1 TO N
250     LET S$=S$&CHR$(64+K)&STR$(X(K))&"  "
260   NEXT
270   PRINT S$
280 END DEF
290 DEF TRY(I)
300   NUMERIC J
310   FOR J=1 TO N
320     IF A(J) AND B(I+J) AND C(I-J) THEN
330       LET X(I)=J:LET A(J),B(I+J),C(I-J)=0
340       IF I<N THEN
350         CALL TRY(I+1)
360       ELSE
370         CALL WRITE
380       END IF
390       LET A(J),B(I+J),C(I-J)=1
400     END IF
410   NEXT
420 END DEF
430 DEF INIT(REF T)
440   FOR I=LBOUND(T) TO UBOUND(T)
450     LET T(I)=1
460   NEXT
470 END DEF


perm   =: ! A.&i. ]               NB. all permutations of integers 0 to y
comb2  =: (, #: [email protected],@(</)&i.)~    NB. all size 2 combinations of integers 0 to y
mask   =: [ */@:~:&(|@-/) {
queenst=: comb2 (] #"1~ mask)&.|: perm


public class NQueens {

  private static int[] b = new int[8];
  private static int s = 0;

  static boolean unsafe(int y) {
    int x = b[y];
    for (int i = 1; i <= y; i++) {
      int t = b[y - i];
      if (t == x ||
          t == x - i ||
          t == x + i) {
        return true;
      }
    }

    return false;
  }

  public static void putboard() {
    System.out.println("\n\nSolution " + (++s));
    for (int y = 0; y < 8; y++) {
      for (int x = 0; x < 8; x++) {
        System.out.print((b[y] == x) ? "|Q" : "|_");
      }
      System.out.println("|");
    }
  }

  public static void main(String[] args) {
    int y = 0;
    b[0] = -1;
    while (y >= 0) {
      do {
        b[y]++;
      } while ((b[y] < 8) && unsafe(y));
      if (b[y] < 8) {
        if (y < 7) {
          b[++y] = -1;
        } else {
          putboard();
        }
      } else {
        y--;
      }
    }
  }
}


function queenPuzzle(rows, columns) {
    if (rows <= 0) {
        return [[]];
    } else {
        return addQueen(rows - 1, columns);
    }
}

function addQueen(newRow, columns, prevSolution) {
    var newSolutions = [];
    var prev = queenPuzzle(newRow, columns);
    for (var i = 0; i < prev.length; i++) {
        var solution = prev[i];
        for (var newColumn = 0; newColumn < columns; newColumn++) {
            if (!hasConflict(newRow, newColumn, solution))
                newSolutions.push(solution.concat([newColumn]))
        }
    }
    return newSolutions;
}

function hasConflict(newRow, newColumn, solution) {
    for (var i = 0; i < newRow; i++) {
        if (solution[i]     == newColumn          ||
            solution[i] + i == newColumn + newRow ||
            solution[i] - i == newColumn - newRow) {
                return true;
        }
    }
    return false;
}

console.log(queenPuzzle(8,8));


def single_solution_queens(n):
  def q: "♛";
  def init(k): reduce range(0;k) as $i ([]; . + ["."]);
  def matrix(k): init(k) as $row | reduce range(0;k) as $i ([]; . + [$row]);
  def place(stream; i; j):
    # jq indexing is based on offsets but we are using the 1-based formulae:
    reduce stream as $s (.; setpath([-1+($s|i), -1+($s|j)]; q) );
  def even(k):
    if ((k-2) % 6) != 0 then
         place( range(1; 1+(k/2));         .; 2*. )
       | place( range(1; 1+(k/2)); (k/2) + .; 2*. -1 )
    else place( range(1; 1+(k/2));         .; 1 + ((2*. + (k/2) - 3) % k))
       | place( range(1; 1+(n/2)); n + 1 - .; n - ((2*. + (n/2) - 3) % n))
    end;

  matrix(n)                          # the chess board
  | if (n % 2) == 0 then even(n)
    else even(n-1) | .[n-1][n-1] = q
    end;

# Example:
def pp: reduce .[] as $row
  ("";  reduce $row[] as $x (.; . + $x) + "\n");

single_solution_queens(8) | pp


"""
# EightQueensPuzzle

Ported to **Julia** from examples in several languages from
here: https://hbfs.wordpress.com/2009/11/10/is-python-slow
"""
module EightQueensPuzzle

export Board, solve!

mutable struct Board
    cols::Int
    nodes::Int
    diag45::Int
    diag135::Int
    solutions::Int

    Board() = new(0, 0, 0, 0, 0)
end

"Marks occupancy."
function mark!(b::Board, k::Int, j::Int)
    b.cols    ⊻= (1 << j)
    b.diag135 ⊻= (1 << (j+k))
    b.diag45  ⊻= (1 << (32+j-k))
end

"Tests if a square is menaced."
function test(b::Board, k::Int, j::Int)
    b.cols    & (1 << j)        +
    b.diag135 & (1 << (j+k))    +
    b.diag45  & (1 << (32+j-k)) == 0
end

"Backtracking solver."
function solve!(b::Board, niv::Int, dx::Int)
    if niv > 0
        for i in 0:dx-1
            if test(b, niv, i) == true
                mark!(b, niv, i)
                solve!(b, niv-1, dx)
                mark!(b, niv, i)
            end
        end
    else
        for i in 0:dx-1
            if test(b, 0, i) == true
                b.solutions += 1
            end
        end
    end
    b.nodes += 1
    b.solutions
end

end # module

using  .EightQueensPuzzle

for n = 1:17
    b = Board()
    @show n
    print("elapsed:")
    solutions = @time solve!(b, n-1, n)
    @show solutions
    println()
end


// version 1.1.3

var count = 0
var c = IntArray(0)
var f = ""

fun nQueens(row: Int, n: Int) {
    outer@ for (x in 1..n) {
        for (y in 1..row - 1) {
            if (c[y] == x) continue@outer
            if (row - y == Math.abs(x - c[y])) continue@outer
        }
        c[row] = x
        if (row < n) nQueens(row + 1, n)
        else if (++count == 1) f = c.drop(1).map { it - 1 }.toString()
    }
}

fun main(args: Array<String>) {
   for (n in 1..14) {
       count = 0
       c = IntArray(n + 1)
       f = ""
       nQueens(1, n)
       println("For a $n x $n board:")
       println("  Solutions = $count")
       if (count > 0) println("  First is $f")
       println()
   }
}


'N queens
'>10 would not work due to way permutations used
'anyway, 10 doesn't fit in memory
Input "Input N for N queens puzzle (4..9) ";N
if N<4 or N>9 then print "N out of range - quitting": end

ABC$= " "
dash$ = ""
for i = 0 to N-1
    ABC$=ABC$+" "+chr$(asc("a")+i)
    dash$ = dash$+"--"
next

dim q(N)
t0=time$("ms")

fact = 1
for i = 1 to N
    fact = fact*i
next

dim anagram$(fact)
global nPerms
print "Filling permutations array"
t0=time$("ms")
    res$=permutation$("", left$("0123456789", N))
t1=time$("ms")
print "Created all possible permutations ";t1-t0

t0=time$("ms")
'actually fact = nPerms
for k=1 to nPerms
    for i=0 to N-1
        q(i)=val(mid$(anagram$(k),i+1,1))
        'print q(i);
    next
    'print

    fail = 0
    for i=0 to N-1
        for j=i+1 to N-1
            'check rows are different
            if q(i)=q(j) then fail = 1: exit for
            'check diagonals are different
            if i+q(i)=j+q(j) then fail = 1: exit for
            'check other diagonals are different
            if i-q(i)=j-q(j) then fail = 1: exit for
        next
        if fail then exit for
    next

    if not(fail) then
        num=num+1
        print " ";dash$
            for i=0 to N-1
                print N-i; space$(2*q(i));" *"
            next
        print " ";dash$
        print ABC$
    end if

next

t1=time$("ms")
print "Time taken ";t1-t0
print "Number of solutions ";num

'----------------------------------
'from
'http://babek.info/libertybasicfiles/lbnews/nl124/wordgames.htm
'Programming a Word Game by Janet Terra,
'The Liberty Basic Newsletter - Issue #124 - September 2004
Function permutation$(pre$, post$)
'Note the variable nPerms must first be stated as a global variable.
    lgth = Len(post$)
    If lgth < 2 Then
        nPerms = nPerms + 1
        anagram$(nPerms) = pre$;post$
    Else
        For i = 1 To lgth
            tmp$=permutation$(pre$+Mid$(post$,i,1),Left$(post$,i-1)+Right$(post$,lgth-i))
        Next i
    End If
End Function


10 mode 1:defint a-z
20 while n<4:input "How many queens (N>=4)";n:wend
30 dim q(n),e(n),o(n)
40 r=n mod 6
50 if r<>2 and r<>3 then gosub 320:goto 220
60 for i=1 to int(n/2)
70 e(i)=2*i
80 next
90 for i=1 to round(n/2)
100 o(i)=2*i-1
110 next
120 if r=2 then gosub 410
130 if r=3 then gosub 460
140 s=1
150 for i=1 to n
160 if e(i)>0 then q(s)=e(i):s=s+1
170 next
180 for i=1 to n
190 if o(i)>0 then q(s)=o(i):s=s+1
200 next
210 ' print board
220 cls
230 for i=1 to n
240 locate i,26-q(i):print chr$(238);
250 locate i,24-n   :print chr$(96+i);
260 locate n+1,26-i :print i;
270 next
280 locate 1,1
290 call &bb06
300 end
310 ' the simple case
320 p=1
330 for i=1 to n
340 if i mod 2=0 then q(p)=i:p=p+1
350 next
360 for i=1 to n
370 if i mod 2 then q(p)=i:p=p+1
380 next
390 return
400 ' edit list when remainder is 2
410 for i=1 to n
420 if o(i)=3 then o(i)=1 else if o(i)=1 then o(i)=3
430 if o(i)=5 then o(i)=-1 else if o(i)=0 then o(i)=5:return
440 next
450 ' edit list when remainder is 3
460 for i=1 to n
470 if e(i)=2 then e(i)=-1 else if e(i)=0 then e(i)=2:goto 500
480 next
490 ' edit list some more
500 for i=1 to n
510 if o(i)=1 or o(i)=3 then o(i)=-1 else if o(i)=0 then o(i)=1:o(i+1)=3:return
520 next


to try :files :diag1 :diag2 :tried
  if :files = 0 [make "solutions :solutions+1  show :tried  stop]
  localmake "safe (bitand :files :diag1 :diag2)
  until [:safe = 0] [
    localmake "f bitnot bitand :safe minus :safe
    try bitand :files :f  ashift bitand :diag1 :f -1  (ashift bitand :diag2 :f 1)+1  fput bitnot :f :tried
    localmake "safe bitand :safe :safe-1
  ]
end

to queens :n
  make "solutions 0
  try (lshift 1 :n)-1 -1 -1 []
  output :solutions
end

print queens 8  ; 92


N = 8

-- We'll use nil to indicate no queen is present.
grid = {}
for i = 0, N do
  grid[i] = {}
end

function can_find_solution(x0, y0)
  local x0, y0 = x0 or 0, y0 or 1  -- Set default vals (0, 1).
  for x = 1, x0 - 1 do
    if grid[x][y0] or grid[x][y0 - x0 + x] or grid[x][y0 + x0 - x] then
      return false
    end
  end
  grid[x0][y0] = true
  if x0 == N then return true end
  for y0 = 1, N do
    if can_find_solution(x0 + 1, y0) then return true end
  end
  grid[x0][y0] = nil
  return false
end

if can_find_solution() then
  for y = 1, N do
    for x = 1, N do
      -- Print "|Q" if grid[x][y] is true; "|_" otherwise.
      io.write(grid[x][y] and "|Q" or "|_")
    end
    print("|")
  end
else
  print(string.format("No solution for %d queens.\n", N))
end


Module N_queens {
          Const l = 15  'number of queens
          Const b = False  'print option
          Dim a(0 to  l), s(0 to l), u(0 to 4 * l - 2)
          Def long n, m, i, j, p, q, r, k, t
          For i = 1 To l: a(i) = i: Next i
          For n = 1 To l
              m = 0
              i = 1
              j = 0
              r = 2 * n - 1
              Do {
                  i--
                  j++
                  p = 0
                  q = -r
                  Do {
                      i++
                      u(p) = 1
                      u(q + r) = 1
                      Swap a(i), a(j)
                      p = i - a(i) + n
                      q = i + a(i) - 1
                      s(i) = j
                      j = i + 1
                  } Until j > n Or u(p) Or u(q + r)
                  If u(p) = 0 Then {
                      If u(q + r) = 0 Then {
                          m++  'm: number of solutions
                          If b Then {
                              Print "n="; n; "m="; m
                              For k = 1 To n {
                                  For t = 1 To n {
                                      Print If$(a(n - k + 1) = t-> "Q", ".");
                                  }
                                  Print
                              }
                          }
                      }
                  }
                  j = s(i)
                  While j >= n And i <> 0 {
                            Do {
                                      Swap a(i), a(j)
                                      j--
                            }  Until j < i
                            i--
                            p = i - a(i) + n
                            q = i + a(i) - 1
                            j = s(i)
                            u(p) = 0
                            u(q + r) = 0
                  }
              } Until i = 0
              Print n, m  'number of queens, number of solutions
          Next n
}
N_queens


divert(-1)

The following macro find one solution to the eight-queens problem:

define(`solve_eight_queens',`_$0(1)')
define(`_solve_eight_queens',
`ifelse(none_of_the_queens_attacks_the_new_one($1),1,
            `ifelse(len($1),8,`display_solution($1)',`$0($1`'1)')',
        `ifelse(last_is_eight($1),1,`$0(incr_last(strip_eights($1)))',
                `$0(incr_last($1))')')')

It works by backtracking.

Partial solutions are represented by strings. For example, queens at
a7,b3,c6 would be represented by the string "736". The first position
is the "a" file, the second is the "b" file, etc. The digit in a given
position represents the queen's rank.

When a new queen is appended to the string, it must satisfy the
following constraint:

define(`none_of_the_queens_attacks_the_new_one',
       `_$0($1,decr(len($1)))')
define(`_none_of_the_queens_attacks_the_new_one',
       `ifelse($2,0,1,
               `ifelse(two_queens_attack($1,$2,len($1)),1,0,
                       `$0($1,decr($2))')')')

The `two_queens_attack' macro, used above, reduces to `1' if the
ith and jth queens attack each other; otherwise it reduces to `0':

define(`two_queens_attack',
`pushdef(`file1',eval($2))`'dnl
pushdef(`file2',eval($3))`'dnl
pushdef(`rank1',`substr($1,decr(file1),1)')`'dnl
pushdef(`rank2',`substr($1,decr(file2),1)')`'dnl
eval((rank1) == (rank2) ||
     ((rank1) + (file1)) == ((rank2) + (file2)) ||
     ((rank1) - (file1)) == ((rank2) - (file2)))`'dnl
popdef(`file1',`file2',`rank1',`rank2')')

Here is the macro that converts the solution string to a nice display:

define(`display_solution',
`pushdef(`rule',`+----+----+----+----+----+----+----+----+')`'dnl
rule
_$0($1,8)
rule
_$0($1,7)
rule
_$0($1,6)
rule
_$0($1,5)
rule
_$0($1,4)
rule
_$0($1,3)
rule
_$0($1,2)
rule
_$0($1,1)
rule`'dnl
popdef(`rule')')
define(`_display_solution',
`ifelse(index($1,$2),0,`|  Q ',`|    ')`'dnl
ifelse(index($1,$2),1,`|  Q ',`|    ')`'dnl
ifelse(index($1,$2),2,`|  Q ',`|    ')`'dnl
ifelse(index($1,$2),3,`|  Q ',`|    ')`'dnl
ifelse(index($1,$2),4,`|  Q ',`|    ')`'dnl
ifelse(index($1,$2),5,`|  Q ',`|    ')`'dnl
ifelse(index($1,$2),6,`|  Q ',`|    ')`'dnl
ifelse(index($1,$2),7,`|  Q ',`|    ')|')

Here are some simple macros used above:

define(`last',`substr($1,decr(len($1)))')        Get the last char.
define(`drop_last',`substr($1,0,decr(len($1)))') Remove the last char.
define(`last_is_eight',`eval((last($1)) == 8)')  Is the last char "8"?
define(`strip_eights',
  `ifelse(last_is_eight($1),1,`$0(drop_last($1))',
          `$1')')           Backtrack by removing all final "8" chars.
define(`incr_last',
       `drop_last($1)`'incr(last($1))')      Increment the final char.

The macros here have been presented top-down. I believe the program
might be easier to understand were the macros presented bottom-up;
then there would be no "black boxes" (unexplained macros) as one reads
from top to bottom.

I leave such rewriting as an exercise for the reader. :)

divert`'dnl
dnl
solve_eight_queens


queens:=proc(n)
  local a,u,v,m,aux;
  a:=[$1..n];
  u:=[true$2*n-1];
  v:=[true$2*n-1];
  m:=[];
  aux:=proc(i)
    local j,k,p,q;
    if i>n then
      m:=[op(m),copy(a)];
    else
      for j from i to n do
        k:=a[j];
        p:=i-k+n;
        q:=i+k-1;
        if u[p] and v[q] then
          u[p]:=false;
          v[q]:=false;
          a[j]:=a[i];
          a[i]:=k;
          aux(i+1);
          u[p]:=true;
          v[q]:=true;
          a[i]:=a[j];
          a[j]:=k;
        fi;
      od;
    fi;
  end;
  aux(1);
  m
end:

for a in queens(8) do printf("%a\n",a) od;


safe[q_List, n_] :=
 With[{l = [email protected]},
  [email protected]@q == [email protected][q + [email protected]] ==
   [email protected][q - [email protected]] == l]
nQueen[q_List: {}, n_] :=
 If[safe[q, n],
  If[Length[q] == n, {q},
   Cases[nQueen[Append[q, #], n] & /@ Range[n],
    Except[{Null} | {}], {2}]], Null]


n=8;
solutions=[[]];
v = 1:n;
P = perms(v);
for i=1:length(P)
    for j=1:n
        sub(j)=P(i,j)-j;
        add(j)=P(i,j)+j;
    end
    if n==length(unique(sub)) && n==length(unique(add))
        solutions(end+1,:)=P(i,:);
    end
end

fprintf('Number of solutions with %i queens: %i', n, length(solutions));

if ~isempty(solutions)
    %Print first possible solution
    board=solutions(1,:);
    s = repmat('-',n);
    for k=1:length(board)
        s(k,board(k)) = 'Q';
    end
    s
end


int: n;
array [1..n] of var 1..n: q; % queen in column i is in row q[i]

include "alldifferent.mzn";

constraint alldifferent(q);                       % distinct rows
constraint alldifferent([ q[i] + i | i in 1..n]); % distinct diagonals
constraint alldifferent([ q[i] - i | i in 1..n]); % upwards+downwards

% search
solve :: int_search(q, first_fail, indomain_min)
      satisfy;
output [ if fix(q[j]) == i then "Q" else "." endif ++
         if j == n then "\n" else "" endif | i,j in 1..n]


MODULE NQueens;
FROM InOut IMPORT Write, WriteCard, WriteString, WriteLn;

CONST N = 8;
VAR hist: ARRAY [0..N-1] OF CARDINAL;
    count: CARDINAL;

PROCEDURE Solve(n, col: CARDINAL);
    VAR i, j: CARDINAL;

    PROCEDURE Attack(i, j: CARDINAL): BOOLEAN;
        VAR diff: CARDINAL;
    BEGIN
        IF hist[j] = i THEN RETURN TRUE;
        ELSE
            IF hist[j] < i THEN diff := i - hist[j];
            ELSE diff := hist[j] - i;
            END;
            RETURN diff = col-j;
        END;
    END Attack;
BEGIN
    IF col = n THEN
        INC(count);
        WriteLn;
        WriteString("No. ");
        WriteCard(count, 0);
        WriteLn;
        WriteString("---------------");
        WriteLn;

        FOR i := 0 TO n-1 DO
            FOR j := 0 TO n-1 DO
                IF j = hist[i] THEN Write('Q');
                ELSIF (i + j) MOD 2 = 1 THEN Write(' ');
                ELSE Write('.');
                END;
            END;
            WriteLn;
        END;
    ELSE
        FOR i := 0 TO n-1 DO
            j := 0;
            WHILE (j < col) AND (NOT Attack(i,j)) DO INC(j); END;
            IF j >= col THEN
                hist[col] := i;
                Solve(n, col+1);
            END;
        END;
    END;
END Solve;

BEGIN
    count := 0;
    Solve(N, 0);
END NQueens.


Queens	New count,flip,row,sol
	Set sol=0
	For row(1)=1:1:4 Do try(2)  ; Not 8, the other 4 are symmetric...
	;
	; Remove symmetric solutions
	Set sol="" For  Set sol=$Order(sol(sol)) Quit:sol=""  Do
	. New xx,yy
	. Kill sol($Translate(sol,12345678,87654321)) ; Vertical flip
	. Kill sol($Reverse(sol)) ; Horizontal flip
	. Set flip="--------" for xx=1:1:8 Do  ; Flip over top left to bottom right diagonal
	. . New nx,ny
	. . Set yy=$Extract(sol,xx),nx=8+1-xx,ny=8+1-yy
	. . Set $Extract(flip,ny)=nx
	. . Quit
	. Kill sol(flip)
	. Set flip="--------" for xx=1:1:8 Do  ; Flip over top right to bottom left diagonal
	. . New nx,ny
	. . Set yy=$Extract(sol,xx),nx=xx,ny=yy
	. . Set $Extract(flip,ny)=nx
	. . Quit
	. Kill sol(flip)
	. Quit
	;
	; Display remaining solutions
	Set count=0,sol="" For  Set sol=$Order(sol(sol)) Quit:sol=""  Do  Quit:sol=""
	. New s1,s2,s3,txt,x,y
	. Set s1=sol,s2=$Order(sol(s1)),s3="" Set:s2'="" s3=$Order(sol(s2))
	. Set txt="+--+--+--+--+--+--+--+--+"
	. Write !,"  ",txt Write:s2'="" " ",txt Write:s3'="" " ",txt
	. For y=8:-1:1 Do
	. . Write !,y," |"
	. . For x=1:1:8 Write $Select($Extract(s1,x)=y:" Q",x+y#2:"  ",1:"##"),"|"
	. . If s2'="" Write " |"
	. . If s2'="" For x=1:1:8 Write $Select($Extract(s2,x)=y:" Q",x+y#2:"  ",1:"##"),"|"
	. . If s3'="" Write " |"
	. . If s3'="" For x=1:1:8 Write $Select($Extract(s3,x)=y:" Q",x+y#2:"  ",1:"##"),"|"
	. . Write !,"  ",txt Write:s2'="" " ",txt Write:s3'="" " ",txt
	. . Quit
	. Set txt="   A  B  C  D  E  F  G  H"
	. Write !,"  ",txt Write:s2'="" " ",txt Write:s3'="" " ",txt Write !
	. Set sol=s3
	. Quit
	Quit
try(col)	New ok,pcol
	If col>8 Do  Quit
	. New out,x
	. Set out="" For x=1:1:8 Set out=out_row(x)
	. Set sol(out)=1
	. Quit
	For row(col)=1:1:8 Do
	. Set ok=1
	. For pcol=1:1:col-1 If row(pcol)=row(col) Set ok=0 Quit
	. Quit:'ok
	. For pcol=1:1:col-1 If col-pcol=$Translate(row(pcol)-row(col),"-") Set ok=0 Quit
	. Quit:'ok
	. Do try(col+1)
	. Quit
	Quit
Do Queens


const BoardSize = 8

proc underAttack(col: int; queens: seq[int]): bool =
  if col in queens: return true
  for i, x in queens:
    if abs(col - x) == queens.len - i:
      return true
  return false

proc solve(n: int): seq[seq[int]] =
  result = newSeq[seq[int]]()
  result.add(@[])
  var newSolutions = newSeq[seq[int]]()
  for row in 1..n:
    for solution in result:
      for i in 1..BoardSize:
        if not underAttack(i, solution):
          newSolutions.add(solution & i)
    swap result, newSolutions
    newSolutions.setLen(0)

echo "Solutions for a chessboard of size ", BoardSize, 'x', BoardSize
echo ""

for i, answer in solve(BoardSize):
  for row, col in answer:
    if row > 0: stdout.write ' '
    stdout.write chr(ord('a') + row), col
  stdout.write if i mod 4 == 3: "\n" else: "      "


bundle Default {
  class NQueens {
    b : static : Int[];
    s : static : Int;

    function : Main(args : String[]) ~ Nil {
      b := Int->New[8];
      s := 0;

      y := 0;
      b[0] := -1;

      while (y >= 0) {
        do {
          b[y]+=1;
        }
        while((b[y] < 8) & Unsafe(y));

        if(b[y] < 8) {
          if (y < 7) {
            b[y + 1] := -1;
            y += 1;
          }
          else {
            PutBoard();
          };
        }
        else {
          y-=1;
        };
      };
    }

    function : Unsafe(y : Int) ~ Bool {
      x := b[y];
      for(i := 1; i <= y; i+=1;) {
        t := b[y - i];
        if(t = x | t = x - i | t = x + i) {
          return true;
        };
      };

      return false;
    }

    function : PutBoard() ~ Nil {
      IO.Console->Print("\n\nSolution ")->PrintLine(s + 1);
      s += 1;
      for(y := 0; y < 8; y+=1;) {
        for(x := 0; x < 8; x+=1;) {
          IO.Console->Print((b[y] = x) ? "|Q" : "|_");
        };
        "|"->PrintLine();
      };
    }
  }
}


(* Authors: Nicolas Barnier, Pascal Brisset
   Copyright 2004 CENA. All rights reserved.
   This code is distributed under the terms of the GNU LGPL *)

open Facile
open Easy

(* Print a solution *)
let print queens =
  let n = Array.length queens in
  if n <= 10 then (* Pretty printing *)
    for i = 0 to n - 1 do
      let c = Fd.int_value queens.(i) in (* queens.(i) is bound *)
      for j = 0 to n - 1 do
        Printf.printf "%c " (if j = c then '*' else '-')
      done;
      print_newline ()
    done
  else (* Short print *)
    for i = 0 to n-1 do
      Printf.printf "line %d : col %a\n" i Fd.fprint queens.(i)
    done;
  flush stdout;
;;

(* Solve the n-queens problem *)
let queens n =
  (* n decision variables in 0..n-1 *)
  let queens = Fd.array n 0 (n-1) in

  (* 2n auxiliary variables for diagonals *)
  let shift op = Array.mapi (fun i qi -> Arith.e2fd (op (fd2e qi) (i2e i))) queens in
  let diag1 = shift (+~) and diag2 = shift (-~) in

  (* Global constraints *)
  Cstr.post (Alldiff.cstr queens);
  Cstr.post (Alldiff.cstr diag1);
  Cstr.post (Alldiff.cstr diag2);

  (* Heuristic Min Size, Min Value *)
  let h a = (Var.Attr.size a, Var.Attr.min a) in
  let min_min = Goals.Array.choose_index (fun a1 a2 -> h a1 < h a2) in

  (* Search goal *)
  let labeling = Goals.Array.forall ~select:min_min Goals.indomain in

  (* Solve *)
  let bt = ref 0 in
  if Goals.solve ~control:(fun b -> bt := b) (labeling queens) then begin
    Printf.printf "%d backtracks\n" !bt;
    print queens
  end else
    prerr_endline "No solution"

let _ =
  if Array.length Sys.argv <> 2
  then raise (Failure "Usage: queens <nb of queens>");
  Gc.set ({(Gc.get ()) with Gc.space_overhead = 500}); (* May help except with an underRAMed system *)
  queens (int_of_string Sys.argv.(1));;


declare
  fun {Queens N}
     proc {$ Board}
        %% a board is a N-tuple of rows
        Board = {MakeTuple queens N}
        for Y in 1..N  do
           %% a row is a N-tuple of values in [0,1]
           %% (0: no queen, 1: queen)
           Board.Y = {FD.tuple row N 0#1}
        end

        {ForAll {Rows Board} SumIs1}
        {ForAll {Columns Board} SumIs1}

        %% for every two points on a diagonal
        for [X1#Y1 X2#Y2] in {DiagonalPairs N} do
           %$ at most one of them has a queen
           Board.Y1.X1 + Board.Y2.X2 =<: 1
        end

        %% enumerate all such boards
        {FD.distribute naive {FlatBoard Board}}
     end
  end

  fun {Rows Board}
     {Record.toList Board}
  end

  fun {Columns Board}
     for X in {Arity Board.1} collect:C1 do
        {C1
         for Y in {Arity Board} collect:C2 do
            {C2 Board.Y.X}
         end}
     end
  end

  proc {SumIs1 Xs}
     {FD.sum Xs '=:' 1}
  end

  fun {DiagonalPairs N}
     proc {Coords Root}
        [X1#Y1 X2#Y2] = Root
        Diff
     in
        X1::1#N Y1::1#N
        X2::1#N Y2::1#N
        %% (X1,Y1) and (X2,Y2) are on a diagonal if {Abs X2-X1} = {Abs Y2-Y1}
        Diff::1#N-1
        {FD.distance X2 X1 '=:' Diff}
        {FD.distance Y2 Y1 '=:' Diff}
        %% enumerate all such coordinates
        {FD.distribute naive [X1 Y1 X2 Y2]}
     end
  in
     {SearchAll Coords}
  end

  fun {FlatBoard Board}
     {Flatten {Record.toList {Record.map Board Record.toList}}}
  end

  Solutions = {SearchAll {Queens 8}}
in
  {Length Solutions} = 92 %% assert
  {Inspect {List.take Solutions 3}}


; "eight queens problem" benchmark test

         .radix    16

         .loc 0

          nop            ;
          mov  #scr,@#E800
          mov  #88C6,@#E802
; clear the display RAM
          mov  #scr,r0
          mov  #1E0,r1
cls:      clr  (r0)+
          sob  r1,cls
; display the initial counter value
          clr  r3
          mov  #scr,r0
          jsr  pc,number
; perform the test
          jsr  pc,queens
; display the counter
          mov  #scr,r0
          jsr  pc,number
finish:   br   finish

; display the character R1 at the screen address R0,
; advance the pointer R0 to the next column
putc:     mov  r2,-(sp)
; R1 <- 6 * R1
         asl  r1        ;* 2
         mov  r1,-(sp)
         asl  r1        ;* 4
         add  (sp)+,r1  ;* 6
         add  #chars,r1
         mov  #6,r2
putc1:   movb (r1)+,(r0)
         add  #1E,r0
         sob  r2,putc1
         sub  #B2,r0         ;6 * 1E - 2 = B2
         mov  (sp)+,r2
         rts  pc

print1:   jsr  pc,putc
; print a string pointed to by R2 at the screen address R0,
; advance the pointer R0 to the next column,
; the string should be terminated by a negative byte
print:    movb (r2)+,r1
          bpl  print1
          rts  pc

; display the word R3 decimal at the screen address R0
number:   mov  sp,r1
          mov  #A0A,-(sp)
          mov  (sp),-(sp)
          mov  (sp),-(sp)
          movb #80,-(r1)
numb1:    clr  r2
          div  #A,r2
          movb r3,-(r1)
          mov  r2,r3
          bne  numb1
          mov  sp,r2
          jsr  pc,print
          add  #6,sp
          rts  pc

queens:  mov  #64,r5         ;100
l06:     clr  r3
         clr  r0
l00:     cmp  #8,r0
         beq  l05
         inc  r0
         movb #8,ary(r0)
l01:     inc  r3
         mov  r0,r1
l02:     dec  r1
         beq  l00
         movb ary(r0),r2
         movb ary(r1),r4
         sub  r2,r4
         beq  l04
         bcc  l03
         neg  r4
l03:     add  r1,r4
         sub  r0,r4
         bne  l02
l04:     decb ary(r0)
         bne  l01
         sob  r0,l04
l05:     sob  r5,l06
         mov  r3,cnt
         rts  pc

; characters, width = 8 pixels, height = 6 pixels
chars:  .byte     3C, 46, 4A, 52, 62, 3C   ;digit '0'
        .byte     18, 28, 8,  8,  8,  3E   ;digit '1'
        .byte     3C, 42, 2,  3C, 40, 7E   ;digit '2'
        .byte     3C, 42, C,  2,  42, 3C   ;digit '3'
        .byte     8,  18, 28, 48, 7E, 8    ;digit '4'
        .byte     7E, 40, 7C, 2,  42, 3C   ;digit '5'
        .byte     3C, 40, 7C, 42, 42, 3C   ;digit '6'
        .byte     7E, 2,  4,  8,  10, 10   ;digit '7'
        .byte     3C, 42, 3C, 42, 42, 3C   ;digit '8'
        .byte     3C, 42, 42, 3E, 2,  3C   ;digit '9'
        .byte     0,  0,  0,  0,  0,  0    ;space

        .even

cnt:    .blkw     1
ary:    .blkb     9

        .loc 200

scr:                                        ;display RAM


my ($board_size, @occupied, @past, @solutions);

sub try_column {
        my ($depth, @diag) = shift;
        if ($depth == $board_size) {
                push @solutions, "@past\n";
                return;
        }

        # @diag: marks cells diagonally attackable by any previous queens.
        #        Here it's pre-allocated to double size just so we don't need
        #        to worry about negative indices.
        $#diag = 2 * $board_size;
        for (0 .. $#past) {
                $diag[ $past[$_] + $depth - $_ ] = 1;
                $diag[ $past[$_] - $depth + $_ ] = 1;
        }

        for my $row (0 .. $board_size - 1) {
                next if $occupied[$row] || $diag[$row];

                # @past:     row numbers of previous queens
                # @occupied: rows already used. This gets inherited by each
                #            recursion so we don't need to repeatedly look them up
                push @past, $row;
                $occupied[$row] = 1;

                try_column($depth + 1);

                # clean up, for next recursion
                $occupied[$row] = 0;
                pop @past;
        }
}

$board_size = 12;
try_column(0);

#print for @solutions; # un-comment to see all solutions
print "total " . @solutions . " solutions\n";


with javascript_semantics
--
-- demo\rosetta\n_queens.exw
-- =========================
--
sequence co,    -- columns occupied
                -- (ro is implicit)
         fd,    -- forward diagonals
         bd,    -- backward diagonals
         board

atom count

procedure solve(integer row, integer N, integer show)
    for col=1 to N do
        if not co[col] then
            integer fdi = col+row-1,
                    bdi = row-col+N
            if not fd[fdi]
            and not bd[bdi] then
                board[row][col] = 'Q'
                co[col] = 1
                fd[fdi] = 1
                bd[bdi] = 1
                if row=N then
                    if show then
                        puts(1,join(board,"\n")&"\n")
                        puts(1,repeat('=',N)&"\n")
                    end if
                    count += 1
                else
                    solve(row+1,N,show)
                end if
                board[row][col] = '.'
                co[col] = 0
                fd[fdi] = 0
                bd[bdi] = 0
            end if
        end if
    end for
end procedure

procedure n_queens(integer N=8, integer show=1)
    co = repeat(0,N)
    fd = repeat(0,N*2-1)
    bd = repeat(0,N*2-1)
    board  = repeat(repeat('.',N),N)
    count = 0
    solve(1,N,show)
    printf(1,"%d queens: %d solutions\n",{N,count})
end procedure

for N=1 to iff(platform()=JS?12:14) do
    n_queens(N,N<5)
end for


<title>
n x n Queen solving program
</title>

<?php
echo "
n x n Queen solving program
";

//Get the size of the board
$boardX = $_POST['boardX'];
$boardY = $_POST['boardX'];

// Function to rotate a board 90 degrees
function rotateBoard($p, $boardX) {
    $a=0;
    while ($a < count($p)) {
        $b = strlen(decbin($p[$a]))-1;
        $tmp[$b] = 1 << ($boardX - $a - 1);
        ++$a;
    }
    ksort($tmp);
    return $tmp;
}

// This function will find rotations of a solution
function findRotation($p, $boardX,$solutions){
    $tmp = rotateBoard($p,$boardX);
    // Rotated 90
    if (in_array($tmp,$solutions)) {}
    else {$solutions[] = $tmp;}

    $tmp = rotateBoard($tmp,$boardX);
    // Rotated 180
    if (in_array($tmp,$solutions)){}
    else {$solutions[] = $tmp;}

    $tmp = rotateBoard($tmp,$boardX);
    // Rotated 270
    if (in_array($tmp,$solutions)){}
    else {$solutions[] = $tmp;}

    // Reflected
    $tmp = array_reverse($p);
    if (in_array($tmp,$solutions)){}
    else {$solutions[] = $tmp;}

    $tmp = rotateBoard($tmp,$boardX);
    // Reflected and Rotated 90
    if (in_array($tmp,$solutions)){}
    else {$solutions[] = $tmp;}

    $tmp = rotateBoard($tmp,$boardX);
    // Reflected and Rotated 180
    if (in_array($tmp,$solutions)){}
    else {$solutions[] = $tmp;}

    $tmp = rotateBoard($tmp,$boardX);
    // Reflected and Rotated 270
    if (in_array($tmp,$solutions)){}
    else {$solutions[] = $tmp;}
    return $solutions;
}

// This is a function which will render the board
function renderBoard($p,$boardX) {
$img = 'data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAC0AAAAtCAYAAAA6GuKaAAAABmJLR0QA/wD/AP+gvaeTAAAGFUlEQVRYhe2YXWibVRjHf2lqP9JmaRi4YW1IalY3rbZsaddMgsquBm676b6KyNDhLiaUeSEMvPNCcNuNyJjgLiboCnoxKFlv6lcHy7AtMhhaWTVZWhisjDTEtEuW5PHiPWnfvH2TvNk6vekfDm/O+Z/zPP/3PM/5eAMb2MAG/nfYn4LNVuBj4ENgB/Ar8Ogp+KkJbwLfqvKGgbMBPwKiK+Oq3aqNdcebQEEnqAC8ruO7KBVcLF012KiKuhpFv0/prNlU239qw0x0pdBJFXt30NJDjx9Uu1Ub1TSYdq4UutcNfI61oW0Bflb8T6quRzUbNafPFdbm4zcmTucV91kZO18o/osy/GeKnzcRVFWDMT2shO4X4IL6/UqZPv2GpxHFcReUvVo1lMAYunKh+UTxeeB5A/cMkFF8RtX1eF6NE2XHTIN+ltekoHGmf0HLqe9V3Qb8ZWK4Xjf+HQP3KtCgfjeouh7v6PzWsxZ6f98De1kbjbIovumoCfcp2gzkgb8p3cJOUjpTJ3WcTfXPq/Gfmtge1Y01RaV9+jv1fAsYMnAu3XgfENJxfUoU6tmn40Kqf9Gvi1IMKX96/zWJnlLP4i7wrIEvzkQeeFfXvltnt07Vi3iX1RcyzuSzrO46ev81YS+rYcqjbUVFfIl2CSryS4ATcKCF3biQHIpf0rU/UnaKuMLqAhXlv2a4Dc4FOKi4bwyiBTgBvGYyRlT7CUPbI1b334MmY9zlhFVKjwQQ09ULaDNTNKYPbx54j9L81aNP8XldW3G8W9kt6LiY8m8Ksy1Hj0mgA+3eXYeWd2eBRkpf2A4MoO3JOYPdHPA2sMtgu07ZOavsFnegvPL72PiItWEroB0axtwtmPStxOeUHbNxH1USVe1qOm3SVkA7NIwX+1phU3YKJpyZX8swW4y1FOMsVotG1UUI1mbrH9ZeL/UQi3b0C7dS/2W0LbIsqi1E0K6PL5oRdrudHTt22Px+Pz6fD6/XS3NzM21tbSt9FhcXWVpaIhqN2mKxGLOzs8zMzJDP581MQukHw2OLPgt8VRQZDAbZv38/wWCQnTt30tKyGoRUKsWDBw/IZrOkUimcTicNDQ1s3rwZp9O50i+dTjM9Pc2NGzcIh8NEIhH9S3xuQVNV2IArp06dkoWFBRERefjwoUxMTMi5c+fk8OHD0tPTIy6Xq2Keulwu6enpkSNHjsj58+dlYmJCMpmMiIgsLCzIxYsXBe1UfNIFvoL6M2fO/Hn58uXC4OCgtLa2PsniXClOp1MGBwfl0qVLhdOnT/+BtcjX9FYe4Pe+vj6Hy+Vat9lIJpMyOTm5BLwExNfL7gpCodAFeQoIhUIXqntfhaVwFHH9+nXp7+8vuFyuWv8vKYtkMlmYnJwse+F/Urzi9/ulqanJ6gFhqTQ1NeW7u7sF6Fx3xd3d3bdERNLptITDYRkeHpZgMCgOh6MmkQ6HQ/bs2SPDw8MSDoclnU6LiMju3buvlHG9BlYX1F5gfGhoiEAgwL59+9i+fTsAuVyOWCxGPB4nHo+TSCTIZrMkEgncbjeNjY243W46OjrweDx4vV7q67WsnJmZYWxsjGvXrjE+Pm5Zj1XRX3d2dg7Nz8/bs9ksAFu2bGHXrl0EAgG2bduG1+vF4/HgdDrZtGkTdrudXC5HKpUilUpx9+5dYrEYd+7cYXp6mqmpKe7fvw9AQ0MDXV1d3L59+2Xgd4uaKqO3t/cnEZFkMikjIyNy9OhRaW9vf6Jcbm9vl2PHjsnIyIgkk0kRETl06NAHVvRYnenA8ePHJ4PBIAcOHGDr1q0AxONxbt68yezsLNFolLm5ORKJBMvLy6TTaVpaWmhubl5JD5/Ph9/vZ2BgAI/HA8C9e/cYHR3l6tWry2NjY88Bi+slGqAHOFVXVxfq7e3tGhgYqAsGgwQCAfH5fLbGxsaqBjKZDNFoVKampmyRSIRIJFK4devWn4VC4TpwEfjNipDHPdlagADaf3X9NpvthY6Ojk6Px+Mq3vLsdjv5fJ7FxUWWl5eJx+OJubm5mIjMon1O/Yr2N0G6VufrdhwrtAJtaN9+bWihzqB9pNYsbgMbeAz8C3N/JQD4H5KCAAAAAElFTkSuQmCC';
echo "
";
for ($y = 0; $y < $boardX; ++$y) {
	echo '
';
	for ($x = 0; $x < $boardX; ++$x){
	if (($x+$y) & 1) { $cellCol = '#9C661F';}
	else {$cellCol = '#FCE6C9';}

	if ($p[$y] == 1 << $x) { echo "	";}
	else { echo " 	";}
	}
	echo '
';
}
echo '

&nbsp';

}

//This function allows me to generate the next order of rows.
function pc_next_permutation($p) {
    $size = count($p) - 1;
    // slide down the array looking for where we're smaller than the next guy

    for ($i = $size - 1; $p[$i] >= $p[$i+1]; --$i) { }

    // if this doesn't occur, we've finished our permutations
    // the array is reversed: (1, 2, 3, 4) => (4, 3, 2, 1)
    if ($i == -1) { return false; }

    // slide down the array looking for a bigger number than what we found before
    for ($j = $size; $p[$j] <= $p[$i]; --$j) { }
    // swap them
    $tmp = $p[$i]; $p[$i] = $p[$j]; $p[$j] = $tmp;
    // now reverse the elements in between by swapping the ends
    for (++$i, $j = $size; $i < $j; ++$i, --$j)
    { $tmp = $p[$i]; $p[$i] = $p[$j]; $p[$j] = $tmp; }
    return $p;
}

//This function needs to check the current state to see if there are any
function checkBoard($p,$boardX) {
	$a = 0; //this is the row being checked
	while ($a < count($p)) {
		$b = 1;
		while ($b < ($boardX - $a)){
            $x = $p[$a+$b] << $b;
            $y = $p[$a+$b] >> $b;
            if ($p[$a] == $x | $p[$a] == $y) {
                return false;
            }
            ++$b;
		}
	++$a;
	}
	return true;
}

if (isset($_POST['process']) && isset($_POST['boardX']))
{
//Within here is the code that needs to be run if process is clicked.

//First I need to create the different possible rows
for ($x = 0; $x < $boardX; ++$x){
	$row[$x] = 1 << $x;
}

//Now I need to create all the possible orders of rows, will be equal to [boardY]!
$solcount = 0;
$solutions = array();
while ($row != false) {
	if (checkBoard($row,$boardX)){
	if(!in_array($row,$solutions)){
		$solutions[] = $row;
			renderBoard($row,$boardX);
			$solutions = findRotation($row,$boardX,$solutions);
			++$solcount;
		}

	}
	$row = pc_next_permutation($row);
}
echo "

&nbsp&nbsp&nbsp&nbspRows/Columns: ".$boardX."
&nbsp&nbsp&nbsp&nbspUnique Solutions: ".$solcount."
&nbsp&nbsp&nbsp&nbspTotal Solutions: ".count($solutions)."  - Note: This includes symmetrical solutions
";
//print_r($solutions);
}

//This code collects the starting parameters
echo <<<_END
<form name="input" action="index.php" method="post">
&nbsp&nbsp&nbsp&nbspNumber of columns/rows <select name="boardX" />
<option value="1">One</option>
<option value="2">Two</option>
<option value="3">Three</option>
<option value="4" >Four</option>
<option value="5">Five</option>
<option value="6">Six</option>
<option value="7">Seven</option>
<option value="8" selected="selected">Eight</option>
<option value="9">Nine</option>
<option value="10">Ten</option>
</select>
    <input type="hidden" name="process" value="yes" />
&nbsp<input type="submit" value="Process" />
</form>

_END;

?>


<html>
<body>
<pre>
<?php

/*************************************************************************
*
* This algorithm solves the 8 queens problem using backtracking.
* Please try with N<=25 * * * *************************************************************************/
class Queens {
    var $size;
    var $arr;
    var $sol;

    function Queens($n = 8) {
        $this->size = $n;
        $this->arr = array();
        $this->sol = 0;
        // Inicialiate array;
        for($i=0; $i<$n; $i++) {
            $this->arr[$i] = 0;
        }
    }

    function isSolution($n) {
        for ($i = 0; $i < $n; $i++) {
            if ($this->arr[$i] == $this->arr[$n] ||
            ($this->arr[$i] - $this->arr[$n]) == ($n - $i) ||
            ($this->arr[$n] - $this->arr[$i]) == ($n - $i))
            {
                return false;
            }
        }
        return true;
    }

    function PrintQueens() {
        echo("solution #".(++$this->sol)."\n");
        // echo("solution #".($this->size)."\n");
        for ($i = 0; $i < $this->size; $i++) {
            for ($j = 0; $j < $this->size; $j++) {
                if ($this->arr[$i] == $j) echo("& ");
                else echo(". ");
            }
            echo("\n");
        }
        echo("\n");
    }

    // backtracking Algorithm
    function run($n = 0) {
        if ($n == $this->size){
            $this->PrintQueens();
        }
        else {
            for ($i = 0; $i < $this->size; $i++) {
                $this->arr[$n] = $i;
                if($this->isSolution($n)){
                    $this->run($n+1);
                }
            }
        }
    }
}

$myprogram = new Queens(8);
$myprogram->run();

?>
</pre>
</body>
</html>


import sat.
% import mip.

queens_sat(N,Q) =>
  Q = new_array(N,N),
  Q :: 0..1,

  foreach (K in 1-N..N-1)
    sum([Q[I,J] : I in 1..N, J in 1..N, I-J==K]) #=< 1
  end,

  foreach (K in 2..2*N)
    sum([Q[I,J] :  I in 1..N, J in 1..N, I+J==K]) #=< 1
  end,

  foreach (I in 1..N)
    sum([Q[I,J] : J in 1..N]) #= 1
  end,

  foreach (J in 1..N)
    sum([Q[I,J] : I in 1..N]) #= 1
  end,
  solve([inout],Q).


(load "@lib/simul.l")  # for 'permute'

(de queens (N)
   (let (R (range 1 N)  Cnt 0)
      (for L (permute (range 1 N))
         (when
            (= N  # from the Python solution
               (length (uniq (mapcar + L R)))
               (length (uniq (mapcar - L R))) )
            (inc 'Cnt) ) )
      Cnt ) )


NQUEENS: PROC OPTIONS (MAIN);
 DCL A(35) BIN FIXED(31) EXTERNAL;
 DCL COUNT BIN FIXED(31) EXTERNAL;
 COUNT = 0;
 DECLARE SYSIN FILE;
 DCL ABS BUILTIN;
 DECLARE SYSPRINT FILE;
 DECLARE N BINARY FIXED (31); /* COUNTER */
 /* MAIN LOOP STARTS HERE */
 GET LIST (N) FILE(SYSIN); /* N QUEENS, N X N BOARD */
 PUT SKIP (1) FILE(SYSPRINT);
 PUT SKIP LIST('BEGIN N QUEENS PROCESSING *****') FILE(SYSPRINT);
 PUT SKIP LIST('SOLUTIONS FOR N: ',N) FILE(SYSPRINT);
 PUT SKIP (1) FILE(SYSPRINT);
  IF N < 4 THEN DO;
    /* LESS THAN 4 MAKES NO SENSE  */
      PUT SKIP (2) FILE(SYSPRINT);
      PUT SKIP LIST (N,' N TOO LOW') FILE (SYSPRINT);
      PUT SKIP (2) FILE(SYSPRINT);
      RETURN (1);
   END;
   IF N > 35 THEN DO;
     /* WOULD TAKE WEEKS    */
       PUT SKIP (2) FILE(SYSPRINT);
       PUT SKIP LIST (N,' N TOO HIGH') FILE (SYSPRINT);
       PUT SKIP (2) FILE(SYSPRINT);
       RETURN (1);
    END;

    CALL QUEEN(N);

     PUT SKIP (2) FILE(SYSPRINT);
     PUT SKIP LIST (COUNT,' SOLUTIONS FOUND') FILE(SYSPRINT);
     PUT SKIP (1) FILE(SYSPRINT);
     PUT SKIP LIST ('END OF PROCESSING ****') FILE(SYSPRINT);
     RETURN(0);
  /* MAIN LOOP ENDS ABOVE  */

  PLACE: PROCEDURE (PS);
     DCL PS BIN FIXED(31);
     DCL I  BIN FIXED(31) INIT(0);
     DCL A(50) BIN FIXED(31) EXTERNAL;

  DO I=1 TO PS-1;
       IF A(I) = A(PS) THEN  RETURN(0);
       IF ABS ( A(I) - A(PS) ) = (PS-I) THEN RETURN(0);
  END;
    RETURN (1);
  END PLACE;

  QUEEN: PROCEDURE (N);
      DCL N BIN FIXED (31);
      DCL K BIN FIXED (31);
      DCL A(50) BIN FIXED(31) EXTERNAL;
      DCL COUNT BIN FIXED(31) EXTERNAL;
      K = 1;
      A(K) = 0;
      DO WHILE (K > 0);
         A(K) = A(K) + 1;
         DO WHILE ( ( A(K)<= N) & (PLACE(K) =0) );
             A(K) = A(K) +1;
         END;
         IF (A(K) <= N) THEN DO;
           IF (K = N ) THEN DO;
                         COUNT = COUNT + 1;
                 END;
           ELSE DO;
             K= K +1;
             A(K) = 0;
           END; /* OF INSIDE ELSE */
         END; /* OF FIRST IF */
         ELSE DO;
              K = K -1;
         END;
      END;  /* OF EXTERNAL WHILE LOOP  */
   END QUEEN;

 END NQUEENS;


#COMPILE EXE
#DIM ALL

SUB aux(n AS INTEGER, i AS INTEGER, a() AS INTEGER, _
        u() AS INTEGER, v() AS INTEGER, m AS QUAD)

    LOCAL j, k, p, q AS INTEGER
    IF i > n THEN
        INCR m
        FOR k = 1 TO n : PRINT a(k); : NEXT : PRINT
    ELSE
        FOR j = i TO n
            k = a(j)
            p = i - k + n
            q = i + k - 1
            IF u(p) AND v(q) THEN
                u(p) = 0 : v(q) = 0
                a(j) = a(i) : a(i) = k
                CALL aux(n, i + 1, a(), u(), v(), m)
                u(p) = 1 : v(q) = 1
                a(i) = a(j) : a(j) = k
            END IF
        NEXT
    END IF
END SUB

FUNCTION PBMAIN () AS LONG
    LOCAL n, i AS INTEGER
    LOCAL m AS QUAD
    IF COMMAND$(1) <> "" THEN
        n = VAL(COMMAND$(1))
        REDIM a(1 TO n) AS INTEGER
        REDIM u(1 TO 2 * n - 1) AS INTEGER
        REDIM v(1 TO 2 * n - 1) AS INTEGER
        FOR i = 1 TO n
            a(i) = i
        NEXT
        FOR i = 1 TO 2 * n - 1
            u(i) = 1
            v(i) = 1
        NEXT
        m = 0
        CALL aux(n, 1, a(), u(), v(), m)
        PRINT m
    END IF
END FUNCTION


function PlaceQueen ( [ref]$Board, $Row, $N )
    {
    #  For the current row, start with the first column
    $Board.Value[$Row] = 0

    #  While haven't exhausted all columns in the current row...
    While ( $Board.Value[$Row] -lt $N )
        {
        #  If not the first row, check for conflicts
        $Conflict = $Row -and
                    (   (0..($Row-1)).Where{ $Board.Value[$_] -eq $Board.Value[$Row] }.Count -or
                        (0..($Row-1)).Where{ $Board.Value[$_] -eq $Board.Value[$Row] - $Row + $_ }.Count -or
                        (0..($Row-1)).Where{ $Board.Value[$_] -eq $Board.Value[$Row] + $Row - $_ }.Count )

        #  If no conflicts and the current column is a valid column...
        If ( -not $Conflict -and $Board.Value[$Row] -lt $N )
            {

            #  If this is the last row
            #    Board completed successfully
            If ( $Row -eq ( $N - 1 ) )
                {
                return $True
                }

            #  Recurse
            #  If all nested recursions were successful
            #    Board completed successfully
            If ( PlaceQueen $Board ( $Row + 1 ) $N )
                {
                return $True
                }
            }

        #  Try the next column
        $Board.Value[$Row]++
        }

    #  Everything was tried, nothing worked
    Return $False
    }

function Get-NQueensBoard ( $N )
    {
    #  Start with a default board (array of column positions for each row)
    $Board = @( 0 ) * $N

    #  Place queens on board
    #  If successful...
    If ( PlaceQueen -Board ([ref]$Board) -Row 0 -N $N )
        {
        #  Convert board to strings for display
        $Board | ForEach { ( @( "" ) + @(" ") * $_ + "Q" + @(" ") * ( $N - $_ ) ) -join "|" }
        }
    Else
        {
        "There is no solution for N = $N"
        }
    }


int n = 8;
int[] b = new int[n];
int s = 0;
int y = 0;

void setup() {
  size(400, 400);
  textAlign(CENTER, CENTER);
  textFont(createFont("DejaVu Sans", 44));
  b[0] = -1;
}

void draw() {
  if (y >= 0) {
    do {
      b[y]++;
    } while ((b[y] < n) && unsafe(y));
    if (b[y] < n) {
      if (y < (n-1)) {
        b[++y] = -1;
      } else {
        drawBoard();
      }
    } else {
      y--;
    }
  } else {
    textSize(18);
    text("Press any key to restart", width / 2, height - 20);
  }
}

boolean unsafe(int y) {
  int x = b[y];
  for (int i = 1; i <= y; i++) {
    int t = b[y - i];
    if (t == x ||
      t == x - i ||
      t == x + i) {
      return true;
    }
  }
  return false;
}

void drawBoard() {
  float w = width / n;
  for (int y = 0; y < n; y++) {
    for (int x = 0; x < n; x++) {
      fill(255 * ((x + y) % 2));
      square(x * w, y * w, w);
      if (b[y] == x) {
        fill(255 - 255 * ((x + y) % 2));
        textSize(42);
        text("♕", w / 2 +  x *w, w /2 + y * w);
      }
    }
  }
  fill(255, 0, 0);
  textSize(18);
  text("Solution " + (++s), width / 2, height / 90);
}

void keyPressed() {
  b = new int[n];
  s = 0;
  y = 0;
  b[0] = -1;
}


solution([]).

solution([X/Y|Others]) :-
 solution(Others),
 member(Y, [1,2,3,4,5,6,7,8]),
 noattack(X/Y, Others).

noattack(_,[]).

noattack(X/Y,[X1/Y1|Others]) :-
 Y =\= Y1,
 Y1 - Y =\= X1 - X,
 Y1 - Y =\= X - X1,
 noattack(X/Y,Others).

member(Item,[Item|Rest]).

member(Item,[First|Rest]) :-
 member(Item,Rest).

template([1/Y1,2/Y2,3/Y3,4/Y4,5/Y5,6/Y6,7/Y7,8/Y8]).


/*
 n-queens.pure
 Tectonics:
     pure -c queens.pure -o queens
  or
     pure -q -i queens.pure
*/
using system;

queens n = search n 1 [] with
   search n i p  = [reverse p] if i>n;
                 = cat [search n (i+1) ((i,j):p) | j = 1..n; safe (i,j) p];
   safe (i,j) p  = ~any (check (i,j)) p;
   check (i1,j1) (i2,j2)
                 = i1==i2 || j1==j2 || i1+j1==i2+j2 || i1-j1==i2-j2;
end;

compiling || (puts("queens 4: " + str(queens 4)) $$
              puts("Solutions to queens 7: " + str(#queens 7)));


Global solutions

Procedure showBoard(Array queenCol(1))
  Protected row, column, n = ArraySize(queenCol())

  PrintN(" Solution " + Str(solutions))
  For row = 0 To n
    For column = 0 To n
      If queenCol(row) = column
        Print("|Q")
      Else
        Print("| ")
      EndIf
    Next
    PrintN("|")
  Next
EndProcedure

Macro advanceIfPossible()
  x + 1
  While x <= n And columns(x): x + 1: Wend
  If x > n
    ProcedureReturn #False ;backtrack
  EndIf
EndMacro

Procedure placeQueens(Array queenCol(1), Array columns(1), row = 0)
  Protected n = ArraySize(queenCol())

  If row > n
    solutions + 1
    showBoard(queenCol())
    ProcedureReturn #False ;backtrack
  EndIf

  Protected x, queen, passed
  While columns(x): x + 1: Wend

  ;place a new queen in one of the available columns
  Repeat
    passed = #True
    For queen = 0 To row - 1
      If ((queenCol(queen) - x) = (queen - row)) Or ((queenCol(queen) - x) = -(queen - row))
        advanceIfPossible()
        passed = #False
        Break ;ForNext loop
      EndIf
    Next

    If passed
      queenCol(row) = x: columns(x) = 1
      If Not placeQueens(queenCol(), columns(), row + 1)
        columns(x) = 0
        advanceIfPossible()
      EndIf
    EndIf
  ForEver
EndProcedure

Procedure queens(n)
  If n > 0
    Dim queenCol(n - 1)
    Dim columns(n - 1)
    placeQueens(queenCol(), columns())
  EndIf
EndProcedure

If OpenConsole()
  Define i
  For i = 1 To 12
    solutions = 0
    queens(i)
    PrintN(#CRLF$ + Str(solutions) + " solutions found for " + Str(i) + "-queens.")
    Input()
  Next

  Print(#CRLF$ + "Press ENTER to exit")
  Input()
  CloseConsole()
EndIf


F monte_carlo_pi(n)
   V inside = 0
   L 1..n
      V x = random:()
      V y = random:()
      I x * x + y * y <= 1
         inside++
   R 4.0 * inside / n

print(monte_carlo_pi(1000000))


from itertools import permutations

n = 8
cols = range(n)
for vec in permutations(cols):
    if n == len(set(vec[i]+i for i in cols)) \
         == len(set(vec[i]-i for i in cols)):
        print ( vec )


*        Monte Carlo methods       08/03/2017
MONTECAR CSECT
         USING  MONTECAR,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R8,1000            isamples=1000
         LA     R6,4               i=4
       DO WHILE=(C,R6,LE,=F'7')    do i=4 to 7
         MH     R8,=H'10'            isamples=isamples*10
         ZAP    HITS,=P'0'           hits=0
         LA     R7,1                 j=1
       DO WHILE=(CR,R7,LE,R8)        do j=1 to isamples
         BAL    R14,RNDPK              call random
         ZAP    X,RND                  x=rnd
         BAL    R14,RNDPK              call random
         ZAP    Y,RND                  y=rnd
         ZAP    WP,X                   x
         MP     WP,X                   x**2
         DP     WP,ONE                 ~
         ZAP    XX,WP(8)               x**2   normalized
         ZAP    WP,Y                   y
         MP     WP,Y                   y**2
         DP     WP,ONE                 ~
         ZAP    YY,WP(8)               y**2   normalized
         AP     XX,YY                  xx=x**2+y**2
       IF CP,XX,LT,ONE THEN            if x**2+y**2<1 then
         AP     HITS,=P'1'               hits=hits+1
       ENDIF    ,                      endif
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         CVD    R8,PSAMPLES          psamples=isamples
         ZAP    WP,=P'4'             4
         MP     WP,ONE               ~
         MP     WP,HITS              *hits
         DP     WP,PSAMPLES          /psamples
         ZAP    MCPI,WP(8)           mcpi=4*hits/psamples
         XDECO  R6,WC                edit i
         MVC    PG+4(1),WC+11        output i
         MVC    WC,MASK              load mask
         ED     WC,PSAMPLES          edit psamples
         MVC    PG+6(8),WC+8         output psamples
         UNPK   WC,MCPI              unpack mcpi
         OI     WC+15,X'F0'          zap sign
         MVC    PG+31(1),WC+6        output mcpi
         MVC    PG+33(6),WC+7        output mcpi decimals
         XPRNT  PG,L'PG              print buffer
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         L      R13,4(0,R13)       restore previous savearea pointer
         LM     R14,R12,12(R13)    restore previous context
         XR     R15,R15            rc=0
         BR     R14                exit
RNDPK    EQU    *             ---- random number generator
         ZAP    WP,RNDSEED         w=seed
         MP     WP,RNDCNSTA        w*=cnsta
         AP     WP,RNDCNSTB        w+=cnstb
         MVC    RNDSEED,WP+8       seed=w mod 10**15
         MVC    RND,=PL8'0'        0<=rnd<1
         MVC    RND+3(5),RNDSEED+3 return rnd
         BR     R14           ---- return
PSAMPLES DS     0D,PL8             F(15,0)
RNDSEED  DC     PL8'613058151221121'  linear congruential constant
RNDCNSTA DC     PL8'944021285986747'  "
RNDCNSTB DC     PL8'852529586767995'  "
RND      DS     PL8                fixed(15,9)
ONE      DC     PL8'1.000000000'   1 fixed(15,9)
HITS     DS     PL8                fixed(15,0)
X        DS     PL8                fixed(15,9)
Y        DS     PL8                fixed(15,9)
MCPI     DS     PL8                fixed(15,9)
XX       DS     PL8                fixed(15,9)
YY       DS     PL8                fixed(15,9)
PG       DC     CL80'10**x xxxxxxxx samples give Pi=x.xxxxxx'  buffer
MASK     DC     X'40202020202020202020202020202120'  mask CL16 15num
WC       DS     PL16               character 16
WP       DS     PL16               packed decimal 16
         YREGS
         END    MONTECAR


INCLUDE "H6:REALMATH.ACT"

DEFINE PTR="CARD"
DEFINE REAL_SIZE="6"
BYTE ARRAY realArray(1536)

PTR FUNC RealArrayPointer(BYTE i)
  PTR p

  p=realArray+i*REAL_SIZE
RETURN (p)

PROC InitRealArray()
  REAL r2,r255,ri,div
  REAL POINTER pow
  INT i

  IntToReal(2,r2)
  IntToReal(255,r255)

  FOR i=0 TO 255
  DO
    IntToReal(i,ri)
    RealDiv(ri,r255,div)
    pow=RealArrayPointer(i)
    Power(div,r2,pow)
  OD
RETURN

PROC CalcPi(INT n REAL POINTER pi)
  BYTE x,y
  INT i,counter
  REAL tmp1,tmp2,tmp3,r1,r4
  REAL POINTER pow

  counter=0
  IntToReal(1,r1)
  IntToReal(4,r4)

  FOR i=1 TO n
  DO
    x=Rand(0)
    pow=RealArrayPointer(x)
    RealAssign(pow,tmp1)

    y=Rand(0)
    pow=RealArrayPointer(y)
    RealAssign(pow,tmp2)

    RealAdd(tmp1,tmp2,tmp3)

    IF RealGreaterOrEqual(tmp3,r1)=0 THEN
      counter==+1
    FI
  OD

  IntToReal(counter,tmp1)
  RealMult(r4,tmp1,tmp2)
  IntToReal(n,tmp3)
  RealDiv(tmp2,tmp3,pi)
RETURN

PROC Test(INT n)
  REAL pi

  PrintF("%I samples -> ",n)
  CalcPi(n,pi)
  PrintRE(pi)
RETURN

PROC Main()
  Put(125) PutE() ;clear the screen

  PrintE("Initialization of data...")
  InitRealArray()

  Test(10)
  Test(100)
  Test(1000)
  Test(10000)
RETURN


with Ada.Text_IO;                use Ada.Text_IO;
with Ada.Numerics.Float_Random;  use Ada.Numerics.Float_Random;

procedure Test_Monte_Carlo is
   Dice : Generator;

   function Pi (Throws : Positive) return Float is
      Inside : Natural := 0;
   begin
      for Throw in 1..Throws loop
         if Random (Dice) ** 2 + Random (Dice) ** 2 <= 1.0 then
            Inside := Inside + 1;
         end if;
      end loop;
      return 4.0 * Float (Inside) / Float (Throws);
   end Pi;
begin
   Put_Line ("     10_000:" & Float'Image (Pi (     10_000)));
   Put_Line ("    100_000:" & Float'Image (Pi (    100_000)));
   Put_Line ("  1_000_000:" & Float'Image (Pi (  1_000_000)));
   Put_Line (" 10_000_000:" & Float'Image (Pi ( 10_000_000)));
   Put_Line ("100_000_000:" & Float'Image (Pi (100_000_000)));
end Test_Monte_Carlo;


DIM SHARED queens AS INTEGER
CLS
COLOR 15
INPUT "Numero de reinas"; queens
IF queens <= 0 THEN END

CLS
PRINT "queens: Calcula el problema de las"; queens; " reinas."
DIM SHARED arrayqcol(queens) AS LONG ' columnas de reinas
DIM SHARED nsoluciones AS LONG

dofila (1)' comenzar en la fila 1
COLOR 14: LOCATE 6 + (2 * queens), 1: PRINT "Hay " + STR$(nsoluciones) + " soluciones"
END

SUB dofila (ifila) ' comienza con la fila de abajo
    FOR icol = 1 TO queens
        FOR iqueen = 1 TO ifila - 1 ' Comprueba conflictos con las reinas anteriores
            IF arrayqcol(iqueen) = icol THEN GOTO continue1 ' misma columna?
            ' iqueen también es fila de la reina
            IF iqueen + arrayqcol(iqueen) = ifila + icol THEN GOTO continue1 ' diagonal derecha?
            IF iqueen - arrayqcol(iqueen) = ifila - icol THEN GOTO continue1 ' diagonal izquierda?
        NEXT iqueen
        ' En este punto podemos añadir una reina
        arrayqcol(ifila) = icol ' añadir al array
        COLOR 8
        LOCATE ifila + 2, icol: PRINT "x"; ' mostrar progreso

        COLOR 15
        IF ifila = queens THEN ' solucion?
            nsoluciones = nsoluciones + 1
            LOCATE 4 + queens, 1: PRINT "Solucion #" + STR$(nsoluciones)
            FOR i1 = 1 TO queens ' filas
                s1$ = STRING$(queens, ".") ' columnas
                MID$(s1$, arrayqcol(i1), 1) = "Q" ' Q en la columna reina
                PRINT s1$
            NEXT i1
            PRINT ""
        ELSE
            dofila (ifila + 1)' llamada recursiva a la siguiente fila
        END IF
        COLOR 7: LOCATE ifila + 2, icol: PRINT "."; ' quitar reina
continue1:
    NEXT icol
END SUB


PROC pi = (INT throws)REAL:
BEGIN
   INT inside := 0;
   TO throws DO
      IF random ** 2 + random ** 2 <= 1 THEN
         inside +:= 1
      FI
   OD;
   4 * inside / throws
END # pi #;

print (("     10 000:",pi (     10 000),new line));
print (("    100 000:",pi (    100 000),new line));
print (("  1 000 000:",pi (  1 000 000),new line));
print ((" 10 000 000:",pi ( 10 000 000),new line));
print (("100 000 000:",pi (100 000 000),new line))


Pi: function [throws][
    inside: new 0.0
    do.times: throws [
        if 1 > hypot random 0 1.0 random 0 1.0 -> inc 'inside
    ]
    return 4 * inside / throws
]

loop [100 1000 10000 100000 1000000] 'n ->
    print [pad to :string n 8 "=>" Pi n]


DIM SHARED QUEENS AS INTEGER
PRINT "# of queens:";: INPUT QUEENS
IF QUEENS = 0 THEN END
OPEN LTRIM$(STR$(QUEENS)) + "queens.dat" FOR OUTPUT AS #1
PRINT "Queens: Calculates"; QUEENS; " queens problem."
DIM SHARED arrayqcol(QUEENS) AS LONG ' columns of queens
DIM SHARED nsolutions AS LONG
CALL dorow(1) ' start with row 1
LOCATE 22, 1
PRINT STR$(nsolutions) + " solutions"
END
SUB dorow (irow) ' starts with row irow
    FOR icol = 1 TO QUEENS
        FOR iqueen = 1 TO irow - 1 ' check for conflict with previous queens
            IF arrayqcol(iqueen) = icol THEN GOTO continue1 ' same column?
            ' iqueen is also row of queen
            IF iqueen + arrayqcol(iqueen) = irow + icol THEN GOTO continue1 ' right diagonal?
            IF iqueen - arrayqcol(iqueen) = irow - icol THEN GOTO continue1 ' left diagonal?
        NEXT iqueen
        ' at this point we can add a queen
        arrayqcol(irow) = icol ' add to array
        LOCATE irow + 2, icol: PRINT "x"; ' show progress
        _DELAY (.001) ' slows processing
        IF irow = QUEENS THEN ' solution?
            nsolutions = nsolutions + 1
            PRINT #1, "Solution #" + MID$(STR$(nsolutions), 2) + "."
            FOR i1 = 1 TO QUEENS ' rows
                s1$ = STRING$(QUEENS, ".") ' columns
                MID$(s1$, arrayqcol(i1), 1) = "x" ' x in queen column
                PRINT #1, s1$
            NEXT i1
            PRINT #1, ""
        ELSE
            CALL dorow(irow + 1) ' recursive call to next row
        END IF
        LOCATE irow + 2, icol: PRINT "."; ' remove queen
        continue1:
    NEXT icol
END SUB


# --- with command line argument "throws" ---

BEGIN{ th=ARGV[1];
 for(i=0; i<th; i++) cin += (rand()^2 + rand()^2) < 1
 printf("Pi = %8.5f\n",4*cin/th)
}

usage: awk -f pi 2300

Pi =  3.14333


DECLARE FUNCTION getPi! (throws!)
CLS
PRINT getPi(10000)
PRINT getPi(100000)
PRINT getPi(1000000)
PRINT getPi(10000000)

FUNCTION getPi (throws)
	inCircle = 0
		FOR i = 1 TO throws
			'a square with a side of length 2 centered at 0 has
			'x and y range of -1 to 1
			randX = (RND * 2) - 1'range -1 to 1
			randY = (RND * 2) - 1'range -1 to 1
			'distance from (0,0) = sqrt((x-0)^2+(y-0)^2)
			dist = SQR(randX ^ 2 + randY ^ 2)
			IF dist < 1 THEN 'circle with diameter of 2 has radius of 1
				inCircle = inCircle + 1
			END IF
		NEXT i
	getPi = 4! * inCircle / throws
END FUNCTION


# Monte Carlo Simulator
# Determine value of pi
# 21010513

tosses = 1000
in_c = 0
i = 0

for i = 1 to tosses
     x = rand
     y = rand
     x2 = x * x
     y2 = y * y
     xy = x2 + y2
     d_xy = sqr(xy)
     if d_xy <= 1 then
         in_c += 1
     endif
next i

print float(4*in_c/tosses)


      PRINT FNmontecarlo(1000)
      PRINT FNmontecarlo(10000)
      PRINT FNmontecarlo(100000)
      PRINT FNmontecarlo(1000000)
      PRINT FNmontecarlo(10000000)
      END

      DEF FNmontecarlo(t%)
      LOCAL i%, n%
      FOR i% = 1 TO t%
        IF RND(1)^2 + RND(1)^2 < 1 n% += 1
      NEXT
      = 4 * n% / t%


#include <stdio.h>
#include <stdlib.h>
#include <math.h>

double pi(double tolerance)
{
	double x, y, val, error;
	unsigned long sampled = 0, hit = 0, i;

	do {
		/* don't check error every turn, make loop tight */
		for (i = 1000000; i; i--, sampled++) {
			x = rand() / (RAND_MAX + 1.0);
			y = rand() / (RAND_MAX + 1.0);
			if (x * x + y * y < 1) hit ++;
		}

		val = (double) hit / sampled;
		error = sqrt(val * (1 - val) / sampled) * 4;
		val *= 4;

		/* some feedback, or user gets bored */
		fprintf(stderr, "Pi = %f +/- %5.3e at %ldM samples.\r",
			val, error, sampled/1000000);
	} while (!hit || error > tolerance);
              /* !hit is for completeness's sake; if no hit after 1M samples,
                 your rand() is BROKEN */

	return val;
}

int main()
{
	printf("Pi is %f\n", pi(3e-4)); /* set to 1e-4 for some fun */
	return 0;
}


#lang racket

(struct Q (x y) #:transparent)

;; returns true if given q1 and q2 do not conflict
(define (safe? q1 q2)
  (match* (q1 q2)
    [((Q x1 y1) (Q x2 y2))
     (not (or (= x1 x2) (= y1 y2)
              (= (abs (- x1 x2)) (abs (- y1 y2)))))]))

;; returns true if given q doesn't conflict with anything in given list of qs
(define (safe-lst? q qs) (for/and ([q2 qs]) (safe? q q2)))

(define (nqueens n)
  ;; qs is partial solution; x y is current position to try
  (let loop ([qs null] [x 0] [y 0])
    (cond [(= (length qs) n) qs]          ; found a solution
          [(>= x n) (loop qs 0 (add1 y))] ; go to next row
          [(>= y n) #f]                   ; current solution is invalid
          [else
           (define q (Q x y))
           (if (safe-lst? q qs) ; is current position safe?
               (or (loop (cons q qs) 0 (add1 y)) ; optimistically place a queen
                                                 ; (and move pos to next row)
                   (loop qs (add1 x) y))  ; backtrack if it fails
               (loop qs (add1 x) y))])))

(nqueens 8)
; => (list (Q 3 7) (Q 1 6) (Q 6 5) (Q 2 4) (Q 5 3) (Q 7 2) (Q 4 1) (Q 0 0))


using System;

class Program {
    static double MonteCarloPi(int n) {
        int inside = 0;
        Random r = new Random();

        for (int i = 0; i < n; i++) {
            if (Math.Pow(r.NextDouble(), 2)+ Math.Pow(r.NextDouble(), 2) <= 1) {
                inside++;
            }
        }

        return 4.0 * inside / n;
    }

    static void Main(string[] args) {
        int value = 1000;
        for (int n = 0; n < 5; n++) {
            value *= 10;
            Console.WriteLine("{0}:{1}", value.ToString("#,###").PadLeft(11, ' '), MonteCarloPi(value));
        }
    }
}


#include<iostream>
#include<math.h>
#include<stdlib.h>
#include<time.h>

using namespace std;
int main(){
    int jmax=1000; // maximum value of HIT number. (Length of output file)
    int imax=1000; // maximum value of random numbers for producing HITs.
    double x,y;    // Coordinates
    int hit;       // storage variable of number of HITs
    srand(time(0));
    for (int j=0;j<jmax;j++){
        hit=0;
        x=0; y=0;
        for(int i=0;i<imax;i++){
            x=double(rand())/double(RAND_MAX);
            y=double(rand())/double(RAND_MAX);
        if(y<=sqrt(1-pow(x,2))) hit+=1; }          //Choosing HITs according to analytic formula of circle
    cout<<""<<4*double(hit)/double(imax)<<endl; }  // Print out Pi number
}


sub MAIN(\N = 8) {
    sub collision(@field, $row) {
        for ^$row -> $i {
            my $distance = @field[$i] - @field[$row];
            return True if $distance == any(0, $row - $i, $i - $row);
        }
        False;
    }
    sub search(@field, $row) {
        return @field if $row == N;
        for ^N -> $i {
            @field[$row] = $i;
            return search(@field, $row + 1) || next
                unless collision(@field, $row);
        }
        ()
    }
    for 0 .. N / 2 {
        if search [$_], 1 -> @f {
            say @f;
            last;
        }
    }
}


(defn calc-pi [iterations]
  (loop [x (rand) y (rand) in 0 total 1]
    (if (< total iterations)
      (recur (rand) (rand) (if (<= (+ (* x x) (* y y)) 1) (inc in) in) (inc total))
      (double (* (/ in total) 4)))))

(doseq [x (take 5 (iterate #(* 10 %) 10))] (println (str (format "% 8d" x) ": " (calc-pi x))))


(defun approximate-pi (n)
  (/ (loop repeat n count (<= (abs (complex (random 1.0) (random 1.0))) 1.0)) n 0.25))

(dolist (n (loop repeat 5 for n = 1000 then (* n 10) collect n))
  (format t "~%~8d -> ~f" n (approximate-pi n)))


def approx_pi(throws)
  times_inside = throws.times.count {Math.hypot(rand, rand) <= 1.0}
  4.0 * times_inside / throws
end

[1000, 10_000, 100_000, 1_000_000, 10_000_000].each do |n|
   puts "%8d samples: PI = %s" % [n, approx_pi(n)]
end


import Prelude;

public set[list[int]] Nqueens(int n){
	cols = upTill(n);
	result = {};
	for (vector <- permutations(cols)){
		if (n == size({vector[j] + j |j <- cols}) && n == size({vector[j] - j |j <- cols}))
			result += vector;}
	return result;
}


import std.stdio, std.random, std.math;

double pi(in uint nthrows) /*nothrow*/ @safe /*@nogc*/ {
    uint inside;
    foreach (immutable i; 0 .. nthrows)
        if (hypot(uniform01, uniform01) <= 1)
            inside++;
    return 4.0 * inside / nthrows;
}

void main() {
    foreach (immutable p; 1 .. 8)
        writefln("%10s: %07f", 10 ^^ p, pi(10 ^^ p));
}


import 'dart:async';
import 'dart:html';
import 'dart:math' show Random;

// We changed 5 lines of code to make this sample nicer on
// the web (so that the execution waits for animation frame,
// the number gets updated in the DOM, and the program ends
// after 500 iterations).

main() async {
  print('Compute π using the Monte Carlo method.');
  var output = querySelector("#output");
  await for (var estimate in computePi().take(500)) {
    print('π ≅ $estimate');
    output.text = estimate.toStringAsFixed(5);
    await window.animationFrame;
  }
}

/// Generates a stream of increasingly accurate estimates of π.
Stream<double> computePi({int batch: 100000}) async* {
  var total = 0;
  var count = 0;
  while (true) {
    var points = generateRandom().take(batch);
    var inside = points.where((p) => p.isInsideUnitCircle);
    total += batch;
    count += inside.length;
    var ratio = count / total;
    // Area of a circle is A = π⋅r², therefore π = A/r².
    // So, when given random points with x ∈ <0,1>,
    // y ∈ <0,1>, the ratio of those inside a unit circle
    // should approach π / 4. Therefore, the value of π
    // should be:
    yield ratio * 4;
  }
}

Iterable<Point> generateRandom([int seed]) sync* {
  final random = new Random(seed);
  while (true) {
    yield new Point(random.nextDouble(), random.nextDouble());
  }
}

class Point {
  final double x, y;
  const Point(this.x, this.y);
  bool get isInsideUnitCircle => x * x + y * y <= 1;
}


def pi(n) {
    var inside := 0
    for _ ? (entropy.nextFloat() ** 2 + entropy.nextFloat() ** 2 < 1) in 1..n {
         inside += 1
    }
    return inside * 4 / n
}


/*REXX program  places   N   queens on an  NxN  chessboard  (the eight queens problem). */
parse arg N .                                    /*obtain optional argument from the CL.*/
if N=='' | N==","  then N= 8                     /*Not specified:  Then use the default.*/
if N<1             then call nOK                 /*display a message, the board is bad. */
rank= 1;           file= 1;               #= 0   /*starting rank&file;  #≡number queens.*/
@.= 0;             pad= left('', 9* (N<18) )     /*define empty board;  set indentation.*/
                                                 /* [↓]  rank&file ≡ chessboard row&cols*/
  do  while #<N;     @.file.rank= 1              /*keep placing queens until we're done.*/
  if ok(file, rank)  then do; file= 1;    #= #+1 /*Queen not being attacked? Then eureka*/
                              rank= rank+1       /*use another attempt at another rank. */
                              iterate            /*go and try another queen placement.  */
                          end                    /* [↑]  found a good queen placement.  */
  @.file.rank= 0                                 /*It isn't safe.  So remove this queen.*/
  file= file + 1                                 /*So, try the next (higher) chess file.*/
                 do  while file>N;    rank= rank - 1;            if rank==0  then call nOK
                    do j=1  for N;    if \@.j.rank  then iterate             /*¿ocupado?*/
                    @.j.rank= 0;      #= # - 1;     file= j + 1;     leave
                    end  /*j*/
                 end     /*while file>N*/
  end                    /*while    #<N*/
call show                                        /*display the chess board with queens. */
exit  1                                          /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
nOK: say;      say  "No solution for"      N      'queens.';          say;          exit 0
/*──────────────────────────────────────────────────────────────────────────────────────*/
ok:  parse arg f,r;  fp= f + 1;   rm= r - 1      /*if return≡0,  then queen isn't safe. */
              do k=1          for rm;               if @.f.k  then return 0;           end
     f= f-1;  do k=rm  by -1  for rm  while f\==0;  if @.f.k  then return 0;  f= f-1;  end
     f= fp;   do k=rm  by -1  for rm  while f <=N;  if @.f.k  then return 0;  f= f+1;  end
     return 1   /*1≡queen is safe. */            /*  ↑↑↑↑↑↑↑↑    is queen under attack? */
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: say  'A solution for '     N     " queens:"     /*display a title to the terminal.*/
      g= substr( copies("╬═══",  N)  ,2)              /*start of all cells on chessboard*/
      say;      say pad  translate('╔'g"╗", '╦', "╬") /*display top rank (of the board).*/
      line   = '╠'g"╣";   dither= "▓";   ditherQ= '░' /*define a line for cell boundary.*/
      bar    = '║'    ;   queen = "Q"                 /*kinds:   horiz.,  vert.,  salad.*/
      Bqueen = ditherQ  ||  queen  ||  ditherQ        /*glyph befitting a black square Q*/
      Wqueen =           ' 'queen" "                  /*  "       "     " white    "   "*/
        do   rank=1  for N;     if rank\==1  then say pad line;    _=  /*show rank sep. */
          do file=1  for N
          B = (file + rank) // 2                      /*Is the square black ?  Then B=1.*/
          if  B          then Qgylph= Bqueen          /*if black square, use dithered Q.*/
                         else Qgylph= Wqueen          /* " white    "     "   white   " */
          if @.file.rank then _= _ || bar || Qgylph   /*Has queen? Use a 3─char Q symbol*/
                         else if B then _=_ || bar || copies(dither,3) /*dithering      */
                                   else _=_ || bar || copies(  ' ' ,3) /* 3 blanks      */
          end   /*file*/                              /* [↑]  preserve square─ish board.*/
        say pad  _ || bar                             /*show a single rank of the board.*/
        end     /*rank*/                              /*80 cols  can view a 19x19 board.*/
      say pad  translate('╚'g"╝", '╩', "╬");   return /*display the last rank (of board)*/


func mc n . .
  for i range n
    x = randomf
    y = randomf
    if x * x + y * y < 1
      hit += 1
    .
  .
  print 4.0 * hit / n
.
fscale 4
call mc 10000
call mc 100000
call mc 1000000
call mc 10000000


defmodule MonteCarlo do
  def pi(n) do
    count = Enum.count(1..n, fn _ ->
      x = :rand.uniform
      y = :rand.uniform
      :math.sqrt(x*x + y*y) <= 1
    end)
    4 * count / n
  end
end

Enum.each([1000, 10000, 100000, 1000000, 10000000], fn n ->
  :io.format "~8w samples: PI = ~f~n", [n, MonteCarlo.pi(n)]
end)


-module(monte).
-export([main/1]).

monte(N)->
    monte(N,0,0).

monte(0,InCircle,NumPoints) ->
    4 * InCircle / NumPoints;

monte(N,InCircle,NumPoints)->
    Xcoord = rand:uniform(),
    Ycoord = rand:uniform(),
    monte(N-1,
          if Xcoord*Xcoord + Ycoord*Ycoord < 1 -> InCircle + 1; true -> InCircle end,
          NumPoints + 1).

main(N) -> io:format("PI: ~w~n", [ monte(N) ]).


// Bert Mariani 2020-07-17

See "Enter value of N : "  Give n             // Ask User for Size of Board
n = 0 + n
x = 1:n
See "Possible placements: Value as Column of the Row "+ nl

nQueen(1,n)          //===>>>  START

See nl+ nl+"Enter to Exit program: "  Give m       // To Exit CMD window

//================================
// Returns true only and only if two queens can be placed in same row or column

Func Place(k,i)

   for j = 1 to k-1
      if( x[j] = i   OR                  //two queens in same row
         fabs(x[j]-i) = fabs(j-k) )     //two queens in same diagonal
         return 0;
      ok
   next

return 1;

//================================

Func nQueen(k,n)

   for i = 1 to n
      if(place(k,i))        //===>>>  Call
         x[k] = i
         if(k=n)
            See nl
            for i = 1 to n
               See " "+ x[i]
            next
         else
            nQueen(k+1,n)   //===>>>  RECURSION
         ok
      ok
   next

return

//================================


PROGRAM RANDOM_PI

!
! for rosettacode.org
!

!$DOUBLE

PROCEDURE MONTECARLO(T->RES)
      LOCAL I,N
      FOR I=1 TO T DO
        IF RND(1)^2+RND(1)^2<1 THEN N+=1 END IF
      END FOR
      RES=4*N/T
END PROCEDURE

BEGIN
      RANDOMIZE(TIMER) ! init rnd number generator
      MONTECARLO(1000->RES)     PRINT(RES)
      MONTECARLO(10000->RES)    PRINT(RES)
      MONTECARLO(100000->RES)   PRINT(RES)
      MONTECARLO(1000000->RES)  PRINT(RES)
      MONTECARLO(10000000->RES) PRINT(RES)
END PROGRAM