Fakultäten auf volle Stellenzahl berechnen
===========================
Vorwarnung: Der Algorithmus ("Multiplikation zu Fuß") hat nahezu quadratische Laufzeit! Mit ProfComp compiliert, braucht 100! 234 ms, 500! 8485 ms, 1000! 39750 ms, für 2000! bereits 176889 ms = 2 min 57 sec. Und 2500! langweilt dann schon mit 285013 ms = 4 min 45 sec, die 9131 Stellen von 3000! brauchen gar 419766 ms = 7 min. (Aus Fadesse: 4000! mit 12674 Stellen ziemlich genau 13 min). Um 10000! auszuprobieren (dafür wäre die reservierte Stellenzahl ausgelegt) ist mir meine Lebenszeit zu schade (Schätzung: ~4 1/2 Tage)... Das Ding schreit nach Assembler !
Gruss
Code
WindowTitle "Fakultätsberechnung mit voller Stellenzahl"
'Source: http://en.wikipedia.org/wiki/Arbitrary-precision_arithmetic
'Translated to XProfan 11.2a by P. Specht (D) Demoware 2011-08 f
'Demo only. No warranty whatsoever. Ohne jegliche Gewähr!
Def &Limit 35661 'Ausreichende Anzahl Stellen
Def &Base 10 'The base of the simulated arithmetic.
Def &FactorialLimit 10000 'Max number to solve
Declare Digit&[&Limit] 'The big number.
Declare carry&, d&, n& 'Assistants during multiplication.
Declare last&, i& 'Indices to the big number's digits.
Declare text$[&Limit] 'Scratchpad for the output.
Declare tdigit$[15] 'The Number Signs in that Base System
tdigit$[0]="0":tdigit$[1]="1":tdigit$[2]="2":tdigit$[3]="3"
tdigit$[4]="4":tdigit$[5]="5":tdigit$[6]="6":tdigit$[7]="7"
tdigit$[8]="8":tdigit$[9]="9":tdigit$[10]="A":tdigit$[11]="B"
tdigit$[12]="C":tdigit$[13]="D":tdigit$[14]="E":tdigit$[15]="F"
Declare Fact&
Declare Dauer&
Font 2 : Randomize
Window 0,0 - %MaxX/2,%MaxY-50
Eingabe:
cls rnd(8^8)
Print " Fakultät berechnen von n = ";:input Fact&
if Fact&=0
Print: Print " 0! = 1 (per Definition)"
WaitInput
goto "Eingabe"
elseif Fact&<0
Print " Fakultät hier nur von natürlichen, also positiven Zahlen!"
Print " Danke für's testen!"
WaitInput
goto "Finis"
elseIf Fact& > &FactorialLimit
print " Für den reservierten Speicher zu groß, bitte max. ";&FactorialLimit
Beep
Waitinput
Goto "Eingabe"
Endif
Print " Berechnung von n! ..." : Print
'BEGIN Arbitrary Precision Algorithm
dauer&=&GetTickCount
Clear Digit&[] 'Clear the whole array.
Digit&[1]=1 'The big number starts with 1,
last&=1 'Its highest-order digit is number 1.
WHILELOOP Fact& 'Step through producing 1!, 2!, 3!, 4!, etc.
n&=&Loop
carry&=0 'Start a multiply by n.
WhileLoop last& 'Step along every digit.
i&=&Loop
d&=digit&[i&] * n& + carry& 'Classic multiply.
digit&[i&]=d& mod &Base 'The low-order digit of the result.
carry&=d& \ &Base 'The carry to the next digit.
EndWhile
While carry& > 0 'Store the carry in the big number.
if last& >= &Limit
print "Array Overflow!"
Beep
WaitInput
END
endif
last&=last& + 1 'One more digit.
digit&[last&]=carry& mod &Base 'Placed.
carry& = carry& \ &Base 'The carry reduced.
Endwhile 'With n > Base, maybe > 1 digit extra.
Case n&<Fact& : continue 'Else Output
dauer&=&GetTickCount-dauer&
Print
Print " ";n&;"! = "; 'Translate from binary to text:
whileloop last&,1,-1 'Arabic numerals put the low order last, so
print tdigit$[digit&[&Loop]]; 'we have to reverse the order.
case %pos > Width(%hwnd) /10.26 : print
if %csrlin > (Height(%hwnd)-40)/20
print " ...weiter mit Taste! "
WaitInput
CLS rgb(200,200,200)
print "...";
endif
endwhile
Print
Print " Diese Zahl hat "; last&; " Stellen, berechnet in "; dauer&; " ms "
ENDWHILE 'Upward to the next multiplication
WaitInput
Goto "Eingabe"
Finis:
END
Alles anzeigen