| |
|
|
p.specht
| et wieder une Rosettacode-devoir dans XProfan übertragen: on lieu un N * N Schachbrett so voller la dame-Figuren, dass cet sich pas mutuel bedrohen.
Titre de la fenêtre "N-Queens Problem (ab 11x11 viel patience nötig!)"
'https://rosettacode.org/wiki/N-queens_problem#BBC_BASIC
Fenêtre Style 24
declare sl$,i%,j%,tmp%,co%,num%,Size%,Cell%
Proc Brett
font 1
declare i&
whileloop Size%+4:i&=&Boucle:whileloop Size%+4
si between(i&,3,Size%+2) and between(&Boucle,3,Size%+2)
imprimer si((i&+&Boucle) mod 2," ",chr$(176));
d'autre :imprimer "+";:endif:endwhile:imprimer
Endwhile
ENDPROC
Nochma:
CLS:font 2
imprimer "\n Schachbrett-Breite = ";
input sl$
cas val(sl$)<4:sl$=8
Cls
Size%=val(sl$)
Cell%=32
Brett
locate Size%+6,3:Imprimer " Rechnet ...";
num%=FNqueens(Size%,Cell%)
locate Size%+6,3
font 2
imprimer " Pour ein",size%," x ",size%,"Brett gibt es en tout "+STR$(num%)+" Lösungen!"
beep
WaitInput
Goto "Nochma"
Proc FNqueens :parameters n%,s%
declare i%,j%,m%,p%,q%,r%,a%[n%],b%[n%],c%[4*n%-2]
:whileloop n%:i%=&Boucle:a%[i%]=i%:endwhile
m%=0
i%=1
j%=0
r%=2*n%-1
REPEAT
dec i%
inc j%
p%=0
q%= -r%
REPEAT
inc i%
c%[p%]=1
c%[q%+r%]=1
tmp%=en%[i%]:a%[i%]=en%[j%]:a%[j%]=tmp%
p%=i%-en%[i%]+n%
q%=i%+en%[i%]-1
b%[i%]=j%
j%=i%+1
UNTIL (j%>n%) OU c%[p%] OU c%[q%+r%]
IF c%[p%]=0
IF c%[q%+r%]=0
IF m%=0'.te Solution représenter, =m% ... alle
Whileloop n%:p%=&Boucle
LOCATE a%[p%]+2,p%+2
PRINT "D";
Endwhile
ENDIF
inc m%
ENDIF
ENDIF
j%=b%[i%]
WHILE (j%>=n%) AND (i%<>0)
REPEAT
tmp%=en%[i%]:a%[i%]=en%[j%]:a%[j%]=tmp%
j%=j%-1
UNTIL j%<i%
dec i%
p%=i%-en%[i%]+n%
q%=i%+en%[i%]-1
j%=b%[i%]
c%[p%]=0
c%[q%+r%]=0
ENDWHILE
UNTIL i%=0
Retour m%
ENDPROC
|
|
|
| XProfan 11Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 29.05.2021 ▲ |
|
|
|