Кто-нибудь может перевести Паскаль в C#?
Формулировка задачи:
Отзовитесь! Кто сможет перевести
Решение задачи: «Кто-нибудь может перевести Паскаль в C#?»
textual
Листинг программы
program iter;
type
tmatr = array[1..10,1..10] of real;
tvec = array[1..10] of real;
var
a7:tmatr;
n1:integer;
y1,y2:tvec;
k:integer;
procedure vvod1(n:integer; var a:tmatr);
var
i5,j5:integer;
begin
writeln('Wwedite ',sqr(n),' elementow');
for i5:=1 to n do
for j5:=1 to n do
read(a[i5,j5]);
end;
procedure vvod2(n:integer; var b:tvec);
var
i5:integer;
begin
writeln('Wwedite ',n,' elementow');
for i5:=1 to n do
read(b[i5]);
end;
{//перемножение матриц}
function umnm(aa1,aa2:tmatr; n5:integer;var a:tmatr):integer;
var
i,j,i1,j1:integer;
r1:real;
begin
for i1:=1 to n5 do
for j1:=1 to n5 do begin
r1:=0;
for i:=1 to n5 do
r1:=r1+aa1[i1,i]*aa2[i,j1];
a[i1,j1]:=r1;
end;
end;
{//умножение матрицы на вектор}
function umnv(a5:tmatr;b5:tvec;n5:integer; var b:tvec):integer;
var
i,i1:integer;
r1:real;
begin
for i1:=1 to n5 do begin
r1:=0;
for i:=1 to n5 do begin
r1:=r1+a5[i1,i]*b5[i];
end;
b[i1]:=r1;
end;
end;
procedure it(a:tmatr;y0:tvec;eps:real;n:integer);
var
i,j:integer;
dy:array[1..10] of real;
b1,b2:tvec;
a1,a2:tmatr;
y,norm:real;
b:boolean;
k:integer;
begin
b:=false;
k:=0;
for i:=1 to n do
for j:=1 to n do
a1[i,j]:=a[i,j];
for i:=1 to n do b2[i]:=y0[i];
while (not b)and(k<14) do begin
k:=k+1;
b:=true;
for i:=1 to n do b1[i]:=b2[i];
{//умножаем матрицу на вектор}
umnv(a1,y0,n,b2);
for i:=1 to n do begin dy[i]:=b2[i]/b1[i]; end;
y:=0;
for i:=1 to n do begin writeln(i,' : ',dy[i]:4:4); end;
for i:=1 to n do begin y:=y+dy[i]; end;
y:=y/n; writeln('na shage ',k,' chislo ',y);
for i:=1 to n do if abs(y-dy[i])>eps then b:=false;
{//умножаем матрицу на матрицу}
umnm(a1,a,n,a2);
for i:=1 to n do
for j:=1 to n do
a1[i,j]:=a2[i,j];
for i:=1 to n do begin
for j:=1 to n do
write(a1[i,j]:4:4,' ');
writeln;
end;
readln;
end;
norm:=0;
{//нормируем вектор собственных значений}
for i:=1 to n do begin norm:=norm+sqr(b2[i]); end;
norm:=sqrt(norm);
for i:=1 to n do begin b2[i]:=b2[i]/norm; writeln(b2[i]:4:7); end;
{//в данном сегменте значения выводятся на экран}
readln;
end;
Procedure vivod_matr(A1:Tmatr;N :integer);
var
i,j:integer;
begin
For i:=1 to N do begin
For j:=1 to N do write(A1[i,j]:15,' ');
writeln;
End;
writeln;
End;
{процедура для вывода вектора}
Procedure vivod_vectr(B1:Tvec; N :integer);
var
j:integer;
begin
For j:=1 to N do writeln(B1[j]:0:8,' ');
writeln;
End;
PROCEDURE Qr (Var Nn:Integer;Var A:Tmatr;Var R_1:Tvec;Var R_2:Tvec);
Var
I,J,K,L,M,Na,Its : Integer;
I1,M1,N1,L1,N : Integer;
M3,U1,U11,U2 : Real;
Q,P,R,S,T,U,X,Y,Z,W : Real;
Aa: tMatr;
r1,r2:tvec;
Label NexTw,NexTit,Cont_1,Cont_2,Cont_3;
Label Onew,TwOw,Fin;
Begin //0
Aa:=A;
N:=Nn;
for i:=1 to Nn do
begin //1
r1[i]:=0;
r2[i]:=0;
end; //1
T:=0.0;
NexTw:
If (N=0) Then
Goto Fin;
Its:=0;
Na:=N-1;
M3:=1.0e-11;
NexTit:
For L:=N DownTo 2 Do
Begin //2
U:=Abs(Aa[l,l-1]);
U1:=M3*(Abs(Aa[l-1,l-1])+Abs(Aa[l,l]));
If (U<=U1) Then
Goto Cont_1;
End; //2
L:=1;
Cont_1:
X:=Aa[n,n];
If(L=N) Then
Goto Onew;
Y:=Aa[na,na];
W:=Aa[n,na]*Aa[na,n];
If(L=Na) Then
Goto Twow;
If(Its=30) Then
Goto Fin;
If((Its=10)And(Its=20)) Then
Begin //3
T:=T+X;
For I:=1 To N Do
Begin //4
Aa[i,i]:=Aa[i,i]-X;
End; //4
S:=Abs(Aa[n,na])+Abs(Aa[na,n-2]);
X:=0.75*S;
Y:=0.75*S; W:=-0.4375*S*S;
End; //3
Its:=Its+1;
For M:=N-2 Downto L Do
Begin //5
Z:=Aa[m,m];
R:=X-Z;
S:=Y-Z;
P:=(R*S-W)/Aa[m+1,m]+Aa[m,m+1];
Q:=Aa[m+1,m+1]-Z-R-S;
R:=Aa[m+2,m+1];
S:=Abs(P)+Abs(Q)+Abs(R);
P:=P/S;
Q:=Q/S;
R:=R/S;
If(M=L) Then
Goto Cont_2;
U11:=Abs(Aa[m,m-1])*(Abs(Q)+Abs(R));
U2:=M3*Abs(P)*(Abs(Aa[m-1,m-1])+Abs(Z)+Abs(Aa[m+1,m+1]));
If(U11<=U2) Then
Goto Cont_2;
End; //5
Cont_2:
For I:=M+2 To N Do
Begin //6
Aa[i,i-2]:=0.0;
End; //6
For I:=M+3 To N Do
Begin //7
Aa[i,i-3]:=0.0;
End; //7
For K:=M To Na Do
Begin //8
If (K<>M) Then
Begin //9
P:=Aa[k,k-1];
Q:=Aa[k+1,k-1];
If(K<>Na) Then
R:=Aa[k+2,k-1]
Else
R:=0.0;
X:=Abs(P)+Abs(Q)+Abs(R);
If(X=0.0) Then
Goto Cont_3;
P:=P/X;
Q:=Q/X;
R:=R/X;
End; //9
S:=Sqrt(P*P+Q*Q+R*R);
If(P<0.0) Then
S:=-S;
If(K<>M) Then
Aa[k,k-1]:=-S*X
Else
If(L<>M) Then
Aa[k,k-1]:=-Aa[k,k-1];
P:=P+S; X:=P/S;
Y:=Q/S;
Z:=R/S;
Q:=Q/P;
R:=R/P;
For J:=K To N Do
Begin //10
P:=Aa[k,j]+Q*Aa[k+1,j];
If (K<>Na) Then
Begin //11
P:=P+R*Aa[k+2,j];
Aa[k+2,j]:=Aa[k+2,j]-P*Z;
End; //11
Aa[k+1,j]:=Aa[k+1,j]-P*Y;
Aa[k,j]:=Aa[k,j]-P*X;
End; //10
If((K+3)<N) Then
J:=K+3
Else
J:=N;
For I:=L To J Do
Begin //12
P:=X*Aa[i,k]+Y*Aa[i,k+1];
If(K<>Na) Then
Begin //13
P:=P+Z*Aa[i,k+2];
Aa[i,k+2]:=Aa[i,k+2]-P*R;
End; //13
Aa[i,k+1]:=Aa[i,k+1]-P*Q;
Aa[i,k]:=Aa[i,k]-P;
End; //12
Cont_3:
End; //8
Goto NexTit;
Onew:
R1[n]:=X+T;
R2[n]:=0.0;
{Cnt[n]:=its;}
N:=Na;
Goto Nextw;
Twow:
P:=(Y-X)/2.0;
Q:=P*P+W;
Y:=Sqrt(Abs(Q));
{Cnt[n]:=-its; Cnt[na]:=its;}
X:=X+T;
If(Q>0.0) Then
Begin //14
If(P<0.0) Then
Y:=-1.0*Y;
Y:=P+Y;
R1[na]:=X+Y;
R1[n]:=X-W/Y;
R2[na]:=0.0;
R2[n]:=0.0;
End //14
Else
Begin //15
R1[na]:=X+P;
R1[n]:=X+P;
R2[na]:=Y;
R2[n]:=-1.0*Y;
End; //15
N:=N-2;
Goto Nextw;
Fin:
r_1:=r1;
r_2:=r2;
End; //0
begin
n1:=3;
{while 1=1 do begin
{clrscr;}
{writeln('Wibirite:',#13#10,'1- wwod matrici',#13#10,'2-wwod wectora',#13#10,'3-wichislit',#13#10,'4-wihod');
read(k);
if k=1 then vvod1(n1,a7);
if k=2 then vvod2(n1,y1);
if k=3 then it(a7,y1,0.01,n1);
if k=4 then halt;
end;}
vvod1(n1,a7);
Qr(n1,a7,y1,y2);
WriteLn('sobstvennye vectora matricy:');
vivod_matr(a7,n1);
WriteLn('sobstvennye chisla matricy:');
vivod_vectr(y1,n1);
end.