Delphi: как вычислить формулу, находящуюся в строке?

[Shadow_Still]

Суть кода
Пользователь вводит формулу(только +, -, * и /) для расчета, она записывается/хранится в mysql. В дальнейшем для подобного расчета эта формула будет доставаться и вычисляться.
Проблема:
Как вычислить формулу?
Пример:
a:string;
a:=mysql_row[1];// 'result=(a+b)*c+a-c'
result =?

 

[Zevs]

Обратная польская нотация. Вот код примера (Pascal 7)

Program RPN;

Uses CRT;

Type
  CStack = record
    StP: integer;
    Elements: array [0..80] of char;
  end;
  DStack = record
    StP: integer;
    Elements: array [0..80] of double;
  end;
  CharSet = set of char;
  Values = array ['A'..'Z'] of double;

Const
  Operands: CharSet = ['A'..'Z'];
  Operations: CharSet = ['(', ')', '+', '-', '*', '/', '^'];
  Digits: CharSet = ['0'..'9', '.'];

Procedure InitCStack(var s: CStack);
begin
  s.StP := -1;
end;

Procedure InitDStack(var s: DStack);
begin
  s.StP := -1;
end;

Function PushC(var s: CStack; c: char): boolean;
begin
  PushC := false;
  if s.StP = 80 then exit;
  inc(s.StP);
  s.Elements[s.StP] := c;
  if s.StP > 0 then
    if (s.Elements[s.StP - 1] = '(') and (s.Elements[s.StP] = ')') then dec(s.StP, 2);
  PushC := true;
end;

Function PushD(var s: DStack; d: double): boolean;
begin
  PushD := false;
  if s.StP = 80 then exit;
  inc(s.StP);
  s.Elements[s.StP] := d;
  PushD := true;
end;

Function PopC(var s: CStack): char;
begin
  PopC := #0;
  if s.StP = -1 then exit;
  PopC := s.Elements[s.StP];
  dec(s.StP);
end;

Function PopD(var s: DStack): double;
begin
  PopD := 0;
  if s.StP = -1 then exit;
  PopD := s.Elements[s.StP];
  dec(s.StP);
end;

Function Priority(Op: char):integer;
begin
  if Op = '(' then Priority := 0
  else if Op = ')' then Priority := 1
  else if Op = '+' then Priority := 2
  else if Op = '-' then Priority := 2
  else if Op = '*' then Priority := 3
  else if Op = '/' then Priority := 3
  else if Op = '^' then Priority := 4
  else Priority := -1
end;

Function TransformToRPN(var expression, operandslist: string): integer;
var
  s: CStack;
  i, j, c: integer;
  RPN, dop: string;
  ch, ch1: char;
  prevoperand: boolean;
  d: double;
begin
  InitCStack(s);
  RPN := '';
  operandslist := '';
  TransformToRPN := 0;
  i := 1;
  prevoperand := false;
  while i <= length(expression) do
    begin
      ch := upcase(expression[i]);
      if ch in Operands then
        begin
          if prevoperand then
            begin
              TransformToRPN := i;
              exit;
            end;
          if pos(ch, operandslist) = 0 then
            operandslist := operandslist + ch;
          RPN := RPN + ch;
          prevoperand := true;
        end
      else if ch in Digits then
        begin
          j := i;
          while (expression[i] in Digits) and (i <= length(expression)) do
            inc(i);
          if prevoperand then
            begin
              TransformToRPN := j;
              exit;
            end;
          dop := copy(expression, j, i-j);
          val(dop, d, c);
          if c <> 0 then
            begin
              TransformToRPN := j + c - 1;
              exit;
            end;
          RPN := RPN + '(' + dop + ')';
          dec(i);
          prevoperand := true;
        end
      else if ch in Operations then
        begin
          if (not prevoperand) and (ch <> '(') then
            begin
              TransformToRPN := i;
              exit;
            end;
          if Priority(ch) = 0 then PushC(s, ch)
          else if s.StP = -1 then PushC(s, ch)
          else if Priority(s.Elements[s.StP]) < Priority(ch) then PushC(s,ch)
          else
            begin
              while (Priority(s.Elements[s.StP]) >= Priority(ch)) and
                (s.StP > -1) do
                begin
                  ch1 := PopC(s);
                  if ch1 <> '(' then RPN := RPN + ch1;
                end;
              PushC(s, ch);
            end;
          if ch = ')' then prevoperand := true
          else prevoperand := false;
        end
      else
        begin
          TransformToRPN := i;
          exit;
        end;
      inc(i);
    end;
  while s.StP > -1 do
    begin
      ch := PopC(s);
      if ch <> ')' then RPN := RPN + ch;
    end;
  expression := RPN;
end;

Function CalculateRPNExpression(RPN: string; OpValues: Values): double;
var
  s: DStack;
  d, d1: double;
  i, j: integer;
  ch: char;
  dop: string;
begin
  InitDStack(s);
  i := 1;
  while i <= length(RPN) do
    begin
      ch := RPN[i];
      if ch = '(' then
        begin
          j := i;
          while RPN[j] <> ')' do inc(i);
          dop := copy(RPN, j+1, i-j-1);
          val(dop, d, j);
          PushD(s, d);
        end
      else if ch in Operands then
        PushD(s, OpValues[ch])
      else if ch in Operations then
        begin
          d := PopD(s);
          d1 := PopD(s);
          if ch = '+' then d := d1 + d
          else if ch = '-' then d := d1 - d
          else if ch = '*' then d := d1 * d
          else if ch = '/' then d := d1 / d
          else if ch = '^' then d := exp(d*ln(d1));
          PushD(s, d);
        end;
      inc(i);
    end;
  CalculateRPNExpression := PopD(s);
end;

Var
  ch, ch1: char;
  Expression, RPNExpression, OperandsList: string;
  i: integer;
  OperandsValues: Values;

Begin
  repeat
    clrscr;
    gotoxy(1,1);
    writeln('1. Вычислить выражение.');
    writeln('2. Выход.');
    writeln('Введите свой выбор (1-2).');
    ch := readkey;
    if ch = #0 then ch1 := readkey;
    if ch = '1' then
      begin
        clrscr;
        gotoxy(1,1);
        writeln('Введите выражение');
        readln(Expression);
        RPNExpression := Expression;
        i := TransformToRPN(RPNExpression, OperandsList);
        if i = 0 then
          begin
            writeln('Выражение в ОПЗ:');
            writeln(RPNExpression);
            for i := 1 to length(OperandsList) do
              if OperandsList[i] in Operands then
                begin
                  write('Введите значение ' + OperandsList[i] + ' ');
                  readln(OperandsValues[OperandsList[i]]);
                end;
            write('Значение выражения ');
            writeln(CalculateRPNExpression(RPNExpression, OperandsValues):11:4);
          end
        else
          begin
            writeln('Ошибка в выражении.');
            insert('?', RPNExpression, i);
            writeln(RPNExpression);
          end;
        writeln('Для продолжения натисните пимпу.');
        ch1 := readkey;
        if ch1 = #0 then ch1 := readkey;
      end;
  until ch = '2';
End.

Когда-то студенту-программисту помогал эту ОПН осилить (сам по образованию - инженер-электрик ). А вообще компоненты-парсеры формул есть.

 

[Shadow_Still]

подскажи пожалуйста названия, а то все подряд качать не хочется

А вообще компоненты-парсеры формул есть.

 

[Zevs]

Заглянул на www.torry.ru в раздел VCL->Science->Calculators и вот чего увидел:

TCalc v.1.0 FNCS 187 k 15 Mar 1999
By Pavlos Dimitriadis. A Fast Expression Evaluator for functions. Converts a given formula into it's value. Lot of functions included, like sin(), cos(), tan(), arcsin(), arccos(), arctan(), sinh(), cosh(), tanh(), arcsinh(), arccosh(), arctanh(), exp(), ln(), log().... Free for non-commercial use.

TCalculator v.1.1 FWS 6 k 15 Jun 1998
By Dmitry M. Ivlev. It's simple line interpreteur which can to be used for make calculator or for inner use. This parser can be easelly extends with one argument functions like Ln(), Sin() and so on and also can store temporary results in dynamic variables using them late. Parser understand numbers in format C, Pascal and Assembler and also degrees in special format. For get/set value of variables and call functions interpreteur uses callback function call. Here also TCalculator component used line interpreteur and handle dynamic variables and functions access.

Старенькие, но думаю от этого хуже работать не будут. Сырцы на борту, оба бесплатные.
Может еще что найдется в VCL->Science->Expressions.

 

[ploki]

Проверено временем (2002 год), неплохо написано, достаточно быстро работает:
http://www.dow.wau.nl/aew/ParseExpr.html

 

[AndreyGor]

Отправить в Matlab...

 

[safon777]

Можно использовать fastscript например. Или другой скриптовый движок. А если приложение использует БД, то можно вычислить с помощью SQL запроса