Как можно рассчитать выражение, заданное в строке (string).

Иногда в программе удобно сделать так, чтобы пользователь мог ввести функцию, а программа строила бы по ней график или высчитывала какое-то значение.

Если нужно многократно вычислить одно и то же выражение с разным аргументом (например, для рисования графика) лучше выделить в отдельную процедуру проверку правильности выражения, преобразования строки к удобному виду и т.д.

Наиболее простой способ посчитать значение выражения, это выполнять все операции, начиная с операций высшего приоритета, заменяя задействованные числа и знаки на результат вычислений. Например, выражение "1+2*3^4/5" этот алгоритм начнет рассчитывать с возведения 3 в степень 4. Символы "3^4" уже не нужны и они заменяются на получившийся результат. Получается: "1+2*81/5". Дальше нужно произвести умножение 2 на 81 и т.д.

Перед вычислением нужно убрать все пробелы из строки, заменить все точки и запятые на стандартный разделитель - DecimalSeparator. Помимо этого все символы переводятся на нижний регистр, заменяются некоторые константы, знак ":" заменяется на "/", а модуль, записанный символами "|" заменяется на функцию "abs". Для различия между отрицательным числом и знаком вычитания и для упрощения алгоритма каждое число окружается символами #.

Чтобы можно было вычислить значения выражения с аргументами, перед каждым вычислением нужно вызывать функцию ChangeVar.

Здесь приведен модуль с этими тремя функциями и пример их использования.

unit Recognition;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Math;

type
  TVar = set of char;

procedure Preparation(var s: String; variables: TVar);
function ChangeVar(s: String; c: char; value: extended): String;
function Recogn(st: String; var Num: extended): boolean;

implementation


procedure Preparation(var s: String; variables: TVar);
const
  operators: set of char = ['+','-','*', '/', '^'];
var
  i: integer;
  figures: set of char;
begin
  figures := ['0','1','2','3','4','5','6','7','8','9', DecimalSeparator] + variables;

// " "
  repeat
    i := pos(' ', s);
    if i <= 0 then break;
    delete(s, i, 1);
  until 1 = 0;

  s := LowerCase(s);

// ".", ","
  if DecimalSeparator = '.' then begin
    i := pos(',', s);
    while i > 0 do begin
      s[i] := '.';
      i := pos(',', s);
    end;
  end else begin
    i := pos('.', s);
    while i > 0 do begin
      s[i] := ',';
      i := pos('.', s);
    end;
  end;

// Pi
  repeat
    i := pos('pi', s);
    if i <= 0 then break;
    delete(s, i, 2);
    insert(FloatToStr(Pi), s, i);
  until 1 = 0;

// ":"
  repeat
    i := pos(':', s);
    if i <= 0 then break;
    s[i] := '/';
  until 1 = 0;

// |...|
  repeat
    i := pos('|', s);
    if i <= 0 then break;
    s[i] := 'a';
    insert('bs(', s, i + 1);
    i := i + 3;
    repeat i := i + 1 until (i > Length(s)) or (s[i] = '|');
    if s[i] = '|' then s[i] := ')';
  until 1 = 0;

// #...#
  i := 1;
  repeat
    if s[i] in figures then begin
      insert('#', s, i);
      i := i + 2;
      while (s[i] in figures) do i := i + 1;
      insert('#', s, i);
      i := i + 1;
    end;
    i := i + 1;
  until i > Length(s);
end;

function ChangeVar(s: string; c: char; value: extended): String;
var
  p: integer;
begin
  result := s;
  repeat
    p := pos(c, result);
    if p <= 0 then break;
    delete(result, p, 1);
    insert(FloatToStr(value), result, p);
  until false;
end;

function Recogn(st: String; var num: extended): boolean;
const
  pogr = 1E-10;
var
  p, p1: integer;
  i, j: integer;
  v1, v2: extended;
  func: (fNone, fSin, fCos, fTg, fCtg, fArcsin, fArccos, fArctg, fAbs, fLn, fLg, fExp);
  Sign: integer;
  s: String;
  s1: String;

  function FindLeftValue(p: integer; var Margin: integer; var Value: extended): boolean;
  var
    i: integer;
  begin
    i := p - 1;
    repeat i := i - 1 until (i <= 0) or (s[i] = '#');
    Margin := i;
    try
      Value := StrToFloat(copy(s, i + 1, p - i - 2));
      result := true;
    except
      result := false
    end;
    delete(s, i, p - i);
  end;

  function FindRightValue(p: integer; var Value: extended): boolean;
  var
    i: integer;
  begin
    i := p + 1;
    repeat i := i + 1 until (i > Length(s)) or (s[i] = '#');
    i := i - 1;
    s1 := copy(s, p + 2, i - p - 1);
    result := TextToFloat(PChar(s1), value, fvExtended);
    delete(s, p + 1, i - p + 1);
  end;

  procedure PutValue(p: integer; NewValue: extended);
  begin
    insert('#' + FloatToStr(v1) + '#', s, p);
  end;

begin
  Result := false;
  s := st;

// ()
  p := pos('(', s);
  while p > 0 do begin
    i := p;
    j := 1;
    repeat
      i := i + 1;
      if s[i] = '(' then j := j + 1;
      if s[i] = ')' then j := j - 1;
    until (i > Length(s)) or (j <= 0);
    if i > Length(s) then s := s + ')';
    if Recogn(copy(s, p + 1, i - p - 1), v1) = false then Exit;
    delete(s, p, i - p + 1);
    PutValue(p, v1);

    p := pos('(', s);
  end;

// sin, cos, tg, ctg, arcsin, arccos, arctg, abs, ln, lg, log, exp
  repeat
    func := fNone;
    p1 := pos('sin', s);
    if p1 > 0 then begin
      func := fSin;
      p := p1;
    end;
    p1 := pos('cos', s);
    if p1 > 0 then begin
      func := fCos;
      p := p1;
    end;
    p1 := pos('tg', s);
    if p1 > 0 then begin
      func := fTg;
      p := p1;
    end;
    p1 := pos('ctg', s);
    if p1 > 0 then begin
      func := fCtg;
      p := p1;
    end;
    p1 := pos('arcsin', s);
    if p1 > 0 then begin
      func := fArcsin;
      p := p1;
    end;
    p1 := pos('arccos', s);
    if p1 > 0 then begin
      func := fArccos;
      p := p1;
    end;
    p1 := pos('arctg', s);
    if p1 > 0 then begin
      func := fArctg;
      p := p1;
    end;
    p1 := pos('abs', s);
    if p1 > 0 then begin
      func := fAbs;
      p := p1;
    end;
    p1 := pos('ln', s);
    if p1 > 0 then begin
      func := fLn;
      p := p1;
    end;
    p1 := pos('lg', s);
    if p1 > 0 then begin
      func := fLg;
      p := p1;
    end;
    p1 := pos('exp', s);
    if p1 > 0 then begin
      func := fExp;
      p := p1;
    end;
    if func = fNone then break;

    case func of
      fSin, fCos, fCtg, fAbs, fExp: i := p + 2;
      fArctg: i := p + 4;
      fArcsin, fArccos: i := p + 5;
      else i := p + 1;
    end;
    if FindRightValue(i, v1) = false then Exit;
    delete(s, p, i - p + 1);
    case func of
      fSin: v1 := sin(v1);
      fCos: v1 := cos(v1);
      fTg: begin
        if abs(cos(v1)) < pogr then Exit;
        v1 := sin(v1) / cos(v1);
      end;
      fCtg: begin
        if abs(sin(v1)) < pogr then Exit;
        v1 := cos(v1) / sin(v1);
      end;
      fArcsin: begin
        if Abs(v1) > 1 then Exit;
        v1 := arcsin(v1);
      end;
      fArccos: begin
        if abs(v1) > 1 then Exit;
        v1 := arccos(v1);
      end;
      fArctg: v1 := arctan(v1);
      fAbs: v1 := abs(v1);
      fLn: begin
        if v1 < pogr then Exit;
        v1 := Ln(v1);
      end;
      fLg: begin
        if v1 < 0 then Exit;
        v1 := Log10(v1);
      end;
      fExp: v1 := exp(v1);
    end;
    PutValue(p, v1);
  until func = fNone;

// power
  p := pos('^', s);
  while p > 0 do begin
    if FindRightValue(p, v2) = false then Exit;
    if FindLeftValue(p, i, v1) = false then Exit;
    if (v1 < 0) and (abs(Frac(v2)) > pogr) then Exit;
    if (abs(v1) < pogr) and (v2 < 0) then Exit;
    delete(s, i, 1);
    v1 := Power(v1, v2);
    PutValue(i, v1);
    p := pos('^', s);
  end;

// *, /
  p := pos('*', s);
  p1 := pos('/', s);
  if (p1 > 0) and ((p1 < p) or (p <= 0)) then p := p1;
  while p > 0 do begin
    if FindRightValue(p, v2) = false then Exit;
    if FindLeftValue(p, i, v1) = false then Exit;
    if s[i] = '*'
      then v1 := v1 * v2
      else begin
        if abs(v2) < pogr then Exit;
        v1 := v1 / v2;
      end;
    delete(s, i, 1);
    PutValue(i, v1);

    p := pos('*', s);
    p1 := pos('/', s);
    if (p1 > 0) and ((p1 < p) or (p <= 0)) then p := p1;
  end;

// +, -
  Num := 0;
  repeat
    Sign := 1;
    while (Length(s) > 0) and (s[1] <> '#') do begin
      if s[1] = '-' then Sign := -Sign
        else if s[1] <> '+' then Exit;
      delete(s, 1, 1);
    end;
    if FindRightValue(0, v1) = false then Exit;
    if Sign < 0
      then Num := Num - v1
      else Num := Num + v1;
  until Length(s) <= 0;

  Result := true;
end;

end.

uses Recognition;

procedure TForm1.Button1Click(Sender: TObject);
const
  left = -10;
  right = 10;
  YScale = 50;
  k = 10;
var
  i: integer;
  Num: extended;
  s: String;
  XScale: single;
  col: TColor;
begin
  s := Edit1.Text;
  preparation(s, ['x']);
  XScale := PaintBox1.Width / (right - left);
  randomize;
  col := RGB(random(100), random(100), random(100));
  for i := round(left * XScale * k) to round(right * XScale * k) do
    if recogn(ChangeVar(s, 'x', i / XScale / k), Num) then
      PaintBox1.Canvas.Pixels[round(i / k - left * XScale),
        round(PaintBox1.Height / 2 - Num * YScale)] := col;
end;

Даниил Карапетян. 

На сайте http://delphi4all.narod.ru Вы найдете еще более 100 советов по Delphi.
Email: delphi4all@narod.ru

Тематические ссылки

Ваша ссылка

Ваша ссылка

Обмен кнопками, ведение статистики, реклама.