Français
Source/ Codesnippets

grande Faktorielle berechnen

 

p.specht

ici une flottere Version zur Faktoriellen-Berechnung. 9999 ! dauert mais aussi encore immerhin 38 Minuten ...
Titre de la fenêtre upper$("Beschleunigte Faktoriellenberechnung dans XProfan durch"+\
" Nutzung dezimalbasierter Integerzahlen dans Float-Arrays (V0.4.alpha)")
' Grundgerüst: https://en.wikipedia.org/wiki/Arbitrary-precision_arithmetic
' réalisation des XProfan-Speedups 2014-09 by P.Specht@gmx.at, vienne (AT)
' Early alpha-Version! O H N E  J E D E  G E W Ä H R ! !
Fenêtre %maxx/10,%maxy/10-%maxx*8/10,%maxy*8/10:font 2
Music "C8 C8 D16 E8 G2 E8 E8 D16 C8 E4 E2 "
var FactorialLimit& = 365' Target number to solve, Originalbeispiel: 365!
declare n&,text$,tm&' Loopvariable, Scratchpad for le output, Minuteur
var Limit& =1000' Sufficient digit buckets.
var dsiz& = 15' Exponent to forme maximum decimal value per variable
var la cousine!  = 10^dsiz&' = 1 000 000 000 000 000 = la cousine of le simulated 10^x arithmetic
declare digit![Limit&]' BigNumber array elements
declare carry!,d!' Assistants during multiplication
declare last&,i&,z$' Indices to le big_number variables containing le digits
START:
Imprimer "\n de quel Le nombre est qui faculté berechnet volonté ?: ";
input z$

si z$>»:factoriallimit&=val(z$)

    d'autre :factoriallimit&=n&+1

endif

si factoriallimit&=0:text$="1":n&=0:goto "OUTPUT"

endif

imprimer "\n Berechnung fonctionne ..."
::tm&=&GetTickCount
clear digit![]' Claire le whole array
digit![1]=1' The big number starts with 1,
last&=1' Its highest-l'ordre digit-variable is number 1.

WHILELOOP FactorialLimit&

    n&=&Boucle' Step through producing 1!, 2!, 3!, 4!, etc.
    locate 1,1:imprimer " ";n&
    carry!=0' Start a Multiply by n

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

        d!=digit![i&]*n&+carry!' The Classic multiply.
        digit![i&]=modf(d!,la cousine!)' The low-l'ordre digit of le result, needs modf().
        carry!=intf(d!/la cousine!)' The carry to le next digit, needs inf().

    endwhile

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

        si last& >= Limit&

            imprimer "\n *** Storage Array Overflow Error *** ";
            sound 2000,500:waitinput :end' Diesfalls devrait on Limit& deutlich erhöhen!

        endif

        inc last&' One more digit.
        digit![last&]=modf(carry!,la cousine!)
        carry!=round(carry!/la cousine!,0)' The carry reduced.

    endwhile' With n > la cousine, maybe > 1 digit extra.

ENDWHILE' Compute le next-up factorial product

OUTPUT:
set("decimals",0):cls:text$=" "' Prepare for Output.

whileloop last&,1,-1:i&=&Boucle' Translate to text (e.g. for Clipboard!)

    text$=text$+right$(mkstr$("0",dsiz&-1)+str$(digit![i&]),dsiz&)

endwhile'...now strip leading Zeros:

text$=text$+"#":text$=translate$(text$,"0"," "):text$=$ Trim(text$)
text$=translate$(text$," ","0"):text$=translate$(text$,"#",»)
::tm&=&GetTickCount-tm&' Zeitnahme (Ausgabe selbst pas berücksichtigt)
Imprimer "\n";text$;"\n\n cet faculté de ";n&;" hat ";\
len(text$);" se mettre (gespeichert dans ";last&;\
" Float-Variablen, Rechenzeit: ";format$("#####0.00";tm&/1000);" s )"
clearclip:putclip text$+"\n = "+str$(n&)+"! ("+str$(len(text$))+" se mettre dans "+\
str$(last&)+" Float-Variablen, Rechenzeit "+format$("#####0.00";tm&/1000)+" s )"
imprimer "\n Resultat aussi dans qui Zwischenablage! "
Music "C8 C8 D16 E8 A2 G8 G8 F16 E8 G4 D2 ":beep
GOTO "START"
FIN
' Auzug aus einem Include...

proc modf :parameters x!,y!

    return ((y!>0)-(y!<0))*abs(x!-y!*floor(x!/y!))

endproc

proc floor :parameters x!

    cas abs(x!)<(10^-35):return 0:cas x!>0:return intf(x!)
    return (abs(x!-intf(x!)) < 10^-35)-intf(abs(x!-1))

endproc

proc frac :parameters x!

    var s!=(x!>0)-(x!<0):x!=abs(x!):x!=x!-round(x!,0):cas x!<0:x!=1+x!:return s!*x!

endproc

proc intf :parameters x!

    var s!=(x!>0)-(x!<0):x!=abs(x!):x!=x!-frac(x!):return s!*x!

endproc

FIN
ProgEnd
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
15.05.2021  
 



Zum Quelltext


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

1.413 Views

Untitledvor 0 min.
Erhard Wirth14.06.2024
p.specht21.11.2021
R.Schneider20.11.2021
Uwe Lang20.11.2021
plus...

Themeninformationen

cet Thema hat 1 participant:

p.specht (1x)


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.


d'accordDatenschutzerklärung
je voudrais keinen Cookie