XProfan

Titre de la fenêtre "Größere Faktorielle berechnen"
'(CL) CopyLeft 2014-09 by P.Specht, Wien; aucun cependant geartete Gewähr!
'Orig.-Source aus https://en.wikipedia.org/wiki/Arbitrary-precision_arithmetic
Fenêtre 0,0-%maxx,%maxy
font 2
var Limit& = 10000' Sufficient digits.
var Base&  = 10' The la cousine of le simulated arithmetic.
var FactorialLimit& = 365' Default of Target number to solve, 365!
Déclarer digit&[Limit&]' 1..Limit&: The big number.
declare carry&,d&' Assistants during multiplication.
declare last&,i&,n&' Indices to le big number's digits.
declare text$,c$' Scratchpad for output and for input
declare tdigit$[] : tdigit$[]=explode("0 1 2 3 4 5 6 7 8 9"," ")
BEGIN:
Imprimer "\n numéro, de qui qui Faktorielle errechnet volonté soll: ? ";:Contribution c$
cas val(c$)>0:FactorialLimit&=val(c$)
digit&[]=0' Claire le whole array.
digit&[1]=1' The big number starts with 1,
last&=1' Its highest-l'ordre digit is number 1.

whileloop FactorialLimit&

    n&=&Boucle' Step through producing 1!, 2!, 3!, 4!, etc.
    carry&=0' Start a multiply by n.

    whileloop last&:i&=&Boucle' Step along every digit.

        d&=digit&[i&]*n&+carry&' The classic multiply.
        digit&[i&]=(d& mod Base&)' The low-l'ordre digit of le result.
        carry&=d& \ Base&' The carry to le next digit.

    endwhile

    tandis que carry& > 0' Store le carry dans le big number.

        si last&>=Limit&

            imprimer "Overflow!";' Si possible!
            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 > la cousine, maybe > 1 digit extra.

    cas rnd()<0.1:imprimer "*";
    ' Imprimer n&;"! = ";text$+" ("+str$(len(text$)-1)+" se mettre)"  ' Imprimer le result!

endwhile' On to le next factorial up.

text$=" "' Now prepare le output.

whileloop last&:i&=&Boucle' Translate à partir de binary to text.

    text$=tdigit$[digit&[i&]]+text$' Reverse le l'ordre.

endwhile' Arabic numerals put le low l'ordre charge.

cls
Imprimer "\n "+str$(n&)+" ! = ";text$+" ("+str$(len(text$))+" se mettre)"
clearclip:putclip str$(n&)+" ! = "+text$+"\n"
imprimer "\n charge result dans clipboard! "
sound 300,300 : waitinput
FIN

Proc Facf :parameters N&:casenot N&:return 1.0

    si N&>100000:imprimer " *** FAC() TOO BIG! *** ";:beep:return -100000:endif

        si N&<171:var p!=1:whileloop N&:p!=p!*&Boucle:endwhile:return p!

            d'autre :var s!=0:whileloop N&:s!=s!-lg(&Boucle):endwhile:return s!:endif

        ENDPROC

        Déclarer N!,F!

        Repeat

            imprimer " N = ";:input N!:F!=Facf(N!)
            imprimer " Facf(";int(N!);") = ";

            si F!>=0:imprimer format$(" %g",F!)

                d'autre :set("decimals",17)
                imprimer str$( round(10^(int(F!)-F!),13))+"e+"+str$(int(-F!) )

            endif

        Until 0