Расчет введенной формулы

Расчет введенной формулы

Содержание материала

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

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

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

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

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

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

 

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

Code:

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.

 


 

Эта программа строит заданные графики, используя модуль Recognition. От констант left и right зависит диапазон x, от YScale зависит масштаб по y, а от k зависит качество прорисовки.

Code:

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;

 

Рекомендую так же использовать для этих целей модуль Parsing из RxLib или JVCL

Новые статьи

Случайные статьи

Популярные статьи

Подробности
Родительская категория: Язык программирования Дельфи
Категория: Скрипты, компилляторы и связанные с ними вопросы

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!

Защитный код
Обновить