Обработка прямоугольных матриц Опции

[ProtasSoft]

Вот этот код работает

program ReadMatrixFromFile;
 const
  NMAX = 100;
  MMAX = 100;
type
  Matrix = array [1..NMAX, 1..MMAX] of real;
var
  M: Matrix;
  

(***************************************************
            Процедура ввода матрицы из файла
****************************************************)
procedure EnterMatrixFromFile (Matr:Matrix);

var
  n,m,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;
       n:=i;
       m:=j-1;
       writeln('n=',n,',','m=',m);
       readln(f); inc(i);
   end;

   close(f);
 end;

 begin
        EnterMatrixFromFile(M);
        readln;
 end.

[/quote]

Сообщение отредактировано: ProtasSoft - 16.08.2005 13:26

[volvo]

ProtasSoft, ТОЛЬКО приведенный тобой код работает? Я же просил тебя привести описание Matrix, иначе я не могу заставить программу работать так, как ТЫ этого хочешь, тут телепатов нет. Задавай вопросы корректно...

Кстати, чем тебе не понравился мой код? Что именно не работает в нем? И не надо говорить "ВСЕ" или "Просто не работает"... Если ты говоришь, что код нерабочий, будь добр привести пример программы, и файла, для которых произошла ошибка. Голословных утверждений я не принимаю.

[ProtasSoft]

Если что-то не так сказал прошу прощения.
Далее написал код вместе с функцией попарной обработки строк, но где-то в ней ошибки.

Код

program Matrix_Process;
(******************************************************
* Демонстрация работы с двумерными массивами          *
* (матрицами)                                         *
******************************************************)
const
 NMAX = 100;
 MMAX = 100;
type
 Matrix = array [1..NMAX, 1..MMAX] of real;
var
 M: Matrix;


(***************************************************
           Процедура ввода матрицы из файла
****************************************************)
procedure EnterMatrixFromFile (Matr:Matrix);

var
 n,m,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;
   m:=j-1;
   writeln('n=',n,',','m=',m);
end;
(*****************************************************
      Функция обработки всех пар строк матрицы
******************************************************)
Function Funky(Matr:Matrix):Matrix;
var
 i,j,k,p: integer;
 Sum1,Sum2,Sum3: real;
begin
   for k:=1 to n do
    begin
     for p:=1 to n do
       begin
           Sum1:=0; Sum2:=0;Sum3:=0;
              for j:=1 to m do
              begin
              Sum1:=Sum1+Matr[k,j];
              Sum2:=Sum2+Matr[p,j];
              end;

              for j:=1 to m do
              Sum3:=Sum3+1/(Matr[k,j]+Matr[p,j])*(Matr[k,j]/Sum1-Matr[p,j]/Sum2)*;
              end;
              Funky[k,p]:=Sum1*Sum2*Sum3;
              writeln('Funky[',k,',',p,']',Funky[k,p]);
       end;
    end;

end;

begin
       EnterMatrixFromFile(M);
       Funky(Matr);
       readln;
end.

[klem4]

где-то в ней ошибки.

1) для функции funky не определены размеры прочтенного массива

2) непонятная рекурсия в той-же ф-и (вызываешь ф-ю в ней самой с совершенно непонятными параметрами)

3) синтаксические ошибки

Сообщение отредактировано: klem4 - 16.08.2005 14:42

[klem4]

Я убрал все синтаксические ошибки, и кое-что добавил, но так как я не знаю что должна считать твоя ф-я, да и вообще она выглядит крайне странно, дальше разбирайся сам, теперь программа по крайней мере компилируется.

Исходный код

uses crt;

const
NMAX = 1000;
MMAX = 2000;
type

Matrix = array [1..NMAX, 1..MMAX] of real;

var

M: Matrix;

row,col:integer;

procedure EnterMatrixFromFile (Matr:Matrix; var size1,size2:integer);

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);

size1:=i;
size2:=j-1;

writeln('n=',size1,',','m=',size2);
end;


Function Funky(var Matr:Matrix; size1,size2:integer):Matrix;
var

i,j,k,p: integer;
Sum1,Sum2,Sum3: real;

begin

for k:=1 to size1 do
for p:=1 to size1 do begin

Sum1:=0; Sum2:=0;Sum3:=0;

for j:=1 to size2 do begin

Sum1:=Sum1+Matr[k,j];
Sum2:=Sum2+Matr[p,j];
end;

for j:=1 to size2 do
Sum3:=Sum3+1/(Matr[k,j]+Matr[p,j])*(Matr[k,j]/Sum1-Matr[p,j]/Sum2);
end;

Funky[k,p]:=Sum1*Sum2*Sum3;

writeln('Funky[',k,',',p,']',Funky[k,p]);

end;




Begin

EnterMatrixFromFile(M,row,col);

Funky(M,row,col);

readln;

End.

ЗЫ правильность чтения я не проверял, только исправил явные ошибки!

[volvo]

klem4, как ты думаешь, что будет в массиве Matr после вызова этой процедуры? Ничего не забыл? ;) Var, например...

procedure EnterMatrixFromFile(Matr: Matrix; var size1, size2: integer);

[klem4]

Да, это я проглядел :yes: ... ProtasSoft в заголовке этой ф-и перед Matr:Matrix
поставь var

[ProtasSoft]

Коллеги, вот что у меня получилось с учетом Ваших советов и вроде рабоает.
Правда, я не смог справиться с глобальной переменной массива Matr в первой процедуре ввода массива из файла.
Может чего подскажите.

Кстати, изменил размерность до 1000Х2000 программа перстала работать.

Исходный код

program Matrix_Process;
(******************************************************
* Демонстрация работы с двумерными массивами *
* (матрицами) *
******************************************************)
const
NMAX = 20;
MMAX = 20;
type
Matrix = array [1..NMAX, 1..MMAX] of real;
var
Matr, M1,M2: Matrix;
n,m: integer;

(***************************************************
Процедура ввода матрицы из текстового файла
****************************************************)
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 (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,n)
в текстовый файл

******************************************************)
procedure PrintMatrixToFile (Matrix_: Matrix; nn: integer);
var
i, j: integer;
g:text;
begin

assign(g,'matres.txt');
rewrite(g);

for i:=1 to nn do
begin
for j:=1 to nn do
begin
write (g,Matrix_[i,j]);
end;
writeln(g);
end;
close(g);
end;

procedure Funky(Matrix_: Matrix; nn, mm: integer);
var
i,j,k,p: integer;
Sum1,Sum2,Sum3: real;
Funk:Matrix;

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
Sum1:=Sum1+Matrix_[k,j];
Sum2:=Sum2+Matrix_[p,j];
end;

for j:=1 to mm do
begin
If (Matrix_[k,j]+Matrix_[p,j])<>0 then
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)
else
Sum3:=Sum3;
end;
Funk[k,p]:=Sum1*Sum2*Sum3;
writeln('Funk[',k,',',p,']',Funk[k,p]);

end;
end;
PrintMatrixToFile(Funk,nn);
end;

begin
EnterMatrixFromFile;
readln;
PrintMatrix (Matr,n,m);
PrintMatrixToFile(Matr,n);
readln;
Funky (matr,n,m);
readln;

end.

Сообщение отредактировано: volvo - 9.09.2005 14:00

[volvo]

Кстати, изменил размерность до 1000Х2000 программа перстала работать.

Насколько я вижу, эта программа и не должна работать при больших размерностях - здесь Var тоже был упущен, следовательно при изменении размерности до 1000х2000 программа отказывается работать - просто переполняется стек, так как массив передается не по ссылке, а по значению. Вот так измени:

procedure Funky(Var Matrix_: Matrix; nn, mm: integer);

[ProtasSoft]

Изменил , все равно не работает.

[volvo]

Значит, так... Поменяй следующее:

1.

procedure PrintMatrix (Matrix_: Matrix; nn, mm: integer);

на

procedure PrintMatrix (Var Matrix_: Matrix; nn, mm: integer);

2.

procedure PrintMatrixToFile (Matrix_: Matrix; nn: integer);

на

procedure PrintMatrixToFile (Var Matrix_: Matrix; nn: integer);

3.

procedure Funky(Matrix_: Matrix; nn, mm: integer);
var
  i,j,k,p: integer;
  Sum1,Sum2,Sum3: real;
  Funk:Matrix;
...

на

var
  Funk:Matrix;

procedure Funky(Var Matrix_: Matrix; nn, mm: integer);
var
  i,j,k,p: integer;
  Sum1,Sum2,Sum3: real;
...

И все заработает

[ProtasSoft]

Я извиняюсь, вроде заработало.

[ProtasSoft]

Коллеги, вот что у меня получилось

Исходный код

program Matrix_Process;
(******************************************************
* Демонстрация работы с двумерными массивами *
* (матрицами) *
******************************************************)
const
NMAX = 3000;
MMAX = 3000;
type
Matrix = array [1..NMAX, 1..MMAX] of real;
var
Funk, Matr: Matrix;
n,m: integer;

(***************************************************
Процедура ввода матрицы из файла
****************************************************)
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;

(******************************************************
Процедура печати матрицы размерности nn в текстовый файл
******************************************************)
procedure PrintMatrixToFile (Var Matrix_: Matrix; nn: integer);
var
i, j: integer;
g:text;
begin

assign(g,'matres.txt');
rewrite(g);

for i:=1 to nn do
begin
for j:=1 to nn do
begin
write (g,Matrix_[i,j]);
end;
writeln(g);
end;
close(g);
end;

(***********************************************
Процедура попарной обработки строк матрицы
************************************************)
procedure Funky(Var Matrix_: Matrix; nn, mm: integer);
var
i,j,k,p: 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
Sum1:=Sum1+Matrix_[k,j];
Sum2:=Sum2+Matrix_[p,j];
end;

for j:=1 to mm do
begin
If (Matrix_[k,j]+Matrix_[p,j])<>0 then
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)
else
Sum3:=Sum3;
end;
Funk[k,p]:=Sum1*Sum2*Sum3;
{writeln('Funk[',k,',',p,']',Funk[k,p]);}

end;
end;

end;

(***********************************************
Процедура замены точки на запятую в текстовом файле
************************************************)

procedure RedactirFile;
var
f,g:text;
char_:char;

begin

assign(g,'matres.txt');
reset(g);
assign (f,'matres_v.txt');
rewrite(f);

while not eof(g) do
begin

while not eoln(g) do
begin
read(g,char_);
if char_='.' then
write(f,',')
else
write (f,char_);
end;
readln(g);
writeln(f);
end;
close(f);
close(g);
end;

begin
EnterMatrixFromFile;
readln;
{PrintMatrix (Matr,n,m);}
Funky (Matr,n,m);
PrintMatrixToFile(Funk,n);
RedactirFile;
end.

[ProtasSoft]

Коллеги, пробовал ниже приведенную программку на матрице размером
200Х200 результат был.
Попробовал матрицу размером 600Х400 программа зависает, а если предложить переварить матрицу большего размера, выдается системная ошибка Windows. Есть подозрения, что память все же не хватает.
Подскажите как выйти из положения.
В качестве выхода хочу попровать очистить память от массива, который уже сохранен в файлю. Как это сделать (если возможно)?

Сообщение отредактировано: volvo - 5.03.2009 23:18

[volvo]

Заархивируй свой исходник вместе с файлом данных и присоедини к сообщению. Тогда можно будет говорить об исправлении. Иначе - никак. Возможно что-то не то именно с файлом данных...

[volvo]

ProtasSoft, та программа, которую ты привел, завершается ошибкой по очень банальной причине: ты объявил тип Matrix как матрицу из 700 строк, а в файле данных у тебя строк БОЛЬШЕ (конкретно - 1227), поэтому при попытке доступа к 701 строке программа и вылетает...

После увеличения количества строк в матрице до 1700 она нормально прочиталась, но в строке

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));

(процедура Funky) происходит RunTime Error 207 (деление на 0) - ты хоть и проверяешь

If (Matrix_[k,j]+Matrix_[p,j])<>0 then ...

но у тебя нулю равно sum2, а на него ты делишь... Это тоже надо проверять...
Так что проблемы не в недостатке памяти, просто будь внимательнее... :yes:

[ProtasSoft]

Огромное спасибо. Заработало!
:flowers:
Сообщения разделены в тему Библиотека математических функций

Сообщение отредактировано: volvo - 18.08.2005 18:43

[ProtasSoft]

Снабдил программу Гаммой-функцией и процедурой интегрирования по симпсону. Возникли какие-то проблемы с компиляцией в старых процедурах. Подскажите где баг.

[volvo]

Если ты про проблему с компиляцией функции Simps, то там просто не определена переменная A, сделай что-то типа:

Function Simps(b:extended;m:integer):extended;
var
  sum, h, a: extended;
  N, j:Integer;
begin
  N:=1000; a := 0; { так как у тебя интервал начинается с 0 }
  h:=(b - a)/N;
  sum:=0.5*(power(b,-1+m/2)*exp(-b/2));
  for j:=1 to N-1 do
    sum:=sum+(j mod 2+1)*power(j*h,-1+m/2)*exp(-j*h/2);
  Simps:=2*h*sum/3
end;

Больше явных багов не нашел... После этого изменения программа компилируется нормально...

[ProtasSoft]

После запуска проги выскакивает системная ошибка.
Исправленный исходник и файл данных в аттаче.