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