Developing.ru

Код: Выделить всё

uses crt;
Type Vhod=char;{integer}
     U=^Tree;
     Tree=Record
     Inf:VHOD;
     L,R:U;
End;
var ResTree:U;
    s:string;
    i:byte;
{процедура добавления числа в двоичное дерево}
Procedure InsRec(x:char{integer};Var Tree:U);
Begin
 If Tree = Nil Then
  Begin
   New(Tree);
   Tree^.L := Nil;
   Tree^.R := Nil;
   Tree^.Inf := x
  End
  Else
  If x < Tree^.inf Then
  InsRec(x,Tree^.L)
  Else InsRec(x,Tree^.R);
End;


begin
clrscr;
writeln('Vvedite vyrazhenie: ');
readln(s);
for i:=1 to length(s) do
 begin
  insrec(s[i],ResTree);
 end;
end.

Код: Выделить всё

uses Crt;
type TreePointer = ^tree;
 tree = record
 data: char;
 left: TreePointer;
 right: TreePointer;
end;
var
root, dummy: TreePointer;
ch:char;

function STree(root, r:TreePointer; data: char):TreePointer;
 begin
  if r = nil then
   begin
    new(r);
    r^.left := nil;
    r^.right := nil;
    r^.data := data;
    if data < root^.data then root^.left := r
    else root^.right := r;
    STree := r;
   end
   else
    begin
     if data<r^.data then STree := STree(r, r^.left, data)
     else STree := STree(r, r^.right, data)
    end;
 end;

procedure PrintTree(r: TreePointer; 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;

begin
 clrscr;
 root := nil;
 repeat
 Write('Vvodite dannye (dlia zavershenia vvoda nazhmite probel) -> ');
 ch := ReadKey;
 Writeln(ch);
 if root= nil then root := STree(root, root, ch)
 else dummy := STree(root, root, ch);
 ch := UpCase(ch);
 until ch =' ';
 PrintTree(root, 0);
 readln;
end.

Код: Выделить всё

uses Crt;
type TreePointer = ^tree;
 tree = record
 data: string;
 left: TreePointer;
 right: TreePointer;
end;

const
  MAXPRIORITY=3;
  SIGNS=['+','-','*','/'];

var
root, dummy: TreePointer;
ch:char;
stroka:string;

function PriorSimv (sign: char): integer;
begin
  case sign of
    '+','-': PriorSimv:=0;
    '*','/': PriorSimv:=1;
  end;
end;

function PriorStr (f:string): integer;
begin
 if (f='ln') or (f='exp') or (f='cos') or (f='sin')
 then PriorStr:=0;
end;

function BuildTree (str: string): TreePointer;
var
  tmp: TreePointer;
  i: integer;
  priormin, imin: integer;
  leftstr, rightstr: string;
  flag:boolean;
begin
 if length(str)=1 then
  begin
   New(tmp);
   tmp^.data:=str[1];
   tmp^.left:=nil;
   tmp^.right:=nil;
   BuildTree:=tmp;
  end
  else
   begin
    i:=length(str);flag:=false;
    priormin:=MAXPRIORITY;
    imin:=i;
    while i>=1 do
     begin
      if ((str[i] in SIGNS) and (PriorSimv(str[i])<priormin)) then
       begin
        priormin:=PriorSimv(str[i]);
        imin:=i;
       end;
      i:=i-1;
     end;
    New(tmp);
    tmp^.data:=str[imin];
    leftstr:=Copy(str,1,imin-1);
    rightstr:=Copy(str,imin+1,length(str)-imin);
    tmp^.left:=BuildTree(leftstr);
    tmp^.right:=BuildTree(rightstr);
    BuildTree:=tmp;
  end;
end;

procedure Infiks(r:TreePointer);
 begin
  if r<>nil then begin
  Infiks(r^.left);
  Write(r^.data);
  Infiks(r^.right);
 end;
end;

procedure Prefiks(r:TreePointer);
 begin
  if r<>nil then
   begin
    Write(r^.data);
    Prefiks(r^.left);
    Prefiks(r^.right);
   end;
 end;

procedure Postfiks(r:TreePointer);
 begin
  if r<>nil then
   begin
    Postfiks(r^.left);
    Postfiks(r^.right);
    Write(r^.data);
   end;
 end;

begin
 clrscr;
 root := nil;
 writeln('Vvedite stroku: ');
 readln(stroka);
 root := BuildTree(stroka);
 writeln('Priamoi obhod: ');
 Prefiks(root);
 writeln;
 writeln('Obratnyi obhod: ');
 Postfiks(root);
 writeln;
 writeln('Simmetrichnyi obhod: ');
 Infiks(root);
 readln;
end.