solve-queens-2.lisp

(defun solve-queens (n)
  (declare (fixnum n))
  (let ((res 0)
        (queens (make-array (* 2 n) :fill-pointer 0 :element-type 'fixnum)))
    (declare (fixnum res) (dynamic-extent queens))
    (labels ((put (row)
               (declare (fixnum row))
               (if (> row n)
                 (incf res)
                 (loop for col fixnum from 1 to n do
                   (loop named try-safe
                         with len fixnum = (length queens)
                         for i fixnum from 0 below len by 2
                         as row* fixnum = (aref queens i)
                         as col* fixnum = (aref queens (+ 1 i))
                         when (or (= row row*) (= col col*)
                                  (= (abs (- row row*)) (abs (- col col*))))
                           return (values)
                         finally
                         (progn
                           (vector-push row queens)
                           (vector-push col queens)
                           (put (1+ row))
                           (decf (fill-pointer queens) 2)))))))
      (put 1)
      res)))

solve-queens-2.ss

(define (solve-queens N)
  (define > fx>)
  (define - fx-)
  (define + fx+)
  (define = fx=)
  (define (/= x y) (not (= x y)))
  (define (1+ x)
    (fx+ 1 x))
  (define (abs x) (if (< x 0) (- x) x))
  (define (for-each-int from to f)
    (if (> from to)
      'done
      (begin (f from) (for-each-int (1+ from) to f))))
  (define points (make-fxvector (* 2 N)))
  (define points-length 0)
  (let ((cnt 0))
    (define (put row)
      (if (> row N)
        (set! cnt (1+ cnt))
        (for-each-int 1 N
          (lambda (col)
            (define (check-safe i)
              (if (< i points-length)
                (let ((row* (fxvector-ref points i))
                      (col* (fxvector-ref points (+ 1 i))))
                  (when (and (/= row row*) (/= col col*)
                             (/= (abs (- row row*)) (abs (- col col*))))
                    (check-safe (+ 2 i))))
                ;; if safe
                (begin
                  (fxvector-set! points points-length row)
                  (fxvector-set! points (1+ points-length) col)
                  (set! points-length (+ 2 points-length))
                  (put (1+ row))
                  (set! points-length (- points-length 2)))))
            (check-safe 0)))))
    (put 1)
    cnt))

solve-queens-3-2.lisp

(deftype ufixnum () '(and fixnum unsigned-byte))

(defun solve-queens (n)
  (declare (type ufixnum n))
  (let ((full (- (expt 2 n) 1))
        (count 0))
    (declare (type ufixnum full count))
    (labels ((put (row diag adiag)
               (declare (type ufixnum row diag adiag))
               (cond ((= row full)
                      (incf count))
                     (t (dotimes (i n)
                          (let ((the-bit (expt 2 i)))
                            (declare (ufixnum the-bit))
                            (when (= 0 (logand row the-bit)
                                       (logand diag the-bit)
                                       (logand adiag the-bit))
                              (put (ash (logior row the-bit) 0)
                                   (ash (logior diag the-bit) 1)
                                   (ash (logior adiag the-bit) -1)))))))))
      (put 0 0 0)
      count)))

solve-queens-3.c

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

#define N 15
#define FULL ((1 << N) - 1)

static unsigned put(
    unsigned count, unsigned row, unsigned diag, unsigned adiag
) {
  if (row == FULL) return count + 1;

  for (unsigned i = 0; i < N; i++) {
    unsigned bit = 1 << i;
    if (!(row & bit) && !(diag & bit) && !(adiag & bit))
      count = put(
          count, row | bit, (diag | bit) << 1, (adiag | bit) >> 1
      );
  }
  return count;
}

int main(int argc, char *argv[]) {
  printf("%u\n", put(0, 0, 0, 0));
  return 0;
}

solve-queens-3.clj

(defn solve-queen [^long n]
  (let [full (long (- (bit-shift-left 1 n) 1))]
    (letfn [(put [^long cnt, ^long row, ^long diag, ^long adiag]
              (if (= row full)
                (+ cnt 1)
                (loop [cnt cnt i 0]
                  (if (= i n)
                    cnt
                    (recur
                      (let [bit (long (bit-shift-left 1 i))]
                        (if (= 0 (bit-and bit row) (bit-and bit diag)
                                 (bit-and bit adiag))
                          (put cnt (bit-or bit row)
                                   (bit-shift-left (bit-or bit diag) 1)
                                   (bit-shift-right (bit-or bit adiag) 1))
                          cnt))
                      (long (+ 1 i)))))))]
      (put 0 0 0 0))))

solve-queens-3.hs

import Data.Bits

solveQueens :: Int -> Int

solveQueens n = put (0 :: Int) (0 :: Int) (0 :: Int) (0 :: Int)
  where
    full = 2 ^ n - 1
    put count row diag adiag =
      if row == full
      then count + 1
      else loop 0 count
      where
        loop i count =
          let bit = 1 `shift` i in
            if i == n
            then count
            else if (bit .&. row == 0) && (bit .&. diag == 0) && (bit .&. adiag == 0)
                 then loop (i + 1) (put count
                                        (bit .|. row)
                                        ((bit .|. diag) `shift` 1)
                                        ((bit .|. adiag) `shift` (-1)))
                 else loop (i + 1) count

main = do
  print (solveQueens 15)

solve-queens-3.java

class SolveQueens {
        static class Queens {
                private long n;
                private long full;
                private long count;
                void put(long row, long diag, long adiag) {
                        if (row == full) {
                                count += 1;
                                return;
                        }
                        for (long i = 0; i < n; i++) {
                                long bit = 1 << i;
                                if ((bit & row) == 0 && (bit & diag) == 0 &&
                                    (bit & adiag) == 0)
                                {
                                        put(row | bit, (diag | bit) << 1,
                                            (adiag | bit) >>> 1);
                                }
                        }
                };
                public Queens(long _n) {
                        n = _n;
                        full = (1 << n) - 1;
                        count = 0;
                };
                public long solve() {
                        put(0, 0, 0);
                        return count;
                }
        };
        public static void main(String[] args) {
                System.out.println((new Queens(15)).solve());
        }
};

solve-queens-3.lisp

(defun solve-queens (N &aux (full 0))
  (declare (optimize (speed 3) (safety 0) (debug 0) (space 0))
           (type (and fixnum unsigned-byte) full N))
  (dotimes (i N)
    (setf (ldb (byte 1 i) full) 1))
  (labels ((set-bit (val i)
             (the fixnum (logior val (ash 1 i))))
           (put (cnt col diag adiag)
             (declare (type (and fixnum unsigned-byte) cnt col diag adiag)
                      (inline set-bit))
             (when (= full col)
               (return-from put (1+ cnt)))
             (dotimes (i N cnt) ; <-- cnt returns here
               (unless (or (= 1 (ldb (byte 1 i) col))
                           (= 1 (ldb (byte 1 i) diag))
                           (= 1 (ldb (byte 1 i) adiag)))
                 (setf cnt (put cnt (ash (set-bit   col i)  0)
                                    (ash (set-bit  diag i)  1)
                                    (ash (set-bit adiag i) -1)))))))
    (put 0 0 0 0)))

solve-queens-3.lua

function solve_queen(n)
  local full = bit.lshift(1, n) - 1
  local count = 0
  local function put(row, diag, adiag)
    if row == full then
      count = count + 1
      return
    end

    for i = 0, n do
      local the_bit = bit.lshift(1, i)
      if bit.band(row, the_bit) == 0 and
         bit.band(diag, the_bit) == 0 and
         bit.band(adiag, the_bit) == 0
       then
         put(bit.bor(row, the_bit),
             bit.lshift(bit.bor(diag, the_bit), 1),
             bit.rshift(bit.bor(adiag, the_bit), 1)
         )
       end
    end
  end
  put(0, 0, 0)
  return count
end

solve-queens-3.pas

program solve_queens;

const
        N = 15;
        Full = (1 shl N) - 1;

var Count: QWord;

procedure Put(Row, Diag, ADiag: QWord);
var I, Bit: QWord;
begin
        if Row = Full then
        begin
                Count := Count + 1;
                exit;
        end;
        
        for I := 0 to N - 1 do
        begin
                Bit := 1 shl I;
                if (Bit and Row = 0) and (Bit and Diag = 0)
                and (Bit and Adiag = 0)
                then Put(Row or Bit, (Diag or Bit) shl 1, (ADiag or Bit) Shr 1);
        end
end;

begin
        Count := 0;
        Put(0, 0, 0);
        WriteLn(Count)
end.

solve-queens-3.pl

use v5.12;
use strict;

sub solve_queen {
  my $n = shift;
  my $full = (1 << $n) - 1;
  my $count = 0;
  my $put;
  $put = sub {
    my ($row, $diag, $adiag) = @_;
    if ($row == $full) {
      $count++;
      return;
    }
    for (my $i = 0; $i < $n; $i++) {
      my $bit = 1 << $i;
      if (!($bit & $row) && !($bit & $diag) && !($bit & $adiag)) {
        $put->($bit | $row, ($bit | $diag) << 1, ($bit | $adiag) >> 1);
      }
    }
  };
  $put->(0, 0, 0);
  return $count;
}

print(solve_queen(15) . "\n");

solve-queens-3.rb

def solve_queen(n)
  full = (1 << n) - 1
  count = 0
  put = lambda do |row, diag, adiag|
    if row == full then
      count += 1
      return
    end
    n.times do |i|
      bit = 1 << i
      if row & bit == 0 &&
         diag & bit == 0 &&
         adiag & bit == 0
      then
        put.call(row | bit, (diag | bit) << 1, (adiag | bit) >> 1)
      end
    end
  end
  put.call(0, 0, 0)
  count
end

puts solve_queen(15)

solve-queens-3.sml

fun solve_queen(n) =
let
  val n = Word.fromInt n
  open Word
  infix andb orb << >>
  (* now every operator op is Word.op *)
  val full = (0w1 << n) - 0w1
  fun put count row diag adiag =
  let fun loop i count =
    if i = n
    then count
    else let
      val bit = 0w1 << i
      val safe =
        ((bit andb row) = 0w0) andalso
        ((bit andb diag) = 0w0) andalso
        ((bit andb adiag) = 0w0)
    in
      if safe
      then let
        val row = bit orb row
        val diag = (bit orb diag) << 0w1
        val adiag = (bit orb adiag) >> 0w1
        val count = put count row diag adiag
       in
        loop (i + 0w1) count
      end
      else loop (i + 0w1) count
    end
  in
    if row = full
    then count + 0w1
    else loop 0w0 count
  end
in
  put 0w0 0w0 0w0 0w0
end ;;

print (Int.toString (Word.toInt (solve_queen 15)))

solve-queens-3.ss

(define (solve-queens n)
  (define logand fxlogand)
  (define logior fxlogior)
  (define + fx+)
  (define - fx-)
  (define = fx=)
  (define < fx<)
  (define > fx>)
  (define (ash x c)
    (if (< c 0)
      (fxsrl x (- c))
      (fxsll x c)))
  (define full (- (ash 1 n) 1))
  (define (put count row diag adiag)
    (define (loop i count)
      (let ((bit (fxsll 1 i)))
        (cond ((= i n) count)
              ((= 0 (logand bit row) (logand bit diag) (logand bit adiag))
               (loop (+ 1 i) (put count
                                  (logior bit row)
                                  (ash (logior bit diag) 1)
                                  (ash (logior bit adiag) -1))))
              (else (loop (+ 1 i) count)))))
    (cond ((= row full) (+ 1 count))
          (else (loop 0 count))))
  (put 0 0 0 0))

solve-queens.c

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

struct point {
  int raw, col;
  struct point *next;
};

static int iabs(int x) {
  if (x > 0)
    return x;
  else 
    return -x;
}

int solve_queens(
    int cnt, int N, int raw, struct point *queens
) {
  if (raw > N) return cnt + 1;

  for (int col = 0; col < N; col++) {
    struct point *p = queens;
    int safe = -1;
    while (safe && p != NULL) {
      safe = safe &&
        !(col == p->col
       || col == p->col
       || iabs(p->col - col) == iabs(p->raw - raw));
      p = p->next;
    }
    if (safe) {
      struct point new_queens;
      new_queens.raw = raw;
      new_queens.col = col;
      new_queens.next = queens;
      cnt = solve_queens(cnt, N, raw + 1, &new_queens);
    }
  }
  return cnt;
}

int main(int argc, char *argv[]) {
  if (argc != 2) {
    fprintf(stderr, "need and only need a integer");
    exit(1);
  }
  int N = (int)atol(argv[1]);
  printf("%d\n", solve_queens(0, N, 1, NULL));
}

solve-queens.f08

function solve(N) result(res)
  integer, intent(in) :: N
  integer, dimension(N * 2) :: queens
  integer :: res, queens_length

  res = 0
  queens_length = 0
  call put(1)
contains
  recursive subroutine put(raw)
    integer, intent(in) :: raw
    integer :: i, col, raw2, col2
    logical :: is_safe

    if (raw > N) then
      res = res + 1
      return
    end if

    do col = 1, N
      is_safe = .true.
      do i = 1, queens_length, 2
        raw2 = queens(i)
        col2 = queens(i + 1)
        is_safe = is_safe .and. &
          raw /= raw2 .and. col /= col2 .and. &
          (abs(raw - raw2) /= abs(col - col2))
      end do
      if (is_safe) then
        queens(queens_length + 1) = raw
        queens(queens_length + 2) = col
        queens_length = queens_length + 2
        call put(raw + 1)
        queens_length = queens_length - 2
      end if
    end do
  end subroutine put
end function solve

program queens
  implicit none
  integer :: N
  character(len=1000) :: arg

  interface
    function solve(N) result(res)
      integer, intent(in) :: N
      integer :: res
    end function solve
  end interface

  call get_command_argument(1, arg)
  if (len_trim(arg) == 0) then
    print *, "expected at least an argument as N"
    stop
  end if
  read (arg, *) N

  print *,  solve(N)
end program queens

solve-queens.go

package main

import (
	"fmt"
	"os"
	"strconv"
)

func abs(x int64) int64 {
	if x > 0 {
		return x
	} else {
		return -x
	}
}

func solve(N int64) int64 {
	res := int64(0)
	queens := make([]int64, N*2)
	queensLength := 0
	var put func(int64)
	put = func(raw int64) {
		if raw > N {
			res += 1
			return
		}
		for col := int64(1); col <= N; col++ {
			safe := true
			for i := 0; safe && i < queensLength; i += 2 {
				raw2 := queens[i]
				col2 := queens[i+1]
				safe = safe && raw != raw2 && col != col2 &&
					abs(raw-raw2) != abs(col-col2)
			}
			if safe {
				queens[queensLength] = raw
				queens[queensLength+1] = col
				queensLength += 2
				put(raw + 1)
				queensLength -= 2
			}
		}
	}
	put(1)
	return res
}

func main() {
	if len(os.Args) < 2 {
		fmt.Println("expected at least one argument as N")
		os.Exit(0)
	}
	N, err := strconv.ParseInt(os.Args[1], 10, 64)
	if err != nil {
		fmt.Println(err)
		os.Exit(0)
	}
	fmt.Println(solve(N))
}

solve-queens.js

function abs(x) {
  return x > 0 ? x : -x;
}

function solve_queens(N) {
  let cnt= 0;
  let points = [];
  function put(raw) {
    if (raw > N) {
      cnt += 1;
      return;
    }

    for (let col = 1; col <= N; col++) {
      let safe = 1;
      let len = points.length;
      for (let i = 0; i < len; i += 2) {
        let raw2 = points[i];
        let col2 = points[i + 1];
        safe = safe && raw != raw2 && col != col2 &&
          abs(raw - raw2) != abs(col - col2);
        if (!safe) break;
      }
      if (safe) {
        points.push(raw);
        points.push(col);
        put(raw + 1);
        points.pop();
        points.pop();
      }
    }
  }
  put(1);
  return cnt;
}

console.log(solve_queens(15));

solve-queens.lisp

(declaim (optimize (speed 3) (safety 0) (space 0) (debug 0)))

(defun solve-queens (N &aux (cnt 0))
  (declare (type fixnum N cnt))
  (labels ((put (x safe)
             (declare (type fixnum x))
             (if (> x N)
               (setf cnt (+ 1 cnt))
               (loop for y from 1 to N
                     when (funcall safe x y) do
                 (put
                  (1+ x)
                  (lambda (row col)
                    (declare (fixnum row col))
                    (and (not (or (= x row) (= y col)
                                  (= (abs (- row x))
                                     (abs (- col y)))))
                         (funcall safe row col))))))
             cnt))
    (put 1 (lambda (x y) (declare (ignore x y)) t))))

(time (solve-queens 15))

solve-queens.lua

local function abs(x)
  return x > 0 and x or -x
end

local function solve_queens(N)
  local cnt = 0;
  local points = {}
  local function put(raw)
    if raw > N then
      cnt = cnt + 1
      return "ok"
    end

    for col = 1, N do
      local safe = true
      local len = #points;
      local i = 1
      while i <= len do
        local raw2 = points[i]
        local col2 = points[i + 1]
        safe =
          safe and raw ~= raw2 and col ~= col2 and
          abs(raw - raw2) ~= abs(col - col2)
        if not safe then break end
        i = i + 2
      end
      if safe then
        points[len + 1] = raw
        points[len + 2] = col
        put(raw + 1)
        points[len + 1] = nil
        points[len + 2] = nil
      end
    end
  end
  put(1)
  return cnt
end

solve-queens.pas

{$mode objfpc} {$J-} {$H+}

program SolveQueens;
const
        N = 15;
var
        Queens: array of Integer;
        QueensN, Count: Integer;

        procedure Push(Xs: array of const);
        var X: TVarRec;
        begin for X in Xs do
                begin   Queens[QueensN + 1] := X.VInteger;
                        QueensN := QueensN + 1;
                end
        end;

        procedure Pop(N: Integer);
        begin QueensN := QueensN - N; end;

        procedure Put(Row: Integer);
        label
                Cont;
        var
                i, Col, Row2, Col2: Integer;
        begin
                if Row > N then
                begin   Count := Count + 1;
                        Exit();
                end;

                for Col := 1 to N do
                begin   for i := 1 to QueensN div 2 do
                        begin   Row2 := Queens[2 * i - 1];
                                Col2 := Queens[2 * i - 0];
                                if (Row2 = Row) or (Col2 = Col) or
                                (Abs(Row - Row2) = Abs(Col - Col2))
                                then Goto Cont;
                        end;
                        Push([Row, Col]);
                        Put(Row + 1);
                        Pop(2);
                Cont:
                end
        end;
begin
        Count := 0;
        SetLength(Queens, 2 * N + 1);
        QueensN := 0;
        Put(1);
        WriteLn(Count);
end.

solve-queens.pl

sub solve {
  my $N = shift;
  my @queens;
  my $res = 0;
  my $put;
  $put = sub {
    my $raw = shift;
    if ($raw > $N) {
      $res += 1;
      return;
    }
    foreach my $col (1 .. $N) {
      my $safe = 1;
      my $len = @queens;
      for (my $i = 0; $i < $len; $i += 2) {
        if (@queens[$i] == $raw || @queens[$i + 1] == $col ||
            abs(@queens[$i] - $raw) == abs(@queens[$i + 1] - $col)
        ) {
          $safe = 0;
        }
        $safe or break;
      }
      if ($safe) {
        push @queens, $raw;
        push @queens, $col;
        $put->($raw + 1);
        pop @queens;
        pop @queens;
      };
    };
  };
  $put->(1);
  $res;
}

solve-queens.sml

fun solveQueen (N) = let
  val cnt = ref 0
  fun forEachInt (from, to) f =
    if from > to then ()
    else (f from; forEachInt (from + 1, to) f)
  fun abs x = if x < 0 then ~x else x
  fun and' x y = x andalso y
  fun or' x y z = x orelse y orelse z
  fun put (raw, safe) =
    if raw > N then
      cnt := !cnt + 1
    else
      forEachInt (1, N) ( fn col =>
        if safe (raw, col) then
          put (
            raw + 1,
            fn (x, y) =>
              (and' (not (or' (raw = x) (col = y)
                              (abs (x - raw) = abs (y - col))))
                    (safe (x, y)))
          )
        else ()
      )
in
  put (1, fn (_, _) => true);
  !cnt
end;;

print (Int.toString(solveQueen(15)) ^ "\n");

solve-queens.ss

(define (solve-queens N)
  (define > fx>)
  (define - fx-)
  (define + fx+)
  (define = fx=)
  (define (1+ x)
    (fx+ 1 x))
  (define (abs x) (if (< x 0) (- x) x))
  (define (for-each-int from to f)
    (if (> from to)
      'done
      (begin (f from) (for-each-int (1+ from) to f))))
  (let ((cnt 0))
    (define (put raw safe?)
      (if (> raw N)
        (set! cnt (1+ cnt))
        (for-each-int 1 N
          (lambda (col)
            (if (safe? raw col)
              (put (1+ raw)
                (lambda (x y)
                  (and (not (or (= raw x) (= col y)
                                (= (abs (- x raw))
                                   (abs (- y col)))))
                       (safe? x y)))))))))
    (put 1 (lambda (raw col) #t))
    cnt))

(time (solve-queens 15))

sq3.erl

-module(sq3).
-export([solve_queen/1, perf/1]).

perf(N) ->
    spawn(fun() -> io:format("~p", [timer:tc(fun() -> solve_queen(N) end, microsecond)]) end).

solve_queen(N) ->
    Full = (1 bsl N) - 1,
    put(0, N, Full, 0, 0, 0).

safe(Bit, Row, Diag, ADiag) ->
    (Bit band Row == 0) and (Bit band Diag == 0) and (Bit band ADiag == 0).

put(Count, _, Full, Full, _, _) ->
    Count + 1;
put(Count, N, Full, Row, Diag, ADiag) ->
    Loop = fun Loop(I, C) when I == N ->
                   C;
               Loop(I, C) ->
                   Bit = 1 bsl I,
                   Safe = safe(Bit, Row, Diag, ADiag),
                   if
                       Safe ->
                           NewRow = Row bor Bit,
                           NewDiag = (Diag bor Bit) bsl 1,
                           NewADiag = (ADiag bor Bit) bsr 1,
                           NewCount = put(C, N, Full, NewRow, NewDiag, NewADiag),
                           Loop(I + 1, NewCount);
                       true ->
                           Loop(I + 1, C)
                   end
           end,
    Loop(0, Count).