XProfan

Título de la ventana "RENCONTRES-Zahl, DERANGEMENT y SUBFAKULTÄT"
' (CL)Copyleft 2011ff P.Pájaro carpintero para Profaner
' Intento uno Umsetzung des Wikipedia-Artikels betr. Rencontres-Zahl
' en XProfan 11.2a, KEINE GEWÄHR - No warranty whatsoever!
Font 2
declarar p!,n!,k!,Ren!,i&
Weiter:
cls
Imprimir " In el KOMBINATORIK versteht uno bajo el RENCONTRES-Zahl   "
imprimir " (französisch para 'Begegnungen') el con D(n;k) bezeichnete   "
imprimir " Anzahl jener PERMUTATIONEN uno Menge n unterscheidbarer    "
imprimir " Elemente, en genau k Elemente ihren ursprünglichen o. "
imprimir " una cierto deseado Platz einnehmen (y n-k no)."
imprimir " Ren=D(n;k)=n!/k!*SUM[i=0..(n-k)](-1)^i/i!=(n OVR k)*D(n-k;0) "
imprimir "                                                              "
imprimir " Für el Fall, dass KEINES el n Elemente seinen Platz una-   "
imprimir " nimmt o. 'wiederfindet', ergibt se como Sonderfall el    "
imprimir " Formel para el Zahl möglicher DERANGEMENTS oder 'Totalver-   "
imprimir " setzungen' aller n Elemente a  !n = 'SUBFAKULTÄT de n'     "
imprimir " después de el Formel:  !n = D(n;0) = n! * SUM[i=0..n](-1)^i/i!    "
' imprimir " {Interessant: lim[n..+Inf](SUM[i=0..n](-1)^i/i!))= 1/exp(1)} "
Imprimir "                                                              "
Imprimir " Bsp: Anzahl n el a permutierenden Elemente eingeben: ";:input n!

if n!>15

    imprimir " Wegen oberer Integer-Grenze Por favor, sólo Pagar a 15 - Sorry! "
    WaitInput
    goto "weiter"

endif

imprimir " Prinzipiell gäbe lo "; int(fakul(n!)); " Positions-Permutationen."
Imprimir "                                                              "
Imprimir " Wieviele Elemente debería en Wunschposition posición?: 0";:input k!
'imprimir "                                                              "
imprimir " Dann hay genau ";
Ren!=Rencontres_D(n!,k!)
set("decimals",0)
imprimir Ren!;" solche Permutationen."
set("decimals",3)
imprimir " El Wahrscheinlichkeit para así una Stellung es ";100*Ren!/fakul(int(n!));"%"
set("decimals",0)
WaitInput
goto "Weiter"

Proc Rencontres_D : parámetros n!,k!

    var n&=int(n!)
    var k&=int(k!)
    var p!=1

    whileLoop k&+1,n&

        p!=p!*&Loop

    EndWhile

    var s!=0
    var i&=0

    mientras que i&<=(n&-k&)

        s! = s! + (1.0-2.0*(i& mod 2)) / fakul(i&)
        inc i&

    endwhile

    'imprimir "Vorfaktor: ";p!
    'imprimir "    Summe: ";s!
    volver p! * s!

ENDPROC

Proc fakul

    parámetros p&
    var prd!=1
    caso p&<1 : p&=1
    caso p&>169 :prd! = -1
    caso prd!<0: goto "back"

    whileloop p&,1,-1

        prd!=prd!*&Loop

    endwhile

    back:
    volver prd!

ENDPROC