AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Neuen Beitrag zur Code-Library hinzufügen Delphi [Tutorial] Quadratische Gleichungen vollständig lösen

[Tutorial] Quadratische Gleichungen vollständig lösen

Ein Thema von Wolfgang Mix · begonnen am 24. Jul 2009 · letzter Beitrag vom 10. Apr 2010
Antwort Antwort
Seite 4 von 9   « Erste     234 56     Letzte » 
Benutzerbild von Wolfgang Mix
Wolfgang Mix

Registriert seit: 13. Mai 2009
Ort: Lübeck
1.222 Beiträge
 
Delphi 2005 Personal
 
#31

Re: Quadratische Gleichungen vollständig lösen

  Alt 6. Nov 2009, 20:32
Habe den Aufruf der Funktion noch einmal optimiert (Post #30).

Gruß

Wolfgang
Wolfgang Mix
if you can't explain it simply you don't understand it well enough - A. Einstein
Mein Baby:http://www.epubli.de/shop/buch/Grund...41818516/52824
  Mit Zitat antworten Zitat
Benutzerbild von Wolfgang Mix
Wolfgang Mix

Registriert seit: 13. Mai 2009
Ort: Lübeck
1.222 Beiträge
 
Delphi 2005 Personal
 
#32

Re: Quadratische Gleichungen vollständig lösen

  Alt 21. Nov 2009, 20:34
Habe in Post #30 eine Lösungsmöglichkeit mit der sogenennten "Mitternachtformel"
angefügt, die den Umweg der Berechnungen von p und q aus der PQ-Formel erspart.
Zusätzlich wird gezeigt, wie man die Diskriminante aus der Funktion als 4. Rückgabewert
gewinnt. Außerdem zeige ich, wie man die Rückgabewerte aus der ausgelegerten Funktion
verwerten kann.

Falls es jemanden interessiert, dieses Thema zusammenfassed in der DP abzulegen,
erstelle ich gerne einmal eine Zusammenfassung.

Gruß

Wolfgang
Wolfgang Mix
if you can't explain it simply you don't understand it well enough - A. Einstein
Mein Baby:http://www.epubli.de/shop/buch/Grund...41818516/52824
  Mit Zitat antworten Zitat
Benutzerbild von fkerber
fkerber
(CodeLib-Manager)

Registriert seit: 9. Jul 2003
Ort: Ensdorf
6.723 Beiträge
 
Delphi XE Professional
 
#33

Re: Quadratische Gleichungen vollständig lösen

  Alt 23. Jan 2010, 09:37
Hi!

Zitat von Wolfgang Mix:
Falls es jemanden interessiert, dieses Thema zusammenfassed in der DP abzulegen,
erstelle ich gerne einmal eine Zusammenfassung.

Das wäre klasse - wir (die Codelib-Manager) finden, dass das Thema entsprechend aufbereitet als Tutorial gut geeignet wäre. Dafür müssten neben dem Code auch erklärende Worte zum Thema Rundungsproblem, Auslöschung etc. zu finden sein.
Als reiner Code-Schnippsel im Sinne der C-Lib wäre es ohne längere Erklärungen (die es dann zum Tutorial machen) wahrscheinlich nicht so gut geeignet

Liebe Grüße,
Frederic
Frederic Kerber
  Mit Zitat antworten Zitat
Benutzerbild von Wolfgang Mix
Wolfgang Mix

Registriert seit: 13. Mai 2009
Ort: Lübeck
1.222 Beiträge
 
Delphi 2005 Personal
 
#34

Re: Quadratische Gleichungen vollständig lösen

  Alt 23. Jan 2010, 16:55
Zitat:
... erklärende Worte zum Thema Rundungsproblem, Auslöschung etc. zu finden sein.
Was meinst Du in diesem Zusammenhang mit Auslöschung?
Wolfgang Mix
if you can't explain it simply you don't understand it well enough - A. Einstein
Mein Baby:http://www.epubli.de/shop/buch/Grund...41818516/52824
  Mit Zitat antworten Zitat
Benutzerbild von fkerber
fkerber
(CodeLib-Manager)

Registriert seit: 9. Jul 2003
Ort: Ensdorf
6.723 Beiträge
 
Delphi XE Professional
 
#35

Re: Quadratische Gleichungen vollständig lösen

  Alt 23. Jan 2010, 16:57
Hi!

gammatester hatte das in Post #21 angeprochen:
Zitat:
- Auf die Rundungsfehler/Auslöschung bei "-B/2 + sqrt(Radikand)" und positivem B wird wieder nicht eingegangen.

Grüße, Frederic
Frederic Kerber
  Mit Zitat antworten Zitat
Benutzerbild von Wolfgang Mix
Wolfgang Mix

Registriert seit: 13. Mai 2009
Ort: Lübeck
1.222 Beiträge
 
Delphi 2005 Personal
 
#36

Re: Quadratische Gleichungen vollständig lösen

  Alt 23. Jan 2010, 17:10
jepp, kapiert
Wolfgang Mix
if you can't explain it simply you don't understand it well enough - A. Einstein
Mein Baby:http://www.epubli.de/shop/buch/Grund...41818516/52824
  Mit Zitat antworten Zitat
Benutzerbild von Wolfgang Mix
Wolfgang Mix

Registriert seit: 13. Mai 2009
Ort: Lübeck
1.222 Beiträge
 
Delphi 2005 Personal
 
#37

Re: Quadratische Gleichungen vollständig lösen

  Alt 26. Jan 2010, 21:25
Habe das Thema immer noch in Arbeit, werde den Code weiter vervollständigen
und nebenbei ein Tutorial schreiben, das dann auch grafisch mehr hergibt.

Die berechtigte Kritik von gammatester habe ich leider erst jetzt aufgegriffen
und erstmal in Punkt 5.) problematesiert.
Hinzu kommt Problem Punkt 6.) Überlauf des Zahlenbereiches.

1.) Wenn a = 0 ist, liegt keine quadratische Gleichung vor.

2.) Wenn die Diskriminante Null ist, gibt es nur eine reelle Lösung.

3.) Wenn die Diskriminante positiv ist, gibt es 2 reelle Lösungen

4.) Wenn die Diskriminante negativ ist, gibt es 2 komplexe Lösungen

5.) Auslöschung: Mit p>0 und x1 = -p/2 + Wurzel findet wegen Rundungsfehlern eventuell
eine Auslöschung statt und zwar umso mehr, je kleiner |q| ist. Dies kann zu ungenauen
Ergebnissen führen, da dann beide Summanden fast betragsgleich sind, während
bei x2 beide Größen das gleiche Vorzeichen haben und daher das Problem nicht auftritt.
Mit dem Satz von Vieta q = x1x2 lässt sich dann aber x1 ohne Genauigkeitsverlust
ermitteln. Für p<0 gilt das gleiche, dann vertauscht man eben x1 und x2.

6.) Überlauf: Ein weiteres Problem macht der Term (p/2)^2. Wenn p sehr groß ist,
kann der maximale Zahlenbereich überschritten werden, obwohl die Wurzel klein genug
wäre. Abhilfe schafft hier die Umformung der Wurzel zu |p| * sqrt(1/4 – (q/p)/p).
Falls |p| klein ist, ist die gewöhnliche pq-Formel vorzuziehen.

Gruß

Wolfgang

@gammatester: Wäre nett, wenn Du zwischendurch 'mal grinsen würdest
Wolfgang Mix
if you can't explain it simply you don't understand it well enough - A. Einstein
Mein Baby:http://www.epubli.de/shop/buch/Grund...41818516/52824
  Mit Zitat antworten Zitat
gammatester

Registriert seit: 6. Dez 2005
999 Beiträge
 
#38

Re: Quadratische Gleichungen vollständig lösen

  Alt 27. Jan 2010, 10:41
Wenn das alles implementiert ist, hat der Codelib-Beitrag einen großen Schritt in die richtige Richtung gemacht!

Eine Sache würde ich allerdings noch ändern. Nach dem letzen Quellcode werden reelle und komplexe Lösungen sehr unterschiedlich behandelt wegen der Prüflogik für die Diskriminante d := b^2 - 4ac.

Wenn d>0 ist, gibt es 2 relle Lösungen. Wenn d<0 aber IsZero(d) (d.h. d zwischen -1e-12 und 0), wird (fälschlich) gemeldet, es gäbe eine relle Doppellösung. Konsequenter sollte man die IsZero-Prüfung zuerst machen, oder sie ganz weglassen.

Ich würde sie ganz wegwerfen, solange man keine Skalierung einführt. Im bisherigen Code hat man folgendes Problem: Mit a=f, b=0, c=f gibt es (unabhängig von f<>0) die komplexen Lösungen x1=i, x2=-i. Das wird auch berechnet, wenn abs(f) > 5e-7 ist. Für abs(f)<=5e-7 wird behauptet, es gäbe die relle Doppellösung 0!

Also im Prinzip sähe es dan so aus:

if d<0 then 2 komplexe Lösungen
else if d>0 then 2 reelle Lösungen
else relle Doppellösung

Gruß Gammatester
  Mit Zitat antworten Zitat
Benutzerbild von Wolfgang Mix
Wolfgang Mix

Registriert seit: 13. Mai 2009
Ort: Lübeck
1.222 Beiträge
 
Delphi 2005 Personal
 
#39

Re: Quadratische Gleichungen vollständig lösen

  Alt 27. Jan 2010, 11:23
Gammatester hat geschrieben:

Zitat:
Also im Prinzip sähe es dann so aus:

if d<0 then 2 komplexe Lösungen
else if d>0 then 2 reelle Lösungen
else relle Doppellösung

Gruß Gammatester
Kurz und elegant die 0 umschifft, Klasse

Gruß Wolfgang
Wolfgang Mix
if you can't explain it simply you don't understand it well enough - A. Einstein
Mein Baby:http://www.epubli.de/shop/buch/Grund...41818516/52824
  Mit Zitat antworten Zitat
Benutzerbild von Wolfgang Mix
Wolfgang Mix

Registriert seit: 13. Mai 2009
Ort: Lübeck
1.222 Beiträge
 
Delphi 2005 Personal
 
#40

Re: Quadratische Gleichungen vollständig lösen

  Alt 28. Jan 2010, 19:09
Mit den letzten wertvollen Tipps von Gammatester habe ich
mich zuerst noch einmal der pq-Formel zugewandt, die IF-Strukturen neu
sortiert und die Problematiken Overlow/Underflow sowie der
Auslöschung implementiert (Theorie datu findet Ihr
z.B. im PDF im Anhang). Für angemeldete DPler hänge ich das Projekt
hinten an.
Wäre schön, wenn Ihr das testen würdet und mir Bugs meldet.
Das Ganze soll ja am Ende ein Tutorial werden, das möglichst
fehlerfrei sein sollte.

Danke

Wolfgang
Delphi-Quellcode:
{$R *.dfm}

type
  MySolution = Record
    a,b,d:double;
    c:integer;// 1: 2 real solution; 2: 1 real solution;
              // 3: 2 complex solutions
end;

//Wolfgang Mix - Delphi-PRAXiS
function SolveQuadraticEquation( a, b, c : Double ): MySolution;
var p, q , discriminant, discriminant2, re, im: Double;
label exit;
begin
  // ax² + bx + c = 0
  if (a = 0) then
  raise Exception.CreateFmt
     ('a should not be zero, no quadratic equation',[result.a]);
  p := b / a;
  q := c / a;

  //if p is a very big number - sqr(p/2) > MaxDouble
  if abs(p)>sqrt(Math.MaxDouble) then
  begin
    //code
    showmessage('p is a very big number');
    //showmessage(floattostr(Math.MaxDouble));
    result.a:=abs(p) + sqrt(0.25 - (q/p)/p);
    result.b:=abs(p) - sqrt(0.25 - (q/p)/p);
    result.c:=1;
    result.d:=0.25 - (q/p)/p;
    goto exit;
  end
  else
  //if p is avery samall number - sqr(p/2) < MinDouble
  if (p>=0) and (p<sqrt(Math.MinDouble)) then
  begin
    //code
    showmessage('p is a very small number');
    result.a:=-p/2 + sqrt(sqr(p/2) -q);
    result.b:=-p/2 - sqrt(sqr(p/2) -q);
    result.c:=1;
    result.d:= sqr(p/2);
    goto exit;
  end;

  // calculate discriminant
  discriminant := sqr(p/2) - q;
  Result.d := discriminant;

  // calculate real value
  re:=-p/2;
  // calculate imaginary value
  im:=sqrt(abs(discriminant));
  //Form1.Edit7.Text:=FloatToStr(discriminant);

  if discriminant > 0 then
  begin // 2 solutions
    if p>0 then
    begin
      Result.b := -p/2 - sqrt(discriminant);
      Result.a := q/Result.b; //x1 mit Vieta
      Result.c := 1;
    end
    else Result.a := -p/2 + sqrt( discriminant);
    if p<0 then //
    begin
      Result.a := -p/2 + sqrt( discriminant);
      Result.b := q/Result.a; //x2 mit Vieta
      Result.c := 1;
    end
    else Result.a := -p/2 + sqrt( discriminant);
  end

  else

  if discriminant < 0 then
  begin // 2 complex solutions
     Result.a := re;
     Result.b := im;
     Result.c := 3;
     Result.d := discriminant;
  end
  else

  begin // 2 equal solutions
    Result.a := -p/2;
    Result.b := Result.a;
    Result.c := 2;
    Result.d := discriminant;
  end;

  exit:

end;

procedure TForm1.Button1Click(Sender: TObject);
var a,b,c,discriminant: double;
    indicator:integer;
begin
   RichEdit1.Lines.Clear;
   a:=StrToFloat(Edit1.Text);
   b:=StrToFloat(Edit2.Text);
   c:=StrToFloat(Edit3.Text);
   if (a=0) then
   begin
     // Don't calculate
     showmessage ('a should not be zero, no quadratic equation');
     sleep(2000);
     exit;
   end
   else
   begin
     indicator:= SolveQuadraticEquation(a,b,c).c;
     case indicator of
       1: Begin
            Label1.Caption:='2 real solutions';
            RichEdit1.Lines.Add ('X1= ' +
            (FloatToStr(SolveQuadraticEquation(a,b,c).a)));
            RichEdit1.Lines.Add ('X2= ' +
            (FloatToStr(SolveQuadraticEquation(a,b,c).b)));
          End;
       2: Begin
            Label1.Caption:='1 real solution';
            RichEdit1.Lines.Add ('X= ' +
            (FloatToStr(SolveQuadraticEquation(a,b,c).a)));
          end;
       3: Begin
            Label1.Caption:='2 complex solutions';
            RichEdit1.Lines.Add ('X1= ' +
            (FloatToStr(SolveQuadraticEquation(a,b,c).a))+
            ' + ' + FloatToStr(SolveQuadraticEquation(a,b,c).b )+ ' i ');
            RichEdit1.Lines.Add ('X2= ' +
            (FloatToStr(SolveQuadraticEquation(a,b,c).a))+
            ' - ' + FloatToStr(SolveQuadraticEquation(a,b,c).b )+ ' i ');
          End;
     end;
     discriminant:= SolveQuadraticEquation(a,b,c).d;
     Edit4.Text:=FloatToStr(discriminant);
     Edit5.Text:=IntToStr(indicator);
   end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.Clear;
end;

end.
Angehängte Dateien
Dateityp: zip qgleich8-ausl_schung_198.zip (234,4 KB, 5x aufgerufen)
Dateityp: pdf pq_226.pdf (176,9 KB, 8x aufgerufen)
Wolfgang Mix
if you can't explain it simply you don't understand it well enough - A. Einstein
Mein Baby:http://www.epubli.de/shop/buch/Grund...41818516/52824
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +2. Es ist jetzt 01:21 Uhr.
Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf