Data update

Task/N-queens-problem/Ada/n-queens-problem-1.adb

@@ -0,0 +1,50 @@
+with Ada.Text_IO;  use Ada.Text_IO;
+
+procedure Queens is
+   Board : array (1..8, 1..8) of Boolean := (others => (others => False));
+   function Test (Row, Column : Integer) return Boolean is
+   begin
+      for J in 1..Column - 1 loop
+         if (  Board (Row, J)
+            or else
+               (Row > J and then Board (Row - J, Column - J))
+            or else
+               (Row + J <= 8 and then Board (Row + J, Column - J))
+            )  then
+            return False;
+         end if;
+      end loop;
+      return True;
+   end Test;
+   function Fill (Column : Integer) return Boolean is
+   begin
+      for Row in Board'Range (1) loop
+         if Test (Row, Column) then
+            Board (Row, Column) := True;
+            if Column = 8 or else Fill (Column + 1) then
+               return True;
+            end if;
+            Board (Row, Column) := False;
+         end if;
+      end loop;
+      return False;
+   end Fill;
+begin
+   if not Fill (1) then
+      raise Program_Error;
+   end if;
+   for I in Board'Range (1) loop
+      Put (Integer'Image (9 - I));
+      for J in Board'Range (2) loop
+         if Board (I, J) then
+            Put ("|Q");
+         elsif (I + J) mod 2 = 1 then
+            Put ("|/");
+         else
+            Put ("| ");
+         end if;
+      end loop;
+      Put_Line ("|");
+   end loop;
+   Put_Line ("   A B C D E F G H");
+end Queens;

Task/N-queens-problem/Ada/n-queens-problem-2.adb

@@ -0,0 +1,49 @@
+with Ada.Text_IO;
+use Ada.Text_IO;
+
+procedure CountQueens is
+    function Queens (N : Integer) return Long_Integer is
+        A : array (0 .. N) of Integer;
+        U : array (0 .. 2 * N - 1) of Boolean := (others => true);
+        V : array (0 .. 2 * N - 1) of Boolean := (others => true);
+        M : Long_Integer := 0;
+
+        procedure Sub (I: Integer) is
+            K, P, Q: Integer;
+        begin
+            if N = I then
+                M := M + 1;
+            else
+                for J in I .. N - 1 loop
+                    P := I + A (J);
+                    Q := I + N - 1 - A (J);
+                    if U (P) and then V (Q) then
+                        U (P) := false;
+                        V (Q) := false;
+                        K := A (I);
+                        A (I) := A (J);
+                        A (J) := K;
+                        Sub (I + 1);
+                        U (P) := true;
+                        V (Q) := true;
+                        K := A (I);
+                        A (I) := A (J);
+                        A (J) := K;
+                    end if;
+                end loop;
+            end if;
+        end Sub;
+    begin
+        for I in 0 .. N - 1 loop
+            A (I) := I;
+        end loop;
+        Sub (0);
+        return M;
+    end Queens;
+begin
+    for N in 1 .. 16 loop
+        Put (Integer'Image (N));
+        Put (" ");
+        Put_Line (Long_Integer'Image (Queens (N)));
+    end loop;
+end CountQueens;

Task/N-queens-problem/Emacs-Lisp/n-queens-problem.el

@@ -0,0 +1,80 @@
+(let ((*result* '()))
+  (defun grid-cnt (n)
+    (* n n) )
+  (defun x-axis (n pos)
+    (/ pos n) )
+  (defun y-axis (n pos)
+    (% pos n) )
+  (defun chess-cnt (chess-map)
+    (seq-count (lambda (x) x) chess-map))
+  (defun check-conflict (n chess-map pos)
+    (let ((is-conflict nil))
+      (cl-loop for i from 0 to (1- (grid-cnt n)) while (not is-conflict) do
+	       (when (aref chess-map i)
+		 (when (or (= (x-axis n i) (x-axis n pos))
+			   (= (y-axis n i) (y-axis n pos))
+			   (= (abs (- (x-axis n i) (x-axis n pos)))
+			      (abs (- (y-axis n i) (y-axis n pos))))
+			   )
+		   (setq is-conflict 't)
+		   )
+		 )
+	       )
+      is-conflict )
+    )
+
+  (defun place-chess (n chess-map start-pos)
+    (if (< (chess-cnt chess-map) n)
+	(progn
+	  (let ()
+	    (cl-loop for i from start-pos to (1- (grid-cnt n)) do
+		     (when (not (aref chess-map i)) ;; check if place is empty
+		       ;; check if place is on hold by other chess
+		       (when (not (check-conflict n chess-map i))
+			 (let ((map1 (copy-sequence chess-map)))
+			   (aset map1 i 't)
+			   (place-chess n map1 i)
+			   )
+			 )
+		       )
+		     )
+	    )
+	  )
+      (progn
+	(if *result* (nconc *result* (list chess-map)) (setq *result* (list chess-map)))
+	)
+      )
+    )
+
+  (defun show-result (n)
+    (let ()
+      (seq-map (lambda (map1)
+		
+		 (let ((map-txt ""))
+		   (message ">>>>>>>>>>>>>>")
+		   (seq-map-indexed (lambda (elm idx)
+				      (if (= (% idx n) 0)
+					  ;;(setq map-text (concat map-txt "\n"))
+					  (progn
+					    (message map-txt)
+					    (setq map-txt "") )
+					)
+				      (setq map-txt
+					    (concat map-txt (if elm "✓" "⓪")))
+				      ) map1)
+		   (message "<<<<<<<<<<<<<<\n")
+		   )
+		 ) *result*)
+      )
+    (message "%d solutions in total" (length *result*))
+    )
+
+  (defun start-calculate (n)
+    (let ((chess-map (make-vector (grid-cnt n) nil)))
+      (place-chess n chess-map 0)
+      )
+    (show-result n)
+    )
+
+  (start-calculate 8)
+  )

Task/N-queens-problem/FutureBasic/n-queens-problem.basic

@@ -0,0 +1,91 @@
+//
+// 			N-queens problem solver
+//
+// 		   Using FutureBasic 7.0.34
+// 			   August 2025, R.W.
+//
+// Solves 8 queens on 8 x 8 board. You
+// can adjust the number of queens and
+// board size in the first two lines.
+//
+// Program will calculate the number of solutions.
+// If the flag "detail" is set to _True, the
+// placement of the queens would be indicated.
+
+
+Int BoardSize = 8			// 8x8 board
+Int board(8, 8)				//
+Int solution = 0			// solution count
+Boolean detail 				// whether detailed solution is desired
+
+// Check if placing a queen at (row, col) is safe
+
+local fn Safe(row as int, col as int) as Boolean
+  dim i as int, j as int
+
+  // Check column
+  for i = 1 to row - 1
+    if board(i, col) = 1 then exit fn = _false
+  next
+
+  // Check upper-left diagonal
+  i = row - 1 : j = col - 1
+  while (i >= 1) and (j >= 1)
+    if board(i, j) = 1 then exit fn = _false
+    i-- : j--
+  wend
+
+  // Check upper-right diagonal
+  i = row - 1 : j = col + 1
+  while (i >= 1) and (j <= BoardSize)
+    if board(i, j) = 1 then exit fn = _false
+    i-- : j++
+  wend
+end fn = _True
+
+// Recursive backtracking solver
+local fn Solve(row as int, wantDetail as boolean)
+  dim col as int
+
+  if row > BoardSize
+    // Found one solution — print it
+    dim r as int, c as int
+    solution++
+    if wantDetail
+      for r = 1 to BoardSize
+        for c = 1 to BoardSize
+          if board(r, c) == 1
+            print chr$(asc("a") + r - 1); c; " ";
+          end if
+        next
+      next
+      print
+    end if
+    exit fn
+  end if
+
+  for col = 1 to BoardSize
+    if fn Safe(row, col)
+      board(row, col) = 1
+      fn Solve(row + 1,detail)
+      board(row, col) = 0
+    end if
+  next
+end fn
+
+window 1,@"N-queens problem"
+
+detail = _True		// we want board placement detail
+
+if detail
+  print@
+  print @"Detailed placements for chessboard of size ";¬
+  BoardSize; @"x"; BoardSize
+  print@
+end if
+
+fn Solve(1,detail)
+print@
+print @"There are ";solution;@" solutions for "; BoardSize; @"x"; BoardSize;@" board."
+
+handleEvents

Task/N-queens-problem/Pluto/n-queens-problem.pluto

@@ -0,0 +1,39 @@
+require "table2"
+
+local count = 0
+local c = {}
+local f = {}
+
+local function nqueens(row, n)
+    for x = 1, n do
+        local outer = false
+        local y = 1
+        while y < row do
+            if c[y] == x or row - y == math.abs(x - c[y]) then
+                outer = true
+                break
+            end
+            y += 1
+        end
+        if !outer then
+            c[row] = x
+            if row < n then
+                nqueens(row + 1, n)
+            else
+                count += 1
+                if count == 1 then f = c:mapped(|i| -> i - 1) end
+            end
+        end
+    end
+end
+
+for n = 1, 14 do
+    count = 0
+    c = table.rep(n, 0)
+    f = {}
+    nqueens(1, n)
+    print($"For a {n} x {n} board:")
+    print($"  Solutions = {count}")
+    if count > 0 then print($"  First is \{{f:concat(", ")}}") end
+    print()
+end

Task/N-queens-problem/PowerShell/n-queens-problem-1.ps1

@@ -0,0 +1,59 @@
+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"
+        }
+    }

Task/N-queens-problem/PowerShell/n-queens-problem-2.ps1

@@ -0,0 +1,7 @@
+Get-NQueensBoard 8
+''
+Get-NQueensBoard 3
+''
+Get-NQueensBoard 4
+''
+Get-NQueensBoard 14

Task/N-queens-problem/V-(Vlang)/n-queens-problem.v

@@ -0,0 +1,39 @@
+import math
+
+struct NQueensSolver {
+  mut:
+  count int
+  cnr []int
+  fsg string
+}
+
+fn (mut solver NQueensSolver) n_queens(row int, num int) {
+  outer:
+  for xal in 1 .. num + 1 {
+    for yal in 1 .. row {
+      if solver.cnr[yal] == xal { continue outer }
+      if row - yal == math.abs(xal - solver.cnr[yal]) { continue outer }
+    }
+    solver.cnr[row] = xal
+    if row < num { solver.n_queens(row + 1, num) }
+    else {
+      solver.count++
+      if solver.count == 1 { solver.fsg = solver.cnr[1..].map(it - 1).str() }
+    }
+  }
+}
+
+fn main() {
+  for nal in 1 .. 15 {
+    mut solver := NQueensSolver{
+      count: 0
+      cnr: []int{len: nal + 1}
+      fsg: ""
+    }
+    solver.n_queens(1, nal)
+    println("For a $nal x $nal board:")
+    println("  Solutions = $solver.count")
+    if solver.count > 0 { println("  First is $solver.fsg") }
+    println("")
+  }
+}

Task/N-queens-problem/VBScript/n-queens-problem.vbs

@@ -0,0 +1,46 @@
+'N-queens problem - non recursive & structured - vbs - 24/02/2017
+const l=15
+dim a(),s(),u(): redim a(l),s(l),u(4*l-2)
+for i=1 to l: a(i)=i: next
+for n=1 to l
+    m=0
+    i=1
+    j=0
+    r=2*n-1
+    Do
+        i=i-1
+        j=j+1
+        p=0
+        q=-r
+        Do
+            i=i+1
+            u(p)=1
+            u(q+r)=1
+            z=a(j): a(j)=a(i): a(i)=z  'swap a(i),a(j)
+            p=i-a(i)+n
+            q=i+a(i)-1
+            s(i)=j
+            j=i+1
+        Loop Until j>n Or u(p)<>0 Or u(q+r)<>0
+        If u(p)=0 Then
+            If u(q+r)=0 Then
+                m=m+1  'm: number of solutions
+                'x="": for k=1 to n: x=x&" "&a(k): next: msgbox x,,m
+             End If
+        End If
+        j=s(i)
+        Do While j>=n And i<>0
+            Do
+                z=a(j): a(j)=a(i): a(i)=z  'swap a(i),a(j)
+                j=j-1
+            Loop Until j<i
+            i=i-1
+            p=i-a(i)+n
+            q=i+a(i)-1
+            j=s(i)
+            u(p)=0
+            u(q+r)=0
+        Loop
+    Loop Until i=0
+    wscript.echo n &":"& m
+next 'n