двумерные массивы

[world12_tk]

Добрый день уважаемые форумчанины. У меня возникли маленькая проблема. Мне нужно написать программу, которая считывает матрицуA(N,M), где N<=50, M<=30 из файла, потом присваевает максимальному элементу столбца 1, а минимальному элементу -1. Вывести преобразованную матрицу на экран и записать в файл output.txt.
Вот мой исходный код:

Program Matrix14;

const
  N=50;
  M=30;
type
  matrix=array[1..N,1..M] of integer;

procedure TheTask;
begin
  writeln('Программа присваивает значение +1 максимальному элементу столбца');
  writeln('и -1 минимальному элементу столбца матрицы A(K,L),где K<=50,L<=30');
  writeln;
end;
procedure DefinitionMatrix(var name_file:string;var line:integer; var column:integer);
begin
  writeln('введите название файла');
  readln(name_file);
end;
procedure OpenFile(name_file:string; var fin:text);
begin
  assign(fin,name_file);
  {+$I}
    reset(fin);
  {-$I}
end;

procedure InputMatrix(var line:integer;var column:integer;var fin:text; var matr:matrix);
var
 i,j:integer;
begin
  read(fin,line);
  read(fin,column);
  for i:=1 to line do
  begin
    for j:=1 to column do
      read (fin,matr[i,j]);
  end;
  close(fin);
end;

procedure InitialMatrix(line:integer; column:integer; var matr:matrix);
var
  i,j:integer;
begin
  writeln('Исходная мотрица:');
  for i:=1 to line do
    begin
      for j:=1 to column do
        write(matr[i,j]:4);
      writeln;
    end;
  writeln;
end;

procedure FindingMinElement(line:integer; column:integer; var matr:matrix);
var
  min : integer;
  i,j:integer;
begin
  for j := 1 to column do
    begin
      min :=matr[1,j];
      for i := 1 to line do
      begin
        if(matr[i,j] <= min) Then
           min := matr[i,j];
      end;
       { теперь идем по столбцу еще раз и сравниваем элементы с минимумом}
      for i:=1 to line do
        if matr[i,j] = min then matr[i,j] := -1;
    end;
end;

procedure FindingMaxElement(line:integer; column:integer; var matr:matrix);
var
  max: integer;
  i,j:integer;
begin
  for j := 1 to column do
  begin
    max :=matr[1,j];
    for i := 1 to line do
    begin
      if(matr[i,j] >= max) Then
         max := matr[i,j];
    end;
    for i := 1 to line do
      if matr[i,j] = max then matr[i,j] := 1;
  end;
end;
procedure OpenOutputFile(var fout:text);
begin
  assign(fout,'output.txt');
  rewrite(fout);
end;
procedure OutputMatrixInFile(line:integer; column:integer;var fout:text; var matr:matrix);
var
  i,j:integer;
begin
  for i:=1 to line do
     for j:=1 to column do
        write(fout,matr[i,j]:4,' ');
        writeln;

  close(fout);
end;

procedure OutputMatrix(line:integer; column:integer;var matr:matrix);

var
  i,j:integer;
begin
  for i:=1 to line do
     begin
     for j:=1 to column do
        write(matr[i,j]:4);
        writeln;
     end;
end;
procedure EndOfProgram;
begin
   writeln('результаты работы сохранены в файле output.txt');
   writeln('Для завершения программы нажмите Enter');
   readln;
end;

var
   line, column:integer;
   matr:matrix;
   name_file:string;
   fin,fout:text;
begin
   TheTask;
   DefinitionMatrix(name_file,line,column);
   OpenFile(name_file,fin);
   InputMatrix(line,column,fin,matr);
   InitialMatrix(line,column,matr);
   FindingMinElement(line,column,matr);
   FindingMaxElement(line,column,matr);
   OpenOutputFile(fout);
   OutputMatrixInFile(line,column,fout,matr);
   OutputMatrix(line,column,matr);

   EndOfProgram;
end.

Проблема в том, что я не могу вывести в файл матрицу. Она выводиться строкой. Подскажите мне пожалуйста....
Заранее спасибо...)

[__STDC__]

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

[Juffin]

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

procedure OpenOutputFile(var fout:text);
begin
  assign(fout,'output.txt');
  rewrite(fout);
end;
procedure OutputMatrixInFile(line:integer; column:integer;var fout:text; var matr:matrix);
var
  i,j:integer;
begin
  for i:=1 to line do
     for j:=1 to column do
        write(fout,matr[i,j]:4,' ');
        writeln;

  close(fout);
end;

может, так?

procedure OpenOutputFile(var fout:text);
begin
  assign(fout,'output.txt');
  rewrite(fout);
end;
procedure OutputMatrixInFile(line:integer; column:integer;var fout:text; var matr:matrix);
var
  i,j:integer;
begin
  for i:=1 to line 
  do begin
     for j:=1 to column do
        write(fout,matr[i,j]:4,' ');
        writeln(fout);
     end;
  close(fout);
end;

[alex_fcsm]

Извиняюсь за русские буквы
Процедуры поиска минимумов и максимумов объхединил в одну и так по мелочи: подправил запись в файл и считывание из файла.

Program Matrix14;
uses crt;
const
  N=50;
  M=30;
type
  matrix=array[1..N,1..M] of integer;

procedure TheTask;
begin
  writeln('Ïðîãðàììà ïðèñâàèâàåò çíà÷åíèå +1 ìàêñèìàëüíîìó ýëåìåíòó ñòîëáöà');
  writeln('è -1 ìèíèìàëüíîìó ýëåìåíòó ñòîëáöà ìàòðèöû A(K,L),ãäå K<=50,L<=30');
  writeln;
end;
procedure DefinitionMatrix(var name_file:string;var line:integer; var column:integer);
begin
  writeln('ââåäèòå íàçâàíèå ôàéëà');
  readln(name_file);
end;
procedure OpenFile(name_file:string; var fin:text);
begin
  assign(fin,name_file);
  {+$I}
    reset(fin);
  {-$I}
end;

procedure InputMatrix(var line:integer;var column:integer;var fin:text; var matr:matrix);
var
 i,j:integer;
begin
  line:=0;
  while not(eof(fin)) do
   begin
    inc(line);
    column:=0;
    while not (eoln(fin)) do
      begin
       read(fin,i);
       inc(column);
       matr[line,column]:=i;
      end;
      readln(fin);
   end;
  close(fin);
end;

procedure InitialMatrix(line:integer; column:integer; var matr:matrix);
var
  i,j:integer;
begin
  clrscr;
  writeln('Èñõîäíàÿ ìîòðèöà:');
  for i:=1 to line do
    begin
      for j:=1 to column do
        write(matr[i,j]:6);
      writeln;
    end;
  writeln;
end;

procedure FindingElement(line:integer; column:integer; var matr:matrix);
var
  min,max : integer;
  i,j:integer;
begin
   for j:=1 to column do
    begin
     min:=1;max:=1;
      for i:=2 to line do
       if matr[i,j]<matr[min,j] then min:=i
          else if matr[i,j]>matr[max,j] then max:=i;
      matr[max,j]:=1;
      matr[min,j]:=-1;
    end;
end;


procedure OpenOutputFile(var fout:text);
begin
  assign(fout,'c:\output.txt');
  rewrite(fout);
end;
procedure OutputMatrixInFile(line:integer; column:integer;var fout:text; var matr:matrix);
var
  i,j:integer;
begin
  for i:=1 to line do
   begin
     for j:=1 to column do
        write(fout,matr[i,j]:6,' ');
        writeln(fout);
   end;
  close(fout);
end;

procedure OutputMatrix(line:integer; column:integer;var matr:matrix);

var
  i,j:integer;
begin
  for i:=1 to line do
     begin
     for j:=1 to column do
        write(matr[i,j]:6);
        writeln;
     end;
end;
procedure EndOfProgram;
begin
   writeln('ðåçóëüòàòû ðàáîòû ñîõðàíåíû â ôàéëå output.txt');
   writeln('Äëÿ çàâåðøåíèÿ ïðîãðàììû íàæìèòå Enter');
   readln;
end;

var
   line, column:integer;
   matr:matrix;
   name_file:string;
   fin,fout:text;
begin
   TheTask;
   DefinitionMatrix(name_file,line,column);
   OpenFile(name_file,fin);
   InputMatrix(line,column,fin,matr);
   InitialMatrix(line,column,matr);
   FindingElement(line,column,matr);
   OpenOutputFile(fout);
   OutputMatrixInFile(line,column,fout,matr);
   OutputMatrix(line,column,matr);
   EndOfProgram;
end.

P.S. O_o

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



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.