Диманические массивы в Паскале

[Sazary]

Сообщение от tanek

Можно ли записать процедуру ChangeCoordinates???
а именно

Перепутали темы?

[world12_tk]

Здраствуйте уважаемые пользователи. У меня не правильно считывается квадратная матрица из файла. Это все из-за проверки условия на размерность. Помогите исправить ее.Заранее благодарен. вот исходный код:
Код:

program Project1;

  {$N+}
{$R-}

type
  Element_type=integer;
type
  PVector=^Vector;
  Vector = array [1..1] of Element_type;
  MatrixPtr=^Matr;
  Matr=array[1..1] of PVector;

procedure ProgramDescription;
begin
  writeln ('программа для вычисления среднего арифметического значения');
  writeln (' отрицательных элементов под главной диагональю матрицы A(K,K)');
  writeln ('для продолжении работы нажмите клавишу Enter');
  readln;
end;

procedure OpenFile(var fin:text);
var
  input_name:string;
begin
  writeln('введите имя файла');
  readln(input_name);
  assign(fin,input_name);
  {+$I}
    reset(fin);
  {-$I}
  if (IOResult<>0) then
  begin
    writeln('файл не найден. Выход');
    readln;
    halt;
  end;
end;

procedure DynamicMemoryReservation (var fin:text; dim:integer;var matrix:MatrixPtr);
var
  i:integer;
begin
  Getmem(matrix,dim*sizeof(PVector));
  for i:=1 to dim do
    Getmem(matrix^[i],dim*sizeof(Element_type));
end;

procedure Inputmatrixix (var fin:text; dim:integer; var matrix:MatrixPtr);
var
  i,j:integer;
begin
  for i:=0 to dim-1  do
    for j:=0 to dim-1 do
      read (fin,matrix^[i]^[j]);
end;

procedure RangeChecking(var fin:text;dim:integer);
var
  count:integer;
  element:integer;
begin
  count:=0;
  if (dim<=0) then
  begin
    writeln('размерность должна быть >0. Завершение программы');
    readln;
    halt;
  end;
  while not EOF(fin) do
  begin
    read(fin,element);
    inc(count);
  end;
  writeln('количество элементов в файле =',count-1);
  if (count-1)<>sqr(dim) then
  begin
    writeln('количество элементов должно совпадать с размерностью матрицы. Выход');
    readln;
    halt;
  end;
close(fin);
  reset(fin);
end;

3

procedure PaddingMatrixOfDynamicMemoryAllocation(var dim:integer; var matrix:MatrixPtr);
var
  fin:text;
begin
  ProgramDescription;
  OpenFile(fin);
  readln(fin,dim);
  DynamicMemoryReservation(fin,dim,matrix);
  RangeChecking(fin,dim);
  Inputmatrixix (fin,dim,matrix);
  close(fin);
end;

procedure Outputmatrixix(dim:integer; matrix:MatrixPtr);
var
  i,j:integer;
begin
  writeln('исходная матрица');
  for i := 0 to dim-1 do
  begin
     for j := 0 to dim-1 do
        write(matrix^[i]^[j]  , ' ');
     writeln;
  end;
end;

procedure CalculationOfArithmeticMeanValue (dim:integer; matrix:MatrixPtr;var num_neg: integer; var  sum: double);
var
  i, j: integer;
  sum_neg: double;
begin
  sum_neg := 0;
  num_neg := 0;
  for i := 1 to dim-1 do
     for j := 0 to i-1 do
        if matrix^[i]^[j] < 0 then
        begin
           num_neg := num_neg + 1;
           sum_neg := sum_neg + matrix^[i]^[j];
        end;
  if num_neg>0 then
  sum:= -1*sum_neg/num_neg;

end;

procedure DynamicMemoryLiberation(dim:integer; var matrix:MatrixPtr);
var
  i:integer;
begin

  for i:=1 to dim do
     FreeMem(matrix^[i],dim*sizeof(Element_type));
   FreeMem(matrix,dim*sizeof(PVector));
end;

procedure OutputOfArithmeticMeanValue (num_neg:integer; sum:double);
var
  fout:text;

begin
  assign(fout,'output.txt');
  rewrite(fout);
  if num_neg > 0 then
  begin
     write(fout,'среднее арифметическое значение под главной диагональю = ',sum:4:3);
  end
  else
     write(fout,'отрицательных элементов под главной диагональю нет');
  writeln('результат программы сохранены в файле  OUTPUT.TXT');
  writeln ('для завершении работы нажмите клавишу Enter');
  readln;
  close(fout);
end;

var
  matrix:MatrixPtr;
  dim: integer;
  sum: double;
  num_neg: integer;
  fint:text;
  input_name:string;

begin
  PaddingMatrixOfDynamicMemoryAllocation(dim,matrix);
  Outputmatrixix(dim,matrix);
  CalculationOfArithmeticMeanValue (dim,matrix,num_neg,sum);
  DynamicMemoryLiberation(dim,matrix);
  OutputOfArithmeticMeanValue (num_neg,sum);
end.

[Sazary]

world12_tk, Вам нужно было создать свою тему.

program Project1;

  {$N+}
{$R-}

type
  Element_type=integer;
type
  PVector=^Vector;
  Vector = array [1..1] of Element_type;
  MatrixPtr=^Matr;
  Matr=array[1..1] of PVector;

procedure ProgramDescription;
begin
  writeln ('программа для вычисления среднего арифметического значения');
  writeln (' отрицательных элементов под главной диагональю матрицы A(K,K)');
  writeln ('для продолжении работы нажмите клавишу Enter');
  readln;
end;

procedure OpenFile(var fin:text);
var
  input_name:string;
begin
  writeln('введите имя файла');
  readln(input_name);
  assign(fin,input_name);
  {+$I}
    reset(fin);
  {-$I}
  if (IOResult<>0) then
  begin
    writeln('файл не найден. Выход');
    readln;
    halt;
  end;
end;

procedure DynamicMemoryReservation (var fin:text; dim:integer;var matrix:MatrixPtr);
var
  i:integer;
begin
  Getmem(matrix,dim*sizeof(PVector));
  for i:=0 to dim-1 do
    Getmem(matrix^[i],dim*sizeof(Element_type));
end;

procedure Inputmatrixix (var fin:text; dim:integer; var matrix:MatrixPtr);
var
  i,j:integer;
begin
  for i:=0 to dim-1  do
    for j:=0 to dim-1 do
      read(fin,matrix^[i]^[j]);
end;

procedure RangeChecking(var fin:text;dim:integer);
var
  count:integer;
  element:integer;
begin
  count:=0;
  if (dim<=0) then
  begin
    writeln('размерность должна быть >0. Завершение программы');
    readln;
    halt;
  end;
  while not EOF(fin) do
  begin
    read(fin,element);
    inc(count);
  end;
  writeln('количество элементов в файле =',count);
  if (count)<>sqr(dim) then
  begin
    writeln('количество элементов должно совпадать с размерностью матрицы. Выход');
    readln;
    halt;
  end;
close(fin);
reset(fin);
read(fin,dim);
end;


procedure PaddingMatrixOfDynamicMemoryAllocation(var dim:integer; var matrix:MatrixPtr);
var
  fin:text;
begin
  ProgramDescription;
  OpenFile(fin);
  readln(fin,dim);
  DynamicMemoryReservation(fin,dim,matrix);
  RangeChecking(fin,dim);
  Inputmatrixix (fin,dim,matrix);
  close(fin);
end;

procedure Outputmatrixix(dim:integer; matrix:MatrixPtr);
var
  i,j:integer;
begin
  writeln('исходная матрица');
  for i := 0 to dim-1 do
  begin
     for j := 0 to dim-1 do
        write(matrix^[i]^[j]  , ' ');
     writeln;
  end;
end;

procedure CalculationOfArithmeticMeanValue (dim:integer; matrix:MatrixPtr;var num_neg: integer; var  sum: double);
var
  i, j: integer;
  sum_neg: double;
begin
  sum_neg := 0;
  num_neg := 0;
  for i := 0 to dim-1 do
     for j := 0 to i-1 do
        if matrix^[i]^[j] < 0 then
        begin
           num_neg := num_neg + 1;
           sum_neg := sum_neg + matrix^[i]^[j];
        end;
  if num_neg>0 then
  sum:= -1*sum_neg/num_neg;

end;

procedure DynamicMemoryLiberation(dim:integer; var matrix:MatrixPtr);
var
  i:integer;
begin

  for i:=0 to dim-1 do
     FreeMem(matrix^[i],dim*sizeof(Element_type));
   FreeMem(matrix,dim*sizeof(PVector));
end;

procedure OutputOfArithmeticMeanValue (num_neg:integer; sum:double);
var
  fout:text;

begin
  assign(fout,'output.txt');
  rewrite(fout);
  if num_neg > 0 then
  begin
     write(fout,'среднее арифметическое значение под главной диагональю = ',sum:4:3);
  end
  else
     write(fout,'отрицательных элементов под главной диагональю нет');
  writeln('результат программы сохранены в файле  OUTPUT.TXT');
  writeln ('для завершении работы нажмите клавишу Enter');
  readln;
  close(fout);
end;

var
  matrix:MatrixPtr;
  dim: integer;
  sum: double;
  num_neg: integer;
  fint:text;
  input_name:string;

begin
  PaddingMatrixOfDynamicMemoryAllocation(dim,matrix);
  Outputmatrixix(dim,matrix);
  CalculationOfArithmeticMeanValue (dim,matrix,num_neg,sum);
  OutputOfArithmeticMeanValue (num_neg,sum);
  DynamicMemoryLiberation(dim,matrix);
end.

[world12_tk]

Извените. просто увидел похожую тему, вот и подумал сюда обратиться)))
Большое спасибо