| |
Fortgeschrittene ProgrammierungBinomialkoeffizienten | | | Autor: jopeku | Datum: 13.06.15 15:59 |
| Guten Tag,
kennt jemand für VB6 also nicht für .NET einen Code um den Binomialkoeffizienten
zu berechnen? z.B. für die Werte 30 und 20?
Es gibt zwar Makros für Excel aber ich habe nichts für VB6 gefunden.
Für eine Antwort wäre ich dankbar | |
Re: Binomialkoeffizienten | | | Autor: Zardoz | Datum: 13.06.15 19:44 |
| Hallo jopeku,
probier' mal dieses:
Public Function Binkoeff(ByVal n As Long, ByVal k As Long) As Double
Dim i As Long, P As Double
P = 1
For i = 1 To k
P = P * n / i
n = n - 1
Next i
Binkoeff = P
End Function Gruss,
Zardoz | |
Re: Binomialkoeffizienten | | | Autor: jopeku | Datum: 14.06.15 09:43 |
| @Zardoz
Guten MOrgen und vielen Dank,
ich werde es mal testen. | |
Re: Binomialkoeffizienten | | | Autor: OGGI | Datum: 16.06.15 09:01 |
| Howdy Zardoz,
vielen Dank für den Code zur Binomialkoeffizient , er funktioniert prima und sollte in die Tipps & Tricks mit aufgenommen werden (Algorithmen/Mathematik).
MfG Oggi | |
Re: Binomialkoeffizienten | | | Autor: Manfred X | Datum: 16.06.15 17:22 |
| Vielleicht so .... ?
Public Function Binkoeff(ByVal n As Long, ByVal k As Long) As Double
Const maxvalue As Double = 9999999999999999D
Dim i As Long, P As Double
If k * 2 > n Then k = n - k
P = 1
For i = 1 To k
P = P * n / i
n = n - 1
If P > maxvalue Then P = -1 : Exit For
Next i
Binkoeff = P
End Function | |
Re: Binomialkoeffizienten | | | Autor: OGGI | Datum: 17.06.15 08:43 |
| Howdy Manfred X,
bevor ich diesen Quellcode ausprobiere, gibt es noch Klärungsbedarf. Was ist 9999999999999999D eine Hexadezimalzahl?
If k * 2 > n Then k = n - k 10 über 6 = 210, mit deiner Formel oben 10 über 4 = 210
| |
Re: Binomialkoeffizienten | | | Autor: Manfred X | Datum: 17.06.15 15:05 |
| Hallo!
Für Berechnungen wird im Vorschlag von Zardoz der Datentyp Double verwendet,
weil er sehr große Werte aufnehmen kann.
Double-Werte sind aber nur auf max. 15-16 Stellen genau.
Der Binomialkoeffizent kann riesige Ausprägungen erreichen.
Setzt man in der Funktion keine Obergrenze, wird zwar bis zum maximal
darstellbaren Double-Wert gerechnet - aber große Werte sind nicht exakt.
Zur Optimierung der Berechnungen kann man ausnutzen,
daß ganzzahlige Binomialkoeffizienten symmetrisch sind.
| |
Re: Binomialkoeffizienten | | | Autor: OGGI | Datum: 17.06.15 19:30 |
| Howdy Manfred X
Ah ja, die Deklaration ist aber falsch, ist wohl nicht VB6
Const maxvalue As Double = 9999999999999999D Danke für den Link, ich hatte nur bis zum Inhaltsverzeichnis gelesen. Die Lösung steht unter '4. Algorithmus zur effizienten Berechnung'. Ich habe die Beschreibung dort etwas gekürzt in VB übernommen. Funzt bis auf die maxvalue-Deklaration.
Public Function Binkoeff(ByVal n As Long, ByVal k As Long) As Double
Dim i As Long
Dim P As Double
' Const maxvalue As Double = 9999999999999999D
P = 1
If k * 2 > n Then n = n - k
For i = 1 To k
P = P * (n - k + i) / i
' If P > maxvalue Then P = -1: Exit For
Next i
Binkoeff = P
End Function | |
Re: Binomialkoeffizienten | | | Autor: Manfred X | Datum: 17.06.15 22:06 |
| Wenn Du neben der begrenzten Darstellungsgenauigkeit
des Datentyps Double auch die eingeschränkte Genauigkeit bei der
Berechnung der Produktkette berücksichtigen willst, sollte die
Konstante "maxvalue" auf den Wert 99999999999999# gesetzt werden.
Falls das von Interesse ist:
Bei aktuellen VB-Versionen steht im Net-Namespace "System.Numerics"
der Datentyp "BigInteger" zur Verfügung, der beliebig große Ganzzahlen
ermöglicht.
Beitrag wurde zuletzt am 17.06.15 um 22:10:42 editiert. | |
Re: Binomialkoeffizienten | | | Autor: OGGI | Datum: 17.06.15 22:28 |
| Nein, ich brauche die Darstellungsgenauigkeit des Datentyps Double nicht zu berücksichtigen. Es werden die selben Zahlen wie auf meinem Taschenrechner mit nCr-Taste angezeigt. Bei zu großen Zahlen bringt VB6 die Fehlermeldung "Übelauf". Ich verwende ergo diesen Code:
Public Function Binkoeff(ByVal N As Long, ByVal k As Long) As Double
Dim i As Long
Dim P As Double
P = 1
If k * 2 > N Then N = N - k
For i = 1 To k
P = P * (N - k + i) / i
Next i
Binkoeff = P
End Function Vielen Dank für die Zusammenarbeit | |
Re: Binomialkoeffizienten | | | Autor: Manfred X | Datum: 17.06.15 23:32 |
| Hallo!
Diese Zeile ist fehlerhaft übernommen: If k * 2 > N Then N = N - k
Wenn der Wert des Binomialkoeffizienten über der angegebenen
Grenze - aber noch innerhalb des Double-Limits liegt, kommt es nicht
zu einer Ausnahme (Überlauf), sondern zu Ungenauigkeiten.
| |
Re: Binomialkoeffizienten | | | Autor: OGGI | Datum: 17.06.15 23:42 |
| Ok, ich schmeiß die ganze Zeile raus, die hat mir von Anfang an nicht gefallen. Danke.
Public Function Binkoeff(ByVal N As Long, ByVal k As Long) As Double
Dim i As Long
Dim P As Double
P = 1
For i = 1 To k
P = P * (N - k + i) / i
Next i
Binkoeff = P
End Function | |
Re: Binomialkoeffizienten | | | Autor: Manfred X | Datum: 18.06.15 00:04 |
| Wenn Du sehr große Koeffizienten benötigst,
kannst Du mit VB6 den Variant-Untertyp "Decimal" nutzen,
der maximal 29 Stellen Genauigkeit bietet - aber diese
Berechnungen benötigen relativ viel Rechenzeit.
Public Function Binkoef(ByVal n As Integer, ByVal k As Integer) As String
Dim P As Variant, i As Integer
P = CDec(1)
If k * 2 > n Then k = n - k
For i = 1 To k
P = CDec(P) * CDec(n - k + i) / CDec(i)
Next i
Binkoef = CStr(P)
End Function | |
Re: Binomialkoeffizienten | | | Autor: OGGI | Datum: 18.06.15 10:16 |
| Oh, da kommt ja immer mehr - Super.
Ich hatte bisher vergessen zu erwähnen. Die Codes teste ich direkt in meinem Calculator. Dabei sende ich das Rechenergebnis der Function Binkoeff, vor der Ausgabe, an den VB-Befehl Round - Round(Binkoeff(n, k), Kommastellen).
Dein neuer Code zeigt bei 4.999.999 über 6 ohne Zeitverzögerung die Fehlermeldung »Überlauf« an. Bei "meinem" Code erhalte ich das Ergebnis 2,17012977432075E+37 Mein Taschenrechner mit nCr-Taste steigt bei 2,170129774E+37 aus. Da bin ich 5 Kommastellen genauer, das reicht mir. Bei 4.999.999 über 58 wird dann die Fehlermeldung: 1,#INF angezeigt - läuft also stabil die neue Funktion Binomialkoeffizient.
(Mein Calculator und seine duzend Zusatzfenster, kann unter http://www.oggisoft.de/calculator.htm begutachtet werden. Über Tipps für neue Zusatzfenster freue ich mich, oder ihr generiert selbst ein neues Zusatzfenster, quasi als AddOn. Height 6390, Width 7200 evtl. auch breiter.)
Danke.
Beitrag wurde zuletzt am 18.06.15 um 10:21:55 editiert. | |
Re: Binomialkoeffizienten | | | Autor: Manfred X | Datum: 18.06.15 14:19 |
| Der Binomialkoeffizient entspricht jeweils einem ganzzahligen Wert.
In den meisten Fällen werden solche Koeffizienten in (Summen-)Formeln weiterverarbeitet.
Die Verwendung von Näherungswerten führt dabei gewöhnlich zu großen Berechnungsfehlern.
Du solltest deshalb in Deinem Programm anzeigen, ob das Ergebnis exakt berechnet
worden ist oder ob es sich um eine Näherung handelt. (An dem Übergang zur Exponential-
Darstellung des Wertes läßt sich das nicht zuverlässig erkennen.)
Du könntest einen zusätzlichen Parameter einführen, durch den vorgegeben werden kann,
ob nur exakte Werte oder auch Näherungen mit begrenzter Stellenzahl geliefert werden.
Beitrag wurde zuletzt am 18.06.15 um 14:22:57 editiert. | |
Re: Binomialkoeffizienten | | | Autor: OGGI | Datum: 18.06.15 20:13 |
| Ok, da kann ich in die Protokollliste einen entsprechenden Text mit eintragen. Aber woran erkenne ich selbst, ob es sich um eine Näherung oder um ein exaktes Ergebnis handelt? Ich denke mal, die Endscheidung überlasse ich einfach dem Anwender. | |
Re: Binomialkoeffizienten | | | Autor: Manfred X | Datum: 19.06.15 17:14 |
| Vielleicht so oder ähnlich ....
Public Function Binkoeff(ByVal n As Long, ByVal k As Long, _
Optional ByVal Exact As Boolean = True) As Double
Dim nk, i As Long, P As Double
Binkoeff = -1
If n < 1 Or k < 0 Or k > n Then Exit Function
If k * 2 > n Then k = n - k
P = 1: nk = n - k
For i = 1 To k
If P > 1E+300 Then Exit Function
P = P * (nk + i)
If Exact Then
If P >= 1E+15 Then Exit Function
End If
P = P / i
If Exact Then
If Abs(P - Fix(P)) > 0 Then Exit Function
End If
n = n - 1
Next i
Binkoeff = P
End Function | |
Re: Binomialkoeffizienten | | | Autor: OGGI | Datum: 22.06.15 08:58 |
| Howdy Manfred X,
endschuldige bitte, dass ich erst jetzt wieder posten kann ('der' Eric Burdon war in meiner Stadt). Dein Code steigt mir einfach zu früh aus. Meine Anwender werden es nicht akzeptieren, dass ein Tischrechner weiterrechnet als mein PC-Calculator. Auf der anderen Seite gefällt mir meine Umsetzung des Pseudocodes aus Wikipedia ins VB6 so gut, dass ich mich entschlossen habe, diesen Code im Update Ende dieser Woche zu Verwenden. Auch um den Autor des Wikipedia-Artikels damit zu ehren und ihm zu danken. Dir danke ich recht herzlich für deinen Elan den Code weiterentwickeln zu wollen. Er ist ja nicht weg, sondern bleibt hier verfügbar. Danke.
bis die Tage, Oggi
| |
| Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
|
|
sevISDN 1.0
Überwachung aller eingehender Anrufe!
Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Weitere InfosTipp des Monats sevOutBar 4.0
Vertikale Menüleisten á la Outlook
Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. Weitere Infos
|