1 program bst;(* T.Michalak *);
\r
3 var son,father :node;
\r
4 var fet :arrayof string;
\r
5 var horn :arrayof arrayof char;
\r
6 var rozm,actree,treer,menu,menu2,key,key2,i,x:integer;
\r
7 var hornod,forest :arnode;
\r
8 var bigi,arsmal :arint;
\r
9 var short,first,bigtree,wyjscie,usa,change :boolean;
\r
10 var horbol :arrayof boolean;
\r
11 var trenam :arrayof char;
\r
13 unit bold : procedure;
\r
15 write( chr(27), "[1m")
\r
18 unit reverse : procedure; (* PROCEDURY PRAWIE GRAFICZNE *)
\r
20 write( chr(27), "[7m")
\r
23 unit normal : procedure;
\r
25 write( chr(27), "[0m")
\r
28 unit newpage : procedure;
\r
30 write( chr(27), "[2J")
\r
33 unit setcursor : procedure(x,y : integer);
\r
45 write( chr(27), "[", c, d, ";", e, f, "H")
\r
46 end setcursor; (* KONIEC TYCH PROCEDUR ^ *)
\r
51 unit node:class; (* KLUCZ DRZEWA *)
\r
53 var left,right:node;
\r
56 unit arnode:class; (* TABLICA DRZEW *)
\r
58 var p:arrayof boolean
\r
67 var a:arrayof integer
\r
70 unit search :class(where:node;what:integer);
\r
71 (* ALGORYTM DRZEWA BST *)
\r
72 var isit,leftone:boolean;
\r
76 do if son = none orif son.e=what then exit fi;
\r
78 if son.e>what then son:=son.left;
\r
80 else son:=son.right;
\r
83 if son =/=none then isit:=true fi;
\r
86 unit member:search function:boolean;
\r
87 begin (* CZY ELEMENT NA DRZEWIE *)
\r
91 unit insert:search procedure;
\r
92 var help:node; (* WSTAWIANIE ELEMENTU *)
\r
94 if member(where,what) then
\r
96 writeln("This number is in this tree");
\r
97 for i:=1 to 400 do od
\r
106 if what>father.e then
\r
115 unit delete:search procedure; (* KASOWANIE ELEMENTU *)
\r
116 var help,fathelp:node;
\r
118 if member(where,what) then
\r
119 if son.right=none then
\r
120 if son.left=none then
\r
121 if father=/=none then
\r
125 else father.right:=none;
\r
129 write("This tree is empty now");
\r
131 else if leftone then father.left:=son.left;
\r
133 else father.right:=son.left;
\r
137 else if son.left=none then
\r
138 if leftone then father.left:=son.right;
\r
140 else father.right:=son.right;
\r
143 else if son.right.left=none then
\r
144 son.e:=son.right.e;
\r
147 son.right:=son.right.right;
\r
149 else help:=new node;
\r
151 help:=son.right.left;
\r
152 while help.left=/= none do
\r
156 if help.right=none then son.e:=help.e;
\r
157 fathelp.left:=none;
\r
159 else fathelp.left:=help.right;
\r
166 else writeln("This number is absent");
\r
167 for i:=1 to 1000 do od
\r
173 unit howbig:function(klop:node):integer;
\r
175 unit intx:procedure(klop:node);
\r
178 call intx(klop.left);
\r
180 call intx(klop.right);
\r
190 unit wektor:function (where:node;inout k:integer):arint;
\r
192 unit infiks:procedure(where:node;tab:arint);
\r
194 if where<>none then
\r
195 call infiks(where.left,tab);
\r
198 call infiks(where.right,tab);
\r
205 array result.a dim(1:d);
\r
207 call infiks(where,result);
\r
211 unit union:procedure(forest:arnode);
\r
212 var nrt,no,min,roz,lic,small,maks:integer;
\r
215 unit makser:function(k:integer;where:node):integer;
\r
217 while where.right=/=none do
\r
220 if k>where.e then result:=k else result:=where.e fi;
\r
223 unit minimal:function(tbl:arint;output kl:integer):integer;
\r
228 for lep:=2 to lic do
\r
229 if result>tbl.a(lep) then result:=tbl.a(lep);kl:=lep fi;
\r
233 unit trawers:coroutine(where:node);
\r
234 unit cwalk:procedure(nod:node);
\r
237 call cwalk(nod.left);
\r
240 call cwalk(nod.right);
\r
250 var artraw:arrayof trawers;
\r
254 for i:=1 to upper(horbol) do if horbol(i) then lic:=lic+1 fi od;
\r
255 array forest.a dim(1:lic);
\r
257 for i:=1 to upper(horbol) do
\r
258 if horbol(i) then forest.a(roz):=hornod.a(i);fi;
\r
263 roz:=roz+howbig(forest.a(i))
\r
267 array bigi.a dim(1:roz);
\r
268 array artraw dim(1:lic);
\r
270 array arsmal.a dim (1:lic);
\r
273 artraw(i):=new trawers(forest.a(i));
\r
274 maks:=makser(maks,forest.a(i))
\r
276 for i:=1 to lic do attach(artraw(i));arsmal.a(i):=artraw(i).small od;
\r
281 min:=minimal(arsmal,nrt);
\r
285 attach(artraw(nrt));
\r
286 arsmal.a(nrt):=artraw(nrt).small;
\r
291 unit balance:procedure (inout where:node);
\r
294 unit rozwies:procedure(tabel:arint;a,b:integer);
\r
296 if b-a>0 andif not member(where,tabel.a((a+b) div 2)) then
\r
297 call insert(where,tabel.a((a+b) div 2));
\r
298 call rozwies(tabel,a,(a+b) div 2);
\r
299 call rozwies(tabel,(a+b) div 2,b);
\r
304 tab:=wektor(where,roz);
\r
311 call rozwies(tab,1,roz);
\r
312 call insert(where,tab.a(roz));
\r
315 unit pisz:procedure(where:node);
\r
319 tab:=wektor(where,roz);
\r
320 call setcursor(16,5);
\r
324 for i:=1 to 500 do od;
\r
327 unit rysuj:procedure(where:node,x:integer,y:integer);
\r
330 call setcursor(x,y-1);
\r
331 write("³",where.e:3);
\r
332 call setcursor(x,y+3);
\r
334 call setcursor(x-1,y-1);
\r
336 if x=2 then write("ÄÄÄ¿ ") else write("ÄÁÄ¿ ") fi;
\r
337 call setcursor(x+1,y-1);
\r
338 if where.left=/=none orif where.right=/=none then
\r
340 else write("ÀÄÄÄÙ")
\r
344 for i:=1 to z do k:=2*k od;
\r
346 if x>20 then bigtree:=true fi;
\r
348 if where.left=/=none andif x<21 then
\r
349 for i:=y-k+2 to y do
\r
350 call setcursor(x+2,i);
\r
353 call setcursor(x+2,y+1);
\r
354 if where.right=/=none then write("Á")
\r
357 call setcursor (x+2,y-k+1);
\r
359 call rysuj(where.left,x+4,y-k)
\r
361 if where.right=/=none andif x<17 then
\r
362 for i:=y+2 to y+k do
\r
363 call setcursor(x+2,i);
\r
367 if where.left=none then
\r
368 call setcursor(x+2,y+1);
\r
371 call rysuj(where.right,x+4,y+k)
\r
377 unit newtree:procedure;
\r
378 var name :arrayof char;
\r
379 var art :arrayof arrayof char;
\r
381 unit readstring:function:arrayof char;
\r
384 var pod :arrayof char;
\r
386 call setcursor(17,10);
\r
387 array pod dim (1:8);
\r
391 while c=0 and klap do
\r
394 if c=13 then klap:=false fi;
\r
395 if klap then result(i):=chr(c);
\r
396 c:=0;write(result(i)) else result(i):=' ' fi;
\r
401 call setcursor(15,4);
\r
402 writeln("Give name of a new tree");
\r
403 call setcursor(16,6);
\r
406 hornod.a(actree):=tree.n;
\r
407 hornod.p(actree):=tree.p;
\r
408 forest.a:=copy (hornod.a);
\r
409 forest.p:=copy (hornod.p);
\r
410 array hornod.a dim(1:treer);
\r
411 array hornod.p dim(1:treer);
\r
412 for i:=1 to treer-1 do
\r
413 hornod.a(i):=copy (forest.a(i));
\r
414 hornod.p(i):=forest.p(i);
\r
417 array hornod.a dim(1:1);
\r
418 array hornod.p dim(1:1);
\r
420 hornod.a(treer):=new node;
\r
423 array horn dim(1:treer+1);
\r
424 for i:=1 to treer-1 do
\r
425 horn(i):=copy (art(i))
\r
429 horn(treer):=art(treer-1);
\r
430 tree.n:=hornod.a(treer-1);
\r
437 unit actual:procedure;
\r
439 call setcursor(1,62);
\r
440 writeln("ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ");
\r
441 call setcursor(2,62);
\r
442 write ("³ ACTUAL TREE ³Û ");
\r
443 call setcursor(3,62);
\r
450 else write(" ") fi;
\r
453 call setcursor(4,62);
\r
454 writeln("ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ ");
\r
455 call setcursor(5,62);
\r
456 writeln(" ßßßßßßßßßßßßßßßßß ");
\r
459 unit border:procedure;
\r
463 call setcursor(1,1);
\r
464 writeln("ÚÄÄÄÄÄÄÄÄÄÄÄ¿ ");
\r
471 writeln("³ ",fet(i):8," ³Û ")
\r
473 writeln("ÀÄÄÄÄÄÄÄÄÄÄÄÙÛ ");
\r
474 writeln(" ßßßßßßßßßßßßß ");
\r
479 unit border2:procedure;
\r
483 call setcursor(5,7);
\r
484 writeln("ÚÄÄÄÄÄÄÄÄÄÄÄ¿ ");
\r
485 call setcursor(6,7);
\r
493 for z:=2 to treer do
\r
494 call setcursor(5+z,7);
\r
501 call setcursor(6+treer,7);
\r
502 writeln("ÀÄÄÄÄÄÄÄÄÄÄÄÙÛ ");
\r
503 call setcursor(7+treer,7);
\r
504 writeln(" ßßßßßßßßßßßßß ");
\r
507 unit number:procedure;
\r
509 call setcursor(18,2);
\r
510 writeln("Give the number ");
\r
511 call setcursor(19,6);
\r
515 unit clear:procedure;
\r
517 call setcursor(18,2);
\r
522 unit inkeys:IIuwgraph function:integer;
\r
527 unit fmenu: procedure;
\r
528 unit move:procedure(s1,s2,f1,f2:integer);
\r
530 call setcursor(s1,3);
\r
533 call setcursor(s2,3);
\r
541 if key=13 orif key=-72 orif key=-80 then exit fi;
\r
544 if menu>1 then menu:=menu-1;
\r
545 call move(menu+2,menu+1,menu+1,menu)
\r
547 call move(2,11,1,10)
\r
552 if menu<10 then menu:=menu+1;
\r
553 call move(menu,menu+1,menu-1,menu)
\r
555 call move(11,2,10,1)
\r
562 unit fmenu2: procedure;
\r
563 unit move2:procedure(x1,x2,y:integer);
\r
565 call setcursor(x1,y);
\r
572 array horbol dim (1:treer-1);
\r
573 for i:=1 to treer-1 do
\r
578 call setcursor(10,15);
\r
579 writeln("You haven't tree");
\r
580 for i:=1 to 1000 do od else
\r
581 while menu2=/=treer do
\r
584 if key2=13 orif key2=-72 orif key2=-80 then exit fi;
\r
587 if menu2>1 then menu2:=menu2-1;
\r
588 if horbol(menu2+1) then call bold fi;
\r
589 call move2(menu2+6,menu2+1,9);
\r
591 call move2(menu2+5,menu2,9)
\r
593 if horbol(1) then call bold fi;
\r
596 call move2(treer+5,treer,9)
\r
601 if menu2<treer then menu2:=menu2+1;
\r
602 if horbol(menu2-1) then call bold fi;
\r
603 call move2(menu2+4,menu2-1,9);
\r
605 call move2(menu2+5,menu2,9)
\r
607 if horbol(treer) then call bold fi;
\r
608 call move2(treer+5,treer,9);
\r
614 if menu2=treer orif not usa then
\r
615 if change and menu2=/=treer then
\r
616 hornod.a(actree):=tree.n;
\r
617 hornod.p(actree):=tree.p;
\r
619 tree.p:=hornod.p(menu2);
\r
620 tree.n:=hornod.a(menu2);
\r
621 trenam:=horn(menu2);
\r
624 call setcursor(3,64);
\r
631 if horbol(menu2) then horbol(menu2):=false;
\r
635 horbol(menu2):=true
\r
637 call move2(menu2+5,menu2,9);
\r
646 unit WAITforKEY: procedure;
\r
648 while inkeys=0 do od;
\r
653 hornod:=new arnode;
\r
654 forest:=new arnode;
\r
657 array fet dim(1:10);
\r
658 array horn dim(1:1);
\r
659 array horn(1) dim(1:8);
\r
664 fet(5):="BALANCE ";
\r
667 fet(8):="NEW TREE";
\r
675 for x:=5 to 8 do horn(1,x):=' ' od;
\r
677 array horbol dim(1:1);
\r
680 call SetCursor(5,10);
\r
687 when 1: if treer=/=1 then
\r
689 call insert(tree.n,x);
\r
691 call setcursor(17,1);
\r
692 writeln("You haven't tree");
\r
696 when 2:if treer=/=1 then
\r
698 call setcursor(17,1);
\r
699 write("This tree is empty");
\r
702 call delete(tree.n,x);
\r
705 call setcursor(17,1);
\r
706 writeln("You haven't tree");
\r
710 when 3:if treer=/=1 then
\r
712 call setcursor(17,1);
\r
713 write("This tree is empty");
\r
716 wyjscie:=member(tree.n,x);
\r
719 write( " This number is present ")
\r
721 write(" This number is absent")
\r
726 call setcursor(17,1);
\r
727 writeln("You haven't tree");
\r
731 when 4:if treer=/=1 then
\r
734 call setcursor(17,1);
\r
735 write("This tree is empty")
\r
740 call rysuj(tree.n,2,40);
\r
741 call setcursor(22,40);
\r
743 writeln("Tree to big")
\r
745 writeln("press any key");
\r
749 call setcursor(17,1);
\r
750 writeln("You haven't tree");
\r
756 when 5:if treer=/=1 then
\r
758 call setcursor(17,1);
\r
759 write("This tree is empty");
\r
761 call balance(tree.n);
\r
764 call setcursor(17,1);
\r
765 writeln("You haven't tree");
\r
769 when 6:if treer=/=1 then
\r
775 call union(forest);
\r
777 call balance(tree.n);
\r
781 call setcursor(17,1);
\r
782 writeln("You haven't tree");
\r
787 when 7:if treer<>1 then
\r
789 call setcursor(17,1);
\r
790 write("This tree is empty");
\r
795 call setcursor(17,1);
\r
796 writeln("You haven't tree");
\r
800 when 8: call newtree;
\r
803 when 9: if treer<>1
\r
811 call setcursor(17,1);
\r
812 writeln("You haven't tree");
\r
816 when 10: call endrun;
\r
819 call SetCursor(22,40);
\r
820 write("press any key");
\r
822 call SetCursor(22,40);
\r
824 call SetCursor(17,1);
\r