bst2.log

   1 program tree;\r
   2 (*****************************************************************************\r
   3                    B O G D A N    W I E R C Z Y N S K I\r
   4                             1 0 . 0 1 . 1 9 8 9\r
   5   Przedstawiony program umozliwia tworzenie drzewa BST oraz jego modyfikacje\r
   6   w celach dydaktycznych.  Udostepnia  cztery  podstawowe  operacje  na  tej\r
   7   strukturze danych:insert,delete,minimum i maximum. Struktora drzewa jest\r
   8   wyswietlana na ekranie i kazda akcja powodujaca jej zmiane wiaze sie ze\r
   9   zmiana drzewa na ekranie.\r
  10 ******************************************************************************)\r
  11  \r
  12  \r
  13  unit BST:class;\r
  14  (* Klasa implementujaca BST jako abstrakcyjny typ danych z podstawowymi\r
  15     operacjami zwiazanymi z ta struktora.                                 *)\r
  16  \r
  17   unit vertex:class;\r
  18    var key:integer,\r
  19        left,right:vertex;\r
  20   end vertex;\r
  21  \r
  22   unit find:class(x:real;inout v:vertex);\r
  23   (* Wyszukanie w drzewie o korzeniu v wierzcholka z kluczem o wartosci x *)\r
  24    var father,(* Wskazanie na ojca szukanegoelementu *)\r
  25        znaleziony,(* Wskazanie na wierzcholek ktorego klucz ma wartosc x *)\r
  26        vpom:vertex,(* Zmienna pomocnicza *)\r
  27        lson:boolean;(* Zmienna informujaca ze znaleziony element jest\r
  28                        lewym synem *)\r
  29    begin\r
  30     vpom:=v;\r
  31     father,znaleziony:=none;\r
  32     while vpom=/=none do\r
  33      if x<vpom.key then father:=vpom;vpom:=vpom.left;lson:=true\r
  34       else\r
  35        if x>vpom.key then father:=vpom;vpom:=vpom.right;lson:=false\r
  36         else znaleziony:=vpom;exit\r
  37        fi\r
  38      fi\r
  39     od;\r
  40   end find;\r
  41  \r
  42   unit delete:find procedure;\r
  43   (* Kasowanie wierzcholka ktorego wartosc klucza jest parametrem x w\r
  44      find *)\r
  45    begin\r
  46    if znaleziony=/=none then\r
  47      if znaleziony.left=znaleziony.right then\r
  48       (* Usuwany element jest lisciem  *)        kill(znaleziony)\r
  49       else\r
  50        if znaleziony.right=none then\r
  51          if father=none then v:=v.left\r
  52           (* Usuwany element jest korzeniem drzewa *)\r
  53            else\r
  54             if lson then father.left:=znaleziony.left\r
  55              else father.right:=znaleziony.left\r
  56             fi\r
  57          fi;\r
  58          kill(znaleziony)\r
  59         else\r
  60           vpom:=znaleziony.right;\r
  61           while vpom.left=/=none do\r
  62            vpom:=vpom.left\r
  63           od;\r
  64           znaleziony.key:=vpom.key;\r
  65           if vpom.right=none then  kill(vpom)\r
  66             else\r
  67               znaleziony:=vpom.right; (* Wykorzystanie zmiennej znaleziony\r
  68                                         jako zmiennej pomocniczej        *)\r
  69               vpom.key:=znaleziony.key;\r
  70               vpom.left:=znaleziony.left;\r
  71               vpom.right:=znaleziony.right;\r
  72               kill(znaleziony)\r
  73           fi\r
  74        fi\r
  75      fi\r
  76    fi\r
  77   end delete;\r
  78  \r
  79   unit insert:procedure(x:integer;inout v:vertex);\r
  80   (* Wstawienie do drzewa BST  o korzeniu v elementu ktorego wartosc klucza\r
  81      bedzie rowna x *)\r
  82   var vpom:vertex;\r
  83    begin\r
  84    if v=none then v:=new vertex; v.key:=x (* Puste drzewo *)\r
  85      else\r
  86        vpom:=v;\r
  87        do\r
  88          if x<=vpom.key then\r
  89            if vpom.left=/=none then vpom:=vpom.left\r
  90              else vpom.left:=new vertex;\r
  91                   vpom.left.key:=x;\r
  92                   exit\r
  93            fi\r
  94           else\r
  95             if vpom.right=/=none then vpom:=vpom.right\r
  96               else vpom.right:=new vertex;\r
  97                   vpom.right.key:=x;\r
  98                   exit\r
  99             fi\r
 100          fi\r
 101        od\r
 102    fi\r
 103   end insert;\r
 104  \r
 105   unit minimum:function(v:vertex):integer;\r
 106   (* Znalezienie elementu o najmniejszym kluczu *)\r
 107   begin\r
 108     while v.left =/= none do\r
 109       v:=v.left;\r
 110     od;\r
 111     result:=v.key;\r
 112   end minimum;\r
 113  \r
 114   unit maximum:function(v:vertex):integer;\r
 115   (* Znalezienie elementu o najwiekszym kluczu *)\r
 116   begin\r
 117     while v.right=/= none do\r
 118       v:=v.right;\r
 119     od;\r
 120     result:=v.key;\r
 121   end maximum;\r
 122  \r
 123  end BST;\r
 124  \r
 125  \r
 126  unit SetCursor: procedure(x,y:integer);\r
 127  var i,j:integer,\r
 128      c,d,e,f:char;\r
 129  begin\r
 130    i:= x div 10;\r
 131    j:= x mod 10;\r
 132    c:=chr(48+i);\r
 133    d:=chr(48+j);\r
 134    i:=y div 10;\r
 135    j:=y mod 10;\r
 136    e:=chr(48+i);\r
 137    f:=chr(48+j);\r
 138    write(chr(27),"[",c,d,";",e,f,"H")\r
 139  end SetCursor;\r
 140  \r
 141  unit inchar : IIUWgraph function : integer;\r
 142     (*podaj nr znaku przeslanego z klawiatury *)\r
 143     var i : integer;\r
 144  begin\r
 145     do\r
 146       i := inkey;\r
 147       if i <> 0 then exit fi;\r
 148     od;\r
 149     result := i;\r
 150   end inchar;\r
 151  \r
 152  unit ClearScreen: procedure;\r
 153  begin\r
 154    write(chr(27),"[2J")\r
 155  end ClearScreen;\r
 156  \r
 157  \r
 158 begin\r
 159 pref BST block\r
 160  \r
 161  \r
 162  unit OpenWindow:procedure(x,y,height,width:integer);\r
 163  (* Otwarcie okienka ktorege lewy gorny rog ma wspolrzedne (x,y) i o wymiarach\r
 164     height x width (wysokosc x szerokosc)                                     *)\r
 165  var i,j:integer;\r
 166  begin\r
 167    call SetCursor(x,y);\r
 168    write(chr(218));\r
 169    for j:=2 to width-1 do write(chr(196)) od;\r
 170    write(chr(191));\r
 171    for i:=2 to height-1 do\r
 172      call SetCursor(x+i-1,y);\r
 173      write(chr(179));\r
 174      for j:=2 to width-1 do write(" ") od;\r
 175      write(chr(179));\r
 176    od;\r
 177    call SetCursor(x+height-1,y);\r
 178    write(chr(192));\r
 179    for j:=2 to width-1 do write(chr(196)) od;\r
 180    write(chr(217));\r
 181    call SetCursor(x+1,y+1);\r
 182  end OpenWindow;\r
 183  \r
 184  unit CloseWindow:procedure(x,y,height,width:integer);\r
 185  (* Zamkniecie okienka ktorege lewy gorny rog ma wspolrzedne (x,y) i o wymiarach\r
 186     height x width (wysokosc x szerokosc)                                     *)\r
 187  var i,j:integer;\r
 188  begin\r
 189  \r
 190    for i:=0 to height-1 do\r
 191      call SetCursor(x+i,y);\r
 192      for j:=1 to width do write(" ") od;\r
 193    od;\r
 194  end CloseWindow;\r
 195  \r
 196  unit negative:procedure;\r
 197    begin\r
 198      write(chr(27),"[7m");\r
 199  end negative;\r
 200  \r
 201  unit positive:procedure;\r
 202    begin\r
 203      write(chr(27),"[0m");\r
 204  end positive;\r
 205  \r
 206  unit MenuType:class;\r
 207   var beginingX,beginingY:integer,\r
 208       Name:string;\r
 209  end MenuType;\r
 210  \r
 211  unit Inic:procedure;\r
 212  (* Zainicjowanie systemu,utorzenie odpowiednich danych, ich zainicjowanie,\r
 213     wyswietlenie menu .                                                    *)\r
 214  var i:integer;\r
 215  begin\r
 216    AktPoz:=0;\r
 217    array Menu dim(0:4);\r
 218    for i:=0 to 4 do     (* Wypelnienie tablicy menu *)\r
 219      Menu(i):=new MenuType;\r
 220      Menu(i).beginingX:=2; (* Wspolrzedne peczatku napisu opcji w menu *)\r
 221      Menu(i).beginingY:=8+i*16;\r
 222      case i                  (* Wstawienie odpowiedniego tekstu *)\r
 223        when 0: Menu(i).Name:="INSERT";\r
 224        when 1: Menu(i).Name:="DELETE";\r
 225        when 2: Menu(i).Name:="MINIMUM";\r
 226        when 3: Menu(i).Name:="MAXIMUM";\r
 227        when 4: Menu(i).Name:="EXIT";\r
 228      esac;\r
 229    od;\r
 230    call ClearScreen;\r
 231    call SetCursor(1,1);\r
 232    for i:=1 to 80 do\r
 233      write(chr(196))\r
 234    od;\r
 235    call negative;\r
 236    call SetCursor(Menu(0).beginingX,Menu(0).beginingY);\r
 237    write(Menu(0).Name);\r
 238    call positive;\r
 239    for i:=1 to 4 do\r
 240      call SetCursor(Menu(i).beginingX,Menu(i).beginingY);\r
 241      write(Menu(i).Name);\r
 242    od;\r
 243    call SetCursor(3,1);\r
 244    for i:=1 to 80 do\r
 245      write(chr(196))\r
 246    od;\r
 247    call SetCursor(Menu(0).beginingX,Menu(0).beginingY);\r
 248  end Inic;\r
 249  \r
 250  unit printclass:class;\r
 251  (* Klasa ktora zajmuje sie wyswietlaniem drzewa na ekranie .\r
 252     (Mozna ja traktowac w pewnym sensie jak pprocedure)       *)\r
 253   const X=1,\r
 254         Y=2;\r
 255   var i,j,last,przes,NumberOfVert:integer,\r
 256       VertCoord:array_of array_of integer,(*Tablica zawierajaca wspolrzedne\r
 257                                             wyswietlanych elementow         *)\r
 258       queueForPrint:array_of vertex;(*kolejka elementow do wyswietlenia*)\r
 259  \r
 260   unit printTree:procedure(v:vertex);\r
 261   (* Procedura wyswietlajaca drzewo o podanym korzeniu *)\r
 262   var first:integer,\r
 263       isleft,isright:boolean;\r
 264   begin\r
 265   if v=/=none then\r
 266     first,last:=1;\r
 267     queueForPrint(last):=v;\r
 268     while first<=31 do (* Wstawianie 31 kolejnych wierzcholkow do kolejki\r
 269                           i drukowanie ich.(Tylko tyle miesci sie na\r
 270                           monitorze                                       *)\r
 271       if first<=15 then\r
 272         if queueForPrint(first)=none then\r
 273           queueForPrint(last+1),queueForPrint(last+2):=none;\r
 274           (*Niema synow wiec wstawiamy none *)\r
 275          else\r
 276            queueForPrint(last+1):=queueForPrint(first).left;\r
 277            queueForPrint(last+2):=queueForPrint(first).right;\r
 278            isleft:=queueForPrint(first).left=/=none;\r
 279            isright:=queueForPrint(first).right=/=none;\r
 280            call Setcursor(VertCoord(X,first),VertCoord(Y,first)-1);\r
 281            (* Wypisanie elementu drzewa w odpowiednim formacie *)\r
 282            call format(queueForPrint(first).key);\r
 283            if isleft or_if isright then\r
 284               call Setcursor(VertCoord(X,first)+1,VertCoord(Y,first));\r
 285               write(chr(179));\r
 286               if isleft then\r
 287                 call Setcursor(VertCoord(X,first*2)-1,VertCoord(Y,2*first));\r
 288                 write(chr(179));\r
 289                 call Setcursor(VertCoord(X,first*2)-2,VertCoord(Y,2*first));\r
 290                 write(chr(218));\r
 291                 for i:=1 to ( VertCoord(Y,first)-VertCoord(Y,2*first)-1) do\r
 292                   write(chr(196));\r
 293                 od;\r
 294               fi;\r
 295               if isleft and isright then write(chr(193))\r
 296                 else\r
 297                   if isleft then write(chr(217))\r
 298                     else\r
 299                       call Setcursor(VertCoord(X,first)+2,VertCoord(Y,first));\r
 300                       write(chr(192));\r
 301                   fi;\r
 302               fi;\r
 303               if isright then\r
 304                 for i:=1 to ( VertCoord(Y,2*first+1)-VertCoord(Y,first)-1) do\r
 305                   write(chr(196));\r
 306                 od;\r
 307                 write(chr(191));\r
 308                 call Setcursor(VertCoord(X,first*2+1)-1,\r
 309                                VertCoord(Y,2*first+1));\r
 310                 write(chr(179));\r
 311               fi;\r
 312            fi;\r
 313         fi;\r
 314         last:=last+2\r
 315        else\r
 316          if queueForPrint(first)=/=none then\r
 317            call SetCursor(VertCoord(X,first),VertCoord(Y,first)-1);\r
 318            (* Wypisanie elementu drzewa w odpowiednim formacie *)\r
 319            call format(queueForPrint(first).key);\r
 320            if queueForPrint(first).left=/=none or_if\r
 321               queueForPrint(first).right=/=none then\r
 322               call Setcursor(VertCoord(X,first)+1,VertCoord(Y,first));\r
 323               write(chr(25));\r
 324            fi;\r
 325          fi;\r
 326       fi;\r
 327       first:=first+1\r
 328     od;\r
 329   fi;\r
 330   end printTree;\r
 331  \r
 332   unit format:procedure(x:integer);\r
 333   (* Procedura wybiera odpowiedni format wydruku w zaleznosci od liczby\r
 334      cyfr w liczbie x i wypisuje ja na ekran                            *)\r
 335   begin\r
 336     if x>=0 then\r
 337        if x>999 then write(x:4)\r
 338          else\r
 339           if x>99 then write(x:3)\r
 340            else write(x:2)\r
 341           fi\r
 342        fi\r
 343      else\r
 344        if x<-99 then write(x:4)\r
 345         else\r
 346           if x<-9 then write(x:3)\r
 347            else write(x:2)\r
 348           fi\r
 349        fi\r
 350     fi\r
 351   end format;\r
 352  \r
 353  begin\r
 354    array VertCoord dim(1:2);\r
 355    for i:=1  to 2 do array VertCoord(i) dim(1:31);od;\r
 356    array queueForPrint dim(1:31);\r
 357    przes:=40;\r
 358    last,NumberOfVert:=1;\r
 359    (* Wypelnienie tablicy VertCoord wspolrzednymi wszystkich elementow\r
 360       ktore moga byc wyswietlone na ekranie                            *)\r
 361    for i:=0 to 4 do\r
 362      for j:=1 to NumberOfVert do\r
 363        if i=/=4 then\r
 364          VertCoord(Y,last):=przes+(j-1)*2*przes;\r
 365        fi;\r
 366        VertCoord(X,last):=i*4+7;\r
 367        last:=last+1\r
 368      od;\r
 369      NumberOfVert:=NumberOfVert*2;\r
 370      przes:=przes div 2\r
 371    od;\r
 372    przes:=0;\r
 373    for last:=16 to 31 do\r
 374        VertCoord(Y,last):=2+przes;\r
 375        przes:=przes+5\r
 376    od;\r
 377  end printclass;\r
 378  \r
 379  \r
 380 const  IndicatorLeft=-75,(* Kody znakow wykorzystywanych przy poslugiwaniu *)\r
 381        IndicatorRight=-77,(* sie menu.                                     *)\r
 382        Enter=13,\r
 383        Esc=27,\r
 384        ConstInsert=0,(* Indeksy tablicy Menu odpowiadajace opcjom *)\r
 385        ConstDelete=1,\r
 386        ConstMinimum=2,\r
 387        ConstMaximum=3,\r
 388        ConstExit=4;\r
 389  \r
 390 var i,znak,AktPoz,key:integer,\r
 391     root:vertex,(* Korzen drzewa BST *)\r
 392     print:printclass,\r
 393     Menu :array_of MenuType;\r
 394  \r
 395 (********** POCZATEK PROGRAMU GLOWNEGO **********)\r
 396 begin\r
 397   print:=new printclass;\r
 398   call Inic;\r
 399   do\r
 400     znak:=inchar;\r
 401     case znak\r
 402       when IndicatorRight:call SetCursor(Menu(AktPoz).beginingX,\r
 403                                          Menu(AktPoz).beginingY);\r
 404                           write(Menu(AktPoz).Name);\r
 405                           AktPoz:=(AktPoz+1) mod 5;\r
 406                           call SetCursor(Menu(AktPoz).beginingX,\r
 407                                          Menu(AktPoz).beginingY);\r
 408                           call negative;\r
 409                           write(Menu(AktPoz).Name);\r
 410                           call positive;\r
 411                           call SetCursor(Menu(AktPoz).beginingX,\r
 412                                          Menu(AktPoz).beginingY);\r
 413       when IndicatorLeft: call SetCursor(Menu(AktPoz).beginingX,\r
 414                                          Menu(AktPoz).beginingY);\r
 415                           write(Menu(AktPoz).Name);\r
 416                           AktPoz:=(AktPoz+4) mod 5;\r
 417                           call SetCursor(Menu(AktPoz).beginingX,\r
 418                                          Menu(AktPoz).beginingY);\r
 419                           call negative;\r
 420                           write(Menu(AktPoz).Name);\r
 421                           call positive;\r
 422                           call SetCursor(Menu(AktPoz).beginingX,\r
 423                                          Menu(AktPoz).beginingY);\r
 424       when Enter: if Aktpoz=ConstExit then call endrun\r
 425                     else\r
 426                       call OpenWindow(3,Menu(AktPoz).beginingY,3,22);\r
 427                       case Aktpoz\r
 428                         when ConstInsert:write("VALUE: ");\r
 429                                          readln(key);\r
 430                                          call insert(key,root);\r
 431                                          call print.printtree(root);\r
 432                                          call SetCursor(Menu(AktPoz).beginingX,\r
 433                                                Menu(AktPoz).beginingY);\r
 434                         when ConstDelete:write("VALUE: ");\r
 435                                          readln(key);\r
 436                                          call delete(key,root);\r
 437                                          call CloseWindow(7,1,18,80);\r
 438                                          call print.printtree(root);\r
 439                                          call SetCursor(Menu(AktPoz).beginingX,\r
 440                                               Menu(AktPoz).beginingY);\r
 441                         when ConstMinimum:if root =/= none then\r
 442                                             write(minimum(root):4," ")\r
 443                                             else  write("Empty Tree ");\r
 444                                           fi;\r
 445                                           write("press Esc");\r
 446                                           do\r
 447                                             if inchar=Esc then exit fi;\r
 448                                           od;\r
 449                                           call SetCursor(Menu(AktPoz).beginingX,\r
 450                                                       Menu(AktPoz).beginingY);\r
 451                         when ConstMaximum:if root =/= none then\r
 452                                             write(maximum(root):4," ")\r
 453                                             else  write("Empty Tree ");\r
 454                                           fi;\r
 455                                           write("press Esc");\r
 456                                           do\r
 457                                             if inchar=Esc then exit fi;\r
 458                                           od;\r
 459                                           call SetCursor(Menu(AktPoz).beginingX,\r
 460                                                      Menu(AktPoz).beginingY);\r
 461                       esac;\r
 462                       call CloseWindow(3,Menu(AktPoz).beginingY,3,22);\r
 463                       call SetCursor(Menu(AktPoz).beginingX+1,\r
 464                                           Menu(AktPoz).beginingY);\r
 465                       for i:=1 to 22 do write(chr(196)) od;\r
 466                       call SetCursor(Menu(AktPoz).beginingX,\r
 467                                           Menu(AktPoz).beginingY);\r
 468                   fi;\r
 469  \r
 470     esac;\r
 471   od;\r
 472 end ;\r
 473 end tree\r