Question

Pascalabc.net нужна ! в заданой матрице размер которой указывает пользователь, а элементы образуются случайным образом: посчитать количество столбцов, в которых одинаковые суммы элементов.

Answer 1

// PascalABC.NET 3.3, сборка 1583 от 25.11.2017
// Внимание! Если программа не работает, обновите версию!

begin
  var (m,n):=ReadInteger2('Количество строк и столбцов в матрице:');
  Writeln('*** Исходная матрица ***');
  var a:=MatrRandom(m,n,10,20);
  a.Println(3); Writeln(3*a.ColCount*'-');
  var k:=a.Cols.Select(col->col.Sum).GroupBy(t->t)
      .Select(t->(t.Key,t.Count)).Where(t->t[1]>1).Sum(t->t[1]);
  Writeln('Искомое количество столбцов: ',k)
end.

Пример
Количество строк и столбцов в матрице: 4 15
*** Исходная матрица ***
 12 13 15 17 16 17 19 19 13 18 15 14 10 10 15
 15 17 15 10 18 13 11 17 14 19 15 10 15 17 19
 15 16 14 14 20 10 20 16 20 13 12 16 20 10 13
 16 17 17 13 19 15 20 11 13 17 11 17 10 18 11

Искомое количество столбцов: 7

Программа короткая, но в ней есть часть, понимание которой может быть затруднено. Поэтому ниже приводится эта же программа, в которой один из операторов разбит на несколько с выдачей промежуточных результатов.

begin
  var (m,n):=ReadInteger2('Количество строк и столбцов в матрице:');
  Writeln('*** Исходная матрица ***');
  var a:=MatrRandom(m,n,10,20);
  a.Println(3); Writeln(3*a.ColCount*'-');
  // по шажкам
  var s1:=a.Cols.Select(col->col.Sum);
  Writeln('Суммы поколонно:'); s1.Println;
  var s2:=s1.GroupBy(t->t);
  Writeln('Группировка сумм:'); Writeln(s2);
  var s3:=s2.Select(t->(t.Key,t.Count));
  Writeln('То же, формат "значение, количество":'); Writeln(s3);
  var s4:=s3.Where(t->t[1]>1);
  Writeln('Оставляем только суммы с повторами:'); Writeln(s4);
  var k:=s4.Sum(t->t[1]);
  Writeln('Искомое количество столбцов: ',k)
end.

Пример
Количество строк и столбцов в матрице: 4 15
*** Исходная матрица ***
 11 11 16 15 17 13 15 14 11 18 20 16 15 15 15
 20 17 10 18 18 14 11 19 16 13 16 18 16 10 12
 16 20 10 13 12 14 16 19 11 16 19 16 17 12 12
 19 12 12 11 10 14 18 10 15 11 10 13 10 11 10

Суммы поколонно:
66 60 48 57 57 55 60 62 53 58 65 63 58 48 49
Группировка сумм:
[[66],[60,60],[48,48],[57,57],[55],[62],[53],[58,58],[65],[63],[49]]
То же, формат "значение, количество":
[(66,1),(60,2),(48,2),(57,2),(55,1),(62,1),(53,1),(58,2),(65,1),(63,1),(49,1)]
Оставляем только суммы с повторами:
[(60,2),(48,2),(57,2),(58,2)]
Искомое количество столбцов: 8

Answer 2

//Pascal
var
  A: array [1 .. 255, 1 .. 255] of integer;
  sumA, historyA: array [1 .. 255] of integer;
  i, j, n, m, z, count, count2: byte;
  tmpSum: integer;
begin
  randomize;
  write('Строк = '); readln(n);
  write('Столбцов = '); readln(m);
  for i := 1 to n do
  begin
    for j := 1 to m do
    begin
      A[i, j] := random(5);
      write(A[i, j]:4);
    end;
    writeln;
  end;
  writeln('---------------------------------------');
  for j := 1 to m do
  begin
    tmpSum := 0;
    count := 0;
    for i := 1 to n do
      tmpSum := tmpSum + A[i, j];
    sumA[j] := tmpSum;
  end;
  for i := 1 to m do
    write(sumA[i]:4);
  writeln; writeln;
  for j := 1 to m do
  begin
    count := 0;
    count2 := 0;
    tmpSum := sumA[j];
    for i := 1 to m do
    begin
      if (sumA[i] = tmpSum) then
        count := count + 1;
      if historyA[i] = tmpSum then
        count2 := count2 + 1;;
    end;
    if (count <> 1) and (count2 <> 1) then
    begin
      writeln('Одинаковых столбцов суммы ', tmpSum, ' = ', count);
      historyA[j] := tmpSum;
    end;
  end;
  readln;
end.