Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Сложение неизвестных 
V
    Опции темы
Ak47black
  Дата 16.3.2006, 21:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2205
Регистрация: 2.12.2005

Репутация: 1
Всего: 0
Привет всем.
Некак немогу сочинить smile функцию которая бы складывала или вычитала неизвестные ( например из 2*x*y+2*x*y в 4*x*y или из 2*y - y в 1*н и т.п. )
Подскажите пожалуйста кто представляет как можно сделать такую функцию. smile
PM MAIL   Вверх
Yanis
Дата 17.3.2006, 02:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111
2 Ak47black
Если у тебя установлена RxLib, то можешь использовать функцию GetFormulaValue из модуля Parsing.pas


--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
maxim1000
Дата 17.3.2006, 02:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник
Сообщений: 3334
Регистрация: 11.1.2003
Где: Киев

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

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

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


--------------------
qqq
PM WWW   Вверх
Yanis
Дата 17.3.2006, 06:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111
2 maxim1000
Проще обойтись тем, что уже есть в RxLib. С другой стороны, конечно хорошо, если написать всё самому, но данном случае по моему не желательно, а точнее не применимо smile


--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
Bog d`An
Дата 17.3.2006, 06:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 217
Регистрация: 26.3.2005
Где: Украина:Днепропет ровск

Репутация: нет
Всего: 3
конечно проще. но в целях саморазвития (и выполнения лабы в универе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
--------------------
Удача откроет двери даже там, где их нет.Генри Морган--------------------[Furry team][Agent`s team][СРУКер]   
PM MAIL WWW   Вверх
Демо
Дата 17.3.2006, 09:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50
Код

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;



Это сообщение отредактировал(а) Демо - 17.3.2006, 09:59


--------------------
    
PM MAIL ICQ Skype   Вверх
Bog d`An
Дата 17.3.2006, 22:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 217
Регистрация: 26.3.2005
Где: Украина:Днепропет ровск

Репутация: нет
Всего: 3
зависимости?
--------------------
Удача откроет двери даже там, где их нет.Генри Морган--------------------[Furry team][Agent`s team][СРУКер]   
PM MAIL WWW   Вверх
Ak47black
Дата 18.3.2006, 14:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2205
Регистрация: 2.12.2005

Репутация: 1
Всего: 0
Ок. спасиба за помошь.
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0548 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.