Erweiterte Exponentialgleichung lösen

Übersicht

BlitzMax, BlitzMax NG

Codearchiv & Module

	BlitzMoritz Betreff: Erweiterte Exponentialgleichung lösen	So, Mai 10, 2009 21:27 Antworten mit Zitat
Ich bin bei einem meiner Projekte auf das Problem gestoßen, eine nicht-triviale Exponentialgleichung der folgenden Form lösen zu müssen: a·b^x = c·x + d Für jene, die es interessieren sollte, habe ich das Problem hier genauer erörtert: Anleitung.pdf Mit dem Konstruktionsprogramm "geogebra" und folgender Datei kann man sich's interaktiv veranschaulichen: Konstruktionsdatei.ggb Mit folgender BM-Klasse kann man die Aufgabe zuverlässlich und schnell lösen (inklusive Demoprogramm und Funktionsgraphen): Code: [AUSKLAPPEN] [EINKLAPPEN] SuperStrict SeedRnd MilliSecs() AppTitle = "TExpEquation-Demo" Graphics Desktop().Width-20, Desktop().Height-20 For Local i:Int = 0 To 99 Local a:Float = 10Rnd()-5 Local b:Float = 5Rnd() Local c:Float = 10Rnd()-5 Local d:Float = 10Rnd()-5 Local ExpEquation:TExpEquation = TExpEquation.build(a, b, c, d) Local Solution:Float[] = ExpEquation.solve() 'Graph------------------------------------------------------------------------------ Local Schritt:Float = 0.125 Local x:Float = -70 Local Zoom:Float = GraphicsWidth() / (2x) SetColor 160, 160, 160 DrawText "Gesucht: Nullstellen von h(x) = (" + a + ") (" + b + ")^x - (" + c + ")x - (" + d + ")", 10, 10 DrawText "Bei Tastendruck gibt's andere Zufalls-Parameter . . .", 10, 30 DrawRect GraphicsWidth()/2, 0, 1, GraphicsHeight() DrawRect 0, GraphicsHeight()/2, GraphicsWidth(), 1 SetColor 255,0,0 Local y:Float, Memoy:Float = ab^x-cx-d While x =< 70 x = x + Schritt y = ab^x-cx-d DrawLine( GraphicsWidth()/2-Zoom(x-Schritt), GraphicsHeight()/2+ZoomMemoy, GraphicsWidth()/2-Zoomx, GraphicsHeight()/2+Zoomy) Memoy = y Wend SetColor 0,255,0 If Len(Solution) = 0 Then DrawText "Keine Nullstelle", 10, 50 ElseIf Len(Solution) = 1 Then DrawRect GraphicsWidth()/2-ZoomSolution[0], GraphicsHeight()/3, 1, GraphicsHeight()/3 DrawText "Eine Nullstelle x = " + Solution[0], 10, 50 Else 'If Len(Solution) = 2 Then DrawRect GraphicsWidth()/2-ZoomSolution[0], GraphicsHeight()/3, 1, GraphicsHeight()/3 DrawText "Erste Nullstelle x = " + Solution[0], 10, 50 DrawRect GraphicsWidth()/2-ZoomSolution[1], GraphicsHeight()/3, 1, GraphicsHeight()/3 DrawText "Zweite Nullstelle x = " + Solution[1], 10, 70 If Solution[0] = Solution[1] Then Notify "Eben sind beide Loesungen identisch. Macht Newton alles richtig?" End If Flip WaitKey() If KeyDown(KEY_ESCAPE) Or AppTerminate() = True Then End Cls Next ' Benutzerdefinierte Klasse "TExpEquation", © 2009, Udo Kinast Alias "BlitzMoritz" ' ================================================================= ' Diese Klasse soll eine erweiterte Exponentialgleichung der Form a · b^x = c · x + d lösen, ' für die es keine gewöhnliche Lösungsroutine gibt. Man kann sich die Aufgabenstellung auch als ' Schnittstelle einer Exponentialfunktion a · b^x mit der Geraden c · x + d vorstellen. ' Die Parameter, die der Funktion als Argumente zu übergeben sind, heißen a, b, c und d: ' a und c sind Koeffizienten, wobei c als Steigung der Geraden zu verstehen ist, ' d ist der y-Achsenabschnitt der Geraden und b die Basis der Potenz, die größer Null sein muss. ' Wiederum anders ausgedrückt geht es um die Nullstellen einer Funktion a · b^x - c · x - d ' Die Funktion gibt Null zurück, falls es keine Lösung gibt, ansonsten entweder ein ein- oder zwei- ' dimensionales Float-Array, je nachdem, ob es eine oder zwei Schnittstellen gibt. ' Die Genauigkeit der Näherungslösung wird mit dem optionalen Parameter "New_Exactness" definiert. '############################################################ Type TExpEquation '############################################################ Field a:Float, b:Float, c:Float, d:Float, Exactness:Float, Memo_New_X:Float '############################################################ Function build:TExpEquation(New_a:Float, New_b:Float, New_c:Float, New_d:Float, New_Exactness:Float = 0.001) '############################################################ Local NTEE:TExpEquation = New TExpEquation NTEE.a = New_a NTEE.b = New_b NTEE.c = New_c NTEE.d = New_d NTEE.Exactness = Max(New_Exactness, 0.000001) 'Eine Millionstel sei die Untergrenze Return NTEE '############################################################ End Function '############################################################ Method solve:Float[]() '############################################################ If b > 1 Then '--------------------------------------------------------------------------------------------------------- If a > 0 Then '------------------------------------------------------------------------------------------------- If c > 0 Then '----------------------------------------------------------------------------------------- Local xM:Float = Log(c/(aLog(b))) / Log(b) If cxM+d >= ab^xM Then Return [ Newton(-d/c, ab^(-d/c)-c(-d/c)-d), Newton( 2xM+d/c, ab^(2xM+d/c)-c(2xM+d/c)-d ) ] Else Return Null End If '----------------------------------------------------------------------------------------- ElseIf c < 0 Then '----------------------------------------------------------------------------------------- If d > a Then Return [ Newton(0, a-d)] ElseIf d < a Then Return [ Newton((a-d)/c, ab^((a-d)/c)-a ) ] Else 'd = a Return [0.0] End If '----------------------------------------------------------------------------------------- Else 'c = 0 '----------------------------------------------------------------------------------------- If d > 0 Then Return [ Float(Log(d/a) / Log (b)) ] Else 'd <= 0 Return Null End If '----------------------------------------------------------------------------------------- End If '------------------------------------------------------------------------------------------------- ElseIf a < 0 Then '------------------------------------------------------------------------------------------------- If c > 0 Then '----------------------------------------------------------------------------------------- If d > a Then Return [ Newton( (a-d)/c, ab^((a-d)/c)-c((a-d)/c)-d) ] ElseIf d < a Then Return [ Newton( 0, a-d ) ] Else 'd = a Return [0.0] End If '----------------------------------------------------------------------------------------- ElseIf c < 0 Then '----------------------------------------------------------------------------------------- Local xM:Float = Log(c/(aLog(b))) / Log(b) If cxM+d <= ab^xM Then Return [ Newton(-d/c, ab^(-d/c) ), Newton(2xM+d/c, ab^(2xM+d/c)-c(2xM+d/c)-d ) ] Else Return Null End If '----------------------------------------------------------------------------------------- Else 'c = 0 '----------------------------------------------------------------------------------------- If d < 0 Then Return [ Float(Log(d/a) / Log (b)) ] Else 'd >= 0 Return Null End If '----------------------------------------------------------------------------------------- End If '------------------------------------------------------------------------------------------------- Else 'a = 0 '------------------------------------------------------------------------------------------------- If c <> 0 Then '----------------------------------------------------------------------------------------- Return [ -d/c ] '----------------------------------------------------------------------------------------- Else 'c = 0 '----------------------------------------------------------------------------------------- If d = 0 Then Return [ 0.0, 0.0 ] '(Null zurückzugeben wäre falsch) Else 'if d <> 0 Return Null End If '----------------------------------------------------------------------------------------- End If '------------------------------------------------------------------------------------------------- End If '--------------------------------------------------------------------------------------------------------- ElseIf b < 1 And b > 0 Then '--------------------------------------------------------------------------------------------------------- If a > 0 Then '------------------------------------------------------------------------------------------------- If c > 0 Then '----------------------------------------------------------------------------------------- If d <> a Then Return [ Newton(-d/c, ab^(-d/c) ) ] Else 'd = a Return [0.0] End If '----------------------------------------------------------------------------------------- ElseIf c < 0 Then '----------------------------------------------------------------------------------------- Local xM:Float = Log(c/(aLog(b))) / Log(b) If cxM+d >= ab^xM Then Return [ Newton(2xM+d/c, ab^(2xM+d/c)-c(2xM+d/c)-d ), Newton(-d/c, ab^(-d/c)) ] Else Return Null End If '----------------------------------------------------------------------------------------- Else 'c = 0 '----------------------------------------------------------------------------------------- If d > 0 Then Return [ Float(Log(d/a) / Log (b)) ] Else 'd <= 0 Return Null End If '----------------------------------------------------------------------------------------- End If '------------------------------------------------------------------------------------------------- ElseIf a < 0 Then '------------------------------------------------------------------------------------------------- If c > 0 Then '----------------------------------------------------------------------------------------- Local xM:Float = Log(c/(aLog(b))) / Log(b) If cxM+d <= ab^xM Then Return [ Newton(2xM+d/c, ab^(2xM+d/c)-c(2xM+d/c)-d), Newton(-d/c, ab^(-d/c)) ] Else Return Null End If '----------------------------------------------------------------------------------------- ElseIf c < 0 Then '----------------------------------------------------------------------------------------- If d > a Then Return [ Newton( 0, a-d) ] ElseIf d < a Then Return [ Newton( -d/c, ab^(-d/c)) ] Else 'd = a Return [0.0] End If '----------------------------------------------------------------------------------------- Else 'c = 0 '----------------------------------------------------------------------------------------- If d < 0 Then Return [ Float(Log(d/a) / Log (b)) ] Else 'd >= 0 Return Null End If '----------------------------------------------------------------------------------------- End If '------------------------------------------------------------------------------------------------- Else 'a = 0 '------------------------------------------------------------------------------------------------- If c <> 0 Then '----------------------------------------------------------------------------------------- Return [ -d/c ] '----------------------------------------------------------------------------------------- Else 'c = 0 '----------------------------------------------------------------------------------------- If d = 0 Then Return [ 0.0, 0.0 ] '(Null zurückzugeben wäre falsch) Else 'if d <> 0 Return Null End If '----------------------------------------------------------------------------------------- End If '------------------------------------------------------------------------------------------------- End If '--------------------------------------------------------------------------------------------------------- ElseIf b = 1 Then '--------------------------------------------------------------------------------------------------------- If c <> 0 Then '------------------------------------------------------------------------------------------------- Return [ (a-d) / c ] '------------------------------------------------------------------------------------------------- Else 'c = 0 '------------------------------------------------------------------------------------------------- If a = d Then Return [ 0.0, 0.0 ] '(Null zurückzugeben wäre falsch) Else 'if a <> d Return Null End If '------------------------------------------------------------------------------------------------- End If '--------------------------------------------------------------------------------------------------------- Else 'b <= 0 '--------------------------------------------------------------------------------------------------------- Return Null '--------------------------------------------------------------------------------------------------------- End If '############################################################ End Method '############################################################ Method Newton:Float(Start_X:Float, Start_Y:Float) 'Näherungsverfahren '############################################################ If Abs(Start_Y) < Exactness Then Return Start_X Local New_X:Float = Start_X - (ab^Start_X-cStart_X-d) / (aLog(b)b^Start_X-c) If Abs(New_X - Memo_New_X) < Exactness Then Return New_X 'Auf diese Notbremse sollte nicht verzichtet werden. Memo_New_X = New_X Local New_Y:Float = ab^New_X-cNew_X-d Return Newton(New_X, New_Y) '############################################################ End Method '############################################################ End Type 'TExpEquation '############################################################

BlitzMoritz

Betreff: Erweiterte Exponentialgleichung lösen

So, Mai 10, 2009 21:27
Antworten mit Zitat

Ich bin bei einem meiner Projekte auf das Problem gestoßen, eine nicht-triviale Exponentialgleichung der folgenden Form lösen zu müssen:
a·b^x = c·x + d
Für jene, die es interessieren sollte, habe ich das Problem hier genauer erörtert:
Anleitung.pdf
Mit dem Konstruktionsprogramm "geogebra" und folgender Datei kann man sich's interaktiv veranschaulichen:
Konstruktionsdatei.ggb
Mit folgender BM-Klasse kann man die Aufgabe zuverlässlich und schnell lösen (inklusive Demoprogramm und Funktionsgraphen):
Code: [AUSKLAPPEN]

SuperStrict
SeedRnd MilliSecs()
AppTitle = "TExpEquation-Demo"
Graphics Desktop().Width-20, Desktop().Height-20
For Local i:Int = 0 To 99
Local a:Float = 10*Rnd()-5
Local b:Float = 5*Rnd()
Local c:Float = 10*Rnd()-5
Local d:Float = 10*Rnd()-5
Local ExpEquation:TExpEquation = TExpEquation.build(a, b, c, d)
Local Solution:Float[] = ExpEquation.solve()
'Graph------------------------------------------------------------------------------
Local Schritt:Float = 0.125
Local x:Float = -70
Local Zoom:Float = GraphicsWidth() / (2*x)
SetColor 160, 160, 160
DrawText "Gesucht: Nullstellen von h(x) = (" + a + ") * (" + b + ")^x - (" + c + ")*x - (" + d + ")", 10, 10
DrawText "Bei Tastendruck gibt's andere Zufalls-Parameter . . .", 10, 30
DrawRect GraphicsWidth()/2, 0, 1, GraphicsHeight()
DrawRect 0, GraphicsHeight()/2, GraphicsWidth(), 1
SetColor 255,0,0
Local y:Float, Memoy:Float = a*b^x-c*x-d
While x =< 70
   x = x + Schritt
   y = a*b^x-c*x-d
   DrawLine( GraphicsWidth()/2-Zoom*(x-Schritt), GraphicsHeight()/2+Zoom*Memoy, GraphicsWidth()/2-Zoom*x, GraphicsHeight()/2+Zoom*y)
   Memoy = y
Wend
SetColor 0,255,0
If Len(Solution) = 0 Then
   DrawText "Keine Nullstelle", 10, 50
ElseIf Len(Solution) = 1 Then
   DrawRect GraphicsWidth()/2-Zoom*Solution[0], GraphicsHeight()/3, 1, GraphicsHeight()/3
   DrawText "Eine Nullstelle x = " + Solution[0], 10, 50
Else 'If Len(Solution) = 2 Then
   DrawRect GraphicsWidth()/2-Zoom*Solution[0], GraphicsHeight()/3, 1, GraphicsHeight()/3
   DrawText "Erste Nullstelle x = " + Solution[0], 10, 50
   DrawRect GraphicsWidth()/2-Zoom*Solution[1], GraphicsHeight()/3, 1, GraphicsHeight()/3
   DrawText "Zweite Nullstelle x = " + Solution[1], 10, 70
   If Solution[0] = Solution[1] Then Notify "Eben sind beide Loesungen identisch. Macht Newton alles richtig?"
End If
Flip
WaitKey()
If KeyDown(KEY_ESCAPE) Or AppTerminate() = True Then End
Cls
Next
' Benutzerdefinierte Klasse "TExpEquation", © 2009, Udo Kinast Alias "BlitzMoritz"
' =================================================================
' Diese Klasse soll eine erweiterte Exponentialgleichung der Form a · b^x = c · x + d lösen,
' für die es keine gewöhnliche Lösungsroutine gibt. Man kann sich die Aufgabenstellung auch als
' Schnittstelle einer Exponentialfunktion a · b^x mit der Geraden c · x + d vorstellen.
' Die Parameter, die der Funktion als Argumente zu übergeben sind, heißen a, b, c und d:
' a und c sind Koeffizienten, wobei c als Steigung der Geraden zu verstehen ist,
' d ist der y-Achsenabschnitt der Geraden und b die Basis der Potenz, die größer Null sein muss.
' Wiederum anders ausgedrückt geht es um die Nullstellen einer Funktion a · b^x - c · x - d
' Die Funktion gibt Null zurück, falls es keine Lösung gibt, ansonsten entweder ein ein- oder zwei-
' dimensionales Float-Array, je nachdem, ob es eine oder zwei Schnittstellen gibt.
' Die Genauigkeit der Näherungslösung wird mit dem optionalen Parameter "New_Exactness" definiert.

'############################################################
Type TExpEquation
'############################################################
Field a:Float, b:Float, c:Float, d:Float, Exactness:Float, Memo_New_X:Float
'############################################################
Function build:TExpEquation(New_a:Float, New_b:Float, New_c:Float, New_d:Float, New_Exactness:Float = 0.001)
'############################################################
   Local NTEE:TExpEquation = New TExpEquation
   NTEE.a = New_a
   NTEE.b = New_b
   NTEE.c = New_c
   NTEE.d = New_d
   NTEE.Exactness = Max(New_Exactness, 0.000001) 'Eine Millionstel sei die Untergrenze
   Return NTEE
'############################################################
End Function
'############################################################
Method solve:Float[]()
'############################################################
   If b > 1 Then
   '---------------------------------------------------------------------------------------------------------
      If a > 0 Then
      '-------------------------------------------------------------------------------------------------
         If c > 0 Then
         '-----------------------------------------------------------------------------------------
            Local xM:Float = Log(c/(a*Log(b))) / Log(b)
            If c*xM+d >= a*b^xM Then
               Return [ Newton(-d/c, a*b^(-d/c)-c*(-d/c)-d), Newton( 2*xM+d/c, a*b^(2*xM+d/c)-c*(2*xM+d/c)-d ) ]
            Else
               Return Null
            End If
         '-----------------------------------------------------------------------------------------
         ElseIf c < 0 Then
         '-----------------------------------------------------------------------------------------
            If d > a Then
               Return [ Newton(0, a-d)]
            ElseIf d < a Then
               Return [ Newton((a-d)/c, a*b^((a-d)/c)-a ) ]
            Else 'd = a
               Return [0.0]
            End If
         '-----------------------------------------------------------------------------------------
         Else 'c = 0
         '-----------------------------------------------------------------------------------------
            If d > 0 Then
               Return [ Float(Log(d/a) / Log (b)) ]
            Else 'd <= 0
               Return Null
            End If
         '-----------------------------------------------------------------------------------------
         End If
      '-------------------------------------------------------------------------------------------------
      ElseIf a < 0 Then
      '-------------------------------------------------------------------------------------------------
         If c > 0 Then
         '-----------------------------------------------------------------------------------------
            If d > a Then
               Return [ Newton( (a-d)/c, a*b^((a-d)/c)-c*((a-d)/c)-d) ]
            ElseIf d < a Then
               Return [ Newton( 0, a-d ) ]
            Else 'd = a
               Return [0.0]
            End If
         '-----------------------------------------------------------------------------------------
         ElseIf c < 0 Then
         '-----------------------------------------------------------------------------------------
            Local xM:Float = Log(c/(a*Log(b))) / Log(b)
            If c*xM+d <= a*b^xM Then
               Return [ Newton(-d/c, a*b^(-d/c) ), Newton(2*xM+d/c, a*b^(2*xM+d/c)-c*(2*xM+d/c)-d ) ]
            Else
               Return Null
            End If
         '-----------------------------------------------------------------------------------------
         Else 'c = 0
         '-----------------------------------------------------------------------------------------
            If d < 0 Then
               Return [ Float(Log(d/a) / Log (b)) ]
            Else 'd >= 0
               Return Null
            End If
         '-----------------------------------------------------------------------------------------
         End If
      '-------------------------------------------------------------------------------------------------
      Else 'a = 0
      '-------------------------------------------------------------------------------------------------
         If c <> 0 Then
         '-----------------------------------------------------------------------------------------
            Return [ -d/c ]
         '-----------------------------------------------------------------------------------------
         Else 'c = 0
         '-----------------------------------------------------------------------------------------
            If d = 0 Then
               Return [ 0.0, 0.0 ] '(Null zurückzugeben wäre falsch)
            Else 'if d <> 0
               Return Null
            End If
         '-----------------------------------------------------------------------------------------
         End If
      '-------------------------------------------------------------------------------------------------
      End If
   '---------------------------------------------------------------------------------------------------------
   ElseIf b < 1 And b > 0 Then
   '---------------------------------------------------------------------------------------------------------
      If a > 0 Then
      '-------------------------------------------------------------------------------------------------
         If c > 0 Then
         '-----------------------------------------------------------------------------------------
            If d <> a Then
               Return [ Newton(-d/c, a*b^(-d/c) ) ]
            Else 'd = a
               Return [0.0]
            End If
         '-----------------------------------------------------------------------------------------
         ElseIf c < 0 Then
         '-----------------------------------------------------------------------------------------
            Local xM:Float = Log(c/(a*Log(b))) / Log(b)
            If c*xM+d >= a*b^xM Then
               Return [ Newton(2*xM+d/c, a*b^(2*xM+d/c)-c*(2*xM+d/c)-d ), Newton(-d/c, a*b^(-d/c)) ]
            Else
               Return Null
            End If
         '-----------------------------------------------------------------------------------------
         Else 'c = 0
         '-----------------------------------------------------------------------------------------
            If d > 0 Then
               Return [ Float(Log(d/a) / Log (b)) ]
            Else 'd <= 0
               Return Null
            End If
         '-----------------------------------------------------------------------------------------
         End If
      '-------------------------------------------------------------------------------------------------
      ElseIf a < 0 Then
      '-------------------------------------------------------------------------------------------------
         If c > 0 Then
         '-----------------------------------------------------------------------------------------
            Local xM:Float = Log(c/(a*Log(b))) / Log(b)
            If c*xM+d <= a*b^xM Then
               Return [ Newton(2*xM+d/c, a*b^(2*xM+d/c)-c*(2*xM+d/c)-d), Newton(-d/c, a*b^(-d/c)) ]
            Else
               Return Null
            End If
         '-----------------------------------------------------------------------------------------
         ElseIf c < 0 Then
         '-----------------------------------------------------------------------------------------
            If d > a Then
               Return [ Newton( 0, a-d) ]
            ElseIf d < a Then
               Return [ Newton( -d/c, a*b^(-d/c)) ]
            Else 'd = a
               Return [0.0]
            End If
         '-----------------------------------------------------------------------------------------
         Else 'c = 0
         '-----------------------------------------------------------------------------------------
            If d < 0 Then
               Return [ Float(Log(d/a) / Log (b)) ]
            Else 'd >= 0
               Return Null
            End If
         '-----------------------------------------------------------------------------------------
         End If
      '-------------------------------------------------------------------------------------------------
      Else 'a = 0
      '-------------------------------------------------------------------------------------------------
         If c <> 0 Then
         '-----------------------------------------------------------------------------------------
            Return [ -d/c ]
         '-----------------------------------------------------------------------------------------
         Else 'c = 0
         '-----------------------------------------------------------------------------------------
            If d = 0 Then
               Return [ 0.0, 0.0 ] '(Null zurückzugeben wäre falsch)
            Else 'if d <> 0
               Return Null
            End If
         '-----------------------------------------------------------------------------------------
         End If
      '-------------------------------------------------------------------------------------------------
      End If
   '---------------------------------------------------------------------------------------------------------
   ElseIf b = 1 Then
   '---------------------------------------------------------------------------------------------------------
      If c <> 0 Then
      '-------------------------------------------------------------------------------------------------
         Return [ (a-d) / c ]
      '-------------------------------------------------------------------------------------------------
      Else 'c = 0
      '-------------------------------------------------------------------------------------------------
         If a = d Then
            Return [ 0.0, 0.0 ] '(Null zurückzugeben wäre falsch)
         Else 'if a <> d
            Return Null
         End If
      '-------------------------------------------------------------------------------------------------
      End If
   '---------------------------------------------------------------------------------------------------------
   Else 'b <= 0
   '---------------------------------------------------------------------------------------------------------
      Return Null
   '---------------------------------------------------------------------------------------------------------
   End If
'############################################################
End Method
'############################################################
Method Newton:Float(Start_X:Float, Start_Y:Float) 'Näherungsverfahren
'############################################################
   If Abs(Start_Y) < Exactness Then Return Start_X
   Local New_X:Float = Start_X - (a*b^Start_X-c*Start_X-d) / (a*Log(b)*b^Start_X-c)
   If Abs(New_X - Memo_New_X) < Exactness Then Return New_X 'Auf diese Notbremse sollte nicht verzichtet werden.
   Memo_New_X = New_X
   Local New_Y:Float = a*b^New_X-c*New_X-d
   Return Newton(New_X, New_Y)
'############################################################
End Method
'############################################################
End Type 'TExpEquation
'############################################################