Диманические массивы в Паскале - Помощь студентам

tanek · 01.05.2009, 23:24

Добрай вечер!!! Мне необходимо сделать программу, котроя присваивает наибольшему элементу столбца матрицы +1, а наименьшему -1. Проблемма в том, что необходимо это с делать с помощью динамического массива...я сделала,, но почему то не работает .Не могли бы вы мне помочь....

Код:

Program Matrix14;

const
  N=50;
  M=30;
type
  MyType=word;
type
  PMyMatrix=^MyMatrix;
  MyMatrix=array[1..1] of MyType;

  MyArrayPtr=^MyArray;
  MyArray=array[1..1] of PMyMatrix;


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 Dinamics (var fin:text; var line,column:integer; var matrix:MyArrayPtr);
var
  i,j:integer;
begin
  read(fin,line);
  read(fin,column);

   Getmem(matrix,column*sizeof(PMyMatrix));
    for i:=1 to line do
      Getmem(matrix^[i],column*sizeof(MyType));
    for i:=1 to column do
      for j:=1 to column do
        matrix^[i]^[j]:=i*j;
end;

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

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

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

procedure FindingMaxElement(line:integer; column:integer; var matrix:MyArrayPtr);
var
  max: integer;
  i,j:integer;
begin
  for j := 1 to column do
  begin
    max :=matrix^[i]^[j];
    for i := 1 to line do
    begin
      if(matrix^[i]^[j] >= max) Then
         max := matrix^[i]^[j];
    end;
    for i := 1 to line do
      if matrix^[i]^[j] = max then matrix^[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 matrix:MyArrayPtr);
var
  i,j:integer;
begin
  for i:=1 to line do
  begin
     for j:=1 to column do
        write(fout,matrix^[i]^[j]:4,' ');
        writeln(fout);
   end;
  close(fout);
end;

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

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



var
   line, column:integer;
   matrix:MyArrayPtr;
   name_file:string;
   fin,fout:text;
begin
   TheTask;
   DefinitionMatrix(name_file,line,column);
   OpenFile(name_file,fin);
   Dinamics (fin,line,column,matrix);
   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);
   OutDinamics(column,matrix);

   EndOfProgram;
end.

зарание спасибо

Sazary · 01.05.2009, 23:50

Исправил:

Код:

Program Matrix14;

const
  N=50;
  M=30;
type
  MyType=integer;
type
  PMyMatrix=^MyMatrix;
  MyMatrix=array[1..1] of MyType;

  MyArrayPtr=^MyArray;
  MyArray=array[1..1] of PMyMatrix;


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 Dinamics (var fin:text; var line,column:integer; var matrix:MyArrayPtr);
var
  i,j:integer;
begin
  read(fin,line);
  read(fin,column);

   Getmem(matrix,column*sizeof(PMyMatrix));
    for i:=1 to line do
      Getmem(matrix^[i],column*sizeof(MyType));
    for i:=1 to column do
      for j:=1 to column do
        matrix^[i]^[j]:=i*j;
end;


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

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

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

procedure FindingMaxElement(line:integer; column:integer; var matrix:MyArrayPtr);
var
  max: integer;
  i,j:integer;
begin
  for j := 1 to column do
  begin
    max :=matrix^[1]^[j];
    for i := 1 to line do
    begin
      if(matrix^[i]^[j] >= max) Then
         max := matrix^[i]^[j];
    end;
    for i := 1 to line do
      if matrix^[i]^[j] = max then matrix^[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 matrix:MyArrayPtr);
var
  i,j:integer;
begin
  for i:=1 to line do
  begin
     for j:=1 to column do
        write(fout,matrix^[i]^[j]:4,' ');
        writeln(fout);
   end;
  close(fout);
end;

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

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


procedure OutDinamics(column:integer; var matrix:MyArrayPtr);
var
  i:integer;
begin
  for i:=1 to column do
    FreeMem(matrix^[i],column*sizeof(MyType));
    FreeMem(matrix,column*sizeof(PMyMatrix));
end;


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

   EndOfProgram;
end.

tanek · 02.05.2009, 00:37

Огромное спасибо, вы мне очень помогли))))))))))

уважаемый Sazary, а не подскажите почему мы массиву присваиваем

Код:

matrix^[i]^[j]:=i*j;

???
и данная программа почему то не считает матрицу, если она прямоугольная???????????

Sazary · 04.05.2009, 22:06

Цитата:

и данная программа почему то не считает матрицу, если она прямоугольная???????????

Почему же? Все считывает. Все работает. Пример исходного файла:

Код:

Цитата:

а не подскажите почему мы массиву присваиваем

Не знаю ) Это же вы писали.
Вообще, это присваивание не нужно, т.к. матрица загружается из файла.

tanek · 04.05.2009, 22:18

ммм....и еще почему

Код:

 Getmem(matrix,column*sizeof(PMyMatrix));
    for i:=1 to line do
      Getmem(matrix^[i],column*sizeof(MyType));
    for i:=1 to column do
      for j:=1 to column do
        matrix^[i]^[j]:=i*j;

и

Код:

begin
  for i:=1 to column do
    FreeMem(matrix^[i],column*sizeof(MyType));
    Free

различаются в написании???
ведь эти процедуры не должныбыть идентичны?

Sazary · 04.05.2009, 22:30

Там, походу, так должно быть:

Код:

 Getmem(matrix,line*sizeof(PMyMatrix));

И очистка:

Код:

for i:=1 to line do
    FreeMem(matrix^[i],column*sizeof(MyType));

tanek · 05.05.2009, 23:19

Добрый вечер!!!!
У меня возникла опять проблемка...Я подредактировала данную програму, но теперь она не правильно выводит матрицу на экран, хотя записывает в файл ее правильно,не могли бы вы посмотреть в чем проблема!!!

Код:

Program Matrix14;

const
  N=50;
  M=30;
type
  MyType=integer;
type
  PMyMatrix=^MyMatrix;
  MyMatrix=array[1..1] of MyType;

  MyArrayPtr=^MyArray;
  MyArray=array[1..1] of PMyMatrix;


procedure TheTask;
begin
  writeln('Программа присваивает значение +1 максимальному элементу столбца');
  writeln('и -1 минимальному элементу столбца матрицы A(K,L),где K<=50,L<=30');
  writeln;
end;


procedure OpenFile(name_file:string; var fin:text);
begin
  writeln('Введите название файла');
  readln(name_file);
  assign(fin,name_file);
  {+$I}
    reset(fin);
  {-$I}
end;

procedure ReadingDimnsion(var fin:text; var line,column:integer);
begin
  read(fin,line);
  read(fin,column);
end;

procedure AllocateMatrix ( line,column:integer; var matrix:MyArrayPtr);
var
  i,j:integer;
begin
   Getmem(matrix,line*sizeof(PMyMatrix));
    for i:=1 to line do
      Getmem(matrix^[i],column*sizeof(MyType));
    for i:=1 to column do
      for j:=1 to column do
end;


procedure InputMatrix(line:integer;column:integer; matrix:MyArrayPtr; var fin:text);
var
 i,j:integer;

begin
 for i:=1 to line do
  begin
    for j:=1 to column do
      read (fin,matrix^[i]^[j]);
  end;
  close(fin);
end;

procedure ReadingMatrixFromFileInDynamicArray(var line,column:integer; var matrix:MyArrayPtr);
var
  name_file:string;
  fin:text;
begin
   OpenFile(name_file,fin);
   ReadingDimnsion(fin,line,column);
   AllocateMatrix ( line,column,matrix);
   InputMatrix(line,column,matrix,fin);
end;

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

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

procedure ReplaceMaxElement(line:integer; column:integer; var matrix:MyArrayPtr);
var
  max: integer;
  i,j:integer;
begin
  for j := 1 to column do
  begin
    max :=matrix^[1]^[j];
    for i := 1 to line do
    begin
      if(matrix^[i]^[j] >= max) Then
         max := matrix^[i]^[j];
    end;
    for i := 1 to line do
      if matrix^[i]^[j] = max then matrix^[i]^[j]:=1;
  end;
end;


procedure OpenOutputFile(var fout:text);
begin
  assign(fout,'output.txt');
  rewrite(fout);
end;


procedure OutputMatrixToFile(line:integer; column:integer; var matrix:MyArrayPtr;var fout:text);
var
  i,j:integer;
begin
  for i:=1 to line do
  begin
     for j:=1 to column do
        write(fout,matrix^[i]^[j]:4,' ');
        writeln(fout);
   end;
  close(fout);
end;

procedure FreeMatrix(var fout:text;line,column:integer;matrix:MyArrayPtr);
var
  i:integer;
begin
  for i:=1 to line do
    FreeMem(matrix^[i],column*sizeof(MyType));
    FreeMem(matrix,column*sizeof(PMyMatrix));
end;


procedure WriteMatrixToFile(column,line:integer;var matrix:MyArrayPtr);
var
  fout:text;
begin
    OpenOutputFile(fout);
    OutputMatrixToFile(line,column,matrix,fout);
    FreeMatrix(fout,line,column,matrix);
end;

procedure PrintTransformedMatrix(line:integer;column:integer;matrix:MyArrayPtr);
var
  i,j:integer;
begin
  writeln('Преобразованная матрица:');
  for i:=1 to line do
     begin
     for j:=1 to column do
        write(matrix^[i]^[j]:4);
        writeln;
     end;
end;


procedure EndOfProgram;
begin
   writeln('Результат работы будет согранен в файле output.txt');
   writeln('Для завершения нажмите Enter');
   readln;
end;


var
   line, column:integer;
   matrix:MyArrayPtr;
begin
   TheTask;
   ReadingMatrixFromFileInDynamicArray(line,column,matrix);
   PrintMatrix(line,column,matrix);
   ReplaceMinElement(line,column,matrix);
   ReplaceMaxElement(line,column,matrix);
   WriteMatrixToFile(column,line,matrix);
   PrintTransformedMatrix(line,column,matrix);
   EndOfProgram;
end.

И не проверрите ли вы правильно и оформлены параметры вхожные и выходные,т.е. нет ли лишних var

Sazary · 06.05.2009, 12:41

Вы убиваете матрицу в функции вывода в файл. И потом пытаетесь ее вывести на экран.
Измененные процедуры:

Код:

procedure FreeMatrix(line,column:integer;matrix:MyArrayPtr);
var
  i:integer;
begin
  for i:=1 to line do
    FreeMem(matrix^[i],column*sizeof(MyType));
    FreeMem(matrix,column*sizeof(PMyMatrix));
end;


procedure WriteMatrixToFile(column,line:integer;matrix:MyArrayPtr);
var
  fout:text;
begin
    OpenOutputFile(fout);
    OutputMatrixToFile(line,column,matrix,fout);
end;

procedure PrintTransformedMatrix(line:integer;column:integer;var matrix:MyArrayPtr);
var
  i,j:integer;
begin
  writeln('Преобразованная матрица:');
  for i:=1 to line do
     begin
     for j:=1 to column do
        write(matrix^[i]^[j]:4);
        writeln;
     end;
  FreeMatrix(line,column,matrix);
end;

tanek · 07.05.2009, 00:22

Спасибочки))))

Уважаемый Sazary, а не подскажите ли вы ....как можно сделать проверку на то , что :в файле написана размерность3*3, а элементов там всего лишь 2????

Sazary · 11.05.2009, 22:57

Цитата:

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

Уважаемый Sazary, а не подскажите ли вы ....как можно сделать проверку на то , что :в файле написана размерность3*3, а элементов там всего лишь 2????

Пусть содержимое файла будет таким:

Код:

Первая строчка - задает размерность. То есть, 3 на 3.
Читаем следующую (1 2). Считаем сколько в ней пробелов. Их должно быть на 1 меньше количества столбцов (3). Но их 2. Значит, данные некорректны.
Так можно проверить каждую строку на соответствие количества элементов.

Чтобы проверить правильность первого числа (количество строк), соответственно, нужно посчитать сколько там строк.

Можно вместо пробелов считать сразу числа и потом сверить количество с размерностью.

02.05.2009, 00:37	#3
tanek Форумчанин Регистрация: 07.03.2009 Сообщений: 209	Огромное спасибо, вы мне очень помогли)))))))))) уважаемый Sazary, а не подскажите почему мы массиву присваиваем Код: `matrix^[i]^[j]:=ij;` ??? и данная программа почему то не считает матрицу, если она прямоугольная??????????? Последний раз редактировалось Stilet; 06.05.2009 в 12:54.*

04.05.2009, 22:18	#5
tanek Форумчанин Регистрация: 07.03.2009 Сообщений: 209	ммм....и еще почему Код: `Getmem(matrix,columnsizeof(PMyMatrix)); for i:=1 to line do Getmem(matrix^[i],columnsizeof(MyType)); for i:=1 to column do for j:=1 to column do matrix^[i]^[j]:=ij;` и Код: `begin for i:=1 to column do FreeMem(matrix^[i],columnsizeof(MyType)); Free` различаются в написании??? ведь эти процедуры не должныбыть идентичны?

04.05.2009, 22:30	#6
Sazary В тени Старожил Регистрация: 19.12.2008 Сообщений: 5,788	Там, походу, так должно быть: Код: `Getmem(matrix,linesizeof(PMyMatrix));` И очистка: Код: `for i:=1 to line do FreeMem(matrix^[i],columnsizeof(MyType));` Вполне очевидно, чтобы что-то понять, необходимо книги читать. Не нужно плодить бессмысленных тем. Вас Поиск избавит от многих проблем. ___________________________________ ___________________________________ _______ [=Правила форума=]_____[Поиск]_____[Литература по С++]____[Литература. Паскаль]

06.05.2009, 12:41	#8
Sazary В тени Старожил Регистрация: 19.12.2008 Сообщений: 5,788	Вы убиваете матрицу в функции вывода в файл. И потом пытаетесь ее вывести на экран. Измененные процедуры: Код: procedure FreeMatrix(line,column:integer;matrix:MyArrayPtr); var i:integer; begin for i:=1 to line do FreeMem(matrix^[i],columnsizeof(MyType)); FreeMem(matrix,columnsizeof(PMyMatrix)); end; procedure WriteMatrixToFile(column,line:integer;matrix:MyArrayPtr); var fout:text; begin OpenOutputFile(fout); OutputMatrixToFile(line,column,matrix,fout); end; procedure PrintTransformedMatrix(line:integer;column:integer;var matrix:MyArrayPtr); var i,j:integer; begin writeln('Преобразованная матрица:'); for i:=1 to line do begin for j:=1 to column do write(matrix^[i]^[j]:4); writeln; end; FreeMatrix(line,column,matrix); end; Вполне очевидно, чтобы что-то понять, необходимо книги читать. Не нужно плодить бессмысленных тем. Вас Поиск избавит от многих проблем. ___________________________________ ___________________________________ _______ [=Правила форума=]_____[Поиск]_____[Литература по С++]____[Литература. Паскаль]

07.05.2009, 00:22	#9
tanek Форумчанин Регистрация: 07.03.2009 Сообщений: 209	Спасибочки)))) Уважаемый Sazary, а не подскажите ли вы ....как можно сделать проверку на то , что :в файле написана размерность33, а элементов там всего лишь 2???? Последний раз редактировалось Stilet; 12.05.2009 в 10:57.*

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Задача в Паскале.Массивы.	Deco18	Помощь студентам	6	04.03.2010 08:37
Массивы в Паскале	Dartchuwak	Помощь студентам	3	13.12.2009 12:06
Массивы в Турбо Паскале	mela	Помощь студентам	2	01.05.2009 13:57
Массивы в паскале	xSPiRiTx	Помощь студентам	8	04.03.2009 18:08