**[**Back to MISC SWAG index**]** **[**Back to Main SWAG index**]** **[**Original**]**

*{
pigeons@JSP.UMontreal.CA (Pigeon Steven)
> Hey, I have a friend who is taking a Pascal class at another col-
>lege and he asked me to make a query of you all. Basically, he has to
>do the "eight queens" on a chessboard (with none of them interfering
>vertically, horizontally, or diagonally with each other) problem in
>Pascal. The program has to use stacks. Its input is the number of
>queens (the dimensions of the chessboard are that number x that number).
>The output is that it can't be done with that number of queens or a
>grid of the queens and either empty spaces or dashes. I was wondering
>if any of you had any similar programs in old code lying around, and if
>so if you could send it to me. My friend says it's a pretty classic
>problem for programmers, so I figured I'd ask. Oh, and in case some of
>you think that I am this "friend", the only Pascal course here at Brown
>(cs15) has already done its job with stacks, and it wasn't this. Btw,
>speaking of cs here, it's Object-Oriented; my friend's program needs to
>be done procedureally (straight-line), not in OOPas. I thank you all
>for your indulgence in allowing me to post this. Please don't flame me,
>as I am only trying to help out a friend. If there is a more appropriate
>place for me to post this, please tell me (I am going to post this to
>cs groups if possible). Oh, and as I don't get around here often, I
>would appreciate it much if any and all replies were sent to the address
>below. Thanx,
>
Here's a programm that does that. It's a little bit strange, but I put
extra code so the board would not be passed as a parameter (since Turbo
Profiler said :"Hey, 75% of your run time goes in copy of the board").
The file is name REINES5.PAS (litterally QUEENS5.PAS) and it's limited
(so to say) to 64x64 boards (with 64 queens on it). It is fast enough.
}
***program **Probleme_des_reines;
**const **max = 64;
libre = 8;
reine = 8;
**const **colname:**string **=
'abcdefghijklmnopqrstuvwxyz'+
'ABCDEFGHIJKLMNOPQRSTUVWXYZ'+
'àáâçäåæèéêë';
**type **echiquier = **array**[1..max,1..max] **of **byte;
**var **sol,recursions:longint;
top:word;
Reines,Attaques:echiquier;
**function **min(a,b:integer):integer;
**begin
if **a<b
**then **min:=a
**else **min:=b;
**end**;
**procedure **mark(x,y:integer);
**var **t,g,i:integer;
**begin
for **t:=y+1 **to **top **do **inc(attaques[x,t]);
t:=x+1;
g:=y+1;
**for **i:=1 **to **min(top-t,top-g)+1 **do
begin
**inc(attaques[t,g]);
inc(t);
inc(g);
**end**;
t:=x-1;
g:=y+1;
**if **t>0 **then
for **i:=1 **to **min(top-g+1,t) **do
begin
**inc(attaques[t,g]);
dec(t);
inc(g);
**end**;
Reines[x,y]:=reine;
**end**;
**procedure **unmark(x,y:integer);
**var **t,g,i:integer;
**begin
for **t:=y+1 **to **top **do **dec(attaques[x,t]);
t:=x+1;
g:=y+1;
**for **i:=1 **to **min(top-t,top-g)+1 **do
begin
**dec(attaques[t,g]);
inc(t);
inc(g);
**end**;
t:=x-1;
g:=y+1;
**if **t>0 **then
for **i:=1 **to **min(top-g+1,t) **do
begin
**dec(attaques[t,g]);
dec(t);
inc(g);
**end**;
Reines[x,y]:=libre;
**end**;
**procedure **traduit;
**var **t,g:integer;
**begin
**write(sol:4,'. ');
**for **t:=1 **to **top **do
for **g:=1 **to **top **do
if **Reines[g,t]=reine **then **write(colname[t],g,' ');
writeln(' ',recursions);
**end**;
**function **find(level,j:integer):integer;
**begin
**inc(j);
**while **(attaques[j,level]<>libre) **and **(j<top) **do **inc(j);
**if **(attaques[j,level]=libre)
**then **find:=j
**else **find:=0;
**end**;
**procedure **recurse(level:integer);
**var **t:integer;
**begin
**inc(recursions);
t:=0;
**repeat
**t:=find(level,t);
**if **t<>0
**then begin
if **level=top
**then begin
**inc(sol);
Reines[t,level]:=reine;
traduit;
Reines[t,level]:=libre;
**end
else begin
**mark(t,level);
recurse(level+1);
unmark(t,level);
**end**;
**end
until **(t=0) **or **(t=top);
**end**;
**function **fact(n:real):real;
**begin
if **n<=1 **then **fact:=1
**else **fact:=n*fact(n-1);
**end**;
**var **a:echiquier;
i:integer;
**begin
**sol:=0;
val(paramstr(1),top,i);
**if **top>max
**then begin
**writeln('! ',Top,' a ete remis a ',max,' (max)');
top:=max;
**end**;
**if **top<1 **then **top:=1;
writeln;
writeln(' Le probleme des ',top,' reines FAST (c) 1992-1993 Steven Pigeon');
writeln;
recursions:=0;
fillchar(attaques,sizeof(attaques),libre);
fillchar(Reines,sizeof(Reines),libre);
recurse(1);
writeln;
writeln(' Solutions: ',sol);
writeln(' Recursions: ',recursions,' (au lieu de ',fact(top):0:0,')');
**end**.

**[**Back to MISC SWAG index**]** **[**Back to Main SWAG index**]** **[**Original**]**