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
Thema durchsuchen
Ansicht
Themen-Optionen

[Tutorial] Quadratische Gleichungen vollständig lösen

Ein Thema von Wolfgang Mix · begonnen am 24. Jul 2009 · letzter Beitrag vom 10. Apr 2010
 
Benutzerbild von Wolfgang Mix
Wolfgang Mix

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

Re: Quadratische Gleichungen vollständig lösen

  Alt 5. Nov 2009, 19:19
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

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
 


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 +1. Es ist jetzt 19:42 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz