Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > Сложение неизвестных


Автор: Ak47black 16.3.2006, 21:59
Привет всем.
Некак немогу сочинить smile функцию которая бы складывала или вычитала неизвестные ( например из 2*x*y+2*x*y в 4*x*y или из 2*y - y в 1*н и т.п. )
Подскажите пожалуйста кто представляет как можно сделать такую функцию. smile

Автор: Yanis 17.3.2006, 02:02
2 Ak47black
Если у тебя установлена RxLib, то можешь использовать функцию GetFormulaValue из модуля Parsing.pas

Автор: maxim1000 17.3.2006, 02:57
ну если подразумевается только сцепливание слагаемых, которые отличаются только числовым множителем, можно попросту выделять этот множитель из каждого слагаемого и сравнивать остальную часть (т.е. x*y в первом примере), а общий числовой множитель - сумма двух

если же за скобки выносить еще и переменные, то не всегда этот процесс будет однозначен: x+x*y+y=x*(1+y)+y=x+(x+1)*y, так что надо как-то задавать, какой именно вариант интересует, а от способа задавания будет зависеть и способ реализации...

если это делается для упрощения выражений, возможно, стоит рассмотреть оба, составить некоторое дерево операций вынесения за скобки (хотя одними вынесениями за скобки более-менее сложные выражения не упростить)...

Автор: Yanis 17.3.2006, 06:37
2 maxim1000
Проще обойтись тем, что уже есть в RxLib. С другой стороны, конечно хорошо, если написать всё самому, но данном случае по моему не желательно, а точнее не применимо smile

Автор: Bog d`An 17.3.2006, 06:57
конечно проще. но в целях саморазвития (и выполнения лабы в универеsmile) мною было написано вот это
Код

unit ReaderUnit;
interface
Uses
  SysUtils, SourceUnit;


Function StrToValue(Text:String):TErrData;
Function Calculate(str:string):TErrData;

implementation
Uses MainUnit, DrawUnit;


//------------------------------------------------------------------------------
Function ValueTest(Var str:String):Boolean;
Var
  Counter,ValCounter:Integer;
Begin
  ValueTest:=True;

  if length(str)>0 then
    if (not(str[Length(str)]in['0'..'9'])) then
    Begin
      ValueTest:=False;
      Exit;
    End;

  ValCounter:=Length(str)+2;
  For Counter:=Length(str)-1 downto Length(str)-3 do
    if Counter<=1 then break
    else
      if not(str[counter]in['0'..'9']) then
      Begin
        if not((str[counter]in['+','-'])and(str[counter-1]in['E','e'])and(str[counter-2]in['0'..'9'])) then
        Begin
          if not(str[counter]in['.',',']) then
          Begin
            ValueTest:=False;
            Exit;
          End
          else
          Begin
            str[counter]:='.';
          End
        End
        else
        Begin
          ValCounter:=counter;
          break
        End;
      End;

  For Counter:=ValCounter-2 downto 1 do
    if Counter<=1 then break
    else
    Begin
      if not(str[counter]in['0'..'9']) then
      Begin
        if not(str[counter]in['.',',']) then
        Begin
          ValueTest:=False;
          Exit;
        End
        else
        Begin
          str[counter]:='.';
        End
      End;
    End;    
        
  if not(str[1]in['0'..'9','+','-']) then
    Begin
      ValueTest:=False;
      ValueTest:=False;
      ValueTest:=False;
      Exit;
    End;
End;

//------------------------------------------------------------------------------
Function StrToValue(Text:String):TErrData;
//Переводит строковые данные в число
//+ подставляет глобальные переменные
var
  CurValue:TErrData;
  Code: Integer;
begin
  CurValue.Err:=0;
  CurValue.ErrPart:=-1;
  if (UpperCase(text)='X')or(UpperCase(text)='Y') then
  Begin
    if (UpperCase(text)='X') then
      StrToValue.Data:=x;
    if (UpperCase(text)='Y') then
      StrToValue.Data:=y;
  End
  else
  Begin
    If ValueTest(Text) Then
      try
      Val(Text, CurValue.Data, Code);
      except
        on EOverflow do
        Begin
          StrToValue.Err:=OOfRErr;
          StrToValue.ErrPart:=code;
          Exit;
        End;
      End
    else
    Begin
      StrToValue.Err:=InvStrErr;
      StrToValue.ErrPart:=1;
      Exit;
    End;
    { Error during conversion to Real? }
    if Code <> 0 then
      Begin
        StrToValue.Err:=CFErr;
        StrToValue.ErrPart:=code;
        Exit
        //MessageDlg('Error at position: ' + IntToStr(Code), mtWarning, [mbOk], 0, mbOk);
      End
    else
      StrToValue:=CurValue;
    End;
end;

//------------------------------------------------------------------------------
Function Selector(Val1,Val2:TErrData;counter:integer):TErrData;
Begin
  if (Val1.Err<>0)then
  Begin
    Selector.Err:=Val1.Err;
    Selector.ErrPart:=Val1.ErrPart;
  End
  else
  Begin
    Selector.Err:=Val2.Err;
    Selector.ErrPart:=Val2.ErrPart+Counter;
  End;
End;
//------------------------------------------------------------------------------
Function Calculate(str:string):TErrData;
Var
  bracket, counter, counter1, counter2: integer;
  Symb:Char;
  Val1,Val2:TErrData;
Begin
  Calculate.Err:=NoErr;
  Calculate.ErrPart:=-1;
  if str='' then
  Begin
    Calculate.Err:=InvArgErr;
    Calculate.ErrPart:=0;
    Exit;
  End;
  //Проверка количества скобок
  bracket:=0;
  For counter:=length(str) downto 1 do
  Begin
    Symb:=str[counter];
    Case Symb of
      '(':inc(bracket);
      ')':dec(bracket);
    End;
  End;
  If bracket <> 0 then
  Begin
    if bracket > 0 then
    Begin
      Calculate.ErrPart:=length(str);
      Calculate.Err:=OpBkErr;
    End
    else
    Begin
      Calculate.ErrPart:=1;
      Calculate.Err:=ClBkErr;
    End;
    Exit;
  End;

  //Выполнение действий + & -
  For counter:= length(str) downto 1 do
  Begin
    Symb:=str[Counter];
    case Symb of
      '(':inc(bracket);
      ')':dec(bracket);
      '+':
      if (bracket=0)and((not(str[Counter-1]in['E','e']))and(counter<>1)) then
      Begin
        Begin
          val1:=calculate(copy(str,1,counter-1));
          val2:=calculate(copy(str,counter+1,length(Str)-counter));
          if (Val1.Err=0)and(Val2.Err=0)then calculate.Data:=Val1.Data+Val2.Data
          else calculate:=Selector(Val1,Val2,counter);
          Exit;
        End;
      End;
      '-':
      if (bracket=0)and((not(str[Counter-1]in['E','e','+','-','*','/','^','(']))and(Counter<>1)) then
      Begin
        Begin
          val1:=calculate(copy(str,1,counter-1));
          val2:=calculate(copy(str,counter+1,length(Str)-counter));
          if (Val1.Err=0)and(Val2.Err=0)then calculate.Data:=Val1.Data-Val2.Data
          else calculate:=Selector(Val1,Val2,counter);
          Exit;
        End;
      End;
    End;
  End;
  //Выполнение действий * & /
  For counter:= length(str) downto 1 do
  Begin
    Symb:=str[Counter];
    case Symb of
      '(':inc(bracket);
      ')':dec(bracket);
      '*':
      if bracket=0 then
      Begin
        Begin
          val1:=calculate(copy(str,1,counter-1));
          val2:=calculate(copy(str,counter+1,length(Str)-counter));
          if (Val1.Err=0)and(Val2.Err=0)then calculate.Data:=Val1.Data*Val2.Data
          else calculate:=Selector(Val1,Val2,counter);
          Exit;
        End;
      End;
      '/':
      if bracket=0 then
      Begin
        Begin
          val1:=calculate(copy(str,1,counter-1));
          val2:=calculate(copy(str,counter+1,length(Str)-counter));
          if (Val1.Err=0)and(Val2.Err=0)then
            if Val2.Data<>0 then calculate.Data:=Val1.Data/Val2.Data
            else
            Begin
              calculate.Err:=DivZErr;
              calculate.ErrPart:=counter;
            End
          else calculate:=Selector(Val1,Val2,counter);
          Exit;
        End;
      End;
    End;
  End;
  //Возведение в степень-упрощённая запись
  For counter:= length(str) downto 1 do
  Begin
    Symb:=str[Counter];
    case Symb of
      '(':inc(bracket);
      ')':dec(bracket);
      '^':
      if bracket=0 then
      Begin
        Begin
          val1:=calculate(copy(str,1,counter-1));
          val2:=calculate(copy(str,counter+1,length(Str)-counter));
          if (Val1.Err=0)and(Val2.Err=0)then
            try
              calculate:=Power(Val1.Data,Val2.Data);
            except
              on EOverflow do
              Begin
                Calculate.Err:=OvfErr;
                Calculate.ErrPart:=1;
                exit;
              End;
              on  EInvalidOp do
              Begin
                Calculate.Err:=InvOpErr;
                Calculate.ErrPart:=1;
                exit;
              End;
            end
          else calculate:=Selector(Val1,Val2,counter);
          Exit;
        End;
      End;
    End;//case Symb of
  End;

  //удаление наружных скобок
  if ((str[1]='(')and(str[length(str)]=')')) then
  Begin
    calculate:=calculate(copy(str,2,length(Str)-2));
    Exit;
  End;

  //Обработка функций
  {не по алфавиту}

  // ABS
  if Pos('ABS', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,4,length(str)-3));
    if (Val1.Err=0)then
      calculate.Data:=abs(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+4
    End;
    Exit;
  End;

  // DegToRad
  if Pos('DEGTORAD', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,9,length(str)-8));
    if (Val1.Err=0)then
      calculate.Data:=DegToRad(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+9
    End;
    Exit;
  End;

  // RadToDeg
  if Pos('RADTODEG', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,9,length(str)-8));
    if (Val1.Err=0)then
      calculate.Data:=RadToDeg(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+9
    End;
    Exit;
  End;

  // SQRT
  if Pos('SQRT', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,5,length(str)-4));
    if (Val1.Err=0)then
      Try
        calculate.Data:=sqrt(Val1.Data)
      except
        calculate.Err:=MathErr;
        calculate.ErrPart:=5
      End
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+6
    End;
    Exit;
  End;

  // SQR
  if Pos('SQR', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,4,length(str)-3));
    if (Val1.Err=0)then
      calculate.Data:=sqr(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+4
    End;
    Exit;
  End;

  // EXP
  if Pos('EXP', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,4,length(str)-3));
    if (Val1.Err=0)then
      calculate.Data:=exp(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+4
    End;
    Exit;
  End;

  // ARCCOS
  if Pos('ARCCOS', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,7,length(str)-6));
    if (Val1.Err=0)then
    Begin
      Val2:=ArcCos(Val1.Data);
      if Val2.Err=0 then
        calculate:=Val2
      else
      Begin
        calculate.Err:=Val2.Err;
        calculate.ErrPart:=Val1.ErrPart+7
      End;
    End
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+7
    End;
    Exit;
  End;

  // ARCSIN
  if Pos('ARCSIN', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,7,length(str)-6));
    if (Val1.Err=0)then
    Begin
      Val2:=ArcSin(Val1.Data);
      if Val2.Err=0 then
        calculate:=Val2
      else
      Begin
        calculate.Err:=Val2.Err;
        calculate.ErrPart:=Val1.ErrPart+7
      End;
    End
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+7
    End;
    Exit;
  End;

  {
  // ARCCTG
  if Pos('ARCCTG', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,7,length(str)-6));
    if (Val1.Err=0)then
    Begin
      Val2:=ArcCtg(Val1.Data);
      if Val2.Err=0 then
        calculate:=Val2
      else
      Begin
        calculate.Err:=Val2.Err;
        calculate.ErrPart:=Val1.ErrPart+7
      End;
    End
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+7
    End;
    Exit;
  End;
  }

  // ARCTG
  if Pos('ARCTG', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,6,length(str)-5));
    if (Val1.Err=0)then
      calculate.Data:=arctan(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+6
    End;
    Exit;
  End;
  
  // Cos
  if Pos('COS', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,4,length(str)-3));
    if (Val1.Err=0)then
      calculate.Data:=cos(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+4
    End;
    Exit;
  End;

  // Sin
  if Pos('SIN', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,4,length(str)-3));
    if (Val1.Err=0)then
      calculate.Data:=sin(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+4
    End;
    Exit;
  End;

  // CTG
  if Pos('CTG', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,4,length(str)-3));
    if (Val1.Err=0)then
      If (sin(Val1.Data)=0) then
      Begin
        Calculate.Err:=DivZErr;
        Calculate.ErrPart:=5
      End
      else
        calculate.Data:=cos(Val1.Data)/sin(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+4
    End;
    Exit;
  End;

  // TG
  if Pos('TG', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,3,length(str)-2));
    if (Val1.Err=0)then
      If (cos(Val1.Data)=0) then
      Begin
        Calculate.Err:=DivZErr;
        Calculate.ErrPart:=4
      End
      else
        calculate.Data:=sin(Val1.Data)/cos(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+3
    End;
    Exit;
  End;

  // INT
  if Pos('INT', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,4,length(str)-3));
    if (Val1.Err=0)then
      calculate.Data:=INT(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+4;
    End;
    Exit;
  End;

  // FRAC
  if Pos('FRAC', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,5,length(str)-4));
    if (Val1.Err=0)then
      calculate.Data:=frac(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+5;
    End;
    Exit;
  End;
  
  // SGN
  if Pos('SGN', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,4,length(str)-3));
    if (Val1.Err=0)then
      calculate.Data:=SGN(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+4;
    End;
    Exit;
  End;

  // LG
  if Pos('LG', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,3,length(str)-2));
    if (Val1.Err=0)then
      If ((Val1.Data)<=0) then
      Begin
        Calculate.Err:=InvArgErr;
        Calculate.ErrPart:=4
      End
      else
        calculate.Data:=ln(Val1.Data)/Ln(10)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+3
    End;
    Exit;
  End;

  // LN
  if Pos('LN', UpperCase(str))=1 then
  Begin
    Val1:=calculate(copy(str,3,length(str)-2));
    if (Val1.Err=0)then
      If ((Val1.Data)<=0) then
      Begin
        Calculate.Err:=InvArgErr;
        Calculate.ErrPart:=4
      End
      else
        calculate.Data:=Ln(Val1.Data)
    else
    Begin
      calculate.Err:=Val1.Err;
      calculate.ErrPart:=Val1.ErrPart+3
    End;
    Exit;
  End;

  // PI
  if Pos('PI', UpperCase(str))=1 then
  Begin
    Calculate.Err:=NoErr;
    Calculate.ErrPart:=-1;
    Calculate.Data:=PI;
    Exit;
  End;

  //Обработка чисел
  calculate:=StrToValue(str)

End;

end.


естественно можно было оптимизировать smile

Автор: Демо 17.3.2006, 09:59
Код

procedure TForm1.Button1Click(Sender: TObject);
var
  sc: Variant;
begin
  SC:=CreateOLEObject('ScriptControl');
  try
    SC.Language:='VBScript';
    SC.Timeout:=-1;
    SC.AllowUI:=True;
    Label1.Caption:=SC.Eval(Edit1.Text);
  finally
    SC:=Unassigned;
  end;
end;

Автор: Bog d`An 17.3.2006, 22:32
зависимости?

Автор: Ak47black 18.3.2006, 14:12
Ок. спасиба за помошь.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)