Interpreter równań
PiXel
Kod interpretuje i oblicza równania matematyczne.
1 Algorytm ONP
1.1 Metody i właściwości
1.1.1 Klasa TEval
1.1.2 Klasa TSymbolList
1.1.3 Rekord TSymbol
1.2 Przykłady
2 Algorytm bez ONP
2.3 Przykłady
Algorytm ONP
Klasa TEval zawiera zestaw funkcji do konwersji na odwróconą notację polską i obliczania jej.
Obsługuje (domyślnie):
operatory: "(", ")", "+", "-", "", "/", "^",
*funkcje: pierwiastka kwadratowego, trygonometryczne (hiperboliczne i arcusy) i logarytmiczne (podstawa e, 10, 2), wartości bezwzględnej
*stałe: ∏ i e.
Istnieje możliwość ich dowolnej modyfikacji.
Cały unit można pobrać stąd:
Evaluator.zip
Metody i właściwości
Klasa TEval
property Expression: string Wyrażenie matematyczne w postaci "zwykłej" czyli infiksowej. Przypisanie spowoduje automatyczną zamianę na format ONP (postfix) i obliczenie wyniku.property PostfixExpression: string
Wyrażenie matematyczne w postaci ONP. Przypisanie spowoduje automatyczną zamianę na format infix i obliczenie wyniku.
property EvalResult: string
Wynik działania. Właściwość tylko do odczytu.
constructor Create(DefaultSet: Boolean = True)
Tworzy nową instancję klasy. Opcjonalny argument DefaultSet mówi czy utworzyć domyślny zestaw symboli (True) czy pozostawić klasę pustą (False).
procedure Default
Przywraca wszystkie symbole do stanu domyślnego.
function PostfixEval(Value: string): string
function InfixToPostfix(Value: string): string
function PostfixToInfix(Value: string): string
Odpowiednio - obliczanie wartości działania w formacie ONP, konwersja z notacji infix na postfix, konwersja w drugą stronę.
Nie ingerują w właściwości EvalResult, Expression i PostfixExpression.
property Operators: TOperators
property Functions: TFunctions
property Constants: TConstants
Klasy przechowywujące wszystkie rozpoznawane symbole. Wszystkie są potomne klasy TSymbolList.
Klasa TSymbolList
function Items(Index: Integer): TSymbol Zwraca element listy o podanym indeksie.procedure AddItem(Item: TSymbol; SafeAdd: Boolean = True)
Dodaje element na listę. Jeżeli SafeAdd jest True to funkcja nadpisze symbole o takiej samej nazwie (jeżeli istnieją).
Każdy z potomków klasy TSymbolList (wymienione wyżej) posiadają również wygodniejsze odmiany tej funkcji o nazwie Add.
procedure Delete(Index: Integer)
Usuwa element z listy o podanym indeksie.
procedure Clear
Czyści zawartość listy.
function Count: Integer
Zwraca ilość elementów na liście.
property CaseSensitive: Boolean
Ustaw na True jeżeli chcesz aby były rozróżniane wielkie i małe litery.
function Find(Name: string): TSymbol
Wyszukuje element o podanej nazwie.
function IsMember(Name: string): Boolean
Sprawdza czy element o podanej nazwie należy do listy.
function GetIndex(Name: string): Integer
Podaje indeks elementu o podanej nazwie. W przypadku nie znalezienia symbolu zwraca -1.
Rekord TSymbol
Name: string[255] Nazwa symbolu.Priority: Byte (tylko dla operatorów)
Priorytet operatora. Operatory z wyższą wartością mają pierwszeństwo.
AssociativeRight: Boolean (tylko dla operatorów)
Rodzaj łączności operatora. True - prawostronnie łączny, False - lewostronnie łączny.
Operation2: TMathFunction2 (tylko dla operatorów)
Wskaźnik do dwuargumentowej funkcji obliczającej dany operator.
Operation1: TMathFunction1 (tylko dla funkcji)
Analogicznie co wyżej, tyle, że to wskaźnik do funkcji jednoargumentowej liczącej funkcję matematyczną.
Value: Extended (tylko dla stałych)
Wartość stałej.
Przykłady
Na formę kładziemy przycisk oraz 3 edity. Do sekcji uses dodajemy Evaluator. Programujemy zdarzenie OnClick przycisku:
procedure TForm1.Button1Click(Sender: TObject);
var
e: TEval;
begin
e := TEval.Create; // tworzymy klase
e.Expression := Edit1.Text; // w edit1 wpiszemy rownanie matematyczne
Edit3.Text := e.PostfixExpression; // wyswietl rownanie w formacie ONP
Edit2.Text := e.EvalResult; // podaj wynik
e.Free;
end;
Wygodnie również dodawać dowolne funkcje. Najpierw zadeklarujemy taką funcję:
function jakasfunkcja(const a: Extended): Extended;
begin
Result := 2 * a;
end;
Potem dodajemy ja do klasy Functions:
e.Functions.Add('testfunkcja', jakasfunkcja, True);
Od tej pory kiedy w wyrażeniu napiszemy np. testfunkcja(5) + 1 to w wyniku otrzymamy 11.
Jeżeli ostatni parametr jest True to funkcja nie duplikuje wartości, ale je nadpisuje.
Analogicznie sprawa ma sie z operatorami.
function jakisoperator(const a, b: Extended): Extended;
begin
Result := a * b;
end;
...
e.Operators.Add('*', jakisoperator, 1, False, True);
Trzeci argument to priorytet. Zostają najpierw wykonane działania o najwyższym priorytecie.
Przedostatni argument mówi czy operator jest lewostronnie łączny (False) czy prawostronnie łączny (True).
Algorytm bez ONP
Algorytm mojego autorstwa. Trochę naokoło, ale nie korzysta z odwróconej notacji polskiej.
Obsługuje jedynie znaki "(", ")", "+", "-", "*", "/".
Kod jest również "sztywniejszy", co nie pozwala na wprowadzanie w łatwy sposób modyfikacji.
function Eval(Expression: String): String;
{
Kod pochodzi z http://4programmers.net/Delphi/Gotowce/Interpreter_równań
Oryginalny autor - Pixel (markovcd@gmail.com)
}
type
TCharSet = set of char;
function PosEx(substr: TCharSet; str: String): Integer;
var
i: Integer;
begin
Result := 0;
for i := 1 to Length(str) do
if str[i] in substr then begin
Result := i;
Break;
end;
end;
function Eval2(Expression: String): String;
var
i, j: Integer;
s, s1, s2, s3, left, right: String;
e: Extended;
begin
s := Expression;
i := PosEx(['*', '/'], s); // pierwszy znak "*" lub "/"
if i <> 0 then begin // znaleziono znak "*" lub "/"
left := Copy(s, 1, i - 1); // pierwsze wyrazenie wielomianu
s1 := Copy(s, i + 1, Length(s));
j := PosEx(['*', '/'], s1);
if j <> 0 then
right := Copy(s1, 1, j - 1) // drugie wyrazenie wielomianu
else
right := s1;
if s[i] = '*' then // wykonanie dzialania
e := StrToFloat(left) * StrToFloat(right)
else
e := StrToFloat(left) / StrToFloat(right);
s2 := Format('%g', [e]);
if j <> 0 then
s3 := Copy(s1, j, Length(s1));
Result := Eval(s2 + s3);
end else
Result := s;
end;
var
i, j, k, l, m: Integer;
s, s1, s2, s3, left, right: String;
e: Extended;
label
a;
begin
s := StringReplace(Expression, ' ', '', [rfReplaceAll]); // pozbywamy sie spacji
if s[1] in ['+', '-', '*', '/', '^'] then s[1] := ' ';
if s[Length(s)] in ['+', '-', '*', '/', '^'] then s[Length(s)] := ' '; // pozbywamy sie znakow z brzegow
s := Trim(s);
a:// obsluga nawiasow
k := 0; l := 0;
for i := 1 to Length(s) do begin
if s[i] = '(' then begin
if k = 0 then m := i; // pozycja pierwszego nawiasu
Inc(k); // znaleziono nawias otwierajacy
end
else if s[i] = ')' then Inc(l) // znaleziono nawias zamykajacy
else Continue;
if (k = l) and (k <> 0) then begin // jezeli tyle samo nawiasow zamykajacych i otwierajacych
s3 := Eval(Copy(s, m + 1, i - m - 1)); // obliczenie wszystkiego w srodku nawiasu
s := Copy(s, 1, m - 1) + s3 + Copy(s, i + 1, Length(s)); // zamienienie tego co w nawiasie na wartosc obliczona
goto a; // idziemy do poczatku aby szukac nawiasow
end;
end;
i := PosEx(['+', '-'], s); // pierwszy znak "+" lub "-"
if i <> 0 then begin // znaleziono znak "+" lub "-"
left := Copy(s, 1, i - 1); // pierwsze wyrazenie wielomianu
s1 := Copy(s, i + 1, Length(s));
j := PosEx(['+', '-'], s1);
if j <> 0 then
right := Copy(s1, 1, j - 1) // drugie wyrazenie wielomianu
else
right := s1;
left := Eval2(left);
right := Eval2(right);
if s[i] = '+' then // wykonanie dzialania
e := StrToFloat(left) + StrToFloat(right)
else
e := StrToFloat(left) - StrToFloat(right);
s2 := Format('%g', [e]);
if j <> 0 then
s3 := Copy(s1, j, Length(s1));
Result := Eval(s2 + s3);
end else
Result := Eval2(s);
end;
Przykłady
s := Eval('2 + 2*2'); // s jest równe 6
s := Eval('(2 + 2) * 2'); // s jest równe 8
s := Eval('(45/3+6*(3+4)-1)/3'); // s jest równe 18,6666666666667
Wkońcu poprawka ;)
Dodałem unit liczący wszystkiego poprzez ONP.
W gotowcach C# znajdziesz mój kalkulator ONP - przepisanie na Delphi byłoby pomocne.
Było... Kalkulator bez ONP
Ale 6+ za pomysłowość
Mocno przekombinowane, prościej byłoby zrobić to na dwóch stosach, wykorzystując pośrednio ONP. Ale pochwalam pomysłowość. :)