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