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