kodovi/polinomi/POLINOML.MOD

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