Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 267

Раздел: Delphi » Алгоритмы, преобразования
/ вопрос открыт /

Уважаемые эксперты. Мне необходимо вычислить строку вида: "5+3*sin(3*x-8*cos(y)/2)*5^2+8*cos(5)", соответсвенно подставив туда x и y.
Для вычисления я создал пару функций, первая создает дерево вычислений (см. в прилажении), второя подставляем необходимое значение аргумента. А вот как вычисть строку по готовому дереву не могу понять (запутался с указателями). В общем должен работать алгоритм: спуститься по всем ветвям вниз и начать вычисления к веришине, но как это реализовать?

Приложение:
  1. type
  2. PFormula = ^TFormula;
  3. TFormula = packed record
  4. Oper: string;
  5. ArgFormulaL: PFormula;
  6. ArgFormulaR: PFormula;
  7. ArgL: string;
  8. ArgR: string;
  9. end;
  10. //============================//
  11.  
  12. function IsSimple(st: string): boolean;
  13. var
  14. i: word;
  15. begin
  16. result := true;
  17. for i := 1 to Length(st) do
  18. if not (st[i] in ['0'..'9', ',', 'A'..'Z', 'a'..'z']) then
  19. begin
  20. result := false;
  21. exit;
  22. end;
  23. end;
  24.  
  25. function IsFunc(st: string; var sFunc, sParam: string; var Oper: word): boolean;
  26. var
  27. i, k, L, R: word;
  28. begin
  29. result := true;
  30. k := 0; R := 0;
  31. L := Pos('(', st);
  32.  
  33. for i := L to Length(st) do
  34. begin
  35. if st[i] = '(' then inc(k);
  36. if st[i] = ')' then dec(k);
  37. if k = 0 then
  38. begin
  39. R := i;
  40. break;
  41. end;
  42. end;
  43. if R = Length(st) then Oper := 1
  44. else Oper := R+1;
  45. sFunc := Copy(st, 1, L-1);
  46. sParam := Copy(st, L+1, R-L-1);
  47. for i := 1 to Length(sFunc) do
  48. if not(sFunc[i] in ['A'..'Z', 'a'..'z']) then
  49. begin
  50. result := false;
  51. exit;
  52. end;
  53. end;
  54.  
  55. function GetOper(st: string): word;
  56. var
  57. i, k: word;
  58. begin
  59. result := 1;
  60. k := 0;
  61. for i := 1 to Length(st) do
  62. begin
  63. if st[i] = '(' then inc(k);
  64. if st[i] = ')' then dec(k);
  65. if k = 0 then
  66. begin
  67. result := i+1;
  68. exit;
  69. end;
  70. end;
  71. end;
  72.  
  73. procedure Info(Formula: PFormula);
  74. begin
  75. frMain.Memo1.Lines.Add('TFormula: Pointer = ' + inttostr(integer(Formula)));
  76. frMain.Memo1.Lines.Add('TFormula: Oper = ' + Formula.Oper);
  77. frMain.Memo1.Lines.Add('TFormula: ArgL = ' + Formula.ArgL);
  78. frMain.Memo1.Lines.Add('TFormula: ArgR = ' + Formula.ArgR);
  79. frMain.Memo1.Lines.Add('TFormula: ArgFormulaL: Pointer = ' + inttostr(integer(Formula.ArgFormulaL)));
  80. frMain.Memo1.Lines.Add('TFormula: ArgFormulaR: Pointer = ' + inttostr(integer(Formula.ArgFormulaR)));
  81. frMain.Memo1.Lines.Add('');
  82. Application.ProcessMessages;
  83. end;
  84.  
  85. procedure Polski(const st: string; var Formula: TFormula);
  86. var
  87. i, Oper: word;
  88. sFunc, sParam: string;
  89. begin
  90. i := 1;
  91. repeat
  92.  
  93. if st[i] in ['0'..'9', ','] then inc(i)
  94. else
  95.  
  96. if st[i] = '(' then
  97. begin
  98. i := GetOper(st);
  99. Formula.Oper := st[i];
  100. Formula.ArgL := Copy(st, 2, i-3);
  101. Formula.ArgR := Copy(st, i+1, Length(st)-i);
  102.  
  103. if not IsSimple(Formula.ArgL) then
  104. begin
  105. New(Formula.ArgFormulaL);
  106. Polski(Formula.ArgL, Formula.ArgFormulaL^);
  107. end
  108. else
  109. Formula.ArgFormulaL := nil;
  110.  
  111. if not IsSimple(Formula.ArgR) then
  112. begin
  113. New(Formula.ArgFormulaR);
  114. Polski(Formula.ArgR, Formula.ArgFormulaR^);
  115. end
  116. else
  117. Formula.ArgFormulaR := nil;
  118.  
  119. Info(@Formula);
  120. Exit;
  121. end
  122. else
  123.  
  124. if st[i] in ['+', '-', '*', '/', '^', '%'] then
  125. begin
  126. Formula.Oper := st[i];
  127. Formula.ArgL := Copy(st, 1, i-1);
  128. Formula.ArgR := Copy(st, i+1, Length(st)-i);
  129.  
  130. if not IsSimple(Formula.ArgL) then
  131. begin
  132. New(Formula.ArgFormulaL);
  133. Polski(Formula.ArgL, Formula.ArgFormulaL^);
  134. end
  135. else
  136. Formula.ArgFormulaL := nil;
  137.  
  138. if not IsSimple(Formula.ArgR) then
  139. begin
  140. New(Formula.ArgFormulaR);
  141. Polski(Formula.ArgR, Formula.ArgFormulaR^);
  142. end
  143. else
  144. Formula.ArgFormulaR := nil;
  145.  
  146. Info(@Formula);
  147. Exit;
  148. end
  149. else
  150.  
  151. if IsFunc(st, sFunc, sParam, Oper) then
  152. begin
  153.  
  154. if Oper = 1 then
  155. begin
  156. Formula.Oper := sFunc;
  157. Formula.ArgL := sParam;
  158.  
  159. if not IsSimple(Formula.ArgL) then
  160. begin
  161. New(Formula.ArgFormulaL);
  162. Polski(Formula.ArgL, Formula.ArgFormulaL^);
  163. end
  164. else
  165. Formula.ArgFormulaL := nil;
  166.  
  167. Formula.ArgFormulaR := nil;
  168. end
  169.  
  170. else
  171. begin
  172. i := Oper;
  173. Formula.Oper := st[i];
  174. Formula.ArgL := Copy(st, 1, i-1);
  175. Formula.ArgR := Copy(st, i+1, Length(st)-i);
  176.  
  177. if not IsSimple(Formula.ArgL) then
  178. begin
  179. New(Formula.ArgFormulaL);
  180. Polski(Formula.ArgL, Formula.ArgFormulaL^);
  181. end
  182. else
  183. Formula.ArgFormulaL := nil;
  184.  
  185. if not IsSimple(Formula.ArgR) then
  186. begin
  187. New(Formula.ArgFormulaR);
  188. Polski(Formula.ArgR, Formula.ArgFormulaR^);
  189. end
  190. else
  191. Formula.ArgFormulaR := nil;
  192. end;
  193. Info(@Formula);
  194. Exit;
  195. end
  196. else inc(i);
  197. until i > Length(st);
  198. end;
  199.  
  200. procedure SetFormula(Formula: TFormula; Arg, Num: string);
  201. begin
  202. if @Formula <> nil then
  203. begin
  204. if Formula.ArgL = Arg then
  205. Formula.ArgL := Num;
  206. if Formula.ArgFormulaL <> nil then
  207. SetFormula(Formula.ArgFormulaL^, Arg, Num);
  208. if Formula.ArgR = Arg then
  209. Formula.ArgR := Num;
  210. if Formula.ArgFormulaR <> nil then
  211. SetFormula(Formula.ArgFormulaR^, Arg, Num);
  212. Info(@Formula);
  213. end;
  214. end;
  215.  
  216. function Calculate(ArgL, ArgR: extended; Oper: string): extended;
  217. begin
  218. result := 0;
  219. if Oper = '+' then result := ArgL + ArgR;
  220. if Oper = '-' then result := ArgL - ArgR;
  221. if Oper = '*' then result := ArgL * ArgR;
  222. if Oper = '/' then result := ArgL / ArgR;
  223. if Oper = '%' then result := round(ArgL / ArgR);
  224. if Oper = '^' then result := Power(ArgL, ArgR);
  225. if Oper = 'sin' then result := sin(ArgL);
  226. if Oper = 'cos' then result := cos(ArgL);
  227. if Oper = 'tan' then result := tan(ArgL);
  228. if Oper = 'cotan' then result := cotan(ArgL);
  229. if Oper = 'arccos' then result := arccos(ArgL);
  230. if Oper = 'arccot' then result := arccot(ArgL);
  231. if Oper = 'arcsin' then result := arcsin(ArgL);
  232. if Oper = 'sec' then result := sec(ArgL);
  233. if Oper = 'lg' then result := log10(ArgL);
  234. if Oper = 'log' then result := logN(ArgL, ArgR);
  235. end;
  236.  
  237. function CalcFormula(Formula: TFormula): extended;
  238. begin
  239. //if @Formula <> nil then
  240. begin
  241. //?????????????????
  242. end;
  243. end;
  244.  
  245. //================================//
  246. procedure TfrMain.Button1Click(Sender: TObject);
  247. var
  248. st: string;
  249. Formula: TFormula;
  250. begin
  251. Formula.ArgFormulaL := nil;
  252. Formula.ArgFormulaR := nil;
  253. st := edit1.Text;
  254. Polski(st, Formula);
  255. memo1.Lines.Add('-----------------');
  256. SetFormula(Formula, 'x', '7');
  257.  
  258. edit2.text := floattostr(CalcFormula(Formula)); //?????
  259.  
  260. end;


SMaks Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: SMaks (статус: 1-ый класс)
Вопрос отправлен: 15 января 2007, 22:00
Состояние вопроса: открыт, ответов: 2.

Ответ #1. Отвечает эксперт: Матвеев Игорь Владимирович

Здравствуйте, SMaks!

Вычислять выражение нужно рекурсивно, так же как Вы заменяете x и y на числа в SetFormula().

Кроме того, было еще две ошибки:
1. Calculate() по умолчанию должна возвращать левый параметр, а не ноль, чтобы правильно обрабатывались скобки.
2. SetFormula(), параметр Formala должен быть объявлен как var-параметр, иначе Formala не изменится.

Все это в виде готового проекта в прикреплённом файле.
К ответу прикреплён файл. Загрузить » (срок хранения: 60 дней с момента отправки ответа)

Приложение:
  1. function CalcFormula(Formula: TFormula): extended;
  2. var
  3. OprL, OprR : Extended;
  4. begin
  5. if @Formula <> nil then
  6. begin
  7.  
  8.  
  9. if (Formula.ArgL <> '') and IsSimple(Formula.ArgL)
  10. then OprL := StrToFloat(Formula.ArgL) else OprL := 0;
  11.  
  12. if (Formula.ArgR <> '') and IsSimple(Formula.ArgR)
  13. then OprR := StrToFloat(Formula.ArgR) else OprR := 0;
  14.  
  15.  
  16.  
  17.  
  18. if Formula.ArgFormulaL <> nil then OprL := CalcFormula(Formula.ArgFormulaL^);
  19.  
  20. if Formula.ArgFormulaR <> nil then OprR := CalcFormula(Formula.ArgFormulaR^);
  21.  
  22.  
  23. Result := Calculate(OprL, OprR, Formula.Oper);
  24. end;
  25. end;


Ответ отправил: Матвеев Игорь Владимирович (статус: Студент)
Время отправки: 16 января 2007, 08:49
Оценка за ответ: 5

Комментарий к оценке: То что нужно, большое тебе спасибо!

Ответ #2. Отвечает эксперт: min@y™

Посмотри, как этот алгоритм реализован в RxLib (модуль Parsing.pas, класс TRxMathParser).
Замена х и у на значения - это совсем просто.

Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 16 января 2007, 10:24
Оценка за ответ: 2

Комментарий к оценке: Я спрашивал по конкретной задачи!

Мини-форум вопроса

Всего сообщений: 2; последнее сообщение — 17 января 2007, 04:09; участников в обсуждении: 2.
SMaks

SMaks (статус: 1-ый класс), 16 января 2007, 11:59 [#1]:

В заключении, Игорь Владимирович, можешь еще добавить процедурку освобождения всего дерева?
Матвеев Игорь Владимирович

Матвеев Игорь Владимирович (статус: Студент), 17 января 2007, 04:09 [#2]:

Конечно:

procedure FreeFormula(var Formula: PFormula);
begin
if Formula <> nil then
begin
if Formula.ArgFormulaL <> nil then // Если узел слева не пуст -
FreeFormula(Formula.ArgFormulaL); // проверим его
if Formula.ArgFormulaR <> nil then // Аналогично справа
FreeFormula(Formula.ArgFormulaR);

// Суда попадаем только по выходу из обоих вложенных вызовов,
// что гарантирует, что
// Formula.ArgFormulaL = nil и Formula.ArgFormulaR = nil, поэтому
// дополнительную проверку на это можно не проводить.
try
Dispose(Formula);
Formula := nil;
except
// Пропускаем ошибку EInvalidPointer - Invalid pointer operation.
// Она возникнет, если Вы попытаетесь освободить статическую переменную
on EInvalidPointer do MessageDlg('Ошибка с указателем.'#13#13+
'==> Вы пытаетесь освободить статическую переменную.',
mtError, [mbOk], -1);
end;
end;
end;

Только одно замечание - если Вы освобождаете дерево - само собой корневой узел тоже должен быть динамической переменной, т.е. память под нее должна была быть выделена в run-time (New/GetMem/AllocMem), иначе попытка ее освободить приведет к ошибке. В приведенной функции это исключение блокируется блоком try/except.

Готовый пример, где корень дерева инициализируется в run-time см: (файл удалён)

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2023
Текущее время: 20 марта 2023, 15:07
Выполнено за 0.02 сек.
Рейтинг@Mail.ru