Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- type PTree=^elem_tree;
- elem_tree = record
- data:string[150];
- left:PTree;
- right:PTree;
- end;
- procedure obhod (pt:PTree);
- begin
- if pt<>nil then begin
- obhod(pt^.left);
- write(pt^.data,' ');
- obhod(pt^.right);
- end;
- end;
- {Процедура позволяет взглянуть на дерево,
- использовалась во время отладки программы}
- procedure PrintTree(r: PTree; n: integer);
- var i:integer;
- begin
- if r<>nil then begin
- PrintTree(r^.left, n+1);
- for i := 1 to n do Write(' ');
- Writeln(r^.data);
- PrintTree(r^.right, n+1);
- end;
- end;
- procedure to_tree(var root: Ptree; data: string[10]);
- begin
- if root = nil then
- begin
- new(root);
- root^.data := data;
- root^.right := nil;
- root^.left := nil;
- end
- end;
- procedure create_tree(source: string; var root: Ptree);
- var
- temp_int, err, bracket, i, j: integer;
- left_root, right_root: string;
- begin
- val(source, temp_int, err);
- if (err > 0) and (length(source) <> 1) then
- begin
- i := length(source); //ставимся на последний символ в строке
- //нужно поработать со скобками
- if source[i] = ')' then
- begin//скобки
- bracket := 1;
- while bracket <> 0 do
- begin
- dec(i);
- if source[i] = ')' then inc(bracket);
- if source[i] = '(' then dec(bracket);
- end;
- if i = 1 then
- begin//если все полученное выражение оказалось в скобках
- delete(source, 1, 1); //удалим эти внешние скобки
- delete(source, length(source), 1);
- create_tree(source, root); //и разберем выражение без внешних скобок
- end
- else
- begin//если выражение в скобках кончилось где-то посередине
- dec(i);
- if (source[i] = '*') or (source[i] = '/') then //для ситуации (a+b)/c+d
- begin
- j := i;
- while (j > 1 ) and (source[j] <> '+') and (source[j] <> '-') do //ищем знак плюс или минус
- begin
- dec(j);
- if source[j] = ')' then
- begin
- bracket := 1;
- while bracket <> 0 do
- begin
- dec(j);
- if source[j] = ')' then inc(bracket);
- if source[j] = '(' then dec(bracket);
- end;
- end;
- end;
- if j <> 1 then i := j;
- end;
- case source[i] of //вбиваем в дерево обозначение операции
- '+': to_tree(root, '-1');
- '-': to_tree(root, '-2');
- '*': to_tree(root, '-3');
- '/': to_tree(root, '-4');
- '^': to_tree(root, '-5');
- end;
- left_root := copy(source, 1, i - 1); //слева от знака
- right_root := copy(source, i + 1, length(source) - i); //справа от знака
- create_tree(left_root, root^.left); //и разбираем уже их
- create_tree(right_root, root^.right);
- end;
- end //скобки
- else
- begin//если нет скобок
- while (i > 1) and (source[i] <> '+') and (source[i] <> '-') do //ищем знак плюс или минус
- begin
- dec(i);
- if source[i] = ')' then
- begin
- bracket := 1;
- while bracket <> 0 do
- begin
- dec(i);
- if source[i] = ')' then inc(bracket);
- if source[i] = '(' then dec(bracket);
- end;
- end;
- end;
- if i = 1 then //вдруг плюса или минуса не нашли (то есть проверками дошли до конца строки)
- begin
- i := length(source); //тогда снова ставимся на посл элемент
- while (i > 1) and (source[i] <> '*') and (source[i] <> '/') do //и уже ищем * или /
- dec(i);
- end;
- if i = 1 then //вдруг * или / не нашли (то есть проверками дошли до конца строки)
- begin
- i := length(source); //тогда снова ставимся на посл элемент
- while (i > 1) and (source[i] <> '^') do //и уже ищем ^
- dec(i);
- end;
- if source[i] = ')' then inc(i);
- case source[i] of //вбиваем в дерево обозначение операции
- '+': to_tree(root, '-1');
- '-': to_tree(root, '-2');
- '*': to_tree(root, '-3');
- '/': to_tree(root, '-4');
- '^': to_tree(root, '-5');
- end;
- left_root := copy(source, 1, i - 1); //заносим в переменную выражение слева от знака
- right_root := copy(source, i + 1, length(source) - i); //справа от знака
- create_tree(left_root, root^.left); //и разбираем уже их
- create_tree(right_root, root^.right);
- end; //если нет скобок
- end //если на вход получили выражение
- else
- to_tree(root, source);
- end;
- {Процедура для сварачивания выражений, при чем
- работа происходит исключительно на листьях}
- procedure obrabotka (var tree:PTree);
- var k1,k2,z1,z2:integer;
- begin
- if tree<>nil then begin
- if tree^.left<>nil then val(tree^.left^.data,z1,k1);
- if tree^.right<>nil then val(tree^.right^.data,z2,k2);
- {В первом случае пришли просто два числа без переменных}
- if (k1=0)and(k2=0) then
- case strtoint(tree^.data) of
- -1: begin
- //str(z1+z2,tree^.data);
- tree^.data:=floattostr(z1+z2);
- tree^.left:=nil;
- tree^.right:=nil;
- end;
- -2: begin
- //str(z1-z2,tree^.data);
- tree^.data:=floattostr(z1-z2);
- tree^.left:=nil;
- tree^.right:=nil;
- end;
- -3: begin
- //str(z1*z2,tree^.data);
- tree^.data:=floattostr(z1*z2);
- tree^.left:=nil;
- tree^.right:=nil;
- end;
- -4: begin
- //str(z1/z2,tree^.data);
- tree^.data:=floattostr(z1/z2);
- tree^.left:=nil;
- tree^.right:=nil;
- end;
- {Ниже описаны два случая когда одно из пришедших значений содержит переменную}
- end else if (tree^.left^.data[k1]='x')and(k2=0) then
- case strtoint(tree^.data) of
- -3:begin
- if tree^.left^.data[1]='x' then
- tree^.data:=floattostr(z2)+tree^.left^.data
- else begin
- val(copy(tree^.left^.data,1,length(tree^.left^.data)-1),z1,k1);
- tree^.data:=floattostr(z2*z1)+tree^.left^.data[length(tree^.left^.data)];
- end;
- tree^.left:=nil;
- tree^.right:=nil;
- end;
- -4:begin
- if tree^.left^.data[1]='x' then
- tree^.data:=floattostr(z2)+tree^.left^.data
- else begin
- val(copy(tree^.left^.data,1,length(tree^.left^.data)-1),z1,k1);
- tree^.data:=floattostr(z2/z1)+tree^.left^.data[length(tree^.left^.data)];
- end;
- tree^.left:=nil;
- tree^.right:=nil;
- end;
- end else if (tree^.left^.data[k2]='x')and(k1=0) then
- case strtoint(tree^.data) of
- -3:begin
- if tree^.right^.data[1]='x' then
- tree^.data:=floattostr(z2)+tree^.right^.data
- else begin
- val(copy(tree^.right^.data,1,length(tree^.right^.data)-1),z2,k2);
- tree^.data:=floattostr(z2*z1)+tree^.right^.data[length(tree^.right^.data)];
- end;
- tree^.left:=nil;
- tree^.right:=nil;
- end;
- -4:begin
- if tree^.right^.data[1]='x' then
- tree^.data:=floattostr(z2)+tree^.right^.data
- else begin
- val(copy(tree^.right^.data,1,length(tree^.right^.data)-1),z2,k2);
- tree^.data:=floattostr(z1/z2)+tree^.right^.data[length(tree^.right^.data)];
- end;
- tree^.left:=nil;
- tree^.right:=nil;
- end;
- end;
- obrabotka(tree^.right);
- obrabotka(tree^.left);
- end;
- end;
- {Процедура будет заменять символьную переменную на численное значение}
- procedure podstav (var tree:PTree;x:char;i:integer);
- begin
- if tree<>nil then begin
- if tree^.data=x then tree^.data:=floattostr(i);
- podstav(tree^.left,x,i);
- podstav(tree^.right,x,i);
- end;
- end;
- {procedure podgonka (var s:string);
- var i,mesto,razr1,razr2:integer;
- begin
- if s[1]='(' then s:='0+'+s;
- i:=1;
- while i<>length(s) do begin
- if s[i]='*' then mesto:=i;
- inc(i);
- end;
- 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
- for i:=mesto-1 downto 1 do
- if (s[i]='+')or(s[i]='-')or(s[i]=')')or(s[i]='*')or(s[i]='/')or(s[i]='(') then begin
- razr1:=i;
- break;
- end;
- for i:=mesto+1 to length(s) do
- if (s[i]='+')or(s[i]='-')or(s[i]=')')or(s[i]='(')or(s[i]='*')or(s[i]='/')or(i=length(s)) then begin
- razr2:=i;
- break;
- end;
- s:=copy(s,1,razr1)+'('+copy(s,razr1+1,razr2-razr1)+')'+copy(s,razr2,length(s));
- end;
- end;}
- var tree:PTree;
- fp:text;
- s:string;
- i:integer;
- begin
- assign(fp,'inp.txt');
- reset(fp);
- read(fp,s);
- //podgonka(s);
- close(fp);
- create_tree(s,tree);
- obhod(tree);
- writeln;
- printtree(tree,0);
- writeln;
- writeln('Какое значение хотите вместо х?');
- readln(i);
- podstav(tree,'x',i);
- while (tree^.left<>nil)and(tree^.right<>nil) do begin
- obrabotka(tree);
- {obhod(tree);
- writeln;
- printtree(tree,0);
- writeln;}
- end;
- obhod(tree);
- writeln;
- end.
Add Comment
Please, Sign In to add comment