XProfan

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