c1u4
Član broj: 94247 Poruke: 3 85.158.38.*
|
Da profesor je. . no comment!
No sta je tu je, izvinjavam se sto nisam odgovorio, nisam imao vremena da obidjem forum.
Ovako sa mojim skromnim znanjem uspio sam napraviti ovaj program, ali imam negdje gresku za sada ne mogu da vidim gdje, znam da je kod imaginarnog dijela ali. . .
-----------------------------------------------------------------------------------------------------
PROGRAM Kont;
(*USES CRT_PII;*)
TYPE Comp = record
re,im:array[1..10,1..10] of real;
r,i:array[1..10] of real;
end;
TYPE mat = ARRAY [1..10,1..10] of real;
VAR i,j,g,n,m,k,h : integer;
a : mat;
x,u,p,q,p1,q1,I1,I2:comp;
Det:real;
PROCEDURE Unos_Z(VAR m:integer);
VAR i,j :integer;
BEGIN
FOR i:=1 TO m DO
FOR j:=i TO m DO
BEGIN
write('Z(',i,j,') realno =');
readln(x.re[i,j]);
write('Z(',i,j,') imaginarno =');
readln(x.im[i,j]);
writeln;
END;
FOR i:=1 TO m-1 DO
FOR j:=i+1 TO m DO
BEGIN
x.re[j,i]:=x.re[i,j];
x.im[j,i]:=x.im[i,j];
END;
END;
PROCEDURE Unos_U(VAR m:integer);
VAR i :integer;
BEGIN
FOR i:=1 TO m DO
BEGIN
write('U(',i,i,') realno =');
readln(u.re[i,i]);
write('U(',i,i,') imaginarno =');
readln(u.im[i,i]);
writeln;
END;
END;
PROCEDURE Ispis_jed(VAR m: integer);
VAR i,j :integer;
BEGIN
FOR i:=1 TO m DO
BEGIN
FOR j:=1 TO m DO
BEGIN
if j=m THEN write('(',x.re[i,j]:5:2,' + j ',x.im[i,j]:5:2,') * I',j)
ELSE write('(',x.re[i,j]:5:2,' + j ',x.im[i,j]:5:2,') * I',j,' + ');
if j=m THEN write (' = (',u.re[i,i]:5:2,' + j ',u.im[i,i]:5:2,')V');
END;
writeln;
END;
END;
PROCEDURE Ispis_D(VAR m:integer);
VAR i,j :integer;
BEGIN
FOR i:=1 TO m DO
BEGIN
FOR j:=1 TO m DO
if x.im[i,j]>=0 THEN
write('(',x.re[i,j]:5:2,' + j ',x.im[i,j]:5:2,') ')
ELSE write('(',x.re[i,j]:5:2,' - j ',abs(x.im[i,j]):5:2,') ');
writeln;
END;
END;
PROCEDURE Mnoz2(VAR m:integer);
VAR spr,spi,smr,smi,spr1,spi1,smr1,smi1,spr2,spi2,smr2,smi2:real;
I1r,I1i,I2r,I2i,Dsr,Dsi,D1r,D1i,D2r,D2i:real;
BEGIN
spr:=x.re[1,1]*x.re[2,2]-x.im[1,1]*x.im[2,2];
spi:=x.re[1,1]*x.im[2,2]+x.im[1,1]*x.re[2,2];
smr:=x.re[2,1]*x.re[1,2]-x.im[2,1]*x.im[1,2];
smi:=x.re[2,1]*x.im[1,2]+x.im[2,1]*x.re[1,2];
if (spi-smi)>=0
THEN writeln ('Ds=',(spr-smr):5:2,' + j ',(spi-smi):5:2)
ELSE writeln ('Ds=',(spr-smr):5:2,' - j ',abs(spi-smi):5:2);
spr1:=u.re[1,1]*x.re[2,2]-u.im[1,1]*x.im[2,2];
spi1:=u.re[1,1]*x.im[2,2]+u.im[1,1]*x.re[2,2];
smr1:=u.re[2,2]*x.re[1,2]-u.im[2,2]*x.im[1,2];
smi1:=u.re[2,2]*x.im[1,2]+u.im[2,2]*x.re[1,2];
if (spi1-smi1)>=0
THEN writeln ('D1=',(spr1-smr1):5:2,' + j ',(spi1-smi1):5:2)
ELSE writeln ('D1=',(spr1-smr1):5:2,' - j ',abs(spi1-smi1):5:2);
spr2:=x.re[1,1]*u.re[2,2]-x.im[1,1]*u.im[2,2];
spi2:=x.re[1,1]*u.im[2,2]+x.im[1,1]*u.re[2,2];
smr2:=x.re[2,1]*u.re[1,1]-x.im[2,1]*u.im[1,1];
smi2:=x.re[2,1]*u.im[1,1]+x.im[2,1]*u.re[1,1];
if (spi1-smi1)>=0
THEN writeln ('D2=',(spr2-smr2):5:2,' + j ',(spi2-smi2):5:2)
ELSE writeln ('D2=',(spr2-smr2):5:2,' - j ',abs(spi2-smi2):5:2);
Dsr:=spr-smr;
Dsi:=spi-smi;
D1r:=spr1-smr1;
D1i:=spi1-smi1;
D2r:=spr2-smr2;
D2i:=spi2-smi2;
I1r:=(D1r*Dsr)+(D1i*Dsi);
I1i:=(D1i*Dsr)-(D1r*Dsi);
I2r:=(D2r*Dsr)+(D2i*Dsi);
I2i:=(D2i*Dsr)-(D2r*Dsi);
writeln;
writeln ('Ik1=(',(I1r/(sqr(Dsr)+sqr(Dsi))):10:5,' + j ',(I1i/(sqr(Dsr)+sqr(Dsi))):10:5,')A' );
writeln ('Ik2=(',(I2r/(sqr(Dsr)+sqr(Dsi))):10:5,' + j ',(I2i/(sqr(Dsr)+sqr(Dsi))):10:5,')A' );
END;
PROCEDURE Mnoz(VAR R:mat;VAR s:real;m:integer);
TYPE PROIZ = ARRAY [1..10] of real;
VAR i,j,h :integer;
spr,spi,sm,pr,p1r,pi,p1i :real;
BEGIN
spr:=0;
spi:=0;
sm:=0;
FOR j:=1 TO m DO
BEGIN
p.r[j]:=1;
h:=j;
FOR i:=1 TO m DO
BEGIN
IF h<=m THEN
BEGIN
INC(h)
END
ELSE
BEGIN
h:=1;
p.r[j]:=p.r[j]*x.re[i,h];
INC(h)
END;
END;
END;
FOR j:=m DOWNTO 1 DO
BEGIN
q.r[j]:=1;
h:=j;
FOR i:=1 TO m DO
BEGIN
IF h>=1 THEN
BEGIN
q.r[j]:=q.r[j]*x.re[i,h];
DEC(h)
END
ELSE
BEGIN
h:=m;
q.r[j]:=q.r[j]*x.re[i,h];
DEC(h)
END;
END;
sm:=sm+q.r[j]
END;
s:=spr-sm;
writeln(spr:10:2,' ',sm:10:2,' ',s:10:2)
END;
BEGIN
repeat
writeln ('-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-');
write ('Unesite broj grana:');
readln (g);
write ('A sada unesite broj cvorova:');
readln (n);
writeln;
m:=g-n+1;
if m<=0 then writeln ('NE POSTOJI TAKVO KOLO!!! PONOVO UNESITE PODATKE!!!');
until m>=0;
writeln ('Kolo ima ',m,' konture.');
Unos_Z(m);
Unos_U(m);
writeln ('JEDNACINE IMAJU SLIJEDECI OBLIK:');
Ispis_jed(m);
writeln;
Ispis_D(m);
writeln;
if m=2 THEN Mnoz2(m)
ELSE Mnoz(a,det,m);
readln;
END.
--------------------------------------------------------------------------------------------------------
ako neko vidi il predlozi nesto da zamjenim, slobodno recite. . .
[Ovu poruku je menjao c1u4 dana 11.05.2006. u 00:37 GMT+1]
|