Delphi-PRAXiS
Seite 1 von 3  1 23      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Neuen Beitrag zur Code-Library hinzufügen (https://www.delphipraxis.net/33-neuen-beitrag-zur-code-library-hinzufuegen/)
-   -   Delphi [Tutorial] Quadratische Gleichungen vollständig lösen (https://www.delphipraxis.net/137624-%5Btutorial%5D-quadratische-gleichungen-vollstaendig-loesen.html)

Wolfgang Mix 24. Jul 2009 13:48


[Tutorial] Quadratische Gleichungen vollständig lösen
 
Liste der Anhänge anzeigen (Anzahl: 2)
Eine quadratische Gleichung hat die allgemeine Form

y = a*x^2 + b*x +c (1)

Die Lösung(en) findet man bei y = 0

a*x^2 + b*x + c = 0 (2)

Teilt man (2) durch a, erhält man die Normalform einer quadratischen Gleichung:

x^2 + p*x + q = 0 (3), wobei p = b/a und q = c/a

Die Lösung(en) erhält man mit der Formel:

x1,2 = -p/2 +- sqrt(sqr(p/2)-q))

4 Möglichkeiten sind zu beachten:

1.) Wenn a = 0 ist, liegt keine quadratische Gleichung vor.
2.) Wenn der Radikand sqr(p/2)-q Null ist, gibt es nur eine reelle Lösung.
3.) Wenn der Radikand positiv ist, gibt es 2 reelle Lösungen
4.) Wenn der Radikand negativ ist, gibt es 2 komplexe Lösungen

Anmerkung zu (4): sqrt(-1) ist die imaginäre Zahl i

Delphi-Quellcode:
procedure TForm2.Button1Click(Sender: TObject);
var a,b,c,Radikand,wurzel,p,q,x1,x2,im,re:real;
begin
  a:=StrToInt(Edit1.Text);
  b:=StrToInt(Edit2.Text);
  c:=StrToInt(Edit3.Text);
  if a=0 then showmessage('Keine quadratische Gleichung');
  try
    p:=b/a;q:=c/a;
  except
     on E : Exception do
     begin
       ShowMessage('Exception class name = '+E.ClassName);
       ShowMessage('Exception message = '+E.Message);
     end;
  end;

  Radikand:=sqr(p/2)-q;

  If Radikand=0 then
  begin
     x1:=-p/2;
     Edit4.Text:= 'x = ' + FloatToStr(-p/2);
     Edit5.Text:='';
     Label6.Caption:='Nur eine Lösung!';
  end;

  If Radikand>0 then
  begin
     x1:=-p/2+sqrt(Radikand);
     x2:=-p/2-sqrt(Radikand);
     Edit4.Text:='x1 = ' + FloatToStr(x1);
     Edit5.Text:='x2 = ' + FloatToStr(x2);
     Label6.Caption:='2 relle Lösungen!';
  end;

  If Radikand<0 then
  begin
      Radikand:=-Radikand;
      re:=-p/2;
      im:=sqrt(Radikand);
      Edit4.Text:=FloatToStr(re) + ' + '+ FloatToStr(im) + ' i';
      Edit5.Text:=FloatToStr(re) + ' - '+ FloatToStr(im) + ' i';
      Label6.Caption:='2 komplexe Lösungen!';
  end;
end;
[edit=TBx]Das Thema dient inzwischen mehr der Erstellung eines Turorials. Wenn ein solches fertig gestellt ist, wird das Thema entsprechend verschoben, Einzug in die CL wird es sicherlich nicht finden. Dafür habe wir dann ja die Tutorial-Sparte. Mfg, TBx[/edit]

fwsp 24. Jul 2009 13:56

Re: Quadratische Gleichungen vollständig lösen
 
Zitat:

Zitat von Wolfgang Mix
Delphi-Quellcode:
If Radikand=0 then

die stelle könnte kritisch sein, denn so ein real lässt sich nicht gern mit einem festen wert vergleichen.
eine möglichkeit um das zu umgehen: einen gewisse abweichung mit einzuberechnen.

//edit
artikel von luckie dazu: http://www.michael-puff.de/Artikel/Fliesskomma.shtml

xZise 24. Jul 2009 14:01

Re: Quadratische Gleichungen vollständig lösen
 
Muss Radikand = 0 problematisch sein? Ich würde behaupten die 0 lässt sich doch darstellen?

MfG
xZise

fwsp 24. Jul 2009 14:02

Re: Quadratische Gleichungen vollständig lösen
 
Zitat:

Zitat von xZise
Ich würde behaupten die 0 lässt sich doch darstellen?

und der andre teil?

Wolfgang Mix 24. Jul 2009 14:24

Re: Quadratische Gleichungen vollständig lösen
 
Wie wär's denn damit:

If (Radikand < 1e99) or (Radikand >1e-99) then

Die Muhkuh 24. Jul 2009 14:44

Re: Quadratische Gleichungen vollständig lösen
 
Oder Math.IsZero ;)

stoxx 24. Jul 2009 15:14

Re: Quadratische Gleichungen vollständig lösen
 
ich finde dieses Beispiel als Lehrbeispiel sehr, sehr, sehhr ungeeignet, weil direkt mit den Editfeldern in den Berechnungen gearbeitet wird.
Besser wäre es, die Ausgabe immer von den Berechnungen zu trennen.
Erst Modul Eingabe, dann alle Werte zur Berechnung .. dann wieder zurück und dann Ausgabe. ..

Daten von der Visualiserung trennen

Jakob Ullmann 24. Jul 2009 15:30

Re: Quadratische Gleichungen vollständig lösen
 
Also die Lösungsformel liest sich so (in Textform) sehr bescheiden. Ich würde vorschlagen, dafür ein Bild einzufügen (z. B. von der Wikipedia, oder von einem LaTeX-Onlineservice, oder halt vom eigenen Webscape). Desweiteren ist es wohl angenehmer, die Formel entsprechend für die allgemeine Form anzupassen. Klar ist so die Herleitung schöner, aber anwenden lässt es sich so nicht so schön.

@stoxx: Prinzipiell hast du da ja recht, aber wegen einer quadratischen Gleichung eine neue Unit aufzumachen, ist vielleicht etwas übertrieben. Klar, wenn da noch mehr dazukäme, wäre es sinnvoll.

stoxx 24. Jul 2009 16:16

Re: Quadratische Gleichungen vollständig lösen
 
Zitat:

Zitat von Jakob Ullmann
@stoxx: Prinzipiell hast du da ja recht, aber wegen einer quadratischen Gleichung eine neue Unit aufzumachen, ist vielleicht etwas übertrieben. Klar, wenn da noch mehr dazukäme, wäre es sinnvoll.

ich meinte keine neue Unit, sondern eine ausgelagerte Funktion reicht vollkommen, die als Rückgabewert einen Array of "Lösungen" hat.
gibt ja manchmal eine, zwei oder keine Reelle Lösung ..

und es geht auch darum, sich sowas erst gar nicht anzugewöhnen, wie der Threadersteller es getan hat.
Übung und Gewohnheit.

Aphton 24. Jul 2009 17:21

Re: Quadratische Gleichungen vollständig lösen
 
Zitat:

Zitat von stoxx
ich meinte keine neue Unit, sondern eine ausgelagerte Funktion reicht vollkommen, ...

Wenn wir schon dabei sind

Delphi-Quellcode:
type
  TDoubleArr = Array of Double;

function SolveQuadraticEquation( A, B, C: Double ): TDoubleArr;
var
  d: Double; // diskriminante (das was unter SQRT steht)
begin
//  ax² + bx + c = 0
  if A = 0 then
    Exit;
  B := B / A;
  C := C / A;
//  Diskriminante berechnen
  d := SQR(B/2) - C;
  if d > 0 then
  begin // zwei Lösungen
    SetLength( Result, 2 );
    Result[0] := -B/2 + SQRT( d );
    Result[1] := -B/2 - SQRT( d );
  end else
  if d = 0 then
  begin // eine Lösung
    SetLength( Result, 1 );
    Result[0] := -B/2;
  end;
// else -> keine Reelle Lösung
end;

sx2008 24. Jul 2009 17:29

Re: Quadratische Gleichungen vollständig lösen
 
Zitat:

Zitat von stoxx
ich finde dieses Beispiel als Lehrbeispiel sehr, sehr, sehhr ungeeignet, weil direkt mit den Editfeldern in den Berechnungen gearbeitet wird.
Besser wäre es, die Ausgabe immer von den Berechnungen zu trennen.
Erst Modul Eingabe, dann alle Werte zur Berechnung .. dann wieder zurück und dann Ausgabe. ..
Daten von der Visualiserung trennen

Das war auch mein erster Gedanke. Eine saubere Funktion wird hier benötigt:
Delphi-Quellcode:
function SolvePolynom2ndOrder(a,b,c: extended; var x1,x2:extended):Integer;
Über die Namen der Ein- und Ausgabeparameter kann natürlich verhandelt werden.
Die Funktion selbst liefert 0=keine Lösung, 1=Doppelte Nullstelle, 2=x1 und x2 enthalten die Nullstellen.
Und ich bin mit Englisch schon sehr verseucht; man darf auch deutsche Funktionsnamen (NullstellenQuadGleichung()) verwenden.

schöni 24. Jul 2009 17:48

Re: Quadratische Gleichungen vollständig lösen
 
Zitat:

Zitat von fwsp
Ich würde behaupten die 0 lässt sich doch darstellen?

Das schon, aber erstens kann Float Format bei sehr kleinen Zahlen fehlerhafte ergebnisse bringen weshalb beim Größenvergleich besser mit einem Grenzwert Epsilon verglichen wird.

Das zweite problem ergibt sich hier wegen p = b/a

Wenn dann der Koeffizient a = 0 ist gibt es eine Exception EDividebyZero.

stoxx 24. Jul 2009 18:00

Re: Quadratische Gleichungen vollständig lösen
 
@ Aphton
Zitat:

Wenn wir schon dabei sind
na so ist das doch schon viel schöner :-)

Wolfgang Mix 24. Jul 2009 18:21

Re: Quadratische Gleichungen vollständig lösen
 
@ Aphton schrieb:

// else -> keine Reelle Lösung

Gib hier bitte 'mal die beiden komplexen Lösungen zurück

mfg

Wolfgang

gammatester 24. Jul 2009 22:42

Re: Quadratische Gleichungen vollständig lösen
 
Zitat:

Zitat von Aphton
Wenn wir schon dabei sind


Das ist keine saubere Lösung. Es wird zB nicht zurückgeliefert, wieviele Lösungen da sind.

mit x := SolveQuadraticEquation(1.0,2.0,1.0); ist x[1] unbelegt (und da man das nicht mitgeteilt kriegt, kracht's oder es wird mit unsinngen Werte weiter gerechnet).

Es ist verständlich, wenn Du den komplexen Fall nicht betrachten willst. Allerdings ist doch der lineare Fall A=0 leicht zu behandeln und sollte nicht durch ein schödes "if A=0 then exit" abqualifiziert werden.

Was in allen Beiträgen so gut wie überhaupt nicht behandelt wird, sind die Rundungsfehler-, Überlauf-, Unterlaufprobleme. Diese sind so alt wie das Programmieren und eigentlich schon seit 40 Jahren im Rahmen des möglichen gelöst.

Aphton 25. Jul 2009 11:28

Re: Quadratische Gleichungen vollständig lösen
 
Zitat:

Zitat von gammatester
Das ist keine saubere Lösung. Es wird zB nicht zurückgeliefert, wieviele Lösungen da sind.

Du kannst mit Length die Anzahl der Lösungen bestimmen:
Delphi-Quellcode:
  X := SolveQuadraticEquation( 1.0, 2.0, 1.0 );
  ShowMessage( 'Anzahl der Lösungen: ' + IntToStr( Length(X) ) );
Natürlich kann man da noch einen eigenen Typen (wie folgt) definieren
Delphi-Quellcode:
  TQuadraticEquationResults = record
    ResultCount: Byte;
    Results: TDoubleArr;
  end;
Aber um ehrlich zu sein, ist das - für meinen Geschmack - nicht unbedingt erforderlich.

MfG

jfheins 25. Jul 2009 12:36

Re: Quadratische Gleichungen vollständig lösen
 
Wenn man ins komplexe geht, kann man sich das mit der Anzahl sparen, da hat die Gleichung immer genau 2 Lösungen :) (Berührpunkt ist eine doppelte Lösung)

Wolfgang Mix 26. Jul 2009 16:53

Re: Quadratische Gleichungen vollständig lösen
 
Ich hoffe, die meisten von Euch können jetzt mit dieser Variante leben:

Delphi-Quellcode:
type
  TSolution = Array of String;

function pq( A, B, C : Double ): TSolution;
var
  Radikand, re, im: Double;
begin
//  ax² + bx + c = 0
  if A = 0 then exit;
    B := B / A; //p
    C := C / A; //q
  //  Radikand berechnen
  Radikand := sqr(B/2) - C;
  //Realteil berechnen
  re:=-B/2;
  //Imaginärteil berechnen
  im:=sqrt(abs(Radikand));

  if Radikand > 0 then
  begin // zwei Lösungen
    SetLength( Result, 2 );
    Result[0] := FloatToStr(-B/2 + sqrt( Radikand ));
    Result[1] := FloatToStr(-B/2 - sqrt( Radikand ));
  end
  else
  if abs(Radikand) < 1e-6  then
  begin // eine Lösung
    SetLength( Result, 1 );
    Result[0] := FloatToStr(-B/2);
  end
  else
  if Radikand < 0 then
  begin
     ///Radikand:=-Radikand;
     SetLength( Result, 2 );
     Result[0] := FloatToStr(re) + ' + ' + FloatToStr(im) + ' i ';
     Result[1] := FloatToStr(re) + ' - ' + FloatToStr(im) + ' i ';
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var a,b,c: double;
begin
   a:=StrToFloat(Edit1.Text);
   b:=StrToFloat(Edit2.Text);
   c:=StrToFloat(Edit3.Text);
   if (a=0) or (b=0) or (c=0) then
   begin
     //Werte der Funktion gar nicht erst übergeben
     showmessage ('Keine reine quadratische Gleichung!');
     sleep(2000);
     exit;
   end
   else
   begin
     Edit4.Text:=pq(a,b,c)[0];
     Edit5.Text:=pq(a,b,c)[1];
   end;
end;

jfheins 26. Jul 2009 18:20

Re: Quadratische Gleichungen vollständig lösen
 
Hmmm ... also wenn ich ehrlich bin: Ich denke nicht, dass das lösen einer Quadratischen Gleichung eine derart große Sache ist, die unbedingt in die CodeLib rein muss ...

ich meine: Wenn ich das mal brauche, guck ich in die Wikipedia und hol mir die Lösungsformel und fertig. Danbn kann ich die unterscheidlichen Fälle (reell/imaginär) auch passend behandeln. Es kann ja sein, dass nur reelle Lösungen Sinn machen. Oder dass es auf den rellen Teil der komplexen Lösung ankommt.

Also nichts für ungut, aber ich wollte nur mal einwerfen, dass sowas nicht undingt rein muss :stupid:

Wolfgang Mix 26. Jul 2009 18:34

Re: Quadratische Gleichungen vollständig lösen
 
Noch eine Anmerkung:

Bei elektrotechnischen Fragestellungen im Wechselstromkreis sind die meisten Lösungen komplexe!

mfg

Wolfgang

gammatester 26. Jul 2009 21:47

Re: Quadratische Gleichungen vollständig lösen
 
Zitat:

Zitat von Wolfgang Mix
Ich hoffe, die meisten von Euch können jetzt mit dieser Variante leben:

Sterben wird daran schon niemand :wink: Allerdings kann ich mir nicht vorstellen, daß viele mit der Variante zufrieden sind. Ehrlich gesagt, habe ich sowas aus meiner Sicht Unsinniges schon lange nicht mehr gesehen. Hier mindestens fünf Gründe:

- Strings als Lösungen einer quadrischen Gleichung mit double-Koeffizienten sind einfach unsäglich (warum nicht gleich mit string-Koeffizienten, dann hätte der Unsinn wenigsten Methode)

- Auf die Rundungsfehler/Auslöschung bei "-B/2 + sqrt(Radikand)" und positivem B wird wieder nicht eingegangen.

- Eine völlig unmotivierte magische Konstanten 1E-6 entscheidet über 1 bzw 2 Lösungen. Dabei wir alles verworfen, bei denen sqrt(Radikand)<0.001 ist.

- Es wird nicht gestestet, wieviel Lösungen zurückgeliefert werden.

- Für die Ausgabe der Lösungen wird die Lösungsfunktion zweimal auf gerufen. Allerdings konsequenter Weise auch dann wenn's nur eine Lösung gibt.


Anders als jfheins halte ich eine QG-Lösung in der Codelib für durchaus sinnvoll, wenn sie universell und so genau wie möglich ist.

xZise 26. Jul 2009 22:03

Re: Quadratische Gleichungen vollständig lösen
 
Ich habe versucht zumindest die Strings rauszunehmen und ich hoffe, das der vergleich auf Radikant = 0 jetzt besser ist :P

Auch kann man angeben, ob man eine komplexe Zahl haben möchte.
Als kleines extra, kann man jetzt auch berechnen, wie denn X für A = 0, B != 0 gilt :P

Delphi-Quellcode:
type
  TCmplxNumber = record
    RealPart, ImaginaryPart : Double
  end;

  TCmplxNumbers = array of TCmplxNumber;

function CmplxNumber(const ARealPart, AImaginaryPart : Double) : TCmplxNumber;
begin
  Result.RealPart := ARealPart;
  Result.ImaginaryPart := AImaginaryPart;
end;

function pq( A, B, C : Double; const AUseComplexNumbers : Boolean): TCmplxNumbers ;
var
  Radikand, re, im: Double;
begin
//  ax² + bx + c = 0
  if IsZero(A) then
  begin
    if not IsZero(B) then
    begin
      // 0x^2 + bx + c = 0 ==> x := -c/b
      SetLength(Result, 1)
      Result := CmplxNumber(-c/b, 0);
    end;
    Exit
  end;
  B := B / A; //p
  C := C / A; //q
  //  Radikand berechnen
  Radikand := Sqr(B/2) - C;

  //Realteil berechnen
  re:=-B/2;

  // Imaginärteil berechnen
  im := Sqrt(Abs(Radikand));

  if Radikand > 0 then
  begin // zwei reele Lösungen
    SetLength(Result, 2);
    Result[0] := CmplxNumber(re + im, 0);
    Result[1] := CmplxNumber(re - im, 0);
  end
  else
  if IsZero(Radikand) then
  begin // eine reele Lösung
    SetLength(Result, 1);
    Result[0] := CmplxNumber(re);
  end
  else
  if (Radikand < 0) and (AUseComplexNumbers) then
  begin // keine reele, aber zwei komplexe Lösungen
    // Radikand:=-Radikand;
    SetLength(Result, 2);
    Result[0] := CmplxNumber(re, im);
    Result[1] := CmplxNumber(re, -im);
  end else
    SetLength(Result, 0);
end;
MfG
xZise

jfheins 26. Jul 2009 22:27

Re: Quadratische Gleichungen vollständig lösen
 
Dann werfe ich mal das hier in den Raum:
Delphi-Quellcode:
type
TComplex = record
  real, imaginary: Double;
end;

TQuadraticSolution = Array[0..1] of TComplex;

implementation

function SolveQuadratic(a, b, c: Double): TQuadraticSolutiuon;
var
  t, ti: Double;
begin

if iszero(b) and iszero(c) then
begin
  Result[0].real := 0;
  Result[0].imaginary := 0;

  Result[1].real := 0;
  Result[1].imaginary := 0;

  exit;
end;

if iszero(a) then
  raise Exception.Create('Coefficient a must not be zero!');

if b*b-4*a*c < 0 then
begin
  t := -0.5 * b;
  ti := -0.5 * sign(b) * sqrt(4*a*c-b*b));

  Result[0].real := t/a;
  Result[0].imaginary := ti/a;

  Result[1].real := t/a;
  Result[1].imaginary := -1 * ti/a;
end
else
begin
  t := -0.5 * (b + sign(b) * sqrt(b*b-4*a*c));
  Result[0].real := t/a;
  Result[0].imaginary := 0;

  Result[1].real := c/t;
  Result[1].imaginary := 0;
end;
end;
Ich hab versucht, das ganze etwas an die numerische Berechnung anzupassen ( http://en.wikipedia.org/wiki/Quadrat...implementation ) ;)

Edit: kleine Korrektur - ist leider nicht ausprobiert :angel:

Wolfgang Mix 27. Jul 2009 10:09

Re: Quadratische Gleichungen vollständig lösen
 
jfheins schrieb:

Zitat:

Edit: kleine Korrektur - ist leider nicht ausprobiert
Bei Eingabe von a=1, b=2 und c=3 muß die Funktion
x1 = -1 + 1,414 i und
x2 = -1 - 1,414 i zurückliefern. Probiere das 'mal bitte!

Da gefällt mir meine letzte Variante besser.

xZise 27. Jul 2009 10:12

Re: Quadratische Gleichungen vollständig lösen
 
Zitat:

Zitat von Wolfgang Mix
Da gefällt mir meine letzte Variante besser.

Und warum das? Mit Strings kannst du nicht weiterrechnen. Und wieder zurück konvertieren ginge zwar, aber nur sicher, wenn du ein Ergebnis hast. Ansonsten könnte das ja imaginär sein. Da ist jfheins wohl die beste, weil diese - im Gegensatz zu unseren - extra auf Fließkomma ausgerichtet ist.

MfG
xZise

jfheins 27. Jul 2009 10:56

Re: Quadratische Gleichungen vollständig lösen
 
Liste der Anhänge anzeigen (Anzahl: 1)
Zitat:

Zitat von Wolfgang Mix
Bei Eingabe von a=1, b=2 und c=3 muß die Funktion
x1 = -1 + 1,414 i und
x2 = -1 - 1,414 i zurückliefern. Probiere das 'mal bitte!

In Ermangelung eines Delphi: Anbei der übersetzte c# Code mit Testprogramm ...

Obige Werte liefern das korrekte Ergebnis - (1,-1,-2) ebenfalls (x1=-1, x2=2)

Code:
namespace Test_2
{
    public partial class Form1 : Form
    {
        public Form1()
        {
            InitializeComponent();
        }

        public bool iszero(Double a)
        {
            return Math.Abs(a) < 1e-6;
        }

        public TQuadraticSolution SolveQuadratic(Double a, Double b, Double c)
        {
            TQuadraticSolution Result;

            if (iszero(b) && iszero(c))
            {
                Result.first.real = 0;
                Result.first.imaginary = 0;

                Result.second.real = 0;
                Result.second.imaginary = 0;

                return Result;
            }

            if (iszero(a))
                throw new ArgumentNullException("a", "Coefficient a must not be zero!");

            if (b * b - 4 * a * c < 0)
            {
                Double t = -0.5 * b;
                Double ti = -0.5 * Math.Sign(b) * Math.Sqrt(4 * a * c - b * b);

                Result.first.real = t / a;
                Result.first.imaginary = ti / a;

                Result.second.real = t / a;
                Result.second.imaginary = -1 * ti / a;
            }
            else
            {
                Double t = -0.5 * (b + Math.Sign(b) * Math.Sqrt(b * b - 4 * a * c));
                Result.first.real = t / a;
                Result.first.imaginary = 0;

                Result.second.real = c / t;
                Result.second.imaginary = 0;
            }
            return Result;
        }


        private void button1_Click(object sender, EventArgs e)
        {
            var solutions = SolveQuadratic((Double)numericUpDown1.Value, (Double)numericUpDown2.Value, (Double)numericUpDown3.Value);
            label1.Text = solutions.first.ToString();
            label2.Text = solutions.second.ToString();
        }
    }

    public struct TComplex
    {
        public Double real;
        public Double imaginary;

        public override String ToString()
        {
            if (imaginary < 0)
                return String.Format("{0} - {1} i", real, -imaginary);
            else
                return String.Format("{0} + {1} i", real, imaginary);
        }
    }

    public struct TQuadraticSolution
    {
        public TComplex first, second;
    }
}

Wolfgang Mix 27. Jul 2009 13:02

Re: Quadratische Gleichungen vollständig lösen
 
Okay, wenn du mit den komplexen Werten weiterrechnen willst, gefällt mir deine Variante.
Die Namensgebung deiner Variablen würde ich noch anpassen.

Zitat:

var public Double complex;
meint wohl den Imaginärteil der komplexen Zahl, die aus Real- und Imaginärteil besteht

z = a + b * i

Gruß

Wolfgang

jfheins 27. Jul 2009 13:11

Re: Quadratische Gleichungen vollständig lösen
 
Okay, hab's korrigiert ;)

Wolfgang Mix 27. Jul 2009 14:02

Re: Quadratische Gleichungen vollständig lösen
 
Ich möchte jetzt 'mal kurz zusammenfassen.
Für die Schulmathematik genügt eigentlich die Kenntnis der PQ-Formel
aus jeder Formelsammlung oder bei Wikipedia.
Mancheiner fragt sich wohl inzwischen: "Wofür brauche ich das?".
Interessant wird da Ganze erst in der E-Technik, wenn Widerstände, Spulen und
Kondensatoren in Reihe, parallel oder noch komplizierter verschaltet werden.
Dann gibt es sehr selten nur noch reelle Ergebnisse.

Wer sich da 'mal einlesen möchte, für den gibt eigentlich nur ein Übungsbuch:

Helmut Lindner, Bd.2, Aufgaben zur Wechselstromtechnik. Das wird an allen
Unis als Standardwerk seit über 30 Jahren eingesetzt und stresst die meisten
Studenten. Gibts in jeder Stadtbibliothek mehrfach oder für 9,90 € im Handel.

Ich danke allen, die sich hier rege beteiligt habe, vor allen aber
Aphton und jfheins, die zeigten, wie man aus Funktionen mehrere Werte
zurückgeben kann. Das kannte ich als alter Pascalianer noch nicht, aber
jetzt. Man darf ja auch im Alter noch dazulernen.:-)

Nochmal danke an alle!

Wolfgang Mix 5. Nov 2009 19:19

Re: Quadratische Gleichungen vollständig lösen
 
Ich habe mich noch einmal mit dem Thema beschäftigt und versucht,
die Verbesserungsvorschläge der Beteiigten zu diesem Thresd umzusetzen.
Daher stelle ich folgende Lösung zur Diskussion:

Delphi-Quellcode:
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,[b]Math[/b];

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Button1: TButton;
    Edit6: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

// Wolfgang Mix - Delphi-PRAXiS
// Solve quadratic equations
function SolveQuadraticEquation( a, b, c : Double ): MySolution;
var p, q , discriminant, re, im: Double;
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;
    //  calculate discriminant
    discriminant := sqr(p/2) - q;
    // calculate real value
    re:=-p/2;
    // calculate imaginary value
    im:=sqrt(abs(discriminant));

  if discriminant > 0 then
  begin // 2 solutions
    Result.a := -p/2 + sqrt( discriminant);
    Result.b := -p/2 - sqrt( discriminant);
    Result.c := 1;
  end
  else
  if Math.IsZero(discriminant) then //needs unit math
  begin // 1 solution
    Result.a := -p/2;
    Result.b := Result.a;
    Result.c := 2;
  end
  else
  if discriminant < 0 then
  begin // 2 complex solutions
     Result.a := re;
     Result.b := im;
     Result.c := 3;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var a,b,c: double;
    indicator:integer;
begin
   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;
     Edit4.Text:=FloatToStr(SolveQuadraticEquation(a,b,c).a);
     Edit5.Text:=FloatToStr(SolveQuadraticEquation(a,b,c).b);
     Edit6.Text:=IntToStr(indicator);
     case indicator of
       1: Label1.Caption:='2 real solutions';
       2: Label1.Caption:='1 real solution';
       3: Label1.Caption:='2 complex solutions';
     end;
   end;
end;

end.
Bedeutung von Rückgabewert c, wenn
c=1 --> 2 relle Lösungen Result[0] und Result[1]
c=2 --> 1 reelle Lösung Result[0] = Result[1]
c=3 --> 2 komplexe Lösungen Result[0] = Realteil
+- Result[1] = Imaginärteil

Nachdem die Lösung mittels PQ-Formel hier im Forum hinreichend diskutiert wurde
und wir zu einer befriedigenden Lösung in Post #30 gekommen sind, zeige ich
zusätzlich noch die Lösung mittels "Mitternachtformel", die wohl bei Lehrern/Dozenten
noch beliebter ist. da der Umweg über die Berechnung von p und q entfällt.
Zusätzlich habe ich mir im Unterschied zu oben noch die Diskriminante (c=4)
als 4. Rückgebewert zurückgeben lassen.
Wie man dann die Rückgabewerte ausgeben kann, zeige ich im Button1.Click.

Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
function SolveQuadraticEquation( a, b, c : Double ): MySolution;
var discriminant, re, im: Double;
begin
    //  ax² + bx + c = 0
    if (a = 0) then
    raise Exception.CreateFmt
     ('a should not be zero, no quadratic equation',[result.a]);
    //  calculate discriminant
    discriminant := sqr(b)-4*a*c;;
    Result.d := discriminant;
    // calculate real value
    re:=-b/(2*a);
    // calculate imaginary value
    im:=sqrt(abs(discriminant))/(2*a);
  //Form1.Edit7.Text:=FloatToStr(discriminant);
  if discriminant > 0 then
  begin // 2 solutions
    Result.a := -b/(2*a) + sqrt( discriminant)/(2*a);
    Result.b := -b/(2*a) - sqrt( discriminant)/(2*a);
    Result.c := 1;
  end
  else
  if Math.IsZero(discriminant) then //needs unit math
  begin // 1 solution
    Result.a := -b/(2*a);
    Result.b := Result.a;
    Result.c := 2;
  end
  else
  if discriminant < 0 then
  begin // 2 complex solutions
     Result.a := re;
     Result.b := im;
     Result.c := 3;
  end;
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;
Der böse Lehrer (wm) verlangt jetzt noch von (Fach-)Gymnasiasten:
Beweisen Sie, daß PQ-Formel und "Mitternachtsformel" absolut identisch sind.
Das ist gemein von dem Typen :mrgreen:

Gruß

Wolfgang

Wolfgang Mix 6. Nov 2009 19:32

Re: Quadratische Gleichungen vollständig lösen
 
Habe den Aufruf der Funktion noch einmal optimiert (Post #30).

Gruß

Wolfgang

Wolfgang Mix 21. Nov 2009 19:34

Re: Quadratische Gleichungen vollständig lösen
 
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

fkerber 23. Jan 2010 08:37

Re: Quadratische Gleichungen vollständig lösen
 
Hi!

Zitat:

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

Wolfgang Mix 23. Jan 2010 15:55

Re: Quadratische Gleichungen vollständig lösen
 
Zitat:

... erklärende Worte zum Thema Rundungsproblem, Auslöschung etc. zu finden sein.
Was meinst Du in diesem Zusammenhang mit Auslöschung?

fkerber 23. Jan 2010 15:57

Re: Quadratische Gleichungen vollständig lösen
 
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

Wolfgang Mix 23. Jan 2010 16:10

Re: Quadratische Gleichungen vollständig lösen
 
jepp, kapiert :)

Wolfgang Mix 26. Jan 2010 20:25

Re: Quadratische Gleichungen vollständig lösen
 
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

gammatester 27. Jan 2010 09:41

Re: Quadratische Gleichungen vollständig lösen
 
Wenn das alles implementiert ist, hat der Codelib-Beitrag einen großen Schritt in die richtige Richtung gemacht! :thumb:

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

Wolfgang Mix 27. Jan 2010 10:23

Re: Quadratische Gleichungen vollständig lösen
 
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 :mrgreen:

Gruß Wolfgang

Wolfgang Mix 28. Jan 2010 18:09

Re: Quadratische Gleichungen vollständig lösen
 
Liste der Anhänge anzeigen (Anzahl: 2)
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.


Alle Zeitangaben in WEZ +1. Es ist jetzt 12:49 Uhr.
Seite 1 von 3  1 23      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz