Guest User

Untitled

a guest
Dec 10th, 2018
86
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 10.55 KB | None | 0 0
  1. type PTree=^elem_tree;
  2. elem_tree = record
  3. data:string[150];
  4. left:PTree;
  5. right:PTree;
  6. end;
  7.  
  8. procedure obhod (pt:PTree);
  9. begin
  10. if pt<>nil then begin
  11. obhod(pt^.left);
  12. write(pt^.data,' ');
  13. obhod(pt^.right);
  14. end;
  15. end;
  16.  
  17. {Процедура позволяет взглянуть на дерево,
  18. использовалась во время отладки программы}
  19. procedure PrintTree(r: PTree; n: integer);
  20. var i:integer;
  21. begin
  22. if r<>nil then begin
  23. PrintTree(r^.left, n+1);
  24. for i := 1 to n do Write(' ');
  25. Writeln(r^.data);
  26. PrintTree(r^.right, n+1);
  27. end;
  28. end;
  29.  
  30. procedure to_tree(var root: Ptree; data: string[10]);
  31. begin
  32. if root = nil then
  33. begin
  34. new(root);
  35. root^.data := data;
  36. root^.right := nil;
  37. root^.left := nil;
  38. end
  39. end;
  40.  
  41. procedure create_tree(source: string; var root: Ptree);
  42. var
  43. temp_int, err, bracket, i, j: integer;
  44. left_root, right_root: string;
  45. begin
  46. val(source, temp_int, err);
  47.  
  48.  
  49. if (err > 0) and (length(source) <> 1) then
  50. begin
  51. i := length(source); //ставимся на последний символ в строке
  52. //нужно поработать со скобками
  53. if source[i] = ')' then
  54. begin//скобки
  55. bracket := 1;
  56. while bracket <> 0 do
  57. begin
  58. dec(i);
  59. if source[i] = ')' then inc(bracket);
  60. if source[i] = '(' then dec(bracket);
  61. end;
  62. if i = 1 then
  63. begin//если все полученное выражение оказалось в скобках
  64. delete(source, 1, 1); //удалим эти внешние скобки
  65. delete(source, length(source), 1);
  66. create_tree(source, root); //и разберем выражение без внешних скобок
  67. end
  68. else
  69. begin//если выражение в скобках кончилось где-то посередине
  70. dec(i);
  71. if (source[i] = '*') or (source[i] = '/') then //для ситуации (a+b)/c+d
  72. begin
  73. j := i;
  74. while (j > 1 ) and (source[j] <> '+') and (source[j] <> '-') do //ищем знак плюс или минус
  75. begin
  76. dec(j);
  77. if source[j] = ')' then
  78. begin
  79. bracket := 1;
  80. while bracket <> 0 do
  81. begin
  82. dec(j);
  83. if source[j] = ')' then inc(bracket);
  84. if source[j] = '(' then dec(bracket);
  85. end;
  86. end;
  87. end;
  88. if j <> 1 then i := j;
  89. end;
  90. case source[i] of //вбиваем в дерево обозначение операции
  91. '+': to_tree(root, '-1');
  92. '-': to_tree(root, '-2');
  93. '*': to_tree(root, '-3');
  94. '/': to_tree(root, '-4');
  95. '^': to_tree(root, '-5');
  96. end;
  97. left_root := copy(source, 1, i - 1); //слева от знака
  98. right_root := copy(source, i + 1, length(source) - i); //справа от знака
  99. create_tree(left_root, root^.left); //и разбираем уже их
  100. create_tree(right_root, root^.right);
  101. end;
  102. end //скобки
  103. else
  104. begin//если нет скобок
  105. while (i > 1) and (source[i] <> '+') and (source[i] <> '-') do //ищем знак плюс или минус
  106. begin
  107. dec(i);
  108. if source[i] = ')' then
  109. begin
  110. bracket := 1;
  111. while bracket <> 0 do
  112. begin
  113. dec(i);
  114. if source[i] = ')' then inc(bracket);
  115. if source[i] = '(' then dec(bracket);
  116. end;
  117. end;
  118. end;
  119. if i = 1 then //вдруг плюса или минуса не нашли (то есть проверками дошли до конца строки)
  120. begin
  121. i := length(source); //тогда снова ставимся на посл элемент
  122. while (i > 1) and (source[i] <> '*') and (source[i] <> '/') do //и уже ищем * или /
  123. dec(i);
  124. end;
  125. if i = 1 then //вдруг * или / не нашли (то есть проверками дошли до конца строки)
  126. begin
  127. i := length(source); //тогда снова ставимся на посл элемент
  128. while (i > 1) and (source[i] <> '^') do //и уже ищем ^
  129. dec(i);
  130. end;
  131. if source[i] = ')' then inc(i);
  132. case source[i] of //вбиваем в дерево обозначение операции
  133. '+': to_tree(root, '-1');
  134. '-': to_tree(root, '-2');
  135. '*': to_tree(root, '-3');
  136. '/': to_tree(root, '-4');
  137. '^': to_tree(root, '-5');
  138. end;
  139. left_root := copy(source, 1, i - 1); //заносим в переменную выражение слева от знака
  140. right_root := copy(source, i + 1, length(source) - i); //справа от знака
  141. create_tree(left_root, root^.left); //и разбираем уже их
  142. create_tree(right_root, root^.right);
  143. end; //если нет скобок
  144. end //если на вход получили выражение
  145. else
  146. to_tree(root, source);
  147.  
  148. end;
  149. {Процедура для сварачивания выражений, при чем
  150. работа происходит исключительно на листьях}
  151. procedure obrabotka (var tree:PTree);
  152. var k1,k2,z1,z2:integer;
  153. begin
  154. if tree<>nil then begin
  155. if tree^.left<>nil then val(tree^.left^.data,z1,k1);
  156. if tree^.right<>nil then val(tree^.right^.data,z2,k2);
  157. {В первом случае пришли просто два числа без переменных}
  158. if (k1=0)and(k2=0) then
  159. case strtoint(tree^.data) of
  160. -1: begin
  161. //str(z1+z2,tree^.data);
  162. tree^.data:=floattostr(z1+z2);
  163. tree^.left:=nil;
  164. tree^.right:=nil;
  165. end;
  166. -2: begin
  167. //str(z1-z2,tree^.data);
  168. tree^.data:=floattostr(z1-z2);
  169. tree^.left:=nil;
  170. tree^.right:=nil;
  171. end;
  172. -3: begin
  173. //str(z1*z2,tree^.data);
  174. tree^.data:=floattostr(z1*z2);
  175. tree^.left:=nil;
  176. tree^.right:=nil;
  177. end;
  178. -4: begin
  179. //str(z1/z2,tree^.data);
  180. tree^.data:=floattostr(z1/z2);
  181. tree^.left:=nil;
  182. tree^.right:=nil;
  183. end;
  184. {Ниже описаны два случая когда одно из пришедших значений содержит переменную}
  185. end else if (tree^.left^.data[k1]='x')and(k2=0) then
  186. case strtoint(tree^.data) of
  187. -3:begin
  188. if tree^.left^.data[1]='x' then
  189. tree^.data:=floattostr(z2)+tree^.left^.data
  190. else begin
  191. val(copy(tree^.left^.data,1,length(tree^.left^.data)-1),z1,k1);
  192. tree^.data:=floattostr(z2*z1)+tree^.left^.data[length(tree^.left^.data)];
  193. end;
  194. tree^.left:=nil;
  195. tree^.right:=nil;
  196. end;
  197. -4:begin
  198. if tree^.left^.data[1]='x' then
  199. tree^.data:=floattostr(z2)+tree^.left^.data
  200. else begin
  201. val(copy(tree^.left^.data,1,length(tree^.left^.data)-1),z1,k1);
  202. tree^.data:=floattostr(z2/z1)+tree^.left^.data[length(tree^.left^.data)];
  203. end;
  204. tree^.left:=nil;
  205. tree^.right:=nil;
  206. end;
  207. end else if (tree^.left^.data[k2]='x')and(k1=0) then
  208. case strtoint(tree^.data) of
  209. -3:begin
  210. if tree^.right^.data[1]='x' then
  211. tree^.data:=floattostr(z2)+tree^.right^.data
  212. else begin
  213. val(copy(tree^.right^.data,1,length(tree^.right^.data)-1),z2,k2);
  214. tree^.data:=floattostr(z2*z1)+tree^.right^.data[length(tree^.right^.data)];
  215. end;
  216. tree^.left:=nil;
  217. tree^.right:=nil;
  218. end;
  219. -4:begin
  220. if tree^.right^.data[1]='x' then
  221. tree^.data:=floattostr(z2)+tree^.right^.data
  222. else begin
  223. val(copy(tree^.right^.data,1,length(tree^.right^.data)-1),z2,k2);
  224. tree^.data:=floattostr(z1/z2)+tree^.right^.data[length(tree^.right^.data)];
  225. end;
  226. tree^.left:=nil;
  227. tree^.right:=nil;
  228. end;
  229. end;
  230. obrabotka(tree^.right);
  231. obrabotka(tree^.left);
  232. end;
  233. end;
  234. {Процедура будет заменять символьную переменную на численное значение}
  235. procedure podstav (var tree:PTree;x:char;i:integer);
  236. begin
  237. if tree<>nil then begin
  238. if tree^.data=x then tree^.data:=floattostr(i);
  239. podstav(tree^.left,x,i);
  240. podstav(tree^.right,x,i);
  241. end;
  242. end;
  243.  
  244. {procedure podgonka (var s:string);
  245. var i,mesto,razr1,razr2:integer;
  246. begin
  247. if s[1]='(' then s:='0+'+s;
  248. i:=1;
  249. while i<>length(s) do begin
  250. if s[i]='*' then mesto:=i;
  251. inc(i);
  252. end;
  253. if (mesto<>0)and((s[mesto-1]<>')')or(s[mesto+1]<>')'))and((s[mesto-1]='x')or(s[mesto+1]='x'))and(mesto>3) then begin
  254. for i:=mesto-1 downto 1 do
  255. if (s[i]='+')or(s[i]='-')or(s[i]=')')or(s[i]='*')or(s[i]='/')or(s[i]='(') then begin
  256. razr1:=i;
  257. break;
  258. end;
  259. for i:=mesto+1 to length(s) do
  260. if (s[i]='+')or(s[i]='-')or(s[i]=')')or(s[i]='(')or(s[i]='*')or(s[i]='/')or(i=length(s)) then begin
  261. razr2:=i;
  262. break;
  263. end;
  264. s:=copy(s,1,razr1)+'('+copy(s,razr1+1,razr2-razr1)+')'+copy(s,razr2,length(s));
  265. end;
  266. end;}
  267.  
  268. var tree:PTree;
  269. fp:text;
  270. s:string;
  271. i:integer;
  272. begin
  273. assign(fp,'inp.txt');
  274. reset(fp);
  275. read(fp,s);
  276. //podgonka(s);
  277. close(fp);
  278. create_tree(s,tree);
  279. obhod(tree);
  280. writeln;
  281. printtree(tree,0);
  282. writeln;
  283. writeln('Какое значение хотите вместо х?');
  284. readln(i);
  285. podstav(tree,'x',i);
  286. while (tree^.left<>nil)and(tree^.right<>nil) do begin
  287. obrabotka(tree);
  288. {obhod(tree);
  289. writeln;
  290. printtree(tree,0);
  291. writeln;}
  292. end;
  293. obhod(tree);
  294. writeln;
  295. end.
Add Comment
Please, Sign In to add comment