[ Back to the overview Matrix ]

Test case : 8 Queens Problem using Delphi 6

Lines used: 57
         
program queens8_b;

{$APPTYPE CONSOLE}

uses
  SysUtils,math,types;

type
  tqueens=array[1..8] of tpoint;            // coordiantes of the queens

var
 queens:Tqueens;                         // an empty board to starth with
 x:integer;                              // run variable for the outmost call
          
function solve(remaining:integer;addpos:TPoint;queens:Tqueens):boolean;

var
 x,y,c:integer;
 s:string;

  function endangered:Boolean;

  var
    n:integer;

  begin
    result:=false;
    for n:=8 downto remaining+1 do                         // check all other queens
     if (queens[n].x=addpos.x) or (queens[n].y=addpos.y) or  // same col, same row
        (abs(queens[n].x-addpos.x)=abs(queens[n].y-addpos.y))  // or diagonal
         then begin                                        // we are endangered
                result:=true;
                break;
              end;
  end;

begin
  result:=false;                          // default: this is no way to target

  if endangered then exit;                // position is invalid 

  queens[remaining]:=addpos;              // note position

  if remaining=1 then                     // last piece successfully placed
     begin                                // print solution
       result:=true;                      // note success
       Writeln('Solved!');
       for y:=0 to 7 do                   // for each row
         begin
           s:='........';                         // new line is empty
           for c:=1 to 8 do               // for each queen
             if queens[c].y=y then         // queen on this row
               s[queens[c].x+1]:='@';      // draw a queen
           writeln(s);                    // print line
         end;
     end
  else
      for x:=0 to 7 do                           // check all subfields
        for y:=0 to 7 do
            if solve(remaining-1,point(x,y),queens) then // subcall found a solution
              begin
                result:=true;                    // this path is a solution
                exit;                            // don't search any further
              end;
end;


begin
  x:=0;                                                                  // start with field 0
  while (not solve(8,point((x and 7),(x div 8)),queens)) and (x<64) do   // divide the 64 numbers into 8x8 coordinates
    inc(x);                                                              // next field 
end.
Contributed by Andreas Koch, mail at kochandreas.com