Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Kurvendiskussion
Gehe zu Seite Zurück  1, 2
 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu QBasic.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
BOB_BOB



Anmeldungsdatum: 02.01.2015
Beiträge: 13

BeitragVerfasst am: 03.03.2015, 18:07    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden
BOB_BOB



Anmeldungsdatum: 02.01.2015
Beiträge: 13

BeitragVerfasst am: 15.04.2015, 20:48    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4594
Wohnort: ~/

BeitragVerfasst am: 15.04.2015, 23:41    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1208
Wohnort: Ruhrpott

BeitragVerfasst am: 16.04.2015, 09:29    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Toa-Nuva



Anmeldungsdatum: 14.04.2006
Beiträge: 204
Wohnort: München

BeitragVerfasst am: 16.04.2015, 16:03    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
BOB_BOB



Anmeldungsdatum: 02.01.2015
Beiträge: 13

BeitragVerfasst am: 16.04.2015, 16:08    Titel: Antworten mit Zitat

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 durchgeknallt
Was muss ich den an meiner Schleife verändern? Oder ist die totaler Mist?
Gruß Bob
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1208
Wohnort: Ruhrpott

BeitragVerfasst am: 17.04.2015, 11:30    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4594
Wohnort: ~/

BeitragVerfasst am: 17.04.2015, 18:35    Titel: Antworten mit Zitat

Dann will ich doch nochmal Werbung für die von mir oben genannte direkte Berechnungsmethode machen grinsen

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
Benutzer-Profile anzeigen Private Nachricht senden
BOB_BOB



Anmeldungsdatum: 02.01.2015
Beiträge: 13

BeitragVerfasst am: 17.04.2015, 22:54    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1208
Wohnort: Ruhrpott

BeitragVerfasst am: 18.04.2015, 09:46    Titel: Antworten mit Zitat

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 grinsen ).
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 grinsen )

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. traurig Ich arbeite daran...
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1208
Wohnort: Ruhrpott

BeitragVerfasst am: 22.04.2015, 08:38    Titel: Antworten mit Zitat

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 grinsen .
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)) + "*xhappy" + 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. lächeln

Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1208
Wohnort: Ruhrpott

BeitragVerfasst am: 29.04.2015, 12:08    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
BOB_BOB



Anmeldungsdatum: 02.01.2015
Beiträge: 13

BeitragVerfasst am: 29.04.2015, 15:55    Titel: Antworten mit Zitat

Vielen Danke für eure Unterstützung lächeln
Ich werde mich mal durch eure Programme kämpfen lächeln Im Moment sind das noch einige böhmische Dörfer (vllt auch Großstädte lächeln )

Gruß BOB
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4594
Wohnort: ~/

BeitragVerfasst am: 29.04.2015, 17:30    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1208
Wohnort: Ruhrpott

BeitragVerfasst am: 30.04.2015, 10:59    Titel: Antworten mit Zitat

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. lächeln

Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu QBasic. Alle Zeiten sind GMT + 1 Stunde
Gehe zu Seite Zurück  1, 2
Seite 2 von 2

 
Gehe zu:  
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.

 Impressum :: Datenschutz