AVL medis

Norint gauti papildomų balų neštis į egzaminą, galima buvo suprogramuoti AVL medį. Iš kursiokės paėmiau jos AVL programą ir aiškinausi pusę nakties prieš atsiskaitymo dieną. Pagalvojau, kad galbūt galima bus gauti nors ne maksimumą, bet bent pusę taškų už nepaties programuotą programą, jeigu gerai ją sugebėsiu paaiškinti bet kurioje eilutėje, bei jeigu parašysiu programai kažkokių papildomų įrankių. Kitą pusnaktę tuos įrankius ir bandžiau rašyti. Pavyko parašyti procedūrą, kuri sunumeruoja dvejetainio AVL medžio elementus man reikiama hierarchine tvarka, ir antrą procedūrą, kuri tuos elementus išspausdina ekrane atidėdama atitinkamą skaičių tarpų.

AVL programa tai dvejetainis medis, kuris pildomas naujais elementais, balansuojasi. Dvejetainis medis skirtas ten įdėto elemento paieškai. Jeigu į medį bus dedami elementai vienas po kito didėjantys, arba vienas po kito mažėjantys, tai medis turės vieną ilgą šaką, o jei bus dedami įvairūs elementai, tai jis bus šakotas bei trumpašakis ir bus greičiau vykdoma paieška. AVL medis - besibalansuojantis medis. Kuomet viena jo šaka pasidaro ilgesnė už bet kurią kitą 2 sąlyginiai vienetais, tai ji deformuojasi, vykdomas "posūkis": šaka ale nupjaunama, perlaužiama perpus, tada suklijuojama "V" raide ir pritvirtinama prie šakos pamato.

Taip atrodo programos interfeiso fragmentas, atlikus vieno skaičiaus įterpimą į AVL medį:

(dvejetas ir trejetas paraudoninti, neryškiai čia matosi)

Beje, formulę su DIV'ais tai galvojau ir testavau tikrai kokias 3 valandas. O medžio išspausdinimą padariau su lygiavimo klaida (buvo ne visai gražu), kurią sugalvojau kaip pataisyti tik kai prisėdau savaitę po atsiskaitymo.

Pateiksiu tik programos procedūras, kurios paruošia masyvą ir išspausdina medį pseudografiškai.

( uses crt;
type Pnode=^node;
node=record
l,r,t : Pnode;
n: integer;
end;

var root :Pnode; skait: array[1..255] of integer;

function auksciai( rod : Pnode) : integer;
var a1, a2 : integer;
begin
if (rod <> nil)
then
begin
a1 := auksciai(rod^.l) + 1 ;
a2 := auksciai(rod^.r) + 1 ;
if a1>=a2 then auksciai:=a1
else auksciai:=a2 ;
end
else auksciai := -1;
end; )

procedure isEilesMasyvas;
var te:Pnode; au,n,el,power,k,kn: integer;
begin
au:=auksciai(root);
power:=1; el:=0;
for n:=1 to au+1 do begin power:=power*2; el:=el+power div 2; end;
for n:=1 to el do
begin k:=1; kn:=n;
while k*2<=n do k:=k*2; te:=root;
while (kn<>1 ) and (k<>1) and (kn div k <>0) and (te<>nil) do
begin if kn mod k div (k div 2) = 0 then te:=te^.l else te:=te^.r; k:=k div 2; end;
if te <> nil then skait[n]:=te^.n else skait[n]:=0;
end;
writeln('stai isEilesMasyvo ',el, ' elementai: ');
for n:=1 to el do write(skait[n],' ');
end;


procedure piestiMedi(reiksme: integer);
var au,i,j,k,s,power,tarpai: integer;
begin
au:=auksciai(root);
s:=0;
writeln;
writeln('isspausdinu visus Medzio elementus: ');
for i:=1 to au+1 do
begin
power:=1;
for j:=au+1-i downto 1 do begin power:=power*2; end;
tarpai:=power*2-2;
power:=1;
for j:=1 to i do power:=power*2;
for k:=1 to power div 2 do
begin
for j:=1 to tarpai do write(' ');
if k>1 then for j:=1 to tarpai do write(' ');
s:=s+1;
if (skait[s]<10) and (skait[s]>0) then write(' ');
if skait[s]<>0 then
begin write(' ');
if skait[s]<>reiksme then write(skait[s])
else begin textcolor(12); write(skait[s]); textcolor(7); end;
write(' ');
end
else write(' ');
end;

writeln;
end;
end;

Kibirų pilstymas

Prieš porą savaičių dėstytojas uždavė studentams klausimą, už kurį buvo galima gauti papildomų taškelių neštis į egzaminą. Visi kursiokai ėmė spręsti ir bent penkias minutes tvyrojo tyla. Po to staiga net tryse priėjom sprendimą bemaž tuo pačiu metu, bet buvau truputį aplenktas.
Uždavinys toks:
Yra trys kibirai, kurių tūriai 10, 7, 2 litrai. Į pirmąjį įpilta 10 litrų magiško skysčio, kiti - tušti.
Užduotis: reikia neišpilstant magiško skysčio, gauti lygiai 5 litrus viename iš indų.

Jau tą pačią dieną kilo mintis parašyti programą, sprendžiančią tokį uždavinį, tačiau žinojau, kad su mano programavimo tempais, tai užtruks ilgai, tad atsidėjau laisvesnei dienai.
Šiandien per pusiaudienį suprogramavau. Pirmiausia kelias valandas rašiau į sąsiuvinį, ir galiausiai programa užėmė apie vieną pilną pusiau pribraukytą puslapį. Padėjęs pagrindus, persikėliau į PC.
Patiko tai, kad sugebėjau suprogramuoti viską gana lanksčiai, t.y. vartotojui yra leidžiama pasirinkti kibirų skaičius, kibirų tūriai, ir į kokius kibirus ir kiek jis norėtų pripilti skysčio, bei kokį vieną skaičių jam reikia gauti. Visa tai realizuota masyvais ir daug FOR ciklų, vienoje vietoje siekiančių net 4 ciklų "gylį" (i, j, k, k1);
Nepatiko tai, kad programa neieško geriausių pilstymo variantų. Ir dar labiau nepatiko, kad neieško visų pilstymo variantų, dėl ko negalima pasakyti ar ji veikia visais atvejais teisingai.

Dėstytojo uždavinį programa išsprendžia per 15 pilstymų, nors yra bent 2 greitesni būdai kaip gauti 5 litrus.

Taigi, čia programos kodas:



program LitrasSenLitrasTen;
label 0;
const NN=5; NNN=1000;
type WM = array[1..NNN,1..NN] of integer;

var w: WM;
v, x, t: array[1..NN] of integer;
i,j,k,k1,m,m1,m2 :integer; //skaitliukai
t1,t2 :integer; //temporary
N, gauti, def :integer;
total, tot, nutraukti :boolean;

procedure perpilti(a, b, bV: integer; var a1, b1: integer);
begin
if a>=bV-b then
begin
a1:=a-(bV-b);
b1:=bV
end
else
begin
b1:=b+a;
a1:=0
end;
end;

begin
writeln('RS 2011-06-06');
writeln('Programa: pilstymas is kibiro i kibira, kol gaunamas norimas turis');
writeln;
writeln('NE - 0, TAIP - kitas skaicius');
writeln('Norite ivesti savus parametrus?');
writeln('(Jeigu NE, tai programa veiks su DEFAULT parametrais: ');
writeln('Kibiru skaicius: 3, pirmojo V = 10, antrojo V = 7, treciojo V = 2');
writeln('Pirmame kibire yra 10 litru, kiti - tusti. Bandoma gauti 5 litrus.)');
readln(def);
if def = 0 then
begin
N:=3;
v[1]:=10; v[2]:=7; v[3]:=2;
x[1]:=10; x[2]:=0; x[3]:=0;
gauti:=5;
end
else
begin
writeln('Iveskite kibiru skaiciu');
readln(N);
writeln('Iveskite visu kibiru turius');
for i:=1 to N do readln(v[i]);
writeln('Iveskite visu kibiru turini');
for i:=1 to N do readln(x[i]);
writeln('Koki litru skaiciu norite gauti?');
readln(gauti);
end;

for i:=1 to N do
w[1,i]:=x[i];

m:=1; m2:=0; nutraukti := false;

write(0:3,'| ');
for i:=1 to N do write(x[i]:2,' ');
writeln;

repeat
begin
m1:=m;
// writeln('m1:=m; - ',m);
for i:=1 to N do
begin
0:
for j:=1 to N do

if (i<>j) and (x[j]<>v[j]) and (x[i]<>0) then
begin
// writeln('i ir j - ',i,' ',j);
// writeln('x[i],x[j],v[j] - ',x[i],' ',x[j],' ',v[j]);
perpilti(x[i],x[j],v[j], t1,t2);
// writeln('t1,t2 - ',t1,' ',t2);
for k:=1 to N do
if k in [i,j] then
if k=i then
t[k]:=t1
else
t[k]:=t2
else
t[k]:=x[k];
total:=true;
for k:=1 to m do
begin
tot:=true;
for k1:=1 to N do
tot:=tot and (w[k,k1] = t[k1]);
total:=total and (not tot);
// writeln('total, k - ',total,' ',k);
// readln;
end;
if total then
begin
write(m:3,'| ');
for k:=1 to N do
begin
x[k]:=t[k];
w[m+1,k]:=t[k];
write(x[k]:2,' ');
if k=N then writeln;
if t[k]=gauti then nutraukti:= true;
end;
m:=m+1;
goto 0;
end;
end;
end;
if m=m1 then m2:=m2+1 else m2:=0;
end;
until (m2=2) or (m>100) or (nutraukti);

if m2=2 then writeln('m2=2');
if m>1000 then writeln('m>1000');
if nutraukti then writeln('nutraukti');

readln;
end.