1 program grzybobranie;
\r
2 (* to mialo byc drzewo bst z wywazaniem -- AVL *)
\r
3 (* niestety nie zawsz dziala dobrze *)
\r
9 unit virtual comp:function(e2:elem):integer;
\r
14 unit slowo:class(el:elem);
\r
15 var waga:integer,ls,rs:slowo;
\r
24 unit virtual rysuj_drzewo:procedure;
\r
27 unit findc:coroutine(e:elem);
\r
29 var new_slowo:slowo,waga:integer;
\r
31 unit lrot:procedure(inout p:slowo);
\r
40 c1:=pp.waga-p.waga+1;
\r
41 if p.waga>0 then c1:=c1+p.waga; fi;
\r
43 if p.waga>0 then c2:=c2+p.waga; fi;
\r
44 if p.waga>c2 then c2:=p.waga; fi;
\r
50 unit rrot:procedure(inout p:slowo);
\r
60 if p.waga>0 then c1:=c1-p.waga; fi;
\r
62 if p.waga>0 then c2:=c2+p.waga; fi;
\r
63 if c2<0 then c2:=0; fi;
\r
71 unit f:procedure(inout s:slowo);
\r
77 if e.comp(s.el)<=0 then
\r
79 s.waga:=s.waga-waga;
\r
82 s.waga:=s.waga+waga;
\r
85 if s.ls.waga>0 then call rrot(s.ls) fi;
\r
89 if s.rs.waga<0 then call lrot(s.rs) fi;
\r
104 unit wstaw:procedure(e:elem);
\r
111 f.new_slowo:=new slowo(e);
\r
118 unit find:function(e:elem):slowo;
\r
120 unit f:function(s:slowo):slowo;
\r
122 if s=none then result:=none
\r
124 if e.comp(s.el)=0 then result:=s
\r
126 if e.comp(s.el)<0 then result:=f(s.ls)
\r
127 else result:=f(s.rs)
\r
139 unit delete:procedure(e:elem);
\r
141 unit find_last:function(s:slowo):slowo;
\r
144 if result.rs<>none then
\r
145 while result.rs.rs<>none do result:=result.rs; od;
\r
155 ss:=find_last(s.ls);
\r
157 if ss.rs<>none then
\r
159 if ss.rs.ls<>none then
\r
160 ss.rs.el:=ss.rs.ls.el;
\r
167 if ss.ls<>none then
\r
191 unit porzadek:class;
\r
192 var e:elem,x,y,d,nawias:integer,
\r
193 czy_korzen,czy_lewy,koniec:boolean,
\r
195 unit virtual next:procedure(s:slowo;i,dx,ix:integer;lewy:boolean);
\r
203 call next(korzen,1,16,40,false);
\r
210 unit lex:porzadek coroutine;
\r
212 unit virtual next:procedure(s:slowo;i,dx,ix:integer;lewy:boolean);
\r
217 call next(s.ls,i+1,dx div 2,ix-dx,true);
\r
221 czy_korzen:=(s=korzen);
\r
225 call next(s.rs,i+1,dx div 2,ix+dx,false);
\r
233 unit pre:porzadek coroutine;
\r
235 unit virtual next:procedure(s:slowo;i,dx,ix:integer;lewy:boolean);
\r
243 czy_korzen:=(s=korzen);
\r
248 call next(s.ls,i+1,dx div 2,ix-dx,true);
\r
249 call next(s.rs,i+1,dx div 2,ix+dx,false);
\r
257 unit post:porzadek coroutine;
\r
259 unit virtual next:procedure(s:slowo;i,dx,ix:integer;lewy:boolean);
\r
264 call next(s.ls,i+1,dx div 2,ix-dx,true);
\r
265 call next(s.rs,i+1,dx div 2,ix+dx,false);
\r
269 czy_korzen:=(s=korzen);
\r
282 unit SetCursor : procedure(row, column : integer);
\r
283 var c,d,e,f : char,
\r
290 i := column div 10;
\r
291 j := column mod 10;
\r
294 write( chr(27), "[", c, d, ";", e, f, "H")
\r
298 unit drzewo_liczb:drzewo class;
\r
300 unit liczba:elem class(i:integer);
\r
302 unit virtual comp:function(e2:liczba):integer;
\r
304 if i < e2.i then result:=-1
\r
305 else if i > e2.i then result:=1
\r
313 unit wstaw_liczbe:procedure(i:integer);
\r
315 call wstaw(new liczba(i));
\r
318 unit del_liczba:procedure(i:integer);
\r
320 call delete(new liczba(i));
\r
323 unit virtual rysuj_drzewo:procedure;
\r
324 var l:pre,i:integer;
\r
326 write(chr(27),"[2J");
\r
329 while( ( l.nawias<>0 ) and ( not l.koniec ) )do attach(l); od;
\r
330 while not l.koniec do
\r
331 call SetCursor(4*l.y,l.x);
\r
332 write(l.e qua liczba.i:3);
\r
333 call SetCursor(4*l.y-1,l.x-1);
\r
334 if l.czy_korzen then write("ÚÄÄÄ¿ "); else write("ÚÄÁÄ¿ "); fi;
\r
335 call SetCursor(4*l.y+1,l.x-1);
\r
337 call SetCursor(4*l.y,l.x-1);
\r
339 call SetCursor(4*l.y,l.x+3);
\r
341 if not l.czy_korzen then
\r
343 call SetCursor(4*l.y-2,l.x+1);
\r
345 for i:=1 to 2*l.d-2 do write("Ä"); od;
\r
347 call SetCursor(4*l.y-3,l.x+2*l.d);
\r
350 call SetCursor(4*l.y-2,l.x+1);
\r
352 call SetCursor(4*l.y-3,l.x-2*l.d+2);
\r
354 call SetCursor(4*l.y-2,l.x-2*l.d+2);
\r
356 for i:=1 to 2*l.d-2 do write("Ä"); od;
\r
360 while( ( l.nawias<>0 ) and ( not l.koniec ) )do attach(l); od;
\r
365 unit rysuj_porz:procedure(i:integer);
\r
368 write(chr(27),"[2J");
\r
372 when 4:l:=new post;
\r
375 while not l.koniec do
\r
377 when 0:write(l.e qua liczba.i);
\r
388 var d:drzewo_liczb;
\r
390 var screen:integer;
\r
394 d:=new drzewo_liczb;
\r
396 write(chr(27),"[2J");
\r
397 writeln("aby wstawic wpisz liczbe, aby skasowac minus liczbe, zero konczy!");
\r
399 writeln("0-KONIEC");
\r
400 writeln("1-postac drzewa");
\r
401 writeln("2-porzadek infiksowy");
\r
402 writeln("3-porzadek prosty");
\r
403 writeln("4-porzadek odwrotny");
\r
404 call SetCursor(23,1);
\r
407 write(chr(27),"[2J");
\r
408 if screen<0 or screen>4 then screen:=0; fi;
\r
410 while screen*i<>0 do
\r
411 if screen=1 then call d.rysuj_drzewo;
\r
412 else call d.rysuj_porz(screen);
\r
414 call SetCursor(23,1);
\r
418 if i>0 then call d.wstaw_liczbe(i);
\r
419 else call d.del_liczba(-i);
\r