kodovi/polinomi/POLINOML.MOD

   1 (* Modul za rad sa polinomima preko listi
   2    verzija 2014 *)
   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   IF cilj = NIL THEN
  87     IF k#0.0 THEN
  88       NEW(cilj);
  89       cilj^.k := k;
  90       cilj^.st := st;
  91       cilj^.veza := NIL;
  92       IF p = NIL THEN
  93         p := cilj;
  94       ELSE
  95         prethodni^.veza := cilj;
  96       END;
  97     END;
  98   ELSIF cilj^.st=st THEN
  99     IF k # 0.0 THEN
 100       cilj^.k:=k;
 101     ELSE
 102       IF p = cilj THEN
 103         p := p^.veza;
 104       ELSE
 105         prethodni^.veza:= prethodni^.veza^.veza;
 106       END;
 107       DISPOSE(cilj);
 108     END;
 109   ELSE
 110     IF k # 0.0 THEN
 111       NEW(cilj);
 112       cilj^.k := k;
 113       cilj^.st := st;
 114       cilj^.veza := prethodni^.veza;
 115       prethodni^.veza := cilj;
 116     END;
 117   END;
 118 END PostaviClan;
 119
 120 PROCEDURE UbaciMonom(mon:Polinom; VAR p: Polinom);
 121 VAR
 122   stari, tekuci, kopija: Polinom;
 123 BEGIN
 124   IF mon # NIL THEN
 125     NEW(kopija);
 126     kopija^ := mon^;
 127     tekuci := p;
 128         stari := NIL;
 129     WHILE (tekuci#NIL) AND (tekuci^.st>kopija^.st) DO
 130       stari := tekuci;
 131       tekuci := tekuci^.veza
 132     END;
 133     kopija^.veza := tekuci;
 134     IF tekuci = p THEN
 135       p := kopija
 136     ELSE
 137       stari^.veza := kopija
 138     END;
 139     IF (tekuci#NIL) AND (kopija^.st = tekuci^.st) THEN
 140       kopija^.k := kopija^.k + tekuci^.k;
 141       kopija^.veza := tekuci^.veza;
 142       DISPOSE(tekuci);
 143       IF kopija^.k = 0.0 THEN
 144         IF p = kopija THEN
 145           p := kopija^.veza
 146         ELSE
 147           stari^.veza := kopija^.veza
 148         END;
 149         DISPOSE(kopija)
 150       END
 151     END
 152   END
 153 END UbaciMonom;
 154
 155 PROCEDURE Unos(VAR p : Polinom);
 156 VAR
 157   i, n: CARDINAL;
 158   novi: Polinom;
 159 BEGIN
 160   Anuliraj(p);
 161   REPEAT
 162     WriteLn;
 163     WriteString('Unesite broj monoma n (n>=0) ');
 164     ReadCard(n);
 165   UNTIL Done;
 166   WriteLn;
 167   FOR i := 1 TO n DO
 168     NEW(novi);
 169     WITH novi^ DO
 170       REPEAT
 171         WriteString('Unesite koeficijent monoma br.');
 172         WriteCard(i, 1);
 173         WriteString(' (<> 0) ');
 174         ReadReal(k);
 175         WriteLn
 176       UNTIL k <> 0.0;
 177       REPEAT
 178         WriteLn;
 179         WriteString('Unesite eksponent monoma br.');
 180         WriteCard(i, 1);
 181         WriteString(' (>=0) ');
 182         ReadCard(st);
 183       UNTIL Done;
 184       WriteLn;
 185     END;
 186     UbaciMonom(novi, p);
 187     DISPOSE(novi);
 188   END
 189 END Unos;
 190
 191 PROCEDURE Saberi(p1, p2: Polinom; VAR zbir: Polinom);
 192 BEGIN
 193   Kopiraj(p1, zbir);
 194   WHILE p2 <> NIL DO
 195     UbaciMonom(p2, zbir);
 196     p2 := p2^.veza
 197   END
 198 END Saberi;
 199
 200 PROCEDURE SaberiNa(p: Polinom; VAR rez: Polinom);
 201 BEGIN
 202   WHILE p <> NIL DO
 203     UbaciMonom(p,rez);
 204     p := p^.veza;
 205   END;
 206 END SaberiNa;
 207
 208 PROCEDURE PromeniZnak(VAR p: Polinom);
 209 VAR
 210   t: Polinom;
 211 BEGIN
 212   t := p;
 213   WHILE t <> NIL DO
 214     t^.k := - t^.k;
 215     t := t^.veza
 216   END
 217 END PromeniZnak;
 218
 219 PROCEDURE Oduzmi(p1,p2: Polinom; VAR razlika: Polinom);
 220 BEGIN
 221   Kopiraj(p2, razlika);
 222   PromeniZnak(razlika);
 223   WHILE p1 <> NIL DO
 224     UbaciMonom(p1, razlika);
 225     p1 := p1^.veza
 226   END
 227 END Oduzmi;
 228
 229 PROCEDURE MonomPuta(p, mon: Polinom; VAR mp: Polinom);
 230 VAR
 231   tekuci: Polinom;
 232 BEGIN
 233   Anuliraj(mp);
 234   IF (mon <> NIL) AND (p <> NIL) THEN
 235     NEW(mp);
 236     mp^.k := p^.k * mon^.k;
 237     mp^.st := p^.st + mon^.st;
 238     p := p^.veza;
 239     tekuci := mp;
 240     WHILE p <> NIL DO
 241       NEW(tekuci^.veza);
 242       tekuci := tekuci^.veza;
 243       tekuci^.k := p^.k * mon^.k;
 244       tekuci^.st := p^.st + mon^.st;
 245       p := p^.veza
 246     END;
 247     tekuci^.veza := NIL
 248   END
 249 END MonomPuta;
 250
 251 PROCEDURE Puta(p1, p2: Polinom; VAR pr: Polinom);
 252 VAR
 253   pomocni: Polinom;
 254 BEGIN
 255   Anuliraj(pr);
 256   IF (p1 <> NIL) AND (p2 <> NIL) THEN
 257     MonomPuta(p1, p2, pr);
 258     p2 := p2^.veza;
 259     WHILE p2 <> NIL DO
 260       MonomPuta(p1, p2, pomocni);
 261       REPEAT
 262         UbaciMonom(pomocni, pr);
 263         pomocni := pomocni^.veza
 264       UNTIL pomocni = NIL;
 265       p2 := p2^.veza
 266     END
 267   END
 268 END Puta;
 269
 270 PROCEDURE Kolicnik(p1, p2: Polinom; VAR kol, ost: Polinom; VAR ok: BOOLEAN);
 271
 272   PROCEDURE Deli(VAR kol, ost: Polinom);
 273   VAR
 274     novi, pomocni: Polinom;
 275   BEGIN
 276     IF ost <> NIL THEN
 277       IF ost^.st >= p2^.st THEN
 278         NEW(novi);
 279         novi^.k := - ost^.k / p2^.k;
 280         novi^.st := ost^.st - p2^.st;
 281         MonomPuta(p2, novi, pomocni);
 282         Saberi(ost, pomocni, ost);
 283         novi^.k := - novi^.k;
 284         UbaciMonom(novi, kol);
 285         DISPOSE(novi);
 286         Deli(kol, ost)
 287       END
 288     END
 289   END Deli;
 290
 291 BEGIN (* Kolicnik *)
 292   ok := TRUE;
 293   Anuliraj(kol);
 294   IF p2 = NIL THEN
 295     ok := FALSE
 296   ELSE
 297     Kopiraj(p1, ost);
 298     Deli(kol, ost)
 299   END
 300 END Kolicnik;
 301
 302 PROCEDURE PolinomNaN(p: Polinom; n: CARDINAL;
 303                      VAR rez: Polinom);
 304 VAR
 305   i: CARDINAL;
 306 BEGIN
 307   IF n = 0 THEN
 308     NEW(rez);
 309     rez^.k := 1.0;
 310     rez^.st := 0;
 311     rez^.veza := NIL;
 312   ELSIF n = 1 THEN
 313         Kopiraj( p, rez );
 314   ELSE
 315     rez := p;
 316     FOR i := 2 TO n DO
 317       Puta(rez, p, rez)
 318     END
 319   END;
 320 END PolinomNaN;
 321
 322 PROCEDURE DisposePolinom(VAR p: Polinom);
 323 VAR
 324   pomocni: Polinom;
 325 BEGIN
 326   pomocni := p;
 327   WHILE pomocni # NIL DO
 328     p := p^.veza;
 329     DISPOSE(pomocni);
 330     pomocni := p
 331   END
 332 END DisposePolinom;
 333
 334 END PolinomL.