Версия для печати темы

Автор: klem4 1.12.2007 3:11

Надоело заниматься всякой ерундой связанной с сессией, вот решил развеяться, недавняя задача про раскрытие скобок в выражении подтолкнула меня написать это )

В общем можно забивать любые правильные* арифметические выражения и получать результат их вычисления

*правильные - т.е. выражение может состоять только из чисел, разделитель десятичной части - точка, скобок, и бинарных операций +-*/

унарный минус также приветствуется: выражение -3*(5/-2) = -3*(-2.5) = +7.5.

вот 4 примера возможных выражений (приведены как тест):

просьба сообщать о найденных багах.

ps в выражение записывать нужно без пробелов. Правильность выражения и баланс скобок не проверяются (пока)

{$N+}
program _SmartCalc;

uses crt;

type
  TFloat = Single;
  TOperands = array [1..128] of TFloat;
  TOperations = array [1..127] of Char;

function FloatToStr(const fValue: TFloat): String;
var
  sValue: String;
begin
  Str(fValue:0:2, sValue); FloatToStr := sValue;
end;

function StrToFloat(const sValue: String): TFloat;
var
  fValue: TFloat;
  err: Integer;
begin
  Val(sValue, fValue, err); StrToFloat := fValue;
end;

function AtomExpr(const operand_a, operand_b: TFloat;
 const operation: Char): TFloat;
begin
  case operation of
    '+': AtomExpr := operand_a + operand_b;
    '-': AtomExpr := operand_a - operand_b;
    '*': AtomExpr := operand_a * operand_b;
    '/': AtomExpr := operand_a / operand_b; 
  end;
end;

procedure SimplifyExpr(var operands: TOperands;
 var operations: TOperations; var opnds_count, optns_count: Byte);

var
  i, j: Byte;
begin
  i := 1;

  while i <= optns_count do begin

    if operations[i] in ['*', '/'] then begin

      operands[i] :=
       AtomExpr(operands[i], operands[i + 1], operations[i]);

      for j := i + 1 to opnds_count - 1 do
       operands[j] := operands[j + 1];

      dec(opnds_count);

      for j := i to optns_count - 1 do
       operations[j] := operations[j + 1];

      dec(optns_count);
    end
      else inc(i);

  end;
end;


function SubExpr(const s: String): TFloat;
const
  ops = '+-*/';
var
  operands: TOperands;
  operations: TOperations;

  opnds_count, optns_count, i, j, len: Byte;

  temp: String;
  _result: TFloat;
begin
  _result := 0;

  opnds_count := 0;
  optns_count := 0;

  len := Length(s);

  i := 1;

  while i <= len do begin
    temp := '';

    if (s[i] = '-') and ((i = 1) or (pos(s[i - 1], ops) > 0)) then begin
       temp := ConCat(temp, '-');
       inc(i);
    end;

    while (i <= len) and not (s[i] in ['+', '-', '*', '/']) do begin
      temp := ConCat(temp, s[i]);
      inc(i);
    end;

    inc(opnds_count);

    operands[opnds_count] := StrToFloat(temp);

    if i <= len then begin
      inc(optns_count);
      operations[optns_count] := s[i];
    end;

    inc(i);
  end;

  SimplifyExpr(operands, operations, opnds_count, optns_count);

  for i := 1 to optns_count do begin
    operands[1] := AtomExpr(operands[1], operands[2], operations[i]);
    for j := 2 to opnds_count - 1 do
     operands[j] := operands[j + 1];
  end;

  SubExpr := operands[1];
end;

function SmartCalc(const s: String): TFloat;
var
  expr, tmp: String;
  break_start, break_end, i: Byte;

begin
  expr := s;

  while Pos('(', expr) > 0 do begin
    i := 1;

    break_start := 0;
    break_end := 0;

    repeat

      while expr[i] <> '(' do
        inc(i);

      break_start := i;
      inc(i);

      while not (expr[i] in ['(', ')']) do
        inc(i);

      if expr[i] = ')' then
        break_end := i;

    until break_end > 0;

    tmp := Copy(expr, break_start + 1, break_end - break_start - 1);

    Delete(expr, break_start, break_end - break_start + 1);
    Insert(FloatTOStr(SubExpr(tmp)), expr, break_start);

    break_end := 0;
  end;

  SmartCalc := SubExpr(expr);
end;


var
  ex1, ex2, ex3, ex4: String;

begin
  clrscr;

  ex1 := '10*(5+2*(1-3))';                      { +10   }
  ex2 := '(-1+(5/2)+3+4+5/2--1*5)';             { +16   }
  ex3 := '-2*(2+3)*4+(2*2+1+-5/2)*2+(2*(6/3))'; { -31   }
  ex4 := '1*10*100+((0*81))+0.5+(((0.5)))';     { +1001 }

  writeln(ex1, ' = ', SmartCalc(ex1):0:2);
  writeln(ex2, ' = ', SmartCalc(ex2):0:2);
  writeln(ex3, ' = ', SmartCalc(ex3):0:2);
  writeln(ex4, ' = ', SmartCalc(ex4):0:2);

  readln;
end.

Автор: volvo 1.12.2007 3:28

И не лень было делать то, что уже в принципе есть: http://forum.pascal.net.ru/index.php?s=&showtopic=4694&view=findpost&p=40351 (работает - в смысле результатов - точно так же, как и твое, но все вычисляется рекурсивно, и работа ведется со строкой)?

Кстати, лишнюю переменную убери (SubExpr):

...
  _result: TFloat;
begin
  _result := 0;
...

Автор: klem4 1.12.2007 3:34

круто, там с синусами, может прикручу потом )) Да не, не лень, просто давно ничего не писал, вот захотелось)) Ну и решил выложить...

Автор: Malice 1.12.2007 14:23

Потестил, работает ! По опыту помню, что первый баг это разделение минуса как операции от минуса как знак перед числом например. Но у тебя предусмотрено..
2Volvo - накопленная база знаний - это конечно хорошо, помогает выполнять задачи быстро и все такое. Но такой подход отучает думать, сводит работу к copy&paste. Конечно, думать профессионалам каждый раз заново не надо, но для разминки или для студентов, которые как раз здесь и тусуются, не лишне было бы и поизобретать велосипед. Да и прога по ссылке писалась не по острой необходимости, а тоже ради себя. Так что я такой подход приветствую, сам иногда чего нибудь такое пишу