kodovi/polinomi/POLINOML.MOD

   1 (* Modul za rad sa polinomima preko listi
   2    verzija 2014; rev 1 *)
   3 IMPLEMENTATION MODULE PolinomL;
   4 FROM InOut IMPORT Write, WriteString, WriteLn,
   5            WriteCard, ReadCard, Done;
   6 FROM RealInOut IMPORT WriteReal, ReadReal;
   7 FROM Storage IMPORT ALLOCATE, DEALLOCATE;
   8
   9 PROCEDURE Anuliraj(VAR p: Polinom);
  10 BEGIN
  11   p := NIL;
  12 END Anuliraj;
  13
  14 PROCEDURE Kopiraj(p: Polinom; VAR kopija: Polinom);
  15 VAR
  16   pomocni: Polinom;
  17 BEGIN
  18   IF p = NIL THEN
  19     kopija := NIL
  20   ELSE
  21     NEW(kopija);
  22     kopija^ := p^;
  23     p := p^.veza;
  24     pomocni := kopija;
  25     WHILE p <> NIL DO
  26       NEW(pomocni^.veza);
  27       pomocni := pomocni^.veza;
  28       pomocni^ := p^;
  29       p := p^.veza
  30     END
  31   END
  32 END Kopiraj;
  33
  34 PROCEDURE Stampaj(p: Polinom; d: CARDINAL);
  35
  36   PROCEDURE StampajMonom(m : Polinom);
  37   BEGIN
  38     WITH m^ DO
  39       IF st <> 0 THEN
  40         IF ABS(k) <> 1.0 THEN
  41           WriteReal(ABS(k), d)
  42         END;
  43         Write('x');
  44         IF st <> 1 THEN
  45           Write('^');
  46           WriteCard(st, 1)
  47         END
  48       ELSE
  49         WriteReal(ABS(k), d)
  50       END
  51     END
  52   END StampajMonom;
  53
  54 BEGIN
  55   IF p = NIL THEN
  56     WriteReal(0., d)
  57   ELSE
  58     IF p^.k < 0.0 THEN
  59       WriteString(' - ')
  60     END;
  61     StampajMonom(p);
  62     p := p^.veza;
  63     WHILE p <> NIL DO
  64       IF p^.k > 0.0 THEN
  65         WriteString(' + ')
  66       ELSE
  67         WriteString(' - ')
  68       END;
  69       StampajMonom(p);
  70       p := p^.veza
  71     END
  72   END
  73 END Stampaj;
  74
  75 PROCEDURE PostaviClan(k:REAL; st:CARDINAL;
  76                       VAR p:Polinom);
  77 VAR
  78   cilj, prethodni : Polinom;
  79 BEGIN
  80   cilj := p;
  81   prethodni := NIL;
  82   WHILE (cilj # NIL) AND (cilj^.st>st) DO
  83     prethodni := cilj;
  84     cilj := cilj^.veza;
  85   END;
  86   (* da li upisujemo vrednost ili sklanjamo clan *)
  87   IF k#0.0 THEN
  88     (* da li menjamo clan ili pravimo novi *)
  89     IF (cilj # NIL) AND (cilj^.st = st) THEN
  90       cilj^.k:=k;
  91     ELSE
  92       NEW(cilj);
  93       cilj^.k := k;
  94       cilj^.st := st;
  95       cilj^.veza := NIL;
  96       IF prethodni = NIL THEN
  97         (* ili je prazan polinom, ili dodajemo na pocetak *)
  98         cilj^.veza := p;
  99         p := cilj;
 100       ELSE
 101         cilj^.veza := prethodni^.veza;
 102         prethodni^.veza := cilj;
 103       END;
 104     END;
 105   ELSE
 106     (* da li postoji ovakav clan *)
 107     IF (cilj # NIL) AND (cilj^.st = st) THEN
 108       IF p = cilj THEN
 109         p := p^.veza;
 110       ELSE
 111         prethodni^.veza:= prethodni^.veza^.veza;
 112       END;
 113       DISPOSE(cilj);
 114     END;
 115   END;
 116 END PostaviClan;
 117
 118 PROCEDURE KoeficijentUz(p:Polinom; st:CARDINAL):REAL;
 119 VAR
 120   tekuci : Polinom;
 121 BEGIN
 122   tekuci := p;
 123   WHILE (tekuci#NIL) AND (tekuci^.st > st) DO
 124     tekuci := tekuci^.veza;
 125   END;
 126   IF (tekuci # NIL) AND (tekuci^.st = st) THEN
 127     RETURN tekuci^.k;
 128   ELSE
 129     RETURN 0.0;
 130   END;
 131 END KoeficijentUz;
 132
 133 PROCEDURE MaksimalniStepen(p:Polinom):CARDINAL;
 134 BEGIN
 135   IF p#NIL THEN
 136     RETURN p^.st;
 137   ELSE
 138     RETURN 0;
 139   END;
 140 END MaksimalniStepen;
 141
 142 PROCEDURE UbaciMonom(mon:Polinom; VAR p: Polinom);
 143 VAR
 144   stari, tekuci, kopija: Polinom;
 145 BEGIN
 146   IF mon # NIL THEN
 147     NEW(kopija);
 148     kopija^ := mon^;
 149     tekuci := p;
 150         stari := NIL;
 151     WHILE (tekuci#NIL) AND (tekuci^.st>kopija^.st) DO
 152       stari := tekuci;
 153       tekuci := tekuci^.veza
 154     END;
 155     kopija^.veza := tekuci;
 156     IF tekuci = p THEN
 157       p := kopija
 158     ELSE
 159       stari^.veza := kopija
 160     END;
 161     IF (tekuci#NIL) AND (kopija^.st = tekuci^.st) THEN
 162       kopija^.k := kopija^.k + tekuci^.k;
 163       kopija^.veza := tekuci^.veza;
 164       DISPOSE(tekuci);
 165       IF kopija^.k = 0.0 THEN
 166         IF p = kopija THEN
 167           p := kopija^.veza
 168         ELSE
 169           stari^.veza := kopija^.veza
 170         END;
 171         DISPOSE(kopija)
 172       END
 173     END
 174   END
 175 END UbaciMonom;
 176
 177 PROCEDURE Unos(VAR p : Polinom);
 178 VAR
 179   i, n: CARDINAL;
 180   novi: Polinom;
 181 BEGIN
 182   Anuliraj(p);
 183   REPEAT
 184     WriteLn;
 185     WriteString('Unesite broj monoma n (n>=0) ');
 186     ReadCard(n);
 187   UNTIL Done;
 188   WriteLn;
 189   FOR i := 1 TO n DO
 190     NEW(novi);
 191     WITH novi^ DO
 192       REPEAT
 193         WriteString('Unesite koeficijent monoma br.');
 194         WriteCard(i, 1);
 195         WriteString(' (<> 0) ');
 196         ReadReal(k);
 197         WriteLn
 198       UNTIL k <> 0.0;
 199       REPEAT
 200         WriteLn;
 201         WriteString('Unesite eksponent monoma br.');
 202         WriteCard(i, 1);
 203         WriteString(' (>=0) ');
 204         ReadCard(st);
 205       UNTIL Done;
 206       WriteLn;
 207     END;
 208     UbaciMonom(novi, p);
 209     DISPOSE(novi);
 210   END
 211 END Unos;
 212
 213 PROCEDURE Saberi(p1, p2: Polinom; VAR zbir: Polinom);
 214 BEGIN
 215   Kopiraj(p1, zbir);
 216   WHILE p2 <> NIL DO
 217     UbaciMonom(p2, zbir);
 218     p2 := p2^.veza
 219   END
 220 END Saberi;
 221
 222 PROCEDURE SaberiNa(p: Polinom; VAR rez: Polinom);
 223 BEGIN
 224   WHILE p <> NIL DO
 225     UbaciMonom(p,rez);
 226     p := p^.veza;
 227   END;
 228 END SaberiNa;
 229
 230 PROCEDURE PromeniZnak(VAR p: Polinom);
 231 VAR
 232   t: Polinom;
 233 BEGIN
 234   t := p;
 235   WHILE t <> NIL DO
 236     t^.k := - t^.k;
 237     t := t^.veza
 238   END
 239 END PromeniZnak;
 240
 241 PROCEDURE Oduzmi(p1,p2: Polinom; VAR razlika: Polinom);
 242 BEGIN
 243   Kopiraj(p2, razlika);
 244   PromeniZnak(razlika);
 245   WHILE p1 <> NIL DO
 246     UbaciMonom(p1, razlika);
 247     p1 := p1^.veza
 248   END
 249 END Oduzmi;
 250
 251 PROCEDURE MonomPuta(p, mon: Polinom; VAR mp: Polinom);
 252 VAR
 253   tekuci: Polinom;
 254 BEGIN
 255   Anuliraj(mp);
 256   IF (mon <> NIL) AND (p <> NIL) THEN
 257     NEW(mp);
 258     mp^.k := p^.k * mon^.k;
 259     mp^.st := p^.st + mon^.st;
 260     p := p^.veza;
 261     tekuci := mp;
 262     WHILE p <> NIL DO
 263       NEW(tekuci^.veza);
 264       tekuci := tekuci^.veza;
 265       tekuci^.k := p^.k * mon^.k;
 266       tekuci^.st := p^.st + mon^.st;
 267       p := p^.veza
 268     END;
 269     tekuci^.veza := NIL
 270   END
 271 END MonomPuta;
 272
 273 PROCEDURE Puta(p1, p2: Polinom; VAR pr: Polinom);
 274 VAR
 275   pomocni, brisi: Polinom;
 276 BEGIN
 277   Anuliraj(pr);
 278   IF (p1 <> NIL) AND (p2 <> NIL) THEN
 279     MonomPuta(p1, p2, pr);
 280     p2 := p2^.veza;
 281     WHILE p2 <> NIL DO
 282       MonomPuta(p1, p2, pomocni);
 283       REPEAT
 284         UbaciMonom(pomocni, pr);
 285         brisi := pomocni;
 286         pomocni := pomocni^.veza;
 287         DISPOSE(brisi);
 288       UNTIL pomocni = NIL;
 289       p2 := p2^.veza
 290     END
 291   END
 292 END Puta;
 293
 294 PROCEDURE Kolicnik(p1, p2: Polinom; VAR kol, ost: Polinom; VAR ok: BOOLEAN);
 295
 296   PROCEDURE Deli(VAR kol, ost: Polinom);
 297   VAR
 298     novi, pomocni: Polinom;
 299   BEGIN
 300     IF ost <> NIL THEN
 301       IF ost^.st >= p2^.st THEN
 302         NEW(novi);
 303         novi^.k := - ost^.k / p2^.k;
 304         novi^.st := ost^.st - p2^.st;
 305         MonomPuta(p2, novi, pomocni);
 306         SaberiNa(pomocni, ost);
 307         DisposePolinom(pomocni);
 308         novi^.k := - novi^.k;
 309         UbaciMonom(novi, kol);
 310         DISPOSE(novi);
 311         Deli(kol, ost)
 312       END
 313     END
 314   END Deli;
 315
 316 BEGIN (* Kolicnik *)
 317   ok := TRUE;
 318   Anuliraj(kol);
 319   IF p2 = NIL THEN
 320     ok := FALSE
 321   ELSE
 322     Kopiraj(p1, ost);
 323     Deli(kol, ost)
 324   END
 325 END Kolicnik;
 326
 327 PROCEDURE PolinomNaN(p: Polinom; n: CARDINAL;
 328                      VAR rez: Polinom);
 329 VAR
 330   i: CARDINAL;
 331   pret : Polinom;
 332 BEGIN
 333   IF n = 0 THEN
 334     NEW(rez);
 335     rez^.k := 1.0;
 336     rez^.st := 0;
 337     rez^.veza := NIL;
 338   ELSE
 339     Kopiraj( p, rez );
 340     FOR i := 2 TO n DO
 341       pret := rez;
 342       Puta(pret, p, rez);
 343       DisposePolinom(pret);
 344     END
 345   END;
 346 END PolinomNaN;
 347
 348 PROCEDURE DisposePolinom(VAR p: Polinom);
 349 VAR
 350   pomocni: Polinom;
 351 BEGIN
 352   pomocni := p;
 353   WHILE pomocni # NIL DO
 354     p := p^.veza;
 355     DISPOSE(pomocni);
 356     pomocni := p
 357   END
 358 END DisposePolinom;
 359
 360 END PolinomL.