SHARE
TWEET

Untitled

a guest May 28th, 2018 100 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. MODULE Stabla;
  2. FROM IO IMPORT WrStr, RdStr, WrLn, WrInt;
  3. IMPORT FIO;
  4. FROM Str IMPORT Length, Copy;
  5. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  6.  
  7. TYPE
  8.     InfoTip = INTEGER;
  9.     stablo = POINTER TO cvor;
  10.     cvor = RECORD
  11.         id : INTEGER;
  12.         info : InfoTip;
  13.         levo : stablo;
  14.         desno : stablo;
  15.     END;
  16.     String = ARRAY[1..20] OF CHAR;
  17. VAR
  18.     s : stablo;
  19.     ok, ok2 : BOOLEAN;
  20.  
  21. (* Dodaje sadrzaj novog cvora u stablo. Istovremeno se kreiraju i "deca"
  22.    cvorovi, ako postoje, u koje ce sadrzaj dodaje nekim kasnijim pozivima. *)
  23. PROCEDURE DodajCvor (VAR s : stablo; id : INTEGER; info : InfoTip; levo, desno : INTEGER) : BOOLEAN;
  24. VAR
  25.     cv, novi : stablo;
  26.     postoji : BOOLEAN;
  27. (* Nalazi cvor u stablu sa odredjenim identifikacionim brojem. Ako takav cvor
  28.    ne postoji u stablu vraca se NIL. *)
  29. PROCEDURE Nadji (s : stablo; id : INTEGER) : stablo;
  30. VAR
  31.     temp : stablo;
  32. BEGIN
  33.     IF (s = NIL) THEN
  34.         RETURN NIL;
  35.     ELSIF (s^.id = id) THEN
  36.         RETURN s;
  37.     ELSE
  38.         temp := Nadji(s^.levo, id);
  39.         IF temp # NIL THEN
  40.             RETURN temp;
  41.         ELSE
  42.             temp := Nadji(s^.desno, id);
  43.             RETURN temp;
  44.         END;
  45.     END;
  46. END Nadji;         
  47. BEGIN
  48.     IF s = NIL THEN
  49.         NEW(s);
  50.         s^.id := id;
  51.         cv := s;
  52.         postoji := TRUE;
  53.     ELSE
  54.         cv := Nadji(s, id);
  55.         postoji := cv # NIL;
  56.     END;
  57.     IF postoji THEN
  58.         cv^.info := info;
  59.         IF levo > 0 THEN
  60.             NEW(novi);
  61.             cv^.levo := novi;
  62.             novi^.id := levo;
  63.             novi^.levo := NIL;
  64.             novi^.desno := NIL;
  65.         END;
  66.         IF desno > 0 THEN
  67.             NEW(novi);
  68.             cv^.desno := novi;
  69.             novi^.id := desno;
  70.             novi^.levo := NIL;
  71.             novi^.desno := NIL;
  72.         END;
  73.         RETURN TRUE;
  74.     ELSE
  75.         RETURN FALSE;
  76.     END;
  77. END DodajCvor; 
  78.  
  79. (* IZ FAJLA *)
  80. PROCEDURE Ucitaj (VAR s : stablo; VAR ok, ok2 : BOOLEAN);
  81. VAR
  82.     f : FIO.File;
  83.     ime : String;
  84.     i, n : CARDINAL;
  85.     id, info, levo, desno : INTEGER;
  86. BEGIN
  87.     WrStr("Unesite ime fajla: ");
  88.     RdStr(ime);
  89.     IF Length(ime) = 0 THEN
  90.         Copy(ime, "s1.txt");
  91.     END;
  92.     ok := FALSE;
  93.     IF FIO.Exists(ime) THEN
  94.         f := FIO.Open(ime);
  95.         n := FIO.RdInt(f);
  96.         ok := TRUE;
  97.         FOR i := 1 TO n DO
  98.             id := FIO.RdInt(f);
  99.             info := FIO.RdInt(f);
  100.             levo := FIO.RdInt(f);
  101.             desno := FIO.RdInt(f);
  102.             ok2 := DodajCvor(s, id, info, levo, desno);
  103.             IF NOT ok2 THEN
  104.                 FIO.Close(f);
  105.                 RETURN;
  106.             END;       
  107.         END;
  108.         FIO.Close(f);
  109.     END;
  110. END Ucitaj;
  111.  
  112. PROCEDURE Ponisti (VAR s : stablo);
  113. BEGIN
  114.     IF s # NIL THEN
  115.         Ponisti(s^.levo);
  116.         Ponisti(s^.desno);
  117.         DISPOSE(s);
  118.         s := NIL;
  119.     END;
  120. END Ponisti;
  121.  
  122. PROCEDURE Stampaj (s : stablo);
  123. PROCEDURE Poseta(s : stablo; poz : CARDINAL);
  124. BEGIN
  125.         IF s # NIL THEN
  126.             Poseta(s^.desno, poz + 5);
  127.             WrInt(s^.id, poz); WrLn;
  128.             Poseta(s^.levo, poz + 5);
  129.         END;
  130. END Poseta;
  131. BEGIN
  132.     WrLn;
  133.     Poseta(s, 5)
  134. END Stampaj;
  135.  
  136. (* Naci visinu stabla. Visina stabla se definise kao rastojanje izmedju korena
  137.    i najudaljenijeg lista. Prazno stablo ima visinu -1, a stablo u kome se
  138.    nalazi samo koren ima visinu 0.  *)
  139. PROCEDURE Visina (s : stablo) : INTEGER;
  140. PROCEDURE Nadji (t : stablo) : INTEGER;
  141. VAR
  142.     l, d : INTEGER;
  143. BEGIN
  144.     WITH t^ DO
  145.         IF levo = NIL THEN
  146.             l := -1;
  147.         ELSE
  148.             l := Visina(levo)
  149.         END;
  150.         IF desno=NIL THEN
  151.             d := -1;
  152.         ELSE
  153.             d := Visina(desno)
  154.         END;
  155.         IF l < d THEN
  156.             RETURN 1 + d
  157.         ELSE
  158.             RETURN 1 + l
  159.         END;
  160.     END;
  161. END Nadji;
  162. BEGIN
  163.     IF s = NIL THEN
  164.         RETURN -1;
  165.     ELSE
  166.         RETURN Nadji(s);
  167.     END;
  168. END Visina;
  169.  
  170. (* Ispisati za svaki id koliko ima cvorova u njegovom podstablu. *)
  171. PROCEDURE CvoroviUPodStablu (s : stablo);
  172. PROCEDURE BrojCvorova (s : stablo) : INTEGER;
  173. BEGIN
  174.         IF s # NIL THEN
  175.             RETURN 1 + BrojCvorova(s^.desno) + BrojCvorova(s^.levo);
  176.         ELSE
  177.         RETURN 0;
  178.     END;
  179. END BrojCvorova;
  180. BEGIN
  181.     IF s # NIL THEN
  182.         WrStr("Cvor sa id brojem ");
  183.         WrInt(s^.id, 2);
  184.         WrStr(" ima ");
  185.         WrInt(BrojCvorova(s) - 1, 2);
  186.         WrStr(" cvorova u njegovom podstablu");
  187.         WrLn;
  188.         CvoroviUPodStablu(s^.levo);
  189.         CvoroviUPodStablu(s^.desno);
  190.         END;
  191. END CvoroviUPodStablu;
  192.  
  193. (* Proveriti da li je sadrzaj korena dupliran negde u stablu. *)
  194. PROCEDURE DupliranSadrzajKorena (s : stablo; info : InfoTip; koren : BOOLEAN);
  195. BEGIN
  196.     IF s # NIL THEN
  197.         IF NOT koren THEN  
  198.             IF s^.info = info THEN
  199.                 WrInt(s^.id, 2);
  200.             END;
  201.         END;
  202.         DupliranSadrzajKorena(s^.levo, info, FALSE);
  203.         DupliranSadrzajKorena(s^.desno, info, FALSE);  
  204.     END;
  205. END DupliranSadrzajKorena;
  206.  
  207. (* Ispisati sve cvorove ciji je sadrzaj dupliran negde u njihovom podstablu. *)
  208. PROCEDURE DupliranSadrzaj (s : stablo);
  209. PROCEDURE Trazi (s : stablo; info : InfoTip; id : INTEGER; samcvor : BOOLEAN);
  210. BEGIN
  211.     IF s # NIL THEN
  212.         IF NOT samcvor THEN
  213.             IF s^.info = info THEN
  214.                 WrStr("Sadrzaj cvora sa id ");
  215.                 WrInt(id, 2);
  216.                 WrStr(" je identican sa sadrzajem od cvora sa id");
  217.                 WrInt(s^.id, 2);
  218.                 WrStr("u njegovom podstablu.");
  219.                 WrLn;
  220.             END;
  221.         END;
  222.         Trazi(s^.levo, info, id, FALSE);
  223.         Trazi(s^.desno, info, id, FALSE);  
  224.     END;
  225. END Trazi;
  226. BEGIN
  227.     IF s # NIL THEN
  228.         Trazi(s, s^.info, s^.id, TRUE);
  229.         DupliranSadrzaj(s^.levo);
  230.         DupliranSadrzaj(s^.desno);
  231.     END;
  232. END DupliranSadrzaj;
  233.  
  234. (* Ispisati samo cvorove kod kojih je levo podstablo vislje od desnog *)
  235. PROCEDURE VisljiLevi (s : stablo);
  236. BEGIN
  237.     IF s # NIL THEN
  238.         IF (Visina(s^.levo) > Visina(s^.desno)) THEN
  239.             WrInt(s^.id, 3);
  240.         END;
  241.         VisljiLevi(s^.levo);
  242.         VisljiLevi(s^.desno);
  243.     END;
  244. END VisljiLevi;
  245.  
  246. (* Ispisati sve cvorove na dubini 3 (0 je koren). *)
  247. PROCEDURE IspisDubina3 (s : stablo; dubina : INTEGER);
  248. BEGIN
  249.     IF s # NIL THEN
  250.         IF dubina # 3 THEN
  251.             IspisDubina3(s^.levo, dubina + 1);
  252.             IspisDubina3(s^.desno, dubina + 1);
  253.         ELSE
  254.             WrInt(s^.id, 2);
  255.         END;
  256.     END;
  257. END IspisDubina3;
  258.  
  259. (* Obrisati podstablo ciji je koren cvor sa zadatim id-om. *)
  260. PROCEDURE BrisiID (VAR s : stablo);
  261. VAR
  262.     id : INTEGER;
  263. PROCEDURE BrisiPodStablo (VAR s : stablo);
  264. BEGIN
  265.     IF s # NIL THEN
  266.         BrisiPodStablo(s^.levo);
  267.         BrisiPodStablo(s^.desno);  
  268.             DISPOSE(s);
  269.         s := NIL;
  270.     END;
  271. END BrisiPodStablo;
  272. BEGIN
  273.     (* ID = 4, bez ucitavanja *)
  274.     id := 4;
  275.     IF s # NIL THEN
  276.         IF s^.id = id THEN
  277.             BrisiPodStablo(s);
  278.         ELSE
  279.             BrisiID(s^.levo);
  280.             BrisiID(s^.desno);
  281.         END;
  282.     END;   
  283. END BrisiID;
  284.  
  285. (* Obrisati sva podstabla ciji je koren cvor sa zadatim sadrzajem. *)
  286. (* ANALOGNO *)
  287.  
  288.  
  289.  
  290. (* Obrnuti podstabla (tj zameniti levo i desno) kod svih cvorova
  291. koji su *)
  292. (* koji su ??? :D :D :D *)
  293. (* neka bude sadrzaj neparan broj *)
  294. PROCEDURE ZameniLevoDesno (VAR s : stablo);
  295. VAR
  296.     pom : stablo;
  297. BEGIN
  298.     IF s # NIL THEN
  299.         ZameniLevoDesno(s^.levo);
  300.         ZameniLevoDesno(s^.desno);
  301.         IF (s^.info MOD 2 = 1) THEN
  302.             pom := s^.levo;
  303.             s^.levo := s^.desno;
  304.             s^.desno := pom;
  305.         END;   
  306.         END;
  307. END ZameniLevoDesno;
  308.  
  309. PROCEDURE uFajl (s : stablo);
  310. VAR
  311.     f : FIO.File;
  312. PROCEDURE Pisi (s : stablo; VAR f : FIO.File);
  313. VAR
  314.     pom : INTEGER;
  315. BEGIN
  316.     IF s # NIL THEN
  317.         FIO.WrLn(f);
  318.         FIO.WrInt(f, s^.id, 4);
  319.         FIO.WrInt(f, s^.info, 4);
  320.         IF s^.levo = NIL THEN
  321.             pom := 0;
  322.         ELSE
  323.             pom := s^.levo^.id;
  324.         END;
  325.         FIO.WrInt(f, pom, 4);
  326.         IF s^.desno = NIL THEN
  327.             pom := 0;
  328.         ELSE
  329.             pom := s^.desno^.id;
  330.         END;
  331.         FIO.WrInt(f, pom, 4);
  332.        
  333.         Pisi(s^.levo, f);
  334.         Pisi(s^.desno, f);
  335.     END;
  336. END Pisi;
  337. PROCEDURE BrCvorova (s : stablo) : INTEGER;
  338. BEGIN
  339.     IF s # NIL THEN
  340.         RETURN 1 + BrCvorova(s^.levo) + BrCvorova(s^.desno);
  341.     END;
  342.     RETURN 0;
  343. END BrCvorova;
  344.  
  345. BEGIN
  346.     f := FIO.Create("imefajla.txt");
  347.     FIO.WrInt(f, BrCvorova(s), 0); (* N je broj cvorova u stablu, za odredjivanje broja imas proceduru u kjizi *)
  348.     Pisi(s, f);
  349.     FIO.Close(f);
  350. END uFajl;
  351.  
  352. BEGIN
  353.     Ucitaj(s, ok, ok2);
  354.     IF ok THEN
  355.         IF ok2 THEN
  356.             uFajl(s);
  357.             WrStr("Stampa: ");
  358.             Stampaj(s);
  359.             WrLn;
  360.             WrStr("Visina stabla je: ");
  361.             WrInt(Visina(s), 2);
  362.             WrLn; WrLn;
  363.             CvoroviUPodStablu(s);
  364.             WrLn;
  365.             WrStr("ID cvorova ciji je sadrzaj identican sa sadrzajem od korena: ");
  366.             DupliranSadrzajKorena(s, s^.info, TRUE);
  367.             WrLn; WrLn;
  368.             DupliranSadrzaj(s);
  369.             WrLn;
  370.             WrStr("ID cvorova kod kojih je levo podstablo vislje od desnog: ");
  371.             VisljiLevi(s);
  372.             WrLn; WrLn;
  373.             WrStr("ID cvorova na dubini 3: ");
  374.             IspisDubina3(s, 0);
  375.             WrLn; WrLn;
  376.             BrisiID(s);
  377.             WrStr("Stablo bez cvora ID 4: ");
  378.             Stampaj(s);
  379.             ZameniLevoDesno(s);
  380.             WrLn; WrLn;
  381.             WrStr("Obrnuto stablo: ");
  382.             Stampaj(s);
  383.             WrLn;
  384.             Ponisti(s);
  385.         ELSE
  386.             WrStr("Sadrzaj fajla nije ispravno zadat!");   
  387.         END;
  388.     ELSE
  389.         WrStr("Fajl ne postoji!");
  390.     END;   
  391. END Stabla.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top