 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
BOB_BOB
Anmeldungsdatum: 02.01.2015
Beiträge: 13
|
 Verfasst am: 03.03.2015, 18:07 Titel: |
 |
|
Nach ein paar Wochen einer Zwangspause habe ich mich wieder ein wenig mit meinem Programm beschäftigt. Ich möchte jetzt ein Koordinatensystem zeichnen.
Die Intervallgrenzen der X Achse möchte ich selber bestimmen. Hier Variable lg!
die Variable g1! wertet mir den Abstand zwischen den Hoch und Tiefpunkt aus. Über den Abstand Abstand will ich nun die Y-Achse an die Funktion anpassen. Wenn g1! größer als 1 ist kriege ich das auch hin. Aber wenn g1! (Also der Abstand zwischen Hoch und Tiefpunkt keiner 1 ist) kleiner 1 ist kriege ich das nicht hin.
Ist mein Koordinatensystem totaler murks? Habt ihr bessere Ideen?
Weiter habe ich mir Idee/Gedanken gemacht wenn der Hoch und Tiefpunkt über bzw unterhalb der X_Achse liegt mir dann nur den 1 und 2 Quadranten bzw den 3 und 4 Quadraten anzeigen zu lassen. Dazu möchte ich dann halt die X-Achse verschieben.
Und wenn die ganze Funktion nun in einem Quadraten ist dann halt nun den Quadraten anzeigen lassen.
Es handelt sich um eine Funktion 3. Grades.
Hier mal mein Koordinatensystem
| Code: | INPUT "Geben sie die gewnschte Intervallgrenze ein__"; lg!
SCREEN 12
IF g1! > 1 THEN
WINDOW (-320, -240)-(320, 240)
LINE (0, 240)-(0, -240), 5
LINE (-320, 0)-(320, 0), 5
FOR i% = 1 TO 100 STEP 1
LINE (i% * 310 / lg!, 3)-(i% * 310 / lg!, -4)
LINE (i% * -310 / lg!, 3)-(i% * -310 / lg!, -4)
LINE (-3, i% * 240 / g1!)-(4, i% * 240 / g1!)
LINE (-3, i% * -240 / g1!)-(4, i% * -240 / g1!)
NEXT i%
FOR i# = -320 TO 320 STEP 1 / 400
PSET (i# * 310 / lg!, (a! * i# ^ 3 + b! * i# ^ 2 + c! * i# + d!) * 240 / g1!), 11
NEXT
ELSEIF g1! < 1 THEN
WINDOW (-320, -240)-(320, 240)
LINE (0, 240)-(0, -240), 5
LINE (-320, 0)-(320, 0), 5
FOR i% = 1 TO 100 STEP 1
LINE (i% * 310 / lg!, 3)-(i% * 310 / lg!, -4)
LINE (i% * -310 / lg!, 3)-(i% * -310 / lg!, -4)
LINE (-3, i% * 240 / 1)-(4, i% * 240 / 1)
LINE (-3, i% * -240 / 1)-(4, i% * -240 / 1)
NEXT i%
FOR i# = -320 TO 320 STEP 1 / 400
PSET (i# * 310 / lg!, (a! * i# ^ 3 + b! * i# ^ 2 + c! * i# + d!) * 240 / 1), 11
NEXT
END IF
|
gruß BOB |
|
| Nach oben |
|
 |
BOB_BOB
Anmeldungsdatum: 02.01.2015
Beiträge: 13
|
| Verfasst am: 15.04.2015, 20:48 Titel: |
|
|
Hallo, ich bin immer mal wieder an meinem kleinen Programm dran.
Ich habe 2 kleine Probleme/Fragen.
Folgende Situation: Ich habe ja ein Programm für Funktionen 3. Grades.
Ich möchte die Nullstellen bestimmen. Bisher habe ich eine Nullstelle immer vorgegeben und dann über das Horner Schema runter gebrochen auf eine Funktion 2. Grades. Dann konnte ich mit der pq-Formel die restlichen Nullstellen bestimmen(wenn vorhanden). Hat prinzipiell auch gut geklappt. Nur ich habe das Problem wenn die Nullstelle die ich selber eingeben möchte keine ganze Zahl ist. Wenn die Nullstelle z.B. 1.453623 beträgt kann ich die zwar eingeben aber wenn ich sie übers Horner Schema überprüfe müsste für d1! genau Null raus kommen. Das ist dann fast unmöglich aufgrund von Rundungsdifferenzen. Gibts einen Trick wie ich die Zahlen z.B. auf 2 Stellen runden lassen kann?
Meine nächste Idee ist jetzt die erste fehlende Nullstelle durch "raten" raus zubekommen. Dazu hatte ich die Idee über eine for next Schleife von -10 bis 10 in 0.01 Schritten durch laufen zu lassen. Dabei müsste jedesmal das Horner Schema durchlaufen werden und wenn bei d1!=0 raus kommt wurde die erste Nullstelle "erraten" und dann kann es weiter im Programm gehen.Im Moment sieht das bei mir so aus.
a!,b!,c! und d! ja die Variablen die ich eingebe.
x01! soll die erste "geratene" Nullstelle sein die ich bisher manuell eingeben musst. Diese soll ja nun und die for next Anweisung geraten werden. Aber funktioniert leider nicht so wie ich das möchte. Da bräuchte ich bitte eure Hilfe.
b1!,c1! und d1! sind dann neue Variablen mit der ich in der pq-Formel weiter rechen kann.
| Code: | LOCATE 5, 11
PRINT " f(x)=a*x^3+b*x^2+c*x+d"
LOCATE 7, 10
INPUT "a= ", a!
IF a = 0 THEN
COLOR 12
LOCATE 9, 10
PRINT "Falsche Eingabe, Variable a muss <>0 sein!!"
COLOR 0
LOCATE 11, 10
PRINT "Weiter mit beliebiger Taste"
SLEEP
CLS
GOTO a1
ELSE
LOCATE 9, 10
INPUT "b= ", b!
LOCATE 11, 10
INPUT "c= ", c!
LOCATE 13, 10
INPUT "d= ", d!
END IF
IF d! = 0 THEN
x01! = d!
ELSE
FOR x01! = -10 TO 10 STEP 0.01
b1! = a! * x01! + b!
c1! = b1! * x01! + c!
d1! = c1! * x01! + d!
NEXT x01!
END IF |
gruß Bob |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4710
Wohnort: ~/
|
| Verfasst am: 15.04.2015, 23:41 Titel: |
|
|
Für Polynome 3. (und 4.) Grades kannst du die Nullstellen noch direkt berechnen (für höhere Grade dann nicht mehr). Wenn du dir das zutraust:
http://de.wikipedia.org/wiki/Kubische_Gleichung
Wenn ich das auf die Schnelle richtig sehe, ist das hier eine schöne Seite, wo du dir die Rechenschritte nochmal genau zeigen lassen kannst:
http://www.arndt-bruenner.de/mathe/scripts/polynome.htm
Ansonsten verwendet man dann zur Nullstellenbestimmung (insb. am Computer) eher schon wieder Näherungsverfahren wie Newton, weil man, wie du schon schreibst, mit dem Horner-Schema schnell Rundungsprobleme bekommt.
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
grindstone
Anmeldungsdatum: 03.10.2010
Beiträge: 1283
Wohnort: Ruhrpott
|
| Verfasst am: 16.04.2015, 09:29 Titel: |
|
|
Die Idee mit der Schleife und den 0.01 - Schritten ist nicht schlecht, allerdings wäre es reiner Zufall, wenn du damit die Nullstelle genau treffen würdest. Du kannst allerdings sicher feststellen, ob zwischen zwei Werten eine Nullstelle liegt, wenn nämlich das Vorzeichen des Ergebnisses wechselt (Voraussetzung ist natürlich, daß die Schrittweite klein genug ist, daß sich zwischen zwei Werten garantiert nur eine Nullstelle befindet).
Wenn du ein solches Intervall gefunden hat, kannst du dich mithilfe der sukzessiven Approximation an den exakten Wert der Nullstelle herantasten: Du hast ja jetzt einen "unteren" x - Wert auf der einen und einen "oberen" x - Wert auf der anderen Seite der Nullstelle. Von diesen beiden x- Werten bildest du die Differenz, halbierst sie und addierst sie zum "unteren" x - Wert.
Von diesem neuen "mittleren" x - Wert berechnest du den Funktionswert und siehst dir dessen Vorzeichen an. Hat er dasselbe Vorzeichen wie beim "unteren" x - Wert, liegt die Nullstelle zwischen dem "mittleren" und dem "oberen" x - Wert, und der "mittlere" wird dein neuer "unterer" x - Wert.
Entsprechend liegt die Nullstelle zwischen dem "unteren" und dem "mittleren" x - Wert, wenn das Ergebnis das gleiche Vorzeichen hat wie beim "oberen" x - Wert, und der "mittlere" wird dein neuer "oberer" x - Wert.
Dieses Spielchen (Differenz bilden -> halbieren -> zum unteren x - Wert addieren -> in Funktion einsetzen -> je nach Ergebnis unteren oder oberen Wert austauschen) wiederholst du nun so lange, bis du die Nullstelle gefunden hast oder dem Ergebnis ausreichend nahegekommen bist.
Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen! |
|
| Nach oben |
|
|
Toa-Nuva
Anmeldungsdatum: 14.04.2006
Beiträge: 204
Wohnort: München
|
| Verfasst am: 16.04.2015, 16:03 Titel: |
|
|
| grindstone hat Folgendes geschrieben: | | Du kannst allerdings sicher feststellen, ob zwischen zwei Werten eine Nullstelle liegt, wenn nämlich das Vorzeichen des Ergebnisses wechselt (Voraussetzung ist natürlich, daß die Schrittweite klein genug ist, daß sich zwischen zwei Werten garantiert nur eine Nullstelle befindet). |
Es gibt allerdings auch den Fall, dass die Nullstelle gleichzeitig ein Maximum oder Minimum ist. x² oder -x² wären da zwei triviale Beispiele, wo das der Fall ist. Da ist die Nullstelle bei x=0, aber bei x-Werten größer oder kleiner als 0 ist das Vorzeichen des Ergebnisses trotzdem jeweils gleich.
_________________
704 Signature not found |
|
| Nach oben |
|
|
BOB_BOB
Anmeldungsdatum: 02.01.2015
Beiträge: 13
|
| Verfasst am: 16.04.2015, 16:08 Titel: |
|
|
Hallo, ich danke euch für eure Antworten und links.
Die Polynomdivision ist mir bekannt. Horner Schema ist ja letztlich auc h nichts anderes und für deine Verfahren muss ich eine Nullstelle raten.
Ich würde gerne erstmal meine Version mit einer Schleife zum laufen bringen. Da komme ich ja nicht weiter. Probiere ja mir bekannte Funktionen wo ich die Nullstellen kenne. Im Programm sehe ich ja dann ob es richtig rechnet. An den mathematischen Gundlagen im Bereich der Differentialrechnung scheitere ich nicht eher an meinen begrenzten QB Fähigkeiten 
Was muss ich den an meiner Schleife verändern? Oder ist die totaler Mist?
Gruß Bob |
|
| Nach oben |
|
|
grindstone
Anmeldungsdatum: 03.10.2010
Beiträge: 1283
Wohnort: Ruhrpott
|
| Verfasst am: 17.04.2015, 11:30 Titel: |
|
|
| BOB_BOB hat Folgendes geschrieben: | | Was muss ich den an meiner Schleife verändern? Oder ist die totaler Mist? |
Na ja, dein Programm berechnet 2000 Funktionswerte, ohne irgend etwas damit zu machen.
@Toa-Nuva: Du hast natürlich Recht, ich habe das im folgenden Lösungsansatz berücksichtigt.
@BOB_BOB: Wenn du die Nullstellen schon mit der brute force - Methode suchst, dann mach es gleich richtig.
Vor allen Dingen mußt du die Rundungsfehler in den Griff bekommen. Das geht einerseits dadurch, daß die Funktionswerte nicht mit einfacher, sondern mit doppelter Genauigkeit berechnet werden, und zum anderen kann man mit einem kleinen Trick dafür sorgen, daß die sich bei jedem Schleifendurchlauf aufsummierenden Rundungsfehler der Laufvariablen auf einen einzigen reduziert werden.
Ich habe dein Programm mal entsprechend umgeschrieben: | Code: | a1:
Locate 5, 11
Print " f(x)=a*x^3+b*x^2+c*x+d"
Locate 7, 10
Input "a= ", a#
If a# = 0 Then
Color 12
Locate 9, 10
Print "Falsche Eingabe, Variable a muss <>0 sein!!"
Color 0
Locate 11, 10
Print "Weiter mit beliebiger Taste"
Sleep
Cls
GoTo a1
Else
Locate 9, 10
Input "b= ", b#
Locate 11, 10
Input "c= ", c#
Locate 13, 10
Input "d= ", d#
End If
aufloesung& = 1000000 'schrittweite 0,000001
Print
For x& = -10 * aufloesung& To 10 * aufloesung&
x01# = x& / aufloesung&
b1# = a# * x01# + b#
c1# = b1# * x01# + c#
d1# = c1# * x01# + d#
If (Abs(d1#) > Abs(d1vor#)) And (trend% = 1) Then
'nullstelle oder extremwert gefunden
Print "x = ";x01vor#;" f(x) = ";d1vor#
trend% = 0
ElseIf Abs(d1#) < Abs(d1vor#) Then
trend% = 1
EndIf
d1vor# = d1#
x01vor# = x01#
Next
Print
Print "OK"
Sleep
|
Das Prinzip ist einfach: Das Programm berechnet nacheinander alle Funktionswerte und prüft durch Vergleich mit dem vorangegangenen Wert, ob diese sich auf die x - Achse zu- oder von ihr wegbewegen. Wenn sich ein Wert von der x - Achse wegbewegt, während der vorige sich noch darauf zubewegt hat, hat entweder der Graph die x - Achse geschnitten, oder es liegt ein Extremwert vor.
Du brauchst hier auch keine Nullstelle zu erraten, das Programm berechnet alles von alleine.
Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen! |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4710
Wohnort: ~/
|
| Verfasst am: 17.04.2015, 18:35 Titel: |
|
|
Dann will ich doch nochmal Werbung für die von mir oben genannte direkte Berechnungsmethode machen 
| Code: | #define PI 3.141592653589793
sub nullstellen(a as double, b as double, c as double, d as double)
' berechnet die Lösungen der Gleichung ax^3 + bx^2 + cx + d = 0
if a = 0 then
print "Kubische Gleichungen funktionieren nur mit a <> 0."
exit sub
end if
dim as double p = -1/9*(b/a)^2 + c/3/a, q = 1/27*(b/a)^3 - 1/6*b*c/(a^2) + d/2/a
' Rundungsfehler nahe 0 eliminieren
if abs(p) < 1e-15 then p = 0
if abs(q) < 1e-15 then q = 0
dim as double s = q^2 + p^3
if abs(s) < 1e-15 then s = 0
select case s
case is < 0
print "Es gibt drei reelle Loesungen:"
case 0
if q = 0 then
print "Es gibt eine reelle Loesung (dreifache Nullstelle):"
else
print "Es gibt zwei reelle Loesungen:"
end if
case else
print "Es gibt eine reelle (und zwei komplexe) Loesung:"
end select
if s >= 0 then
if q = 0 then
dim as single x = -b/3/a
print "x1,2,3 = " & x
else
dim as double u, v
if -q + sqr(s) > 0 then u = (-q + sqr(s))^(1/3) else u = -(q - sqr(s))^(1/3)
if -q - sqr(s) > 0 then v = (-q - sqr(s))^(1/3) else v = -(q + sqr(s))^(1/3)
dim as single x1 = u+v-b/3/a, x2 = -(u+v)/2-b/3/a
print "x1 = " & x1
if s = 0 then print "x2,3 = " & x2
end if
else
dim as double phi = acos(-q/sqr(-p^3))
dim as single x(1 to 3) = { 2*sqr(-p)*cos(phi/3) - b/3/a, _
-2*sqr(-p)*cos(phi/3+PI/3) - b/3/a, _
-2*sqr(-p)*cos(phi/3-PI/3) - b/3/a }
for i as integer = 1 to 3
print "x" & i & " = " & x(i)
next
end if
end sub
nullstellen(1, -2, -5, 6)
|
Ich hoffe, dass sich keine Fehler eingeschlichen haben.
edit: dreifache Nullstelle hinzugefügt, und Rundungsfehler für p = 0 und/oder q = 0 eliminiert (keine Ahnung, ob man das in dieser Form machen darf ...)
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
BOB_BOB
Anmeldungsdatum: 02.01.2015
Beiträge: 13
|
| Verfasst am: 17.04.2015, 22:54 Titel: |
|
|
Guten Abend,
vielen Dank für euch Unterstützung:-)
@nemored dein Lösungsansatz ist super. Aber ich denke das dass meine Kenntnisse im Moment übersteigt. Aber ich werde deine Version mit Sicherheit ausprobieren.
@grindstone
dir danke ich auch. Deine Version kommt meinen Vorstellungen am nächsten. Wie kann ich dafür sorgen das deine Schleife solange rechnet bis d1# =0 ist und ich die dafür probierte Nullstelle (hier x01#) raus kriege. Also das Programm soll stoppen wenn d1#=0 ist und ich möchte dann die Nullstelle (xo1#) haben. Mit dieser kann ich ja dann im Horner Schema auf eine Funktion 2. Grades runter brechen und dann auch per pq Formel die anderen Nullstellen berechnen.
Zu deinem Lösungsansatz habe ich natürlich Fragen:-)
was hat es mit dem trend% auf sich?
Vielen vielen Dank für eure Bemühungen:-)
Gruß Bob |
|
| Nach oben |
|
|
grindstone
Anmeldungsdatum: 03.10.2010
Beiträge: 1283
Wohnort: Ruhrpott
|
| Verfasst am: 18.04.2015, 09:46 Titel: |
|
|
| BOB_BOB hat Folgendes geschrieben: | | Wie kann ich dafür sorgen das deine Schleife solange rechnet bis d1# =0 ist und ich die dafür probierte Nullstelle (hier x01#) raus kriege. |
Das dürfte kaum möglich sein, dafür rechnet der Computer (immer noch) zu ungenau. Das ist ja auch der Grund, weshalb das Programm nicht einfach auf 0 testet, sondern die Werte herausfischt, die am dichtesten bei 0 liegen. Man könnte die gefundenen Nullstellen jetzt "nachiterieren", also mit einem anderen Berechnungsverfahren wie beispielsweise der Regula falsi oder dem Newton - Verfahren weiter präzisieren, aber wenn man ein solches Berechnungsverfahren sowieso implementieren muß, kann man auch gleich komplett damit rechnen.
| Zitat: | was hat es mit dem trend% auf sich?
|
Im ersten Entwurf hatte ich diese Variable "draufzu%" genannt, das macht ihren Zweck vielleicht deutlicher. Sie wird auf 1 gesetzt, wenn sich die Funktionswerte auf 0 zubewegen, und auf 0, wenn sie sich davon entfernen. Ohne dieses Flag würde die Abfrage auf jeden Wert reagieren, der sich von 0 entfernt, und das soll sie ja nicht, sie soll ja nur den ersten Wert festhalten, der das tut. Für den zweiten und alle weiteren Werte wird die Abfrage damit gesperrt.
Aber ich habe hier noch etwas anderes gebastelt, das mit dem Newton - Verfahren arbeitet. Damit werden die Nullstellen mit der maximal erreichbaren Genauigkeit berechnet, und das für Polynome beliebigen Grades (Mein Gott, wenn mir in der Oberstufe jemand gesagt hätte, daß ich mich einmal freiwillig mit so etwas beschäftigen würde, hätte ich ihn glatt für verrückt erklärt ). | Code: |
ReDim As Double ko(1), nullstelle(1), kd(1)
Dim As Double x
Dim As Integer i, n, j
Declare Function horner(x As Double, ko() As Double) As Double
Declare Sub ableitung(ko() As Double, ko1a() As Double)
Declare Function newton(anf As Double, ko() As Double) As Double
Declare Sub poldiv(n As Double, ko() As Double, kd() As Double)
ReDim ko(5)
ko(1) = 1
ko(2) = 5
ko(3) = 5
ko(4) = -5
ko(5) = -6
'polynom auf bildschirm ausgeben
For i = 1 To UBound(ko) - 1
Print " ";
If ko(i) > 0 Then
Print "+";
EndIf
Print Str(ko(i));"x^";Str(UBound(ko) - i);
Next
Print " ";
If ko(UBound(ko)) > 0 Then
Print "+";
EndIf
Print Str(ko(UBound(ko)))
Print
Print
'nullstellen berechnen
ReDim nullstelle(1)
i = 1
Do
nullstelle(i) = newton(0,ko()) 'nullstelle suchen
If Str(nullstelle(i)) = "-1.#INF" Then 'keine (weitere) nullstelle gefunden
If i = 1 Then
Print "keine Nullstellen"
EndIf
Exit Do
EndIf
Print i;". Nullstelle ";nullstelle(i) 'nullstelle auf bildschirm
poldiv(nullstelle(i), ko(), kd()) 'polynomdivision durchführen
i += 1
ReDim ko(UBound(kd)) 'koeffizientenarray verkleinern
For j = 1 To UBound(kd) 'koeffizienten übertragen
ko(j) = kd(j)
Next
ReDim Preserve nullstelle(i) 'nullstellenarray erweitern
Loop
Print
Print "OK"
Sleep
End
Function horner(x As Double, k() As Double) As Double
Dim As Double f
Dim As Integer i
'funktionswert mithilfe des horner - schemas berechnen
f = k(1)
For i = 2 To UBound(k)
f = f * x + k(i)
Next
Return f
End Function
Sub ableitung(k() As Double, k1a() As Double)
Dim As Integer grad = UBound(k), i
ReDim k1a(grad - 1) 'koeffizientenarray für 1. ableitung anlegen
For i = 1 To grad - 1 '1. ableitung bilden
k1a(i) = k(i) * (grad - i)
Next
End Sub
Function newton(anfang As Double, k() As Double) As Double
Dim As Double x = anfang, xvor
ReDim As Double k1a(1)
Dim As Integer i
ableitung(k(), k1a()) '1. ableitung des polynoms bilden
For i = 1 To 10000 'maximal 10000 schritte
x = x - (horner(x,k()) / horner(x,k1a())) 'iterationsschritt durchführen
'? "~";x
If x = xvor Then 'wert verändert sich nicht mehr -> maximale genauigkeit erreicht
Return x
EndIf
xvor = x 'vorherigen wert merken
Next
Return x
End Function
Sub poldiv(n As Double, k() As Double, kd() As Double)
Dim As Integer i
ReDim kd(UBound(k) - 1)
ReDim As Double karb(UBound(k))
For i = 1 To UBound(k) 'koeffizienten in arbeitskopie übertragen
karb(i) = k(i)
Next
'polynomdivision durchführen
For i = 1 To UBound(kd)
kd(i) = karb(i)
karb(i + 1) = karb(i + 1) + (karb(i) * n)
Next
End Sub |
@nemored: Dein Programm rechnet übrigens korrekt (oder meins macht dieselben Fehler )
Gruß
grindstone
EDIT: @ BOB_BOB: Für dich habe ich auch noch eine Version des Programms für QBasic hochgeladen.
EDIT 2: Ganz so einfach ist die Sache doch nicht. Wenn während der Iteration die 1. Ableitung irgendwo eine Nullstelle hat, gibt's Probleme.  Ich arbeite daran...
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen! |
|
| Nach oben |
|
|
grindstone
Anmeldungsdatum: 03.10.2010
Beiträge: 1283
Wohnort: Ruhrpott
|
| Verfasst am: 22.04.2015, 08:38 Titel: |
|
|
So, diese Programmversion dürfte jetzt halbwegs wasserdicht sein. Ich habe den ersten Lösungsansatz wieder aufgegriffen, eine Kombination aus brute force und Intervallhalbierung, unter Berücksichtigung des (berechtigten) Einwands von Toa-Nuva. Als Nebenprodukt liefert das Programm jetzt auch noch die Extremwerte mit.
In Kombination mit nemoreds Funktionsplotter (siehe auch hier) ein nettes Tool zur Hausaufgabenhilfe . | Code: | #Include "file.bi"
Type nuex
x As Double ' x
f As Double ' f(x)
f1a As Double ' f'(x)
f2a As Double ' f''(x)
End Type
Dim n As nuex
ReDim As Double ko(1)
Dim As Double von, bis, schritt, xvor
Dim As Integer i
Dim As String polynom, plotter
Declare Function horner(x As Double, ko() As Double) As Double
Declare Sub ableitung(ko() As Double, ko1a() As Double)
Declare Function nullex(von As Double, bis As Double, schritt As Double, ko() As Double) As nuex
ReDim ko(5)
ko(1) = 1
ko(2) = 5
ko(3) = 5
ko(4) = -5
ko(5) = -6
'polynom auf bildschirm ausgeben
polynom = ""
For i = 1 To UBound(ko) - 1
Print " ";
If (ko(i) >= 0) And (i <> 1) Then
Print "+";
polynom += "+"
EndIf
Print Str(ko(i));"x^";Str(UBound(ko) - i);
polynom += Str(ko(i)) + "*x " + Str(UBound(ko) - i)
Next
Print " ";
If ko(UBound(ko)) >= 0 Then
Print "+";
polynom += "+"
EndIf
Print Str(ko(UBound(ko)))
polynom += Str(ko(UBound(ko)))
Print
Print
plotter = ExePath + "\plotter.exe"
If FileExists(plotter) Then 'wenn funktionsplotter vorhanden (im selben Verzeichnis) polynom graphisch darstellen
Shell "start " + plotter + " " + polynom
EndIf
'nullstellen berechnen
von = -10
bis = 10
schritt = .00001
xvor = horner(von - schritt,ko())
Do
n = nullex(von, bis, schritt, ko()) '1. nullstelle und/oder 1. extremwert suchen
If n.x > bis Then 'ende des intervalls erreicht
Exit Do
EndIf
If n.f = 0 Then
Print "Nullstelle ";
EndIf
If n.f1a = 0 Then ' f'(x) = 0 --> extremwert
If n.f2a = 0 Then ' f''(x) = 0
Print "Wendepunkt ";
ElseIf Sgn(n.f2a) = -1 Then ' f''(x) < 0
Print " Maximum ";
ElseIf Sgn(n.f2a) = 1 Then ' f''(x) > 0
Print " Minimum ";
EndIf
EndIf
Print n.x
von = n.x + schritt 'weitersuchen
Loop
Print
Print "OK"
Sleep
End
Function horner(x As Double, k() As Double) As Double
Dim As Double f
Dim As Integer i
'funktionswert mithilfe des horner - schemas berechnen
f = k(1)
For i = 2 To UBound(k)
f = f * x + k(i)
Next
Return f
End Function
Function nullex(von As Double, bis As Double, schritt As Double, k() As Double) As nuex
Dim As Double xvor, fvor, k1a(1), k2a(1), f1avor, xm
Dim As String flag
Dim As nuex n
xvor = von
fvor = horner(xvor,k())
ableitung(k(),k1a()) '1. ableitung
f1avor = horner(xvor,k1a())
ableitung(k1a(),k2a()) '2. ableitung
n.x = von
Do
n.f = horner(n.x,k())
n.f1a = horner(n.x,k1a())
If n.f = 0 Then
Return n
ElseIf (Sgn(n.f) <> Sgn(fvor)) Or (Sgn(n.f1a) <> Sgn(f1avor)) Then
Do
schritt = (n.x - xvor) / 2
xm = xvor + schritt
If Str(xm) = Str(xvor) Then 'genauigkeitsgrenze erreicht
n.x = xm
Exit Do,Do
EndIf
n.f = horner(xm,k())
n.f1a = horner(xm,k1a())
n.f2a = horner(xm,k2a())
If (n.f = 0) Or (n.f = fvor) Then 'nullstelle oder gleicher funktionswert
n.x = xm
Exit Do,Do
ElseIf (Sgn(n.f) <> Sgn(fvor)) Or (Sgn(n.f1a) <> Sgn(f1avor)) Then
If Sgn(n.f) <> Sgn(fvor) Then
flag = "n" 'nullstelle
Else
flag = "e" 'extremwert
EndIf
n.x = xm 'nullstelle/extremwert liegt zwischen xvor und xm
Else
xvor = xm 'nullstelle/extremwert liegt zwischen xm und n.x
fvor = n.f
f1avor = n.f1a
EndIf
Loop
EndIf
xvor = n.x 'werte merken
fvor = n.f
f1avor = n.f1a
n.x += schritt
Loop Until n.x > bis 'ende des intervalls erreicht
Select Case flag
Case "n"
n.f = 0 ' f(x) = 0 setzen
Case "e"
n.f1a = 0 ' f'(x) = 0 setzen
End Select
Return n
End Function
Sub ableitung(k() As Double, k1a() As Double)
Dim As Integer grad = UBound(k), i
ReDim k1a(grad - 1) 'koeffizientenarray für 1. ableitung anlegen
For i = 1 To grad - 1 '1. ableitung bilden
k1a(i) = k(i) * (grad - i)
Next
End Sub
|
@BOB_BOB: Für dich habe ich auch davon eine QBasic - Version hochgeladen. 
Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen! |
|
| Nach oben |
|
|
grindstone
Anmeldungsdatum: 03.10.2010
Beiträge: 1283
Wohnort: Ruhrpott
|
| Verfasst am: 29.04.2015, 12:08 Titel: |
|
|
Ich habe daraus und aus nemoreds Funktionsplotter ein kleines Kommandozeilen - Tool erstellt.
Da das mit den Möglichkeiten von QBasic nicht zu machen ist, habe ich für alle nicht-FB-ler noch eine compilierte Version hochgeladen.
Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen!
Zuletzt bearbeitet von grindstone am 01.05.2015, 10:53, insgesamt 6-mal bearbeitet |
|
| Nach oben |
|
|
BOB_BOB
Anmeldungsdatum: 02.01.2015
Beiträge: 13
|
| Verfasst am: 29.04.2015, 15:55 Titel: |
|
|
Vielen Danke für eure Unterstützung
Ich werde mich mal durch eure Programme kämpfen Im Moment sind das noch einige böhmische Dörfer (vllt auch Großstädte )
Gruß BOB |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4710
Wohnort: ~/
|
| Verfasst am: 29.04.2015, 17:30 Titel: |
|
|
Je nachdem, was das Ziel ist (z. B. wenn es einfach "nur" um die Nutzung mathematischer Verfahren geht), gibt es auch die umfangreiche mathematische Bibliothek FBMath samt einem kleinen Einstiegstutorial.
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
grindstone
Anmeldungsdatum: 03.10.2010
Beiträge: 1283
Wohnort: Ruhrpott
|
| Verfasst am: 30.04.2015, 10:59 Titel: |
|
|
| BOB_BOB hat Folgendes geschrieben: | | Im Moment sind das noch einige böhmische Dörfer |
Tröste dich: Wir haben alle mal so angefangen. Mit jedem "Aha!"-Effekt wird es einfacher.
Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen! |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
