Решаем задачи Абрамян на Паскале. Param26

Param26. Описать процедуру RemoveRows($$A$$, $$M$$, $$N$$, $$K_1$$, $$K_2$$), удаляющую из вещественной матрицы $$A$$ размера $$M \times N$$ строки с номерами от $$K_1$$ до $$K_2$$ включительно (предполагается, что $$1 < K_1 \le K_2$$). Если $$K_1>M$$, то матрица не изменяется; если $$K_2>M$$, то удаляются строки матрицы с номерами от $$K_1$$ до $$M$$. Двумерный массив $$A$$ и числа $$M$$, $$N$$ являются входными и выходными параметрами. Используя процедуру RemoveRows, удалить из данной матрицы $$A$$ размера $$M \times N$$ строки с номерами от $$K_1$$ до $$K_2$$ и вывести размер полученной матрицы и ее элементы.

Решение:

program Param25;

type
 Matrix = array[1..10,1..10] of integer;
var
 M,N,K1,K2:integer;
 A:Matrix;

Procedure RemoveRows(var A:Matrix; var M,N:integer ;K1,K2:integer);
var
 Atemp:Matrix;
 j2,j,Ntemp:integer;
begin
 Ntemp:=0;
 for j:=1 to N do
  begin
   if (J<K1) or (K2<J) then
    begin
     inc(Ntemp);
     for j2:=1 to M do Atemp[J2,Ntemp]:=A[J2,J];
    end;
  end;
 A:=Atemp;
 N:=Ntemp;
end;

Procedure EnterMatrix(var B:Matrix; var M,N:integer);
var j,j2:integer;
begin
 Write('M: ');
 Readln(M);

 Write('N: ');
 Readln(N);

 for j:=1 to N do
  begin
   for j2:=1 to M do
    begin
     Write (' ',J2,':',J,' : ');
     Read (B[J2,J]);
    end;
   Writeln;
  end;
end;

Procedure InputMatrix(B:Matrix; M,N:integer);
var j,j2:integer;
begin
 Writeln('---');
 Writeln(M,'x',N);
 for j:=1 to N do
  begin
   for j2:=1 to M do
    Write (B[J2,J],' ');
   Writeln;
  end;
 Writeln('---');
end;


begin
 EnterMatrix(A,M,N);
 Write('K1: ');
 Readln(K1);
 Write('K2: ');
 Readln(K2);
 RemoveRows(A,M,N,K1,K2);
 InputMatrix(A,M,N);
end.

program Param25;

type

Matrix = array[1..10,1..10] of integer;

var

M,N,K1,K2:integer;

A:Matrix;

Procedure RemoveRows(var A:Matrix; var M,N:integer ;K1,K2:integer);

var

Atemp:Matrix;

j2,j,Ntemp:integer;

begin

Ntemp:=0;

for j:=1 to N do

begin

if (J<K1) or (K2<J) then

begin

inc(Ntemp);

for j2:=1 to M do Atemp[J2,Ntemp]:=A[J2,J];

end;

A:=Atemp;

N:=Ntemp;

end;

Procedure EnterMatrix(var B:Matrix; var M,N:integer);

var j,j2:integer;

begin

Write('M: ');

Readln(M);

Write('N: ');

Readln(N);

for j:=1 to N do

begin

for j2:=1 to M do

begin

Write (' ',J2,':',J,' : ');

Read (B[J2,J]);

end;

Writeln;

end;

Procedure InputMatrix(B:Matrix; M,N:integer);

var j,j2:integer;

begin

Writeln('---');

Writeln(M,'x',N);

for j:=1 to N do

begin

for j2:=1 to M do

Write (B[J2,J],' ');

Writeln;

end;

Writeln('---');

end;

begin

EnterMatrix(A,M,N);

Write('K1: ');

Readln(K1);

Write('K2: ');

Readln(K2);

RemoveRows(A,M,N,K1,K2);

InputMatrix(A,M,N);

end.

Другие задачи из раздела Param можно посмотреть здесь.

Комментарии 1

program Param26;//pabc.net, для любых k1 и k2 в любых сочетаниях

type
  RealArr = array of real;

procedure PrintRealArr(a: array of RealArr);
begin
  for var i := 0 to a.GetLength(0) - 1 do
  begin
    for var j := 0 to a[i].High do 
      Write(a[i][j]:7:2);
    Writeln;
  end
end;

procedure RemoveRows(var a: array of RealArr; k1, k2: integer);
begin
  var BLen: integer;
  
  if ((k1 < 0) and (k2 < 0)) or ((k1 > a.GetLength(0) - 1) and (k2 > a.GetLength(0) - 1))
    then exit
  else if (k1 < 0) and (k2.InRange(0, a.GetLength(0) - 1))
    then BLen := a.GetLength(0) - k2 - 1
  else if (k2 < 0) and (k1.InRange(0, a.GetLength(0) - 1))
    then BLen := a.GetLength(0) - k1 - 1
  else if (k1.InRange(0, a.GetLength(0) - 1)) and (k2 > a.GetLength(0) - 1)
    then BLen := k1
  else if (k2.InRange(0, a.GetLength(0) - 1)) and (k1 > a.GetLength(0) - 1)
    then BLen := k2
  else if ((k1 < 0) and (k2 > a.GetLength(0) - 1)) or ((k2 < 0) and (k1 > a.GetLength(0) - 1))
    then BLen := 0
  else if (k1.InRange(0, a.GetLength(0) - 1)) and (k2.InRange(0, a.GetLength(0) - 1))
    then BLen := a.GetLength(0) - (Abs(k1 - k2) + 1);
  
  var b := new RealArr[BLen];
  var i2 := 0;
  for var i := 0 to a.GetLength(0) - 1 do
  begin
    if i.InRange(k1, k2) or i.InRange(k2, k1) then continue;
    b[i2] := a[i];//присваивается ссылка, содержимое не копируется
    i2 += 1
  end;
  a := b;//присваивается новая ссылка, меняется размер, поэтому var-параметр
end;

begin
  var m := 5;
  var n := 6;
  
  var a := new RealArr[m];
  for var i := 0 to m - 1 do 
    a[i] := ArrGen(n, Int(N * i * 2 + 1), i -> i + 2);//d-from-d, арифм прогрессия
  
  PrintRealArr(a);
  //   1.00   3.00   5.00   7.00   9.00  11.00
  //  13.00  15.00  17.00  19.00  21.00  23.00
  //  25.00  27.00  29.00  31.00  33.00  35.00
  //  37.00  39.00  41.00  43.00  45.00  47.00
  //  49.00  51.00  53.00  55.00  57.00  59.00
  
  var k1 := 5;
  var k2 := 6;
  
  k1 -= 1;
  k2 -= 1;
  RemoveRows(a, k1, k2);
  m := a.GetLength(0);
  
  Writeln($'k1 = {k1+1}, k2 = {k2+1}, m x n = {m} x {n}');//k1 = 5, k2 = 6, m x n = 4 x 6
  PrintRealArr(a);
  //   1.00   3.00   5.00   7.00   9.00  11.00
  //  13.00  15.00  17.00  19.00  21.00  23.00
  //  25.00  27.00  29.00  31.00  33.00  35.00
  //  37.00  39.00  41.00  43.00  45.00  47.00
end.

program Param26;//pabc.net, для любых k1 и k2 в любых сочетаниях

type

RealArr = array of real;

procedure PrintRealArr(a: array of RealArr);

begin

for var i := 0 to a.GetLength(0) - 1 do

begin

for var j := 0 to a[i].High do

Write(a[i][j]:7:2);

Writeln;

end

end;

procedure RemoveRows(var a: array of RealArr; k1, k2: integer);

begin

var BLen: integer;

if ((k1 < 0) and (k2 < 0)) or ((k1 > a.GetLength(0) - 1) and (k2 > a.GetLength(0) - 1))

then exit

else if (k1 < 0) and (k2.InRange(0, a.GetLength(0) - 1))

then BLen := a.GetLength(0) - k2 - 1

else if (k2 < 0) and (k1.InRange(0, a.GetLength(0) - 1))

then BLen := a.GetLength(0) - k1 - 1

else if (k1.InRange(0, a.GetLength(0) - 1)) and (k2 > a.GetLength(0) - 1)

then BLen := k1

else if (k2.InRange(0, a.GetLength(0) - 1)) and (k1 > a.GetLength(0) - 1)

then BLen := k2

else if ((k1 < 0) and (k2 > a.GetLength(0) - 1)) or ((k2 < 0) and (k1 > a.GetLength(0) - 1))

then BLen := 0

else if (k1.InRange(0, a.GetLength(0) - 1)) and (k2.InRange(0, a.GetLength(0) - 1))

then BLen := a.GetLength(0) - (Abs(k1 - k2) + 1);

var b := new RealArr[BLen];

var i2 := 0;

for var i := 0 to a.GetLength(0) - 1 do

begin

if i.InRange(k1, k2) or i.InRange(k2, k1) then continue;

b[i2] := a[i];//присваивается ссылка, содержимое не копируется

i2 += 1

end;

a := b;//присваивается новая ссылка, меняется размер, поэтому var-параметр

end;

begin

var m := 5;

var n := 6;

var a := new RealArr[m];

for var i := 0 to m - 1 do

a[i] := ArrGen(n, Int(N * i * 2 + 1), i -> i + 2);//d-from-d, арифм прогрессия

PrintRealArr(a);

// 1.00 3.00 5.00 7.00 9.00 11.00

// 13.00 15.00 17.00 19.00 21.00 23.00

// 25.00 27.00 29.00 31.00 33.00 35.00

// 37.00 39.00 41.00 43.00 45.00 47.00

// 49.00 51.00 53.00 55.00 57.00 59.00

var k1 := 5;

var k2 := 6;

k1 -= 1;

k2 -= 1;

RemoveRows(a, k1, k2);

m := a.GetLength(0);

Writeln($'k1 = {k1+1}, k2 = {k2+1}, m x n = {m} x {n}');//k1 = 5, k2 = 6, m x n = 4 x 6

PrintRealArr(a);

// 1.00 3.00 5.00 7.00 9.00 11.00

// 13.00 15.00 17.00 19.00 21.00 23.00

// 25.00 27.00 29.00 31.00 33.00 35.00

// 37.00 39.00 41.00 43.00 45.00 47.00

end.

Ответить

Решаем задачи Абрамян на Паскале. Param26

Комментарии:

Комментарии 1

Добавить комментарий Отменить ответ