Посчитать строку с формулой

Delphi , Синтаксис , Математика

Посчитать строку с формулой

Программер живет на 12 этаже. После работы входит к себе в подъезд, заходит в лифт, нажимает 1, потом 2, а потом судорожно ищет клавишу "Enter"...

В Delphi нет функции, которая бы позволяла посчитать строку с формулой. Но есть множество способов реализовать это самому. Здесь я привел самый простой из них. Он не очень быстрый, но при нынешних скоростях компьютеров для многих целей он подойдет.

Принцип его заключается в следующем. Сначала строка оптимизируется – выкидываются все пробелы, точки и запятые меняются на установленный разделяющий знак (DecimalSeparator). Все числа и параметры (например, x), содержащиеся в строке "обособляются" символом #. В дальнейшем это позволяет избежать путаницы с экспонентой, минусами и. т. д. Следующий шаг – замена, если нужно, всех параметров на их значения. И, наконец, последний шаг, подсчет получившейся строки. Для этого программа ищет все операции с самым высоким приоритетом (это скобки). Считает их значение, вызывая саму себя (рекурсивная функция), и заменяет скобки и их содержимое на их значение, обособленное #. Дальше она выполняет то же самое для операции с более низким приоритетом и так до сложения с вычитанием.

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

Вот модуль с этими методами:

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
    1 = 0;
end;

function Recogn(st: string; var Num: extended): boolean;
const
  pogr = 1E-5;
var
  p, p1: integer;
  i, j: integer;
  v1, v2: extended;
  func: (fNone, fSin, fCos, fTg, fCtg, fArcsin, fArccos,
    fArctg, fArcctg, 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, arcctg, 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('arcctg', s);
    if p1 > 0 then
    begin
      func := fArcctg;
      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, fArcctg: 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);
      // fArcctg: v1 := arcctan(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.

А это пример использования этого модуля. Он рисует график функции, введенной в Edit1. Константы left и right определяют края графика, а YScale – масштаб по Y.

uses Recognition;

procedure TForm1.Button1Click(Sender: TObject);
const
  left = -10;
  right = 10;
  YScale = 50;
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) to round(right * XScale) do
    if recogn(ChangeVar(s, 'x', i / XScale), Num) then
      PaintBox1.Canvas.Pixels[round(i - left * XScale),
  round(PaintBox1.Height / 2 - Num * YScale)] := col;
end;

Это модуль программирования на Delphi, реализующий базовый парсер и эвалуатор математических выражений, а также графическое компонент для отображения результата эвалуации выражения.

Единица Recognition содержит несколько процедур и функций:

Preparation: Procedure оптимизирует входную строку, удаляя пробельные символы, преобразовывая ее в нижний регистр, заменая десятичные точки на указанный разделитель (в этом случае - запятую) и вставляя символы # вокруг чисел.
ChangeVar: Функция заменяет все вхождения указанной переменной в входную строку на ее соответствующее значение.
Recogn: Это основная процедура эвалуации. Она принимает входную строку и эвалуирует ее как математическое выражение, используя следующие шаги:
- Парсинг: Procedure разбивает входную строку на подвыражения, идентифицируя скобки, тригонометрические функции (sin, cos, tg), экспоненциальные функции (exp), логарифмические функции (ln, lg), операции возведения в степень (*, /) и простые арифметические операции (+, -).
- Эвалуация: Каждое подвыражение эвалуируется рекурсивно, используя соответствующую математическую функцию или операцию.
- Графическое отображение: Результат эвалуации отображается графически на компоненте TPaintBox.

Пример кода, предоставленный в этом документе, демонстрирует использование этого модуля. Он определяет константы для границ оси x (left и right) и масштаба оси y (YScale). В обработчике события Button1Click он читает входную строку из Edit1, готовит ее с помощью Preparation, а затем эвалуирует ее с помощью Recogn. Результат отображается графически на компоненте TPaintBox, называемом PaintBox1.

Обратите внимание, что это реализация является quite basic и может не обрабатывать все возможные краевые случаи или ошибки. Например, она не поддерживает вложенные скобки или недопустимые значения входных данных. Кроме того, графическое отображение может не быть привлекательным для сложных выражений.

Чтобы улучшить устойчивость и производительность парсера, вы можете рассмотреть использование болееadvanced parsing library или реализации дополнительных механизмов обработки ошибок.

Статья 'Программирование: посчитать строку с формулой' «Программист живет на 12 этаже. После работы входит к себе в подъезд, заходит в лифт, нажимает 1, потом 2, а потом судорожно ищет клавишу 'Enter'...» - это статья о программировании

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.

:: Главная :: Математика ::

Время компиляции файла: 2024-12-22 20:14:06
2025-04-26 17:03:29/0.0042309761047363/0