Динамика. Поменять местами наименьший и второй по величине элементы - Паскаль, Turbo Pascal, PascalABC.NET

StudeHt · 27.05.2009, 01:35

Доброго времени суток господа программисты! Вот возникла проблема с решением задачи: Поменять местами наименьший и второй по величине элементы в каждой строке матрицы. Данные считать из файла, и вывести результат в файл Нашел на форуме похожие задачи, попытался переделать, но что-то не так... Программа не меняет местами элементы. Вот мой код:

Код:

type TMas=array[1..1] of longint;
     PMas=^TMas;
 
     TMatrix=array[1..1] of PMas;
     PMatrix=^TMatrix;
 
procedure OpenFileIn(var FileIn:text; NameFile:string);
begin
  writeln('Введите имя входного файла ');
  readln(NameFile);
  assign(FileIn,NameFile);
  {$I-}
  reset(FileIn);
  {$I+}
  if IOResult<>0 then
    begin
      writeln('Ошибка!!! Файл ',NameFile,' не найден');
      readln;
      halt;
    end;
end;
 
procedure ReadDimensionOfMatrix(var FileIn:text; var Line,Column:longint);
begin
  read(FileIn,Line);
  read(FileIn,Column);
end;
 
procedure AllocationOfMemory(Line,Column:longint; var Matrix:PMatrix);
var i,j:integer;
begin
  GetMem(Matrix,Line*SizeOf(PMas));
  for i:=1 to Line do
    GetMem(Matrix^[i],Column*SizeOf(longint));
end;
 
procedure InputMatrix(Line,Column:longint; Matrix:PMatrix; var FileIn:text);
var i,j:integer;
begin
  for i:=1 to Line do
    begin
      for j:=1 to Column do
        read(FileIn,Matrix^[i]^[j]);
    end;
    Close(FileIn);
end;
 
procedure ReadMatrixFromFileToPMatrix(var Matrix:PMatrix; var Line,Column:longnt);
var FileIn:text;
    NameFile:string;
begin
  OpenFileIn(FileIn,NameFile);
  ReadDimensionOfMatrix(FileIn,Line,Column);
  AllocationOfMemory(Line,Column,Matrix);
  InputMatrix(Line,Column,Matrix,FileIn);
end;
 
procedure PrintMatrix(Line,Column:longint; Matrix:PMatrix);
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 FindMin(Line,Column:longint; var Matrix:PMatrix; var JMin:longint);
var i,j,Min:longint;
begin
  for i:=1 to Line do
    begin
      Min:=Matrix^[i]^[1];
      JMin:=1;
      for j:=1 to Column do
        if Matrix^[i]^[j]<Min then
          begin
            Min:=Matrix^[i]^[j];
            JMin:=j;
          end;
    end;
end;
 
procedure FindFirstMax(Line,Column:longint; var Matrix:PMatrix; var JMax1:longint);
var i,j,Max1:longint;
begin
  for i:=1 to Line do
    begin
      Max1:=Matrix^[i]^[1];
      JMax1:=1;
      for j:=1 to Column do
        if Matrix^[i]^[j]>Max1 then
          begin
            Max1:=Matrix^[i]^[j];
            JMax1:=j;
          end;
    end;
end;
 
procedure FindSecondMax(Line,Column,JMax1:longint; var Matrix:PMatrix; var JMax2:longint);
var i,j,Max2:longint;
begin
  for i:=1 to Line do
    begin
      Max2:=-Maxint-1;
      JMax2:=1;
      for j:=1 to Column do
        if (Matrix^[i]^[j]>Max2) and (j<>JMax1) then
          begin
            Max2:=Matrix^[i]^[j];
            JMax2:=j;
          end;
    end;
end;
 
procedure Bubble(JMin,JMax2:longint; var Buf:longint; var Matrix:PMatrix);
var i,j:longint;
begin
  Buf:=Matrix^[i]^[JMin];
  Matrix^[i]^[JMin]:=Matrix^[i]^[JMax2];
  Matrix^[i]^[JMax2]:=Buf;
end;
 
procedure ChargeByPlaces(Line,Column:longint; var Matrix:PMatrix);
var JMin,JMax1,JMax2,Buf:longint;
begin
  FindMin(Line,Column,Matrix,JMin);
  FindFirstMax(Line,Column,Matrix,JMax1);
  FindSecondMax(Line,Column,JMax1,Matrix,JMax2);
  Bubble(JMin,JMax2,Buf,Matrix);
end;
 
procedure OpenFileOut(var FileOut:text; var NameFile:string);
begin
  writeln('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  rewrite(FileOut);
end;
 
procedure OutputMatrixToFile(Line,Column:longint; var FileOut:text; var Matrix:PMatrix);
var i,j:longint;
begin
  for i:=1 to Line do
    begin
      for j:=1 to Column do
        write(FileOut,Matrix^[i]^[j],' ');
        writeln(FileOut);
    end;
end;
 
procedure DeleteDinamicMatrix(Line,Column:longint; Matrix:PMatrix);
var i:longint;
begin
  for i:=1 to Line do
    FreeMem(Matrix^[i],Column*SizeOf(longint));
    FreeMem(Matrix,Column*SizeOf(PMatrix));
end;
 
procedure WriteMatrixToFile(Line,Column:longint; Matrix:PMatrix);
var FileOut:text;
    NameFile:string;
begin
  OpenFileOut(FileOut,NameFile);
  OutputMatrixToFile(Line,Column,FileOut,Matrix);
  Close(FileOut);
end;
 
var Matrix:PMatrix;
    Line,Column:longint;
begin
  ReadMatrixFromFileToPMatrix(Matrix,Line,Column);
  writeln('Исходная матрица имеет следующий вид:');
  PrintMatrix(Line,Column,Matrix);
  ChargeByPlaces(Line,Column,Matrix);
  writeln('Матрица после преобразований имеет следующий вид:');
  PrintMatrix(Line,Column,Matrix);
  WriteMatrixToFile(Line,Column,Matrix);
  DeleteDinamicMatrix(Line,Column,Matrix);
end.

Помогите пожалуйста. Заранее очень благодарен!!!

Sazary · 27.05.2009, 02:08

Копипаст вреден

В следующий раз лучше пишите сами, с нуля.
Был неверный подход.
Исправил.

Код:

type TMas=array[1..1] of longint;
     PMas=^TMas;
 
     TMatrix=array[1..1] of PMas;
     PMatrix=^TMatrix;
 
procedure OpenFileIn(var FileIn:text; NameFile:string);
begin
  writeln('Введите имя входного файла ');
  readln(NameFile);
  assign(FileIn,NameFile);
  {$I-}
  reset(FileIn);
  {$I+}
  if IOResult<>0 then
    begin
      writeln('Ошибка!!! Файл ',NameFile,' не найден');
      readln;
      halt;
    end;
end;
 
procedure ReadDimensionOfMatrix(var FileIn:text; var Line,Column:longint);
begin
  read(FileIn,Line);
  read(FileIn,Column);
end;
 
procedure AllocationOfMemory(Line,Column:longint; var Matrix:PMatrix);
var i,j:integer;
begin
  GetMem(Matrix,Line*SizeOf(PMas));
  for i:=1 to Line do
    GetMem(Matrix^[i],Column*SizeOf(longint));
end;
 
procedure InputMatrix(Line,Column:longint; Matrix:PMatrix; var FileIn:text);
var i,j:integer;
begin
  for i:=1 to Line do
    begin
      for j:=1 to Column do
        read(FileIn,Matrix^[i]^[j]);
    end;
    Close(FileIn);
end;
 
procedure ReadMatrixFromFileToPMatrix(var Matrix:PMatrix; var Line,Column:longint);
var FileIn:text;
    NameFile:string;
begin
  OpenFileIn(FileIn,NameFile);
  ReadDimensionOfMatrix(FileIn,Line,Column);
  AllocationOfMemory(Line,Column,Matrix);
  InputMatrix(Line,Column,Matrix,FileIn);
end;
 
procedure PrintMatrix(Line,Column:longint; Matrix:PMatrix);
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 FindFirstMax(Line,Column:longint; Matrix:PMatrix; numi : longint; var JMax1:longint);
var j,Max1:longint;
begin
      Max1:=Matrix^[numi]^[1];
      JMax1:=1;
      for j:=1 to Column do
        if Matrix^[numi]^[j]>Max1 then
          begin
            Max1:=Matrix^[numi]^[j];
            JMax1:=j;
          end;
end;
 
procedure FindSecondMax(Line,Column,JMax1:longint; Matrix:PMatrix; numi : longint; var JMax2:longint);
var j,Max2:longint;
begin
      Max2:=-Maxint-1;
      JMax2:=1;
      for j:=1 to Column do
        if (Matrix^[numi]^[j]>Max2) and (j<>JMax1) then
          begin
            Max2:=Matrix^[numi]^[j];
            JMax2:=j;
          end;
end;
 
procedure Bubble(numi,JMax1,JMax2:longint; var Matrix:PMatrix);
var Buf : longint;
begin
  Buf:=Matrix^[numi]^[JMax1];
  Matrix^[numi]^[JMax1]:=Matrix^[numi]^[JMax2];
  Matrix^[numi]^[JMax2]:=Buf;
end;
 
procedure ChargeByPlaces(Line,Column:longint; var Matrix:PMatrix);
var JMin,JMax1,JMax2:longint;
i : longint;
begin
  for i:=1 to Line do
   begin
   FindFirstMax(Line,Column,Matrix,i,JMax1);
   FindSecondMax(Line,Column,JMax1,Matrix,i,JMax2);
   Bubble(i,JMax1,JMax2,Matrix);
   end;
end;
 
procedure OpenFileOut(var FileOut:text; var NameFile:string);
begin
  writeln('Введите имя выходного файла ');
  readln(NameFile);
  assign(FileOut,NameFile);
  rewrite(FileOut);
end;
 
procedure OutputMatrixToFile(Line,Column:longint; var FileOut:text; var Matrix:PMatrix);
var i,j:longint;
begin
  for i:=1 to Line do
    begin
      for j:=1 to Column do
        write(FileOut,Matrix^[i]^[j],' ');
        writeln(FileOut);
    end;
end;
 
procedure DeleteDinamicMatrix(Line,Column:longint; Matrix:PMatrix);
var i:longint;
begin
  for i:=1 to Line do
    FreeMem(Matrix^[i],Column*SizeOf(longint));
    FreeMem(Matrix,Column*SizeOf(PMatrix));
end;
 
procedure WriteMatrixToFile(Line,Column:longint; Matrix:PMatrix);
var FileOut:text;
    NameFile:string;
begin
  OpenFileOut(FileOut,NameFile);
  OutputMatrixToFile(Line,Column,FileOut,Matrix);
  Close(FileOut);
end;
 
var Matrix:PMatrix;
    Line,Column:longint;
begin
  ReadMatrixFromFileToPMatrix(Matrix,Line,Column);
  writeln('Исходная матрица имеет следующий вид:');
  PrintMatrix(Line,Column,Matrix);
  ChargeByPlaces(Line,Column,Matrix);
  writeln('Матрица после преобразований имеет следующий вид:');
  PrintMatrix(Line,Column,Matrix);
  WriteMatrixToFile(Line,Column,Matrix);
  DeleteDinamicMatrix(Line,Column,Matrix);
end.

StudeHt · 27.05.2009, 02:18

Спасибо Вам Sazary. Подскажите только для чего Вы завели переменную numi?

Код:

procedure FindFirstMax(Line,Column:longint; Matrix:PMatrix; numi : longint; var JMax1:longint);
var j,Max1:longint;
begin
      Max1:=Matrix^[numi]^[1];
      JMax1:=1;
      for j:=1 to Column do
        if Matrix^[numi]^[j]>Max1 then
          begin
            Max1:=Matrix^[numi]^[j];
            JMax1:=j;
          end;
end;

Это получается что-то вроде счетчика, как у меня была переменная i?

Sazary · 27.05.2009, 02:20

Цитата:

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

Подскажите только для чего Вы завели переменную numi?

Просто вы не в том месте прогоняли цикл по строкам.
numi - номер строки, для которой ищем максимум.

27.05.2009, 02:18	#3
StudeHt Пользователь Регистрация: 05.04.2009 Сообщений: 78	Спасибо Вам Sazary. Подскажите только для чего Вы завели переменную numi? Код: `procedure FindFirstMax(Line,Column:longint; Matrix:PMatrix; numi : longint; var JMax1:longint); var j,Max1:longint; begin Max1:=Matrix^[numi]^[1]; JMax1:=1; for j:=1 to Column do if Matrix^[numi]^[j]>Max1 then begin Max1:=Matrix^[numi]^[j]; JMax1:=j; end; end;` Это получается что-то вроде счетчика, как у меня была переменная i?

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
найти наибольший и наименьший элемент матрицы B(N x M) и поменять их местами	поЛотЕнчик_просТо	Общие вопросы C/C++	2	13.05.2009 12:17
В массиве Р(10) введенном с клавиатуры поменять местами наибольший и наименьший элементы. Делфи.	Lerika	Помощь студентам	6	23.01.2009 11:52
поменять местами	научите	Паскаль, Turbo Pascal, PascalABC.NET	13	08.01.2009 13:43
Задача по матрицам. Поменять местами наименьший и второй по величине элементы	Иван 883	Паскаль, Turbo Pascal, PascalABC.NET	5	03.01.2009 16:04
Ввести двумерный массив и поменять в нём местами элементы	Ku6ep	Помощь студентам	3	23.12.2008 18:25