XProfan

Window Title "RENCONTRES-number, DERANGEMENT and SUBFAKULTÄT"
' (CL)Copyleft 2011ff P.woodpecker for Profaner
' attempt of/ one Umsetzung the Wikipedia-Artikels betr. Rencontres-number
' in XProfan 11.2a, NO GEWÄHR - No warranty whatsoever!
Font 2
declare p!,n!,k!,reindeer!,i&
moreover:
cls
Print " in the KOMBINATORIK understand one under the RENCONTRES-number   "
print " (french for 'Begegnungen') The with D(n;k) designated   "
print " amount jener PERMUTATIONEN of/ one crowd n unterscheidbarer    "
print " items, with the very k items ihren ursprünglichen or. "
print " a designed desired Space receive (and n-k not)."
print " Ren=D(n;k)=n!/k!*SUM[i=0..(n-k)](-1)^i/i!=(n OVR k)*D(n-k;0) "
print "                                                              "
print " for the drop, that KEINES the n items its Space one-   "
print " takes or. 'wiederfindet', yields as Sonderfall The    "
print " Formel for number möglicher DERANGEMENTS or 'Totalver-   "
print " setzungen' all n items To  !n = 'SUBFAKULTÄT of n'     "
print " to the Formel:  !n = D(n;0) = n! * SUM[i=0..n](-1)^i/i!    "
' print " {interestingly: lim[n..+Inf](SUM[i=0..n](-1)^i/i!))= 1/exp(1)} "
Print "                                                              "
Print " Bsp: amount n the To permutierenden items prompt: ";:input n!

if n!>15

    print " because of upper Integer-boundary Please only numbers To 15 - Sorry! "
    WaitInput
    goto "weiter"

endif

print " in principle were it "; int(fakul(n!)); " Positions-Permutationen."
Print "                                                              "
Print " Wieviele items should in Wunschposition stand?: 0";:input k!
'print "                                                              "
print " then there very ";
Ren!=Rencontres_D(n!,k!)
set("decimals",0)
print reindeer!;" such Permutationen."
set("decimals",3)
print " The probability for so a Stellung is ";100*reindeer!/fakul(int(n!));"%"
set("decimals",0)
WaitInput
goto "Weiter"

Proc Rencontres_D : parameters 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

    while i&<=(n&-k&)

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

    endwhile

    'print "Vorfaktor: ";p!
    'print "    amount: ";s!
    return p! * s!

ENDPROC

Proc fakul

    parameters p&
    var prd!=1
    case p&<1 : p&=1
    case p&>169 :prd! = -1
    case prd!<0: goto "back"

    whileloop p&,1,-1

        prd!=prd!*&Loop

    endwhile

    back:
    return prd!

ENDPROC