old/PAS/mytree.pas

Uses CRT;
Type
  UT = char;                            {�®«ì§®¢ â¥«ì᪨© ⨯}
  PBTree = ^TBTree;                     {“ª § â¥«ì ­  ¤¥à¥¢®}
  TBTree = record                       {�à®áâ® ¤¥à¥¢®}
    info : UT;                          {‡­ ç¥­¨¥}
    count: word;                        {Š®«¨ç¥á⢮}
    Left : PBTree;                      {‹¥¢ ï ¢¥â¢ì}
    Right: PBTree;                      {�à ¢ ï ¢¥â¢ì}
  end;

Function NewChild(info:UT) : PBtree;    {”ã­ªæ¨ï ᮧ¤ ­¨ï ­®¢®© ¢¥â¢¨}
var
 ne : PBTree;                           {“ª § â¥«ì ­  १ã«ìâ â}
begin
 New(ne);
 Ne^.info  := Info;                     {‡ ¯®«­ï¥¬ §­-¥}
 Ne^.Left  := nil;
 Ne^.Right := nil;
 Ne^.count := 1;                        {Š®«-¢® - 1}
 NewChild  := ne;
end; {NewChild}
{---------------------------------}
Procedure DelBranch(br:PBTree);         {“¤ «¥­¨¥ ¢¥â¢¨, ¢¬¥áâ¨ á ¤¥â쬨}
begin
  if br^.left <> nil then DelBranch(br^.left);  {…᫨ ¥áâì «¥¢ë© ॡ¥­®ª -
                                                 㤠«ï¥¬ ¥£®}
  if br^.right <> nil then DelBranch(br^.right);{€ ¥á«¨ ¥áâì ¨ ¯à ¢ë© - ¨
                                                 ¥£® ⮦¥!}
  Dispose(br);                                  {‘®¡á⢥­­® 㤠«¥­¨¥}
end;{DelBranch}
{---------------------------------}
Procedure SetLRootRInfo(info:UT;Br:PBTree);     {„®¡ ¢«¥­¨¥ ­®¢®£® §­-ï ­ 
                                                 ­  ¢¥â¢ì}
begin
  if info < Br^.info then                       {�®áë« ¥¬ ­  «¥¢®}
   begin
     if (Br^.Left=nil) then Br^.Left := NewChild(info)  {…᫨ ­¨ª®£® - ¢¥è ¥¬}
     else SetLRootRInfo(info,BR^.Left);            {ˆ­ ç¥ - á¯ã᪠¥¬ ­  «¥¢®}
   end
  else                                 {€ ¥á«¨ â ª®©-¦¥ - 㢥«¨ç¨¢ ¥¬ ª®«-¢®}
   if (info=Br^.info) then inc(Br^.count)
  else                                 {‡­ ç¨â ®­® - á¯à ¢ }
   begin
     if (Br^.Right=nil) then            {…᫨ ­¨ª®£® - ¢¥è ¥¬ ­ ¯à ¢®}
       Br^.Right := NewChild(info)
     else SetLRootRInfo(info,BR^.Right);  {ˆ­ ç¥ - á¯ã᪠¥¬ ­  ¯à ¢®}
   end;
end;{SetLRootRInfo}
{---------------------------------}
Function MakeLRootRTree(st:string;count:word):PBTree;
  {‘®§¤ ­¨¥ ¤¢®¨ç­®£® ¤¥à¥¢  ¤«ï ¯®¨áª }
var
  ret : PBTree;
  pos : byte;
Begin
  ret := NewChild(st[1]);
  for pos := 2 to count do SetLRootRInfo(st[pos],ret);
  MakeLRootRTree := ret;
End; {MakeLRootRTree}
{---------------------------------}
var
  h : word;                         {ƒ«®¡ «ì­ ï ¯¥à¥¬¥­­ ï - ­®¬¥à ã஢­ï}
Procedure FindInfo(info:UT;Br:PBTree); {�®¨áª §­-ï ¢ ¤¥à¥¢¥, á ¯®¤áç¥â®¬ H}
begin
 if (Br<>nil) then begin
 if (info<Br^.Info) then begin inc(h); FindInfo(info,Br^.Left) end
 else if (info>Br^.Info) then begin inc(h); FindInfo(info,Br^.Right) end;
 end
 else h := 0;
end;{FindInfo}
{---------------------------------}
Function GetHeight(BTree:PBTree):word;
var
 max,h : word;

Procedure Calc(Br:PBtree);
begin
 if Br <> nil then
  begin
    inc(h);
    Calc(Br^.Left);
    Calc(Br^.Right);
    dec(h);
  end
 else
  begin
    if h > max then max := h;
  end;
end;

begin
  max := 0;
  h := 0;
  Calc(BTree);
  GetHeight := max;
end;{GetHeight}
{---------------------------------}
Procedure ShowTree(Tree:PBTree);
var x,y : byte;
{-=-=-=-=-=-=-}
procedure WriteBranch(Br:PBTree;x,y:byte);
begin
  GotoXY(x,y);
  TextColor(BLue);
  Write(BR^.Info);
  TextColor(LightGray);
  GotoXY(x,y+1);
  if (Br^.Left<>nil) and (Br^.Right<>nil) then
   begin
     Write('Ï');
     GotoXY(x-6,y+1);
     Write('ÕÍÍÍÍÍ');
     WriteBranch(Br^.Left,x-6,y+2);
     GotoXY(x+1,y+1);
     Write('ÍÍÍÍ͸');
     WriteBranch(Br^.Right,x+6,y+2);
   end
  else
    if (Br^.Left=nil) and (Br^.Right<>nil) then
     begin
       Write('ÔÍÍÍÍ͸');
       WriteBranch(Br^.Right,x+6,y+2);
     end
  else if (Br^.Left<>nil) and (Br^.Right=nil) then
   begin
     GotoXY(x-6,y+1);
     Write('ÕÍÍÍÍ;');
     WriteBranch(Br^.Left,x-6,y+2);
   end;
end;
{-=-=-=-=-=-=-}
begin
  if GetHeight(Tree) > 10 Then begin WriteLn('Tree to high!');exit;end;
  x := 40;
  y := 1 ;
  ClrScr;
  WriteBranch(Tree,x,y);
end;{ShowTree}
{---------------------------------}
Var
  test  : string;
  BTree : PBTree;
  ch    : char;
BEGIN
  ClrScr;
  WriteLn('‚¢¥¤¨â¥ ¬ áᨢ ¤«ï ᮧ¤ ­¨ï ¤¢®¨ç­®£® ¤¥à¥¢  ¯®¨áª  ¬¥â®¤®¬ Left->Root->Right');
  ReadLn(test);
  BTree := MakeLRootRTree(test,Length(test));
{  WriteLn('‚ëá®â  ¤¥à¥¢ : ',GetHeight(BTree));
  WriteLn('‚¢¥¤¨â¥ ᨬ¢®« ¤«ï ¯®¨áª  ¯® ¤¥à¥¢ã: ');
  ch := ReadKey;
  h := 1;
  FindInfo(ch,BTree);
  if (h<>0) then
    WriteLn('‘¨¬¢®« ''',ch,''' ­ ©¤¥­ ­  ',h,'-®¬ ã஢­¥')
  else
    WriteLn('‘¨¬¢®« ''',ch,''' ­¥ ­ ©¤¥­');
  WriteLn('Press any key to view tree');
  ReadKey;}
  ShowTree(Btree);
  DelBranch(BTree);
  ReadKey;
END.