Поменять местами столбцы с максимальным и минимальным элементами

@Юлия67 · Регистрация: 28.02.2013

Author24 — интернет-сервис помощи студентам

Дана матрица А размера n*m, где n,m<=15. Элементы матрицы – целые случайные числа из диапазона [0, 10*N]. Оформить преобразование матриц в виде функции или процедуры и записать в файл исходную и преобразованную матрицы. Просмотреть файл.

@Юлия67 · 12.03.2013, 14:27 **[ТС]**

вот похожая программа

Код

Program lora_z4;
Uses Crt;
Var A:array [1..15,1..15] of real;
i,j,n,k_max,k_min:integer;
max,min,B:real;
Begin
ClrScr;
Write('Vvedite n (<=15) ');
Readln(n);

for i:=1 to n do
for j:=1 to n do
A[i,j]:=i*j*sin(0.5*i*j);

for i:=1 to n do
Begin
for j:=1 to n do
Write(A[i,j]:6:1);
Writeln;
End;

min:=(A[1,1]);
k_min:=1;
for i:=1 to n do
for j:=1 to n do
if min>(A[i,j]) then
Begin
min:=(A[i,j]);
k_min:=j;
End;

max:=(A[1,1]);
k_max:=1;
for i:=1 to n do
for j:=1 to n do
if max<(A[i,j]) then
Begin
max:=(A[i,j]);
k_max:=j;
End;

Writeln;
Writeln;
Writeln('min = ',min:5:1,' k_min = ',k_min);
Writeln('max = ',max:5:1,' k_max = ',k_max);

for i:=1 to n do
Begin
B:=A[i,k_max];
A[i,k_max]:=A[i,k_min];
A[i,k_min]:=B;
End;

Writeln;
Writeln;
for i:=1 to n do
Begin
for j:=1 to n do
Write(A[i,j]:6:1);
Writeln;
End;

ReadKey;
End.

а вот процедура, помогите пожалуйста собрать все как надо, не получается(

Код

Program lora_z4;
Uses Crt;

procedure DoMatr;
  const MaxSize = 15;
  Var A:array [1..MaxSize,1..MaxSize] of integer;
       i,j,n,m,B, k_max,k_min:integer;
  begin
     Write('Vvedite n (<=15) ');
     Readln(n);
     Write('Vvedite m (<=15) ');
     Readln(m);

     for i:=1 to n do
        for j:=1 to m do
          A[i,j]:= random(10*N+1);
  
     .....
   WriteLn('Press any key to exit...');
   ReadKey;
   Readln;
end; {конец процедуры i*j*sin(0.5*i*j)}
  
{главная программа}
Begin
     ClrScr;
     Randomize;

     DoMatr;
end.

@Юлия67 · 13.03.2013, 14:30 **[ТС]**

ну помогите пожалуйста(

@Puporev · 13.03.2013, 16:15

Pascal

uses crt;
const nmax=15;
type mtr=array[1..nmax,1..nmax] of byte;
procedure obmen(var a:mtr;m,n,jmn,jmx:byte);
var i,x:byte;
begin
for i:=1 to m do
 begin
  x:=a[i,jmn];
  a[i,jmn]:=a[i,jmx];
  a[i,jmx]:=x;
 end;
end;
var a:mtr;
    m,n,i,j,mn,mx,jmn,jmx:byte;
    f:text;
    s:string;
begin
randomize;
repeat
write('Количество строк до ',nmax,' m=');
read(m);
until m in [1..nmax];
repeat
write('Количество столбцов от 2 до ',nmax,' n=');
read(n);
until n in [2..nmax];
assign(f,'result.txt');
rewrite(f);
writeln(f,'Исходная матрица:');
for i:=1 to m do
 begin
  for j:=1 to n do
   begin
    a[i,j]:=random(10*n+1);
    write(f,a[i,j]:4);
   end;
  writeln(f,'');
 end;
mn:=a[1,1];
mx:=mn;
jmn:=1;
jmx:=1;
for i:=1 to m do
for j:=1 to n do
 begin
  if a[i,j]<mn then
   begin
    mn:=a[i,j];
    jmn:=j
   end;
  if a[i,j]>mx then
   begin
    mx:=a[i,j];
    jmx:=j
   end;
 end;
writeln(f,'Минимальный элемент=',mn,' в столбце ',jmn);
writeln(f,'Максимальный элемент=',mx,' в столбце ',jmx);
if jmn=jmx then writeln(f,'Минимальный и максимальный в одном столбце, обмена нет')
else
 begin
  obmen(a,m,n,jmn,jmx);
  writeln(f,'Обмен столбцов ',jmn,' и ',jmx);
  for i:=1 to m do
   begin
    for j:=1 to n do
    write(f,a[i,j]:4);
    writeln(f,'');
   end;
 end;
close(f);
writeln('Просмотр файла');
reset(f);
while not eof(f) do
 begin
  readln(f,s);
  writeln(s)
 end;
close(f)
end.

@Юлия67 1 / 1 / 0 Регистрация: 28.02.2013 Сообщений: 28
		1
	Поменять местами столбцы с максимальным и минимальным элементами 06.03.2013, 21:29. Показов 1831. Ответов 3 Метки нет (Все метки) Дана матрица А размера nm, где n,m<=15. Элементы матрицы – целые случайные числа из диапазона [0, 10N]. Оформить преобразование матриц в виде функции или процедуры и записать в файл исходную и преобразованную матрицы. Просмотреть файл. 0

@Юлия67 1 / 1 / 0 Регистрация: 28.02.2013 Сообщений: 28
	13.03.2013, 14:30 [ТС]	3
	ну помогите пожалуйста( 0

	13.03.2013, 16:15