Uses crt; const k=10;{max razmernost matrici} type matr=array[1..k,1..k+1] of real; stroka=array[1..k+1] of real; strint=array[1..k+1] of integer; Var m{start matrix}:matr; vps{vector perestanovok} :strint; Vnev: array [1..4] of real; m_r,{working matrix} m_o,{A^-1} m_pr{proizvedenie matric} :matr; x,{Reshenie} s,{Symma pri proverke polych reshenii (Gauss Method)} vr{temp str dlya vichislenii} :stroka;{kol-vo reshenii} i,j,i1,j1,h,vv,{schetchiki} v,{choosing} nstr,{nomer str s max koef} nst,{s max koef.} k1,{razmernost matrici pri inicializacii koef.} k2,{razmernost pri vvode s klaviatyri} rr,{razmernost matrici v main prog} vr_el{vrem ele.} :integer; max,{max koef.} dt,{determinant} n, n1,n2,n3,n11,n22,n33{matrix norm's} :real; {funtions} {powering the numbers} function step(a,s:integer):integer; var i,st:integer; begin st:=1; for i:=1 to s do st:=st*a; step:=st; end; {outputing matrix on screen} procedure vivmatr(m:matr; p:integer; f:integer); var pp:integer; i,j:integer; rk:char; begin if f=1 then pp:=p+1 else pp:=p; for i:=1 to p do begin for j:=1 to pp do begin if j=p+1 then begin write('|',m[i,j]:7:2); end else begin write(m[i,j]:7:2); end; end; writeln; end; repeat writeln('press enter to continue'); rk:=readkey; until rk=#13; end; {vichetanie stroki i stolbce} procedure getmatr(m:matr;p,i,j:integer; var gm:matr); var gi,gj,ii,jj:integer; begin gi:=0; for ii:=1 to p-1 do begin if ii=i then gi:=1; gj:=0; for jj:=1 to p-1 do begin if jj=j then gj:=1; gm[ii,jj]:=m[ii+gi,jj+gj]; end; end; end; {determinant} function det(m:matr; p{matrix size}:integer):real; var i,j,n:longint; d:real; b:matr; begin d:=0; n:=1; if p<1 then begin writeln('Determinant: Cann''t run. N=',p); halt; end; if (p=1) then d:=m[1,1]; if (p=2) then d:=d+m[1,1]*m[2,2]-m[1,2]*m[2,1]; if (p>2) then begin for i:=1 to p do begin getmatr(m,p,i,1,b); d:=d+n*m[i,1]*det(b,p-1); n:=-n; end; end; det:=d; end; {A^T} procedure transmatr(m:matr;p:integer;{size} var tm:matr); var i,j:integer; begin for i:=1 to p do for j:=1 to p do tm[i,j]:=m[j,i]; end; {A^-1} procedure obrmatr(m:matr;p:integer; var om:matr); var i,j:integer; vr, ntm{A ishodnaya} :matr;{minor} d:real;{determinant temp var} begin if det(m,p) <> 0 then begin d:=det(m,p); for i:=1 to p do begin for j:=1 to p do begin getmatr(m,p,i,j,vr); ntm[i,j]:=step(-1,i+j)*det(vr,p-1)/d; end; end; transmatr(ntm,p,om); end; end; {peremnojenie matric} procedure proizv(m,n:matr;p:integer; var c:matr); var i,j,v:integer; vr:stroka; begin for i:=1 to p do for j:=1 to p do begin for v:=1 to p do c[i,j]:=c[i,j]+m[i,v]*n[v,j]; end; end; {maxtrix norm's} procedure norma(m:matr;p:integer; var nn1,nn2,nn3:real); var i,j:integer; s,max:real; begin s:=0; {norm e} for i:=1 to p do for j:=1 to p do s:=s+sqr(m[i,j]); s:=sqrt(s); nn1:=s; {norm 1} for i:=1 to p do begin s:=0; for j:=1 to p do begin s:=s+abs(m[j,i]); end; if i=1 then max:=s; if s>max then max:=s; end; nn2:=max; {infinite norm} for i:=1 to p do begin s:=0; for j:=1 to p do begin s:=s+abs(m[i,j]); end; if i=1 then max:=s; if s>max then max:=s; end; nn3:=max; end; {MAIN} begin clrscr; randomize; writeln('Gauss Method'); writeln('Choose :'); writeln('1. Keyboard'); writeln('2. Ready matrix'); readln(v); if v=1 then {keyboard input} begin writeln('Keyboard inputing'); write('Input size: '); readln(k2); rr:=k2; for i:=1 to rr do for j:=1 to rr do begin write('Vvedite koefficient pri å[',i,',',j,']: '); readln(m[i,j]); end; for i:=1 to rr do begin write('Input free row b[',i,']: '); readln(m[i,rr+1]); end; end; {inputing ready coeffc} if v=2 then begin rr:=4; m[1,1]:=3; m[1,2]:=2; m[1,3]:=2; m[1,4]:=5; m[1,5]:=18; m[2,1]:=2; m[2,2]:=4; m[2,3]:=5; m[2,4]:=2; m[2,5]:=27; m[3,1]:=2; m[3,2]:=2; m[3,3]:=3; m[3,4]:=-18; m[3,5]:=-3; m[4,1]:=3; m[4,2]:=2; m[4,3]:=2; m[4,4]:=3; m[4,5]:=16; end; {preparing for work..} for i:=1 to rr do for j:=1 to rr+1 do m_r[i,j]:=m[i,j]; writeln('Ishodnaya matrica'); vivmatr(m_r,rr,1); {determinant} dt:=det(m_r,rr); {on screen...} writeln('Determinant: ',dt:10:4); writeln; {A^-1} obrmatr(m_r,rr,m_o); if dt<>0 then begin writeln('A^-1:'); vivmatr(m_o,rr,0); end else begin writeln('Determinant = 0.A^-1 is not exsist'); end; {A^-1 det} dt:=det(m_o,rr); {on screen} writeln('Determinant (A-^1): ',dt:10:4); writeln; {proizvedenie matric} proizv(m_r,m_o,rr,m_pr); {on screen...} writeln('Proizvedenie matric: '); vivmatr(m_pr,rr,0); {Gauss method} {nahojdenie max koef. i sortirovka strok} {zadanie vektora perestanovok} for i:=1 to rr do vps[i]:=i; {vektor perestanovok} writeln('Nachalnii vektor perestanovok'); for i:=1 to rr do write(vps[i]:3); writeln; {sortirovka po max. elementy} for i:=1 to rr-1 do begin {nohojdenie maks koef.} max:=abs(m_r[i,i]); nstr:=i;nst:=i; for i1:=i to rr do for j1:=i to rr do if abs(max)i then {yslovie vektora perestanovok( vps)} begin vr_el:=vps[i]; vps[i]:=vps[nst]; vps[nst]:=vr_el; end; end; {proverka vivod ishodnoi matrici} writeln('start marix'); vivmatr(m,rr,0); {Cheking - outputing on screen} writeln('matrica otsorrt po max. koeficienty'); vivmatr(m_r,rr,1); {Vivod vektora perestanovok} writeln('Izmenenni vektor perestanovok stolbcov'); for i:=1 to rr do write(vps[i]:3); writeln; {preobrazovenie k triangle matrix} {treangle matrix} for j:=1 to rr do {j - nomer nach. str.} begin {proverka na nylevoi koef pri m_r[j,j]} i1:=1; j1:=0; while (m_r[j,j]=0) and (j+i1<=rr) and (j<>rr) do begin j1:=j+i1; {menyaem stroki} for i:=j to rr+1 do begin vr[i]:=m_r[j,i]; m_r[j,i]:=m_r[j1,i]; m_r[j1,i]:=vr[i]; end; i1:=i1+1; end; {delim koef. j-oi str. na koef pri x[j,j]} for i:=j to rr+1 do {esli delitel =0,to ne delim} if m_r[j,j]<>0 then vr[i]:=m_r[j,i] / m_r[j,j] {prisvaivaem vrem. znacheniu realnie znacheniya dannnoi str.} else vr[i]:=m_r[j,i]; for i:=j to rr+1 do {prisvaivaem polych. stroky matrice} m_r[j,i]:=vr[i]; {kogda nijnyaya stroka - ne vip. deistvii} if j1 then begin for h:=1 to j-1 do {h-koef., kotorii pribavlyaem dlya vibora str.} begin {ymnojaem j str na koef pri å[j+h,1],vichitaem iz j+h polychivshyusya str.} {ymnojenie} for i:=j to rr+1 do vr[i]:=m_r[j,i]*m_r[j-h,j]; {vichitanie} for i:=j to rr+1 do m_r[j-h,i]:=m_r[j-h,i]-vr[i]; end; end; end; {Checking - outputing on screen} writeln('E'); vivmatr(m_r,rr,1); {Vichislenie reshenii...} for i:=1 to rr do x[vps[i]]:=m_r[i,rr+1]; {Cheking and outputing on screen} writeln('Start Matrix'); vivmatr(m,rr,1); writeln('Resheniya matrici: '); for i:=1 to rr do writeln('x',i,' = ',x[i]:5:5); {Cheking...} for i:=1 to rr do begin for j:=1 to rr do begin s[i]:=s[i]+x[j]*m[i,j]; end; writeln(s[i],' - ',m[i,rr+1],' = ',(s[i]) - (m[i,rr+1])); end; writeln('Vektor Nevyazok: '); for i:=1 to rr do for j:=1 to rr do Vnev:=(m[i,j]*x[i])-m[i,5]; for i:=1 to 4 do writeln('Vnev = ',vnev[i]); {End of Gauss Method} {A and A^-1} for i:=1 to rr do for j:=1 to rr+1 do m_r[i,j]:=m[i,j]; writeln('Ishodnaya matrica:'); vivmatr(m_r,rr,0); writeln('A^-1:'); vivmatr(m_o,rr,0); {norm's} norma(m_r,rr,n1,n2,n3); writeln('Norm ishodnoi matrici:'); writeln('Norm e: ',n1:10:4); writeln('Norm 1: ',n2:10:4); writeln('Infinite norm: ',n3:10:4); writeln; norma(m_o,rr,n11,n22,n33); writeln('Norm ^-1:'); writeln('Norm e: ',n11:10:4); writeln('Norm 1: ',n22:10:4); writeln('Infinite norm: ',n33:10:4); writeln; {cond's} writeln('cond 1: ',(n1*n11):10:4); writeln('cond 2: ',(n2*n22):10:4); writeln('cond 3: ',(n3*n33):10:4); repeat until keypressed; end.