Das Programm setzt ein Formular voraus, auf dem sich ein Button (Command1) und ein Label (Label1) befinden. Der Kontrolldruck würde im Direktfenster erscheinen.
| Option Explicit Dim n% Private Sub Command1_Click() n = InputBox("Fakultätsrechner") End SubLabel1.Caption= "Ergebnis: " & n & "! = " & fak(n) Function fak(n As Integer) As Variant 'debug.Print "Aufruf mit " & n If n = 1 Then fak = 1 Else fak = CDec(n * fak(n - 1)) End If End Function |
Die auskommentierte Zeile würde, wenn sie dürfte, anzeigen, wie ein solcher rekursiver Algorithmus arbeitet.
Berechnung der Fakultätsfunktion mit voller Stellenzahl, Beispielprogramm für Verwendung von Textfeldern, Strings, Zeitmessung, rekursiven Funktionsaufruf
| Option Explicit Dim Zeile As String, n As Long, talt As Long Private Sub Form_Load() 'Anfangswerte der HScrollBar setzen n = 100 End SubLabel1.Caption = n Private Sub HScroll1_Change() 'HScrollBar auswerten Text1.Text = "" 'Veränderung löscht Hauptfenster End SubLabel1.Caption = HScroll1.Value n = HScroll1.Value Private Sub Command1_Click() Dim i As Long, j As Long, Raus As String MousePointer = 11 talt = Timer Me.Caption = "Fakultät von " & N ProgressBar1.Max = N Zeile = fak(N) Text1.Text = N & "! = " & vbCrLf Raus = "" j = 0 For i = 1 To Len(Zeile) j = j + 1 Raus = Raus & Mid(Zeile, i, 1) If j = 100 Then Text1.Text = Text1.Text & Raus & vbCrLf Raus = "" j = 0 End If Next End SubIf Raus <> "" Then Text1.Text = Text1.Text & Raus & vbCrLf Text1.Text = Text1.Text & Len(Zeile) & " Glieder; nach " & Format$(Timer - talt, "##.##") & " s" MousePointer = 0 Private Sub Command2_Click() End End SubFunction fak(ByVal n As Long) As String 'rekursive Fakultätsfunktion. If n = 1 Then fak = "1" Else fak = mult(n, fak(n - 1)) End If End Function |
Hier ist eine Funktion mult() verwendet worden, die eine "schriftliche" Multiplikation beliebig langer Zahlen vollzieht. Diese Multiplikationsroutine ist leicht zu erklären. Besser ist aber, sie sich nicht erklären zu lassen, sondern sie einfach nur zu verstehen.
Hilfe: Man stelle sich vor, man multipliziere eine große Zahl mit einer einstelligen Zahl, von hinten nach vorn, mit "Merken" der Überträge.
Alles klar?
| Function mult(ByVal m As Long, Zeile As String) As String Dim Produkt As Long, Übertrag As Long, Ziff As Long, j As Long Übertrag = 0 j = Len(Zeile) Do Produkt = m * CInt(Mid(Zeile, j, 1)) + Übertrag Ziff = 10 * (Produkt / 10 - Fix(Produkt / 10)) Mid(Zeile, j, 1) = Ziff Übertrag = Int(Produkt - Ziff) / 10 j = j - 1 If Übertrag <> 0 And j = 0 Then Zeile = CStr(Übertrag) & Zeile Loop Until j = 0 End Functionmult = Zeile ProgressBar1.Value = m |
Am Ende steht die Ausgabe für die Fortschrittsanzeige, systematisch höchst unbefriedigend, was hat sie mit der Multiplikation zu tun?
Der Grund ist, wenn man rekursiv arbeitet, werden die zeitaufwendigen Multiplikationen erst nach dem n-maligen Aufruf der fak(n)-Funktion erledigt. Darauf hat man aber nur innerhalb der Multiplikationsroutine selbst Zugriff. Wenn man auf rekursiven Aufruf verzichtet, kann diese letzte Zeile hier entfallen.
So, das wars.
ABER, gleich wenn man eine schön große Fakultät berechnen will, passiert dies, egal, wie groß der Speicher ist.
Warum? Der rekursive Aufruf, schön für Programmierer, weil er oft Code spart, ist für den Arbeitsspeicher nicht so schön. Jeder neue Aufruf der Prozedur belegt eine Menge Stapelspeicher, zu (Computer-)deutsch also "Stack". Dabei geht es im Falle der Fakultätsberechnung gut ohne dieses Problem.
Man ersetze den rekursiven Aufruf durch eine For-Next-Schleife und das Speicherproblem ist gelöst. Übrigens, schneller geht es auch noch.
Wer die Fortschrittsanzeige wünscht, hat es jetzt besser. Er/sie kann sie innerhalb der Funktion fak() bedienen. Die Anzeige hat den Nachteil, bei den kleinen Zahlen schnell, später langsamer fortzuschreiten (Ja, ich weiß: .. fort zu schreiten bzw. zu fortschreiten).
| Function fak(ByVal N As Long) As String Dim i As Integer fak = "1" For i = 1 To N fak = mult(i, fak) ProgressBar1.Value = i Next End Function |
e, die nach Leonhard Euler benannte universelle Konstante, die gerade nicht "Eulersche Zahl" heißt; weil, das ist etwas anderes; welche definiert ist als Grenzwert der Folge (1 + 1/n)n für n → ∞ und sich nach
berechnet, läßt sich relativ einfach mit hoher Stellenzahl berechnen. Die zugehörige Reihe ist nicht nur sehr einfach strukturiert, sondern konvergiert auch sehr schnell.
Was ist zu tun?
Es folgt der kommentierte Code. Vorausgesetzt ist eine Form mit einem Button, der die Berechnung startet. Für die Anzeige dient entweder eine TextBox (mit der Begrenzung der Stellenzahl auf 64 anzeigbare kByte) oder besser eine RichTextBox, sie heißt in der Komponentenverwaltung "Microsoft Rich Textbox Control 6.0"; sie kann nämlich 2,4 Milliarden Zeichen anzeigen.
Links ihr Button in der Werkzeugleiste.
Das Textfeld heißt im Code "Text1". Der Code steht in einem Modul.
Zum Algorithmus ist vorab nur zu erklären, daß die lange Zahlenreihe in ein LongInteger-Array gespeichert wird, wobei jeder Eintrag 9 aufeinanderfolgende Ziffern repräsentiert. Das bedeutet, daß für 9 Ziffern 4 Bytes benötigt werden. Das ist günstig, damit der Rechner einen möglichst hohe Stellenzahl bewältigen kann. Für die Berechnung wird allerdings ein zweites Array gleicher Länge benötigt.
| Option Explicit Global HilfsVektor() As Long, ErgVektor() As Long Global Stellenzahl As Long, mussZellen As Long, istZellen As Long Global Startzeit As Long | Die Dimensionierung dynamischer Feldvariabler erfolgt zunächst ohne Angabe der Feldgröße. Erst wenn die gewünschte Länge der zu errechnenden Zahl bekannt ist, wird der Speicherplatz dafür reserviert. |
| Sub Langtest() Dim Zh As Single Stellenzahl = InputBox("Stellenzahl?") End SubZh = Stellenzahl / 8 If Fix(Zh)<>Zh Then mussZellen = Zh + 1 Else mussZellen = Zh istZellen = mussZellen + 0.1 * mussZellen ReDim HilfsVektor(istZellen) As Long ReDim ErgVektor(istZellen) As Long Startzeit = Timer E_Berechnung frmDocument.Text1.Text = frmDocument.Text1.Text & CStr(", die Rechenzeit betrug = " & Timer - Startzeit & "s") | Es wird die gewünschte Stellenzahl erfragt, die beiden Arrays werden mit einer 10%igen Reserve dimensioniert, um Überläufe zu vermeiden, die die letzten berechneten Stellen betreffen könnten. Es wird eine Zeitmessung in Gang gesetzt und die Routine selbst gestartet |
| Private Sub E_Berechnung() Dim N As Long, i As Long Dim HilfsZahl As Long, Übertrag As Long, Rest As Variant Dim Quot As Variant, Quot1 As Variant, Quot2 As Variant Dim genauGrenze As Long, iE As Long, helpGes As String Quot = CDec(1) Quot1 = CDec(1) Quot2 = CDec(1) HilfsVektor(1) = 100000000# ErgVektor(1) = 100000000# N = 0 genauGrenze = 1 | Lauter Vorbereitung, drei Rechenhilfsgrößen erhalten den Typ Decimal, die führende "1" der Reihe wird gesetzt. N wird der Zähler der berechneten Glieder der Reihe |
Do N = N + 1 Do While HilfsVektor(genauGrenze) = 0 genauGrenze = genauGrenze + 1 Loop Rest = 0 For i = genauGrenze To istZellen Quot1 = HilfsVektor(i) + 1000000000# * Rest Quot = Fix(Quot1 / N) Quot2 = Quot * N Rest = Quot1 - Quot2 HilfsVektor(i) = Quot Next Übertrag = 0 iE = genauGrenze - 1 For i = istZellen To iE Step -1 HilfsZahl = HilfsVektor(i) + ErgVektor(i) + Übertrag Übertrag = 0 If HilfsZahl>999999999 Then Übertrag = 1 HilfsZahl = HilfsZahl - 1000000000# End If ErgVektor(i) = HilfsZahl Next Loop Until genauGrenze>mussZellen | Die eigentliche Rechenschleife. Da die Glieder eine steigende Anzahl führender Nullen besitzen (immer kleiner werden), muß nicht für die ganze Stellenzahl gerechnet werden, sondern nur vom ersten Auftreten von Ziffern an. Diese Grenze heißt genauGrenze und wird zunächst ermittelt. Die erste For-Next-Schleife ermittelt das Nte Reihenglied. Es wird so berechnet, daß das (N-1)te durch N geteilt wird. Der Divisionsrest muß ermittelt werden und es muß bis zum bitteren Ende der reservierten Plätze weiter dividiert werden. Die zweite For-Next-Schleife erledigt die Addition des N-ten Gliedes in den Ergebnisvektor ErgVektor unter Berücksichtigung evtl. auftretender Überläufe. |
helpGes = "" For i = 1 To mussZellen helpGes = helpGes & Format$(ErgVektor(i), "000000000") If i / 10 = i \ 10 Then helpGes = helpGes & vbCrLf End If Next End SubhelpGes = helpGes & vbCrLf & mussZellen * 9 & " Stellen, " & CStr(N) & " Reihenglieder wurden berechnet" frmDocument.Text1.Text = helpGes | Das ist die Anzeige, nach jeweils 90 Ziffern wird ein Umbruch eingefügt. |
Zum Schluß ein Eindruck, wie es aussieht, wenn gerade noch alles in eine TextBox paßt.
Solange der Rechnerspeicher die beiden Feldvariablen akzeptiert, kann ruhig gerechnet werden. Erst die Anzeige, so wie hier realisiert, erfordert noch einmal die gesamte Stellenzahl. Da kann es eng werden. Wenn man denn sehr hoch hinaus will, sollte nach Abschluß der Rechnung die gesamte Zahl in ein Diskettenfile geschrieben werden. Mit erneutem Redim-Aufruf für die beiden Variablen mit der Länge Null kann man dann den für die Rechnung beanspruchten Arbeitspeicher freigeben und anschließend die gesamte Zahl wieder einlesen und anzeigen.
Für die Berechnung von Pi gibt es mehrere Algorithmen, die unterschiedlich schnell konvergieren bzw. unterschiedlich umständlich zu rechnen sind. Ich werde hier nutzen: "Simon und Schuster", eine Reihenberechnung, die so geht:
Erforderlich und hier als eigene Subs ausgeführt sind eine Langzahladdition, eine Division, eine Substraktion. Gerechnet wird mit einem Array von Long Integers, davon werden jeweils 9 Ziffernstellen genutzt, die jeden Wert annehmen können. Die Rechenroutine ist auf den Kern vereinfacht; Zeitmessung etc. sei dem Nutzer überlassen.
Hier folgt eine funktionierende Berechnung, die bedarf allerdings der ausführlicheren Besprechung.
Zunächst mal die eigentliche Routine zur Berechnung der Reihe.
In den Arrays A() und B() stehen die wieder verwendbaren Teile der Reihe: Die Zahlen 16 bzw. 4, k mal geteilt duch 5*5 bzw. durch 239*239. Um das k-te neue Reihenglied C() zu erhalten, das dann zu Pi() zu addieren oder davon zu subtrahieren ist, muß noch durch (2k-1), unten durch Gld vertreten, geteilt werden. Die beiden Zahlen Zahlen iga und igb stellen die Zahl derjenigen führenden Plätze im Array dar, die schon den Wert Null haben, also keinen Einfluß mehr auf das Ergebnis haben können. Im Array C() könnte dieses Vorgehen dazu führen, daß Zahlenreste von vorhergehenden Rechenrunden stören, deshalb die ReDim-Befehle, die auf sehr effektive (schnelle) Weise das gesamte Array löschen.
| Sub Pi_Berechnung(ByVal Zellen&, Pi&(), Gld&) Dim A&(), B&(), C&() Dim iga&, igb& 'Vorbereitungen, Startwerte ReDim A&(Zellen + 1), B&(Zellen + 1), C&(Zellen + 1), Pi&(Zellen + 10) A(Zellen + 1) = 1 B(Zellen + 1) = 1 Gld = 1 iga = 1 igb = 1 A(1) = 160000000 Division iga, Zellen, A(), A(), 5 B(1) = 40000000 Division igb, Zellen, B(), B(), 239 Addition iga, Zellen, Pi(), A() Substraktion igb, Zellen, Pi(), B() Do Gld = Gld + 2 Division iga, Zellen, A(), A(), 25 Division iga, Zellen, C(), A(), Gld Do While A(iga) = 0 iga = iga + 1 Loop Substraktion iga, Zellen, Pi(), C() ReDim C(Zellen) Division igb, Zellen, B(), B(), 57121 Division igb, Zellen, C(), B(), Gld Do While B(igb) = 0 igb = igb + 1 Loop Addition igb, Zellen, Pi(), C() Gld = Gld + 2 Division iga, Zellen, A(), A(), 25 Division iga, Zellen, C(), A(), Gld Do While A(iga) = 0 iga = iga + 1 Loop Addition iga, Zellen, Pi(), C() ReDim C(Zellen + 1) Division igb, Zellen, B(), B(), 57121 Division igb, Zellen, C(), B(), Gld Do While B(igb) = 0 igb = igb + 1< Loop Substraktion igb, Zellen, Pi(), C() Loop Until iga >= Zellen End Sub |
In der obigen Prozedur sind die eigentlichen Rechenroutinen für den speziellen Ganzzahlfall nur aufgerufen worden. Die folgen nun.
| Sub Division(von&, bis&, Vek1&(), Vek2&(), ByVal durch&) Dim i& Rest = 0 For i = von To bis Quot = Vek2(i) + 1000000000 * Rest dv = Fix(Quot / durch) Quot1 = dv * durch Rest = Quot - Quot1 Vek1(i) = dv Next End SubSub Addition(ByVal von&, ByVal bis&, Vek1&(), Vek2&()) Dim Ue&, i& Ue = 0 For i = bis To von - 1 Step -1 Vek1(i) = Vek1(i) + Vek2(i) + Ue Ue = 0 If Vek1(i) > 999999999 Then Ue = 1 Vek1(i) = Vek1(i) - 1000000000 End If Next End SubSub Substraktion(ByVal von&, ByVal bis&, Vek1&(), Vek2&()) Dim Ue&, i& Ue = 0 iE = von - 1 For i = bis To von - 1 Step -1 Vek1(i) = Vek1(i) - Vek2(i) - Ue Ue = 0 If Vek1(i) < 0 Then Ue = 1 Vek1(i) = Vek1(i) + 1000000000 End If Next End Sub |
Das Ganze bedarf noch einiger Vorbereitung. Damit die Var-Dec-Umwandlung nicht bei jedem Aufruf der Divisionsroutine erfolgen muß, werden die betroffenen Variablen dv, Rest, Quot und Quot1 global definiert. Weiter ist die Wahl der Stellenzahl und die Anzeige des Ergenisses in einem rtf-Textfeld namens "txt" im folgenden gezeigt. Daß die Anzeige ohne Komma in 90iger-Zeilen erfolgt, ist vielleicht unschön. Daran kann man noch einiges verbessern. Die angegebene Zahl der Reihenglieder ist etwas mißverständlich, weil es eigentlich das letzte (2k-1) ist, was ausgegeben wird.
| Sub Langtest_pi() Dim Stellen&, Zellen&, Gld& Dim zahl&, ergeb$, Pi&() 'Vorbereitung globaler Variabler dv = CDec(1) Rest = CDec(1) Quot = CDec(1) Quot1 = CDec(1) 'Wahl der Stellenzahl Do ergeb = InputBox("Stellenzahl?") If ergeb <> "" Then Stellen = Val(ergeb) If Stellen = 0 Then MsgBox "Bitte eine Zahl > 100 eingeben!" End If Loop Until Stellen > 100 'Platz reservieren zellen = Int(Stellen / 9) + 2 ReDim Pi(zellen + 10) Pi_Berechnung Zellen, Pi(), Gld 'Anzeige zahl = 2 Form1.txt.Text = Format$(Pi(1), "000000000") Do Form1.txt.Text = Form1.txt.Text & Format$(Pi(zahl), "000000000") If zahl / 10 = zahl \ 10 Then Form1.txt.Text = Form1.txt.Text & vbCrLf zahl = zahl + 1 Loop Until zahl > Zellen End SubForm1.txt.Text = Form1.txt.Text & vbCrLf & "Zahl der angezeigten Ziffern " & (Zellen - 1) * 9 Form1.txt.Text = Form1.txt.Text & vbCrLf & "Zahl der Reihenglieder war: " & CStr(Gld) |
Viel Spaß beim Probieren! Der Code kann bezüglich der Laufzeit sicher noch verbessert werden. Für 100.000 Stellen brauche ich ca. 7 Minuten.