program Matrix_Process; (****************************************************** * Демонстрация работы с двумерными массивами * * (матрицами) * ******************************************************) const NMAX = 700; MMAX = 400; type Matrix = array [1..NMAX, 1..MMAX] of real; var StepSv, Funk, Matr: Matrix; n,m: integer; Str:string; file1,file2:string; s1,s2:char; (*************************************************** Процедура ввода матрицы из файла ****************************************************) procedure EnterMatrixFromFile; var i,j: integer; f:text; begin assign(f,'matrixdat.txt'); reset(f); i := 1; while not eof(f) do begin j := 1 ; while not eoln(f) do begin read(f,Matr[i, j]); {writeln('Matr[',i,',',j,']',Matr[i,j]);} inc(j); end; readln(f); inc(i); end; close(f); n:=i-1; {Є®«ЁзҐбўв® бва®Є} m:=j-1; {Є®«ЁзҐбвў® бв®«Ўж®ў} writeln('ђ §¬Ґа Ёб室­®© ¬ ваЁжл: ‘ва®Є n=',n,',','‘в®«Ўж®ў m=',m); end; (****************************************************** Процедура печати матрицы реальной размерности (n,m) на экране, располагающая одну строку матрицы на одной строке экрана ******************************************************) procedure PrintMatrix (Var Matrix_: Matrix; nn, mm: integer); var i, j: integer; begin for i:=1 to nn do begin for j:=1 to mm do writeln('Matrix_[',i,',',j,']',Matrix_[i,j]); writeln; end; end; (****************************************************** Процедура печати матрицы реальной размерности (n,m) в файл, располагающая одну строку матрицы на одной строке ******************************************************) procedure PrintMatrixToFile (Var Matrix_: Matrix; Var String_: string; nn: integer); var i, j: integer; g:text; begin assign(g,String_); rewrite(g); for i:=1 to nn do begin for j:=1 to nn do begin write (g,matrix_[i,j]); write (g,' '); end; writeln(g); end; close(g); end; (****************************************************** Процедура попарной обработки строк прямоугольной матрицы ******************************************************) procedure Funky(Var Matrix_: Matrix; nn, mm: integer); var i,j,k,p,StSv: integer; Sum1,Sum2,Sum3: real; begin for k:=1 to nn do begin for p:=1 to nn do begin Sum1:=0; Sum2:=0; Sum3:=0; for j:=1 to mm do begin StSv:=0; Sum1:=Sum1+Matrix_[k,j]; Sum2:=Sum2+Matrix_[p,j]; end; {writeln('Sum1=',Sum1); writeln('Sum2=',Sum2); readln;} for j:=1 to mm do begin If (Matrix_[k,j]+Matrix_[p,j])<>0 then begin Sum3:=Sum3+((1/(Matrix_[k,j]+Matrix_[p,j]))* (Matrix_[k,j]/Sum1-Matrix_[p,j]/Sum2)* (Matrix_[k,j]/Sum1-Matrix_[p,j]/Sum2)); { writeln ('Sum3=',Sum3); readln;} end else inc(StSv); Sum3:=Sum3 end; Funk[k,p]:=Sum1*Sum2*Sum3; StepSv[k,p]:=mm-StSv; {writeln('Funk[',k,',',p,']',Funk[k,p]);} end; end; end; (******************************************************* Процедура замены в файле символа точки на символ запятой *******************************************************) procedure ExchSymbolInFile (var String1,String2:string; var symbol_1,symbol_2:char); var char_:char; g,f:text; begin assign (g,String1); reset(g); assign (f,String2); rewrite(f); while not eof(g) do begin while not eoln(g) do begin read(g,char_); if char_=symbol_1 then write(f,symbol_2) else write (f,char_); end; readln(g); writeln(f); end; close(f); close(g); end; begin file1:='matrix.txt'; file2:='matrixdat.txt'; s1:='.'; s2:=','; ExchSymbolInFile(file1,file2,s2,s1); EnterMatrixFromFile; readln; {PrintMatrix (Matr,n,m);} {writeln('Љ®­ва®«м а §¬Ґа  ¬ ваЁжл: ‘ва®Є n=',n,',','‘в®«Ўж®ў m=',m); readln;} Funky (Matr,n,m); Str:='matres.txt'; PrintMatrixToFile(Funk,Str,n); Str:='stepsv.txt'; PrintMatrixToFile(StepSv,Str,n); file1:='matres.txt'; file2:='matres_v.txt'; ExchSymbolInFile(file1,file2,s1,s2); file1:='stepsv.txt'; file2:='stepsv_v.txt'; ExchSymbolInFile(file1,file2,s1,s2); end.