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