title image


Smiley Meinst Du das hier ? (vom 04.02.2005 )
hi Havoc,

Ich denk mal du meinst dies hier;





Hier ist mal wieder eine potenzeille Beute für dich :

Ich hatte mal etwas Freizeit und suchte mir eine interessante Aufgabeund

dann habe ich da mal wieder die Frage gesehen "Wie wandle ich einenString in

einen Mathematischen Ausdruck um?". Da dachte ich mir Programier malso was

... Aber dann Universal also eine Basisklasse, die Alle Ausdrücke

verarbeiten kann wenn man von ihr die entsprechenden Klassen ableitet

(mitmöglichst wenig Aufwand).

Und hier ist die Sie freigegeben zum Ausschlachten, kann sogar mit

VariablenUmgehen wenn man will.

Theoretisch kann man davon ales ableiten bis hin zu Matrizen und

rehen,wenn man das braucht und sich nicht davor schrekt die Gramatiken dafür

zu implementieren:

unit UniExpression;interfaceuses Classes, Contnrs, SysUtils;resourcestring msgUnexpectedCloseBracket = 'Unerwartete schliessende Klammer!'; msgMissingOpenBracket = 'Schliessende Klammer ohne öffnenden Klammer!'; msgNoValueReturned = 'Für die Variable %s wurde konnte kein Wert ermittelt werden!'; msgBrockenExpression = 'Fehler im Ausdruck. Unbekante Klasse gefunden!'; msgOperationFailed = 'Fehler bei ausführen der Rechenoperation. Klasse: %s!'; msgBrockenOpStack = 'Fehler im Verarbeitungsstack. Der Stack befindet sich nicht im Endzustand!'; msgNotAValidExpression = 'Die Zeichenkette ist kein gültiger Ausdruck!'+#10#10+'Ausdruck: %s'; msgNotEnoughOperands = 'Fehler im Verarbeitungsstack. Nicht genügend Operatoren auf dem Stack.'+#10+ 'Der Operator benötigt %d Operanden, es wurden aber nur %d vorgefunden!'; msgTypesMismatch ='Operation %s ist für die Datentypenkombination %s und %s nicht definiert!'; const MaxVarNameLen = 20;type EUnexpectedCloseBracket = class(Exception); EMissingOpenBracket = class(Exception); ENoValueReturned = class(Exception); EBrockenExpression = class(Exception); EBrockenOpStack = class(Exception); EOperationFailed = class(Exception); ENotAValidExpression = class(Exception); EWrongOperandsCount = class(Exception); ETypesMismatch = class(Exception); TVarName = String[MaxVarNameLen]; TBracket = class(Tobject) protected FOpen : Boolean; public constructor Create(Open : Boolean); property Open : Boolean read FOpen; end; TValue = class(TPersistent) public procedure CreateCopy(var NewInstance : TValue); virtual; abstract; end; TVariable = class(TPersistent) protected FName : TVarname; public property Name: TVarName read FName; end; TOperator = class(TObject) protected function GetRank : Integer; virtual; abstract; function GetValency : Byte; virtual; abstract; public procedure Execute(Operands : TList; out Result : TValue); virtual; abstract; property Valency : Byte read GetValency; property Rank : Integer read GetRank; end; TValueNeededEvent = procedure(Name : TVarName; ID : Integer; out Value : TValue); //Stammklasse zum lösen mathematisher Ausdrücke //Implementiert die Grundalgorithmen TExpression = class(TObject) private FValueNeeded : TValueNeededEvent; FOperationStack : TObjectStack; FResult : TValue; FSolved : Boolean; FUPNExpression : TObjectList; protected procedure AddOperand(Operand : TValue); procedure AddVariable(Variable : TVariable); procedure AddOperator(Operator : TOperator); procedure OpenBracket; procedure CloseBracket; procedure GetValueFor(Variable : TVariable; var Value : TValue); virtual; procedure ParseExpression(Expression : String); virtual; abstract; public constructor Create; destructor Destroy; override; procedure Clear; function Verify(Expression : String) : boolean; virtual; abstract; procedure Parse(const Expression : String); procedure Solve; property Result : TValue read FResult; property Solved : Boolean read FSolved; property OnValueNeeded : TValueNeededEvent read FValueNeeded write FValueNeeded; end;implementation{ TExpression }procedure TExpression.AddOperand(Operand : TValue);begin FUPNExpression.Add(Operand);end;procedure TExpression.AddOperator(Operator : TOperator);begin while (FOperationStack.Count>0) and (not (FOperationStack.Peek is TBracket)) and (Operator.Rank<=TOperator(FOperationStack.Peek).Rank) do FUPNExpression.Add(FOperationStack.Pop); FOperationStack.Push(Operator);end;procedure TExpression.AddVariable(Variable : TVariable);begin FUPNExpression.Add(Variable);end;procedure TExpression.Clear;begin FSolved:=False; FreeAndNil(FResult); while FOperationStack.Count>0 do FOperationStack.Pop.Free; FUPNExpression.Clear;end;procedure TExpression.OpenBracket;begin FOperationStack.Push(TBracket.Create(true));end;procedure TExpression.CloseBracket;var Item : TObject;begin if FOperationStack.Count>0 then //Liegt was auf dem Stack ???? begin repeat Item:=FOperationStack.Pop; //Das oberste Item hohlen //Wenn das Item keine "Klammer auf" ist, dann in die UPN if not (Item is TBracket) then FUPNExpression.Add(Item); until (FOperationStack.Count=0) or (Item is TBracket); //Wiederhole bis alle raus sind, oder Klammer auf gefunden if not (Item is TBracket) then begin //Keine klammer auf gefunden -> Fehler FreeAndNil(Item); raise EMissingOpenBracket.Create(msgMissingOpenBracket); end else FreeAndNil(Item); end else raise EUnexpectedCloseBracket.Create(msgUnexpectedCloseBracket); //Stack leer ??? Fehler!!!end;constructor TExpression.Create;begin FValueNeeded:=nil; FResult:=nil; FSolved:=false; FOperationStack:=TObjectStack.Create; FUPNExpression:=TObjectList.Create;end;destructor TExpression.Destroy;begin Self.Clear; FreeAndNil(FUPNExpression); FreeAndNil(FOperationStack); FreeAndNil(FResult); inherited;end;procedure TExpression.Parse(const Expression: String);begin Clear; //Ausdruck überprüffen if not Verify(Expression) then raise ENotAValidExpression.CreateFmt(msgNotAValidExpression, [Expression]); //Parsen ParseExpression(Expression); //Ales was noch auf dem Stack ist in die UPN while FOperationStack.Count>0 do FUPNExpression.Add(FOperationStack.Pop);end;procedure TExpression.Solve;var Stack : TObjectStack; i, j : integer; Tmp : TObject; ValueList : TList; ObjectsToClear : TObjectList; Value : TObject;begin FSolved:=False; ObjectsToClear:=TObjectList.Create; //Hier werden alle Objecte gesammelt, die zu löschen sind. try Stack:=TObjectStack.Create; try //Verarbeitungsstack aufbauen for i:=0 to Pred(FUPNExpression.Count) do begin //Das aktuelle Element hohlen und auswerte Tmp:=FUPNExpression.Items[i]; //Tmp ist ein Wert -> auf den Stack if Tmp is TValue then Stack.Push(Tmp) else //Tmp ist eine Variable if Tmp is TVariable then begin Value:=nil; //Nach dem Wert fragen GetValueFor(TVariable(Tmp), TValue(Value)); //Wert ermittelt? Dann auf den Stack if Assigned(Value) then begin Stack.Push(Value); ObjectsToClear.Add(Value); end else raise ENoValueReturned.CreateFmt(msgNoValueReturned, [TVariable(Tmp).ClassName]); end else //Tmp ist ein Operator if Tmp is TOperator then begin //Berechnung durchführen ValueList:=TList.Create; try //Operanden vom Stack hohlen j:=TOperator(Tmp).Valency; while (j>0) and (Stack.Count>0) do begin ValueList.Add(Stack.Pop); Dec(j); end; if j>0 then raise EBrockenOpStack.CreateFmt(msgNotEnoughOperands, [TOperator(Tmp).Valency, TOperator(Tmp).Valency-j]); TOperator(Tmp).Execute(ValueList, TValue(Value)); finally FreeAndNil(ValueList); end; //Berechnung erfolgreich? Dann auf den Stack if Assigned(Value) then begin Stack.Push(Value); //Das Resultat mus hinterher gelöscht werden ... ObjectsToClear.Add(Value); end else raise EOperationFailed.CreateFmt(msgOperationFailed, [TOperator(Tmp).ClassName]); end else raise EBrockenExpression.Create(msgBrockenExpression); end; {for} if Stack.Count<>1 then raise EBrockenOpStack.Create(msgBrockenOpStack); TValue(Stack.Pop).CreateCopy(FResult); FSolved:=True; //Berechnung war erfolgreich finally FreeAndNil(Stack); end; finally FreeAndNil(ObjectsToClear); end;end;procedure TExpression.GetValueFor(Variable: TVariable; var Value: TValue);begin Value:=nil;end;{ TBracket }constructor TBracket.Create(Open: Boolean);begin FOpen:=Open;end;end.



Und hier mal ein Beispiel einer einfachen Ableitung davon (mal auf die

Schnelle, daher kann er keine negativen Zahlen, da muss man für -1 (0-1)

schreiben, wenn ich mal noch mal zeit habe, werde ich das noch machen
src="http://www.spotlight.de/pic/icons-bar/50_Lachend.gif">,

kann +, -, *, / , ^

(^ = Power)

unit MathExpression;interfaceuses UniExpression, Classes, SysUtils, Math;const dtExtended = 0;type TFloatOperator = class(TOperator) protected function GetRank : Integer; override; function GetValency : Byte; override; function InternalExecute(a, b : Extended) : Extended; virtual; abstract; public procedure Execute(Operands : TList; out Result : TValue); override; end; TPower = class(TFloatOperator) protected function GetRank : Integer; override; function InternalExecute(a, b : Extended) : Extended; override; end; TAddition = class(TFloatOperator) protected function GetRank : Integer; override; function InternalExecute(a, b : Extended) : Extended; override; end; TSubtraction = class(TFloatOperator) protected function GetRank : Integer; override; function InternalExecute(a, b : Extended) : Extended; override; end; TMultiplication = class(TFloatOperator) protected function GetRank : Integer; override; function InternalExecute(a, b : Extended) : Extended; override; end; TDivision = class(TFloatOperator) protected function GetRank : Integer; override; function InternalExecute(a, b : Extended) : Extended; override; end; TFloatValue = class(TValue) private FData : Pointer; procedure SetFData(const Value: Extended); function GetFData: Extended; protected procedure AssignTo(Dest : TPersistent); override; public constructor Create; destructor Destroy; override; procedure CreateCopy(var NewInstance : TValue); override; function toString : String; property FloatData : Extended read GetFData write SetFData; end; TMathExpression = class(TExpression) protected procedure ParseExpression(Expression : String); override; procedure AddFloat(Value : Extended); public function Verify(Expression : String) : boolean; override; end;implementation{ TFloatValue }procedure TFloatValue.AssignTo(Dest: TPersistent);begin if Dest is TFloatValue then begin with Dest as TFloatValue do FloatData:=Self.FloatData; end else inherited AssignTo(Dest);end;constructor TFloatValue.Create;begin inherited; GetMem(FData, SizeOf(Extended));end;procedure TFloatValue.CreateCopy(var NewInstance: TValue);begin NewInstance:=TFloatValue.Create; NewInstance.Assign(Self);end;destructor TFloatValue.Destroy;begin FreeMem(FData, SizeOf(Extended)); inherited;end;function TFloatValue.GetFData: Extended;begin result:=Extended(FData^);end;procedure TFloatValue.SetFData(const Value: Extended);begin Extended(FData^):=Value;end;function TFloatValue.toString: String;begin result:=FloatToStr(Extended(FData^));end;{ TFloatOperator }procedure TFloatOperator.Execute(Operands: TList; out Result: TValue);begin Result:=nil; if (TObject(Operands.Items[0]) is TFloatValue) and (TObject(Operands.Items[0]) is TFloatValue) then begin Result:=TFloatValue.Create; TFloatValue(Result).FloatData:=InternalExecute(TFloatValue(Operands.Items[1]).FloatData, TFloatValue(Operands.Items[0]).FloatData); end else raise ETypesMismatch.CreateFmt(msgTypesMismatch, [ClassName, TObject(Operands.Items[0]).ClassName, TObject(Operands.Items[1]).ClassName]);end;function TFloatOperator.GetRank: Integer;begin result:=0;end;function TFloatOperator.GetValency: Byte;begin result:=2;end;{ TMultiplication }function TMultiplication.GetRank: Integer;begin result:=1;end;function TMultiplication.InternalExecute(a, b: Extended): Extended;begin result:=a*b;end;{ TAddition }function TAddition.GetRank: Integer;begin result:=0;end;function TAddition.InternalExecute(a, b: Extended): Extended;begin result:=a+b;end;{ TSubtraction }function TSubtraction.GetRank: Integer;begin result:=0;end;function TSubtraction.InternalExecute(a, b: Extended): Extended;begin result:=a-b;end;{ TDivision }function TDivision.GetRank: Integer;begin result:=1;end;function TDivision.InternalExecute(a, b: Extended): Extended;begin result:=ab;end;{ TPower }function TPower.GetRank: Integer;begin result:=2;end;function TPower.InternalExecute(a, b: Extended): Extended;begin result:=Power(a, b);end;{ TMathExpression }procedure TMathExpression.AddFloat(Value: Extended);var Operand : TFloatValue;begin Operand:=TFloatValue.Create; Operand.FloatData:=Value; AddOperand(Operand);end;procedure TMathExpression.ParseExpression(Expression: String);var i : Integer; Value : String;begin Value:=''; Expression:=Trim(LowerCase(Expression));; for i:=1 to Length(Expression) do begin case Expression[i] of '0'..'9', ',' : Value:=Value+Expression[i]; '*' : begin if Value<>'' then AddFloat(StrToFloatDef(Value, 0)); Value:=''; AddOperator(TMultiplication.Create); end; '/' : begin if Value<>'' then AddFloat(StrToFloatDef(Value, 0)); Value:=''; AddOperator(TDivision.Create); end; '+' : begin if Value<>'' then AddFloat(StrToFloatDef(Value, 0)); Value:=''; AddOperator(TAddition.Create); end; '-' : begin if Value<>'' then AddFloat(StrToFloatDef(Value, 0)); Value:=''; AddOperator(TSubtraction.Create); end; '^' : begin if Value<>'' then AddFloat(StrToFloatDef(Value, 0)); Value:=''; AddOperator(TPower.Create); end; '(' : OpenBracket; ')' : begin AddFloat(StrToFloatDef(Value, 0)); Value:=''; CloseBracket; end; end; end; if Value<>'' then AddFloat(StrToFloatDef(Value, 0));end;function TMathExpression.Verify(Expression: String): boolean;var i : Integer; FltNumber : String; FPoint : Boolean; Brackets : Integer; LastIsClBracket : Boolean; LastIsOpBracket : Boolean; LastIsOp : Boolean;begin Expression:=Trim(LowerCase(Expression)); result:=(Length(Expression)>2); //Kleinstmöglicher Ausdruck : Ziffer Operator Ziffer ==> Length > 2 i:=1; FltNumber:=''; Brackets:=0; LastIsClBracket:=False; LastIsOpBracket:=False; LastIsOp:=False; while (i<=Length(Expression)) and (Brackets>=0) and result do begin FPoint:=False; FltNumber:=''; while (i<=Length(Expression)) and (Expression[i] in ['0'..'9', ',']) and Result do begin LastIsOp:=False; LastIsOpBracket:=False; LastIsClBracket:=False; FltNumber:=FltNumber+Expression[i]; if Expression[i]=',' then if not FPoint then FPoint:=True else result:=False; //zwei mal . in einer Zahl!!!! ==> kein Gültiger Ausdruck Inc(i); end; if i>Length(Expression) then Break; //String abgearbeitet, schluss if Expression[i]<>'(' then //Keine Klammer auf begin if (FltNumber<>'') or LastIsClBracket then //Davor war eine Zahl oder Klammer zu begin case Expression[i] of '+', '-', '*', '/', '^' : begin Inc(i); LastIsOp:=True; LastIsClBracket:=False; LastIsOpBracket:=False; end; ')' : if not LastIsOpBracket then begin LastIsOp:=False; Dec(Brackets); Inc(i); LastIsClBracket:=True; LastIsOpBracket:=False; end else result:=False; //() ist nicht erlaubt else result:=false; //Unbekantes zeichen ==> kein gültiger Ausdruck end; end else result:=LastIsClBracket; //Wenn nicht dann ==> ++ oder +) sind keine gültigen Ausdrücke end else //Klammer auf ... begin LastIsOp:=False; LastIsClBracket:=False; LastIsOpBracket:=True; if FltNumber='' then //Davor war keine Zahl, sondern ein Operator begin Inc(i); Inc(Brackets); //Dann Klammerzahl erhöhen end else result:=false; //Fals doch ==> 12( ist kein gültiger Ausdruck end; end; result:=result and (Brackets=0) and ((not LastIsOp) or (LastIsClBracket)) //Fals eine Klammer nicht zu ist und wir aber am Ende sind dann ==> kein gültiger Ausdruckend;end.



Und so benutzt man das:

procedure TForm1.Button1Click(Sender: TObject);var MS : TMathExpression;begin MS:=TMathExpression.Create; try MS.Parse(edExpression.Text); MS.Solve; if MS.Solved then edExpression.Text:=edExpression.Text+' = '+TFloatValue(MS.Result).toString; finally FreeAndNil(MS); end;end;







Gruss Uwe





Achte auf deine Gedanken - Sie sind der Anfang deiner Taten.   (Chinesisches Sprichwort )



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: