Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- MODULE Stabla;
- FROM IO IMPORT WrStr, RdStr, WrLn, WrInt;
- IMPORT FIO;
- FROM Str IMPORT Length, Copy;
- FROM Storage IMPORT ALLOCATE, DEALLOCATE;
- TYPE
- InfoTip = INTEGER;
- stablo = POINTER TO cvor;
- cvor = RECORD
- id : INTEGER;
- info : InfoTip;
- levo : stablo;
- desno : stablo;
- END;
- String = ARRAY[1..20] OF CHAR;
- VAR
- s : stablo;
- ok, ok2 : BOOLEAN;
- (* Dodaje sadrzaj novog cvora u stablo. Istovremeno se kreiraju i "deca"
- cvorovi, ako postoje, u koje ce sadrzaj dodaje nekim kasnijim pozivima. *)
- PROCEDURE DodajCvor (VAR s : stablo; id : INTEGER; info : InfoTip; levo, desno : INTEGER) : BOOLEAN;
- VAR
- cv, novi : stablo;
- postoji : BOOLEAN;
- (* Nalazi cvor u stablu sa odredjenim identifikacionim brojem. Ako takav cvor
- ne postoji u stablu vraca se NIL. *)
- PROCEDURE Nadji (s : stablo; id : INTEGER) : stablo;
- VAR
- temp : stablo;
- BEGIN
- IF (s = NIL) THEN
- RETURN NIL;
- ELSIF (s^.id = id) THEN
- RETURN s;
- ELSE
- temp := Nadji(s^.levo, id);
- IF temp # NIL THEN
- RETURN temp;
- ELSE
- temp := Nadji(s^.desno, id);
- RETURN temp;
- END;
- END;
- END Nadji;
- BEGIN
- IF s = NIL THEN
- NEW(s);
- s^.id := id;
- cv := s;
- postoji := TRUE;
- ELSE
- cv := Nadji(s, id);
- postoji := cv # NIL;
- END;
- IF postoji THEN
- cv^.info := info;
- IF levo > 0 THEN
- NEW(novi);
- cv^.levo := novi;
- novi^.id := levo;
- novi^.levo := NIL;
- novi^.desno := NIL;
- END;
- IF desno > 0 THEN
- NEW(novi);
- cv^.desno := novi;
- novi^.id := desno;
- novi^.levo := NIL;
- novi^.desno := NIL;
- END;
- RETURN TRUE;
- ELSE
- RETURN FALSE;
- END;
- END DodajCvor;
- (* IZ FAJLA *)
- PROCEDURE Ucitaj (VAR s : stablo; VAR ok, ok2 : BOOLEAN);
- VAR
- f : FIO.File;
- ime : String;
- i, n : CARDINAL;
- id, info, levo, desno : INTEGER;
- BEGIN
- WrStr("Unesite ime fajla: ");
- RdStr(ime);
- IF Length(ime) = 0 THEN
- Copy(ime, "s1.txt");
- END;
- ok := FALSE;
- IF FIO.Exists(ime) THEN
- f := FIO.Open(ime);
- n := FIO.RdInt(f);
- ok := TRUE;
- FOR i := 1 TO n DO
- id := FIO.RdInt(f);
- info := FIO.RdInt(f);
- levo := FIO.RdInt(f);
- desno := FIO.RdInt(f);
- ok2 := DodajCvor(s, id, info, levo, desno);
- IF NOT ok2 THEN
- FIO.Close(f);
- RETURN;
- END;
- END;
- FIO.Close(f);
- END;
- END Ucitaj;
- PROCEDURE Ponisti (VAR s : stablo);
- BEGIN
- IF s # NIL THEN
- Ponisti(s^.levo);
- Ponisti(s^.desno);
- DISPOSE(s);
- s := NIL;
- END;
- END Ponisti;
- PROCEDURE Stampaj (s : stablo);
- PROCEDURE Poseta(s : stablo; poz : CARDINAL);
- BEGIN
- IF s # NIL THEN
- Poseta(s^.desno, poz + 5);
- WrInt(s^.id, poz); WrLn;
- Poseta(s^.levo, poz + 5);
- END;
- END Poseta;
- BEGIN
- WrLn;
- Poseta(s, 5)
- END Stampaj;
- (* Naci visinu stabla. Visina stabla se definise kao rastojanje izmedju korena
- i najudaljenijeg lista. Prazno stablo ima visinu -1, a stablo u kome se
- nalazi samo koren ima visinu 0. *)
- PROCEDURE Visina (s : stablo) : INTEGER;
- PROCEDURE Nadji (t : stablo) : INTEGER;
- VAR
- l, d : INTEGER;
- BEGIN
- WITH t^ DO
- IF levo = NIL THEN
- l := -1;
- ELSE
- l := Visina(levo)
- END;
- IF desno=NIL THEN
- d := -1;
- ELSE
- d := Visina(desno)
- END;
- IF l < d THEN
- RETURN 1 + d
- ELSE
- RETURN 1 + l
- END;
- END;
- END Nadji;
- BEGIN
- IF s = NIL THEN
- RETURN -1;
- ELSE
- RETURN Nadji(s);
- END;
- END Visina;
- (* Ispisati za svaki id koliko ima cvorova u njegovom podstablu. *)
- PROCEDURE CvoroviUPodStablu (s : stablo);
- PROCEDURE BrojCvorova (s : stablo) : INTEGER;
- BEGIN
- IF s # NIL THEN
- RETURN 1 + BrojCvorova(s^.desno) + BrojCvorova(s^.levo);
- ELSE
- RETURN 0;
- END;
- END BrojCvorova;
- BEGIN
- IF s # NIL THEN
- WrStr("Cvor sa id brojem ");
- WrInt(s^.id, 2);
- WrStr(" ima ");
- WrInt(BrojCvorova(s) - 1, 2);
- WrStr(" cvorova u njegovom podstablu");
- WrLn;
- CvoroviUPodStablu(s^.levo);
- CvoroviUPodStablu(s^.desno);
- END;
- END CvoroviUPodStablu;
- (* Proveriti da li je sadrzaj korena dupliran negde u stablu. *)
- PROCEDURE DupliranSadrzajKorena (s : stablo; info : InfoTip; koren : BOOLEAN);
- BEGIN
- IF s # NIL THEN
- IF NOT koren THEN
- IF s^.info = info THEN
- WrInt(s^.id, 2);
- END;
- END;
- DupliranSadrzajKorena(s^.levo, info, FALSE);
- DupliranSadrzajKorena(s^.desno, info, FALSE);
- END;
- END DupliranSadrzajKorena;
- (* Ispisati sve cvorove ciji je sadrzaj dupliran negde u njihovom podstablu. *)
- PROCEDURE DupliranSadrzaj (s : stablo);
- PROCEDURE Trazi (s : stablo; info : InfoTip; id : INTEGER; samcvor : BOOLEAN);
- BEGIN
- IF s # NIL THEN
- IF NOT samcvor THEN
- IF s^.info = info THEN
- WrStr("Sadrzaj cvora sa id ");
- WrInt(id, 2);
- WrStr(" je identican sa sadrzajem od cvora sa id");
- WrInt(s^.id, 2);
- WrStr("u njegovom podstablu.");
- WrLn;
- END;
- END;
- Trazi(s^.levo, info, id, FALSE);
- Trazi(s^.desno, info, id, FALSE);
- END;
- END Trazi;
- BEGIN
- IF s # NIL THEN
- Trazi(s, s^.info, s^.id, TRUE);
- DupliranSadrzaj(s^.levo);
- DupliranSadrzaj(s^.desno);
- END;
- END DupliranSadrzaj;
- (* Ispisati samo cvorove kod kojih je levo podstablo vislje od desnog *)
- PROCEDURE VisljiLevi (s : stablo);
- BEGIN
- IF s # NIL THEN
- IF (Visina(s^.levo) > Visina(s^.desno)) THEN
- WrInt(s^.id, 3);
- END;
- VisljiLevi(s^.levo);
- VisljiLevi(s^.desno);
- END;
- END VisljiLevi;
- (* Ispisati sve cvorove na dubini 3 (0 je koren). *)
- PROCEDURE IspisDubina3 (s : stablo; dubina : INTEGER);
- BEGIN
- IF s # NIL THEN
- IF dubina # 3 THEN
- IspisDubina3(s^.levo, dubina + 1);
- IspisDubina3(s^.desno, dubina + 1);
- ELSE
- WrInt(s^.id, 2);
- END;
- END;
- END IspisDubina3;
- (* Obrisati podstablo ciji je koren cvor sa zadatim id-om. *)
- PROCEDURE BrisiID (VAR s : stablo);
- VAR
- id : INTEGER;
- PROCEDURE BrisiPodStablo (VAR s : stablo);
- BEGIN
- IF s # NIL THEN
- BrisiPodStablo(s^.levo);
- BrisiPodStablo(s^.desno);
- DISPOSE(s);
- s := NIL;
- END;
- END BrisiPodStablo;
- BEGIN
- (* ID = 4, bez ucitavanja *)
- id := 4;
- IF s # NIL THEN
- IF s^.id = id THEN
- BrisiPodStablo(s);
- ELSE
- BrisiID(s^.levo);
- BrisiID(s^.desno);
- END;
- END;
- END BrisiID;
- (* Obrisati sva podstabla ciji je koren cvor sa zadatim sadrzajem. *)
- (* ANALOGNO *)
- (* Obrnuti podstabla (tj zameniti levo i desno) kod svih cvorova
- koji su *)
- (* koji su ??? :D :D :D *)
- (* neka bude sadrzaj neparan broj *)
- PROCEDURE ZameniLevoDesno (VAR s : stablo);
- VAR
- pom : stablo;
- BEGIN
- IF s # NIL THEN
- ZameniLevoDesno(s^.levo);
- ZameniLevoDesno(s^.desno);
- IF (s^.info MOD 2 = 1) THEN
- pom := s^.levo;
- s^.levo := s^.desno;
- s^.desno := pom;
- END;
- END;
- END ZameniLevoDesno;
- PROCEDURE uFajl (s : stablo);
- VAR
- f : FIO.File;
- PROCEDURE Pisi (s : stablo; VAR f : FIO.File);
- VAR
- pom : INTEGER;
- BEGIN
- IF s # NIL THEN
- FIO.WrLn(f);
- FIO.WrInt(f, s^.id, 4);
- FIO.WrInt(f, s^.info, 4);
- IF s^.levo = NIL THEN
- pom := 0;
- ELSE
- pom := s^.levo^.id;
- END;
- FIO.WrInt(f, pom, 4);
- IF s^.desno = NIL THEN
- pom := 0;
- ELSE
- pom := s^.desno^.id;
- END;
- FIO.WrInt(f, pom, 4);
- Pisi(s^.levo, f);
- Pisi(s^.desno, f);
- END;
- END Pisi;
- PROCEDURE BrCvorova (s : stablo) : INTEGER;
- BEGIN
- IF s # NIL THEN
- RETURN 1 + BrCvorova(s^.levo) + BrCvorova(s^.desno);
- END;
- RETURN 0;
- END BrCvorova;
- BEGIN
- f := FIO.Create("imefajla.txt");
- FIO.WrInt(f, BrCvorova(s), 0); (* N je broj cvorova u stablu, za odredjivanje broja imas proceduru u kjizi *)
- Pisi(s, f);
- FIO.Close(f);
- END uFajl;
- BEGIN
- Ucitaj(s, ok, ok2);
- IF ok THEN
- IF ok2 THEN
- uFajl(s);
- WrStr("Stampa: ");
- Stampaj(s);
- WrLn;
- WrStr("Visina stabla je: ");
- WrInt(Visina(s), 2);
- WrLn; WrLn;
- CvoroviUPodStablu(s);
- WrLn;
- WrStr("ID cvorova ciji je sadrzaj identican sa sadrzajem od korena: ");
- DupliranSadrzajKorena(s, s^.info, TRUE);
- WrLn; WrLn;
- DupliranSadrzaj(s);
- WrLn;
- WrStr("ID cvorova kod kojih je levo podstablo vislje od desnog: ");
- VisljiLevi(s);
- WrLn; WrLn;
- WrStr("ID cvorova na dubini 3: ");
- IspisDubina3(s, 0);
- WrLn; WrLn;
- BrisiID(s);
- WrStr("Stablo bez cvora ID 4: ");
- Stampaj(s);
- ZameniLevoDesno(s);
- WrLn; WrLn;
- WrStr("Obrnuto stablo: ");
- Stampaj(s);
- WrLn;
- Ponisti(s);
- ELSE
- WrStr("Sadrzaj fajla nije ispravno zadat!");
- END;
- ELSE
- WrStr("Fajl ne postoji!");
- END;
- END Stabla.
Add Comment
Please, Sign In to add comment