gitweb on Svarog

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