XProfan

Título de la ventana "Größere Faktorielle berechnen"
'(CL) CopyLeft 2014-09 by P.Pájaro carpintero, Wien; Keine sin embargo geartete Gewähr!
'Orig.-Source de https://en.wikipedia.org/wiki/Arbitrary-precision_arithmetic
Ventana 0,0-%maxx,%maxy
font 2
var Limit& = 10000' Sufficient digits.
var Base&  = 10' The base of the simulated arithmetic.
var FactorialLimit& = 365' Default of Target number to solve, 365!
Declarar digit&[Limit&]' 1..Limit&: The big number.
declarar carry&,d&' Assistants during multiplication.
declarar last&,i&,n&' Indices to the big number's digits.
declarar texto$,c$' Scratchpad for output and for input
declarar tdigit$[] : tdigit$[]=explode("0 1 2 3 4 5 6 7 8 9"," ")
BEGIN:
Imprimir "\n Zahl, de el el Faktorielle errechnet voluntad se: ? ";:Entrada c$
caso val(c$)>0:FactorialLimit&=val(c$)
digit&[]=0' Claro the whole array.
digit&[1]=1' The big number starts with 1,
last&=1' Its highest-order digit is number 1.

whileloop FactorialLimit&

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

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

        d&=digit&[i&]*n&+carry&' The classic multiply.
        digit&[i&]=(d& mod Base&)' The low-order digit of the resultado.
        carry&=d& \ Base&' The carry to the next digit.

    endwhile

    mientras que carry& > 0' Store the carry en the big number.

        if last&>=Limit&

            imprimir "Overflow!";' If 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 > Base, maybe > 1 digit extra.

    caso rnd()<0.1:imprimir "*";
    ' Imprimir n&;"! = ";text$+" ("+str$(len(texto$)-1)+" Stellen)"  ' Imprimir the resultado!

endwhile' On to the next factorial up.

text$=" "' Now prepare the output.

whileloop last&:i&=&Loop' Translate from binary to texto.

    texto$=tdigit$[digit&[i&]]+texto$' Reverse the order.

endwhile' Arabic numerals put the low order last.

cls
Imprimir "\n "+str$(n&)+" ! = ";text$+" ("+str$(len(texto$))+" Stellen)"
clearclip:putclip str$(n&)+" ! = "+texto$+"\n"
imprimir "\n Last resultado en clipboard! "
sound 300,300 : waitinput
FIN

Proc Facf :parámetros N&:casenot N&:volver 1.0

    if N&>100000:imprimir " *** FAC() TOO BIG! *** ";:beep:volver -100000:endif

        if N&<171:var p!=1:whileloop N&:p!=p!*&Loop:endwhile:volver p!

            más :var s!=0:whileloop N&:s!=s!-lg(&Loop):endwhile:volver s!:endif

        ENDPROC

        Declarar N!,F!

        Repeat

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

            if F!>=0:imprimir format$(" %g",F!)

                más :set("decimals",17)
                imprimir str$( round(10^(int(F!)-F!),13))+"e+"+str$(int(-F!) )

            endif

        Until 0