XProfan

WindowTitle "Größere Faktorielle berechnen"
'(CL) CopyLeft 2014-09 by P.Specht, Wien; Keine wie auch immer geartete Gewähr!
'Orig.-Source aus https://en.wikipedia.org/wiki/Arbitrary-precision_arithmetic
Window 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!
Declare digit&[Limit&]' 1..Limit&: The big number.
declare carry&,d&' Assistants during multiplication.
declare last&,i&,n&' Indices to the 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:
Print "\n Zahl, von der die Faktorielle errechnet werden soll: ? ";:Input c$
case val(c$)>0:FactorialLimit&=val(c$)
digit&[]=0' Clear 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 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 "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.

    case rnd()<0.1:print "*";
    ' Print n&;"! = ";text$+" ("+str$(len(text$)-1)+" Stellen)"  ' Print the result!

endwhile' On to the next factorial up.

text$=" "' Now prepare the output.

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

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

endwhile' Arabic numerals put the low order last.

cls
Print "\n "+str$(n&)+" ! = ";text$+" ("+str$(len(text$))+" Stellen)"
clearclip:putclip str$(n&)+" ! = "+text$+"\n"
print "\n Last result in clipboard! "
sound 300,300 : waitinput
END

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

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

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

            else :var s!=0:whileloop N&:s!=s!-lg(&Loop):endwhile:return s!:endif

        EndProc

        Declare N!,F!

        Repeat

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

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

                else :set("decimals",17)
                print str$( round(10^(int(F!)-F!),13))+"e+"+str$(int(-F!) )

            endif

        Until 0