Fakultätsberechnung mit voller Stellenzahl

Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

Unsere Datenschutzerklärung wurde aktualisiert. Mit der Nutzung unseres Forums akzeptierst Du unsere Datenschutzerklärung. Du bestätigst zudem, dass Du mindestens 16 Jahre alt bist.

  • 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 :oops: (Schätzung: ~4 1/2 Tage)... Das Ding schreit nach Assembler :evil:!
    Gruss

    Quellcode

    1. WindowTitle "Fakultätsberechnung mit voller Stellenzahl"
    2. 'Source: http://en.wikipedia.org/wiki/Arbitrary-precision_arithmetic
    3. 'Translated to XProfan 11.2a by P. Specht (D) Demoware 2011-08 f
    4. 'Demo only. No warranty whatsoever. Ohne jegliche Gewähr!
    5. Def &Limit 35661 'Ausreichende Anzahl Stellen
    6. Def &Base 10 'The base of the simulated arithmetic.
    7. Def &FactorialLimit 10000 'Max number to solve
    8. Declare Digit&[&Limit] 'The big number.
    9. Declare carry&, d&, n& 'Assistants during multiplication.
    10. Declare last&, i& 'Indices to the big number's digits.
    11. Declare text$[&Limit] 'Scratchpad for the output.
    12. Declare tdigit$[15] 'The Number Signs in that Base System
    13. tdigit$[0]="0":tdigit$[1]="1":tdigit$[2]="2":tdigit$[3]="3"
    14. tdigit$[4]="4":tdigit$[5]="5":tdigit$[6]="6":tdigit$[7]="7"
    15. tdigit$[8]="8":tdigit$[9]="9":tdigit$[10]="A":tdigit$[11]="B"
    16. tdigit$[12]="C":tdigit$[13]="D":tdigit$[14]="E":tdigit$[15]="F"
    17. Declare Fact&
    18. Declare Dauer&
    19. Font 2 : Randomize
    20. Window 0,0 - %MaxX/2,%MaxY-50
    21. Eingabe:
    22. cls rnd(8^8)
    23. Print " Fakultät berechnen von n = ";:input Fact&
    24. if Fact&=0
    25. Print: Print " 0! = 1 (per Definition)"
    26. WaitInput
    27. goto "Eingabe"
    28. elseif Fact&<0
    29. Print " Fakultät hier nur von natürlichen, also positiven Zahlen!"
    30. Print " Danke für's testen!"
    31. WaitInput
    32. goto "Finis"
    33. elseIf Fact& > &FactorialLimit
    34. print " Für den reservierten Speicher zu groß, bitte max. ";&FactorialLimit
    35. Beep
    36. Waitinput
    37. Goto "Eingabe"
    38. Endif
    39. Print " Berechnung von n! ..." : Print
    40. 'BEGIN Arbitrary Precision Algorithm
    41. dauer&=&GetTickCount
    42. Clear Digit&[] 'Clear the whole array.
    43. Digit&[1]=1 'The big number starts with 1,
    44. last&=1 'Its highest-order digit is number 1.
    45. WHILELOOP Fact& 'Step through producing 1!, 2!, 3!, 4!, etc.
    46. n&=&Loop
    47. carry&=0 'Start a multiply by n.
    48. WhileLoop last& 'Step along every digit.
    49. i&=&Loop
    50. d&=digit&[i&] * n& + carry& 'Classic multiply.
    51. digit&[i&]=d& mod &Base 'The low-order digit of the result.
    52. carry&=d& \ &Base 'The carry to the next digit.
    53. EndWhile
    54. While carry& > 0 'Store the carry in the big number.
    55. if last& >= &Limit
    56. print "Array Overflow!"
    57. Beep
    58. WaitInput
    59. END
    60. endif
    61. last&=last& + 1 'One more digit.
    62. digit&[last&]=carry& mod &Base 'Placed.
    63. carry& = carry& \ &Base 'The carry reduced.
    64. Endwhile 'With n > Base, maybe > 1 digit extra.
    65. Case n&<Fact& : continue 'Else Output
    66. dauer&=&GetTickCount-dauer&
    67. Print
    68. Print " ";n&;"! = "; 'Translate from binary to text:
    69. whileloop last&,1,-1 'Arabic numerals put the low order last, so
    70. print tdigit$[digit&[&Loop]]; 'we have to reverse the order.
    71. case %pos > Width(%hwnd) /10.26 : print
    72. if %csrlin > (Height(%hwnd)-40)/20
    73. print " ...weiter mit Taste! "
    74. WaitInput
    75. CLS rgb(200,200,200)
    76. print "...";
    77. endif
    78. endwhile
    79. Print
    80. Print " Diese Zahl hat "; last&; " Stellen, berechnet in "; dauer&; " ms "
    81. ENDWHILE 'Upward to the next multiplication
    82. WaitInput
    83. Goto "Eingabe"
    84. Finis:
    85. END
    Alles anzeigen
    Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3