[Ghost]

bad3p
Могем и написать, только объясни мне дубу, что означает:
1. ...в массив ввести типизованную константу массив...
2. ...совпадают совокупности чисел...


Вот тебе первая задачка (кажись работает):

const
  n = 30;  a: array [1..20] of byte =
    (29, 27, 25, 23, 21, 19, 17, 16, 15, 14, 13, 12, 11, 9, 7, 6, 5, 4, 2, 1);
  b: array [1..(n - 20)] of byte =
    (30, 28, 26, 24, 22, 20, 18, 10, 8, 3);
var
  c: array [1..n] of byte;
  i, j, k: integer;
begin
  i := 1;
  j := 1;
  k := 1;
  while (j <= 20) and (k <= (n - 20)) do begin
    if a[j] > b[k] then begin
      c[i] := a[j];
      inc (j);
    end else begin
      c[i] := b[k];
      inc (k);
    end;
    inc (i);
  end;
  if j > 20 then begin
    while (k <= (n - 20)) do begin
      c[i] := b[k];
      inc (k);
      inc (i);
    end;
  end else begin
    while (j <= 20) do begin
      c[i] := a[j];
      inc (j);
      inc (i);
    end;
  end;
  for i := 1 to n do write (c[i] : 3);
end.

Я так понимаю, "совподают совокупности" означает, что в строках расположены одни и те же числа, причем не важно в каком порядке... Ща попробуем...

Ага. Вот: (в проге для простоты массив Х генерируется случайным образом, состоит только из 0, 1 и 2 (чтобы точно были похожие строки) и имеет размерность 4; все это, есессно, можно легко изменить: поменять константу N и параметр вызова функции Random())

uses
  crt;

const
  n = 4;

var
  x: array [1..n, 1..n] of byte;
  i, j, k: integer;

function like(n1, n2: integer): boolean;
var
  s: set of byte;
  i, j: integer;
begin
  s := [1..n];
  for i := 1 to n do begin
    j := 0;
    repeat inc(j)
    until (j > n) or ((x[n1, i] = x[n2, j]) and (j in s));
    if j > n then break else exclude(s, j);
  end;
  like := (s = []);
end;

begin
  clrscr;
  randomize;
  writeln ('X:');
  for i := 1 to n do begin
    for j := 1 to n do begin
      x[i, j] := random(3);
      write (x[i, j]:4);
    end;
    writeln;
  end;
  writeln;
  writeln ('pohozhie:');
  k := 0;
  for i := 1 to pred(n) do for j := succ(i) to n do if like(i, j) then begin
    writeln ('x[', i:2, ']  ~ x[', j:2, ']');
    inc (k);
  end;
  writeln ('ih kolichestvo: ', k);
  writeln;
  writeln ('nepohozhie:');
  k := 0;
  for i := 1 to pred(n) do for j := succ(i) to n do if not like(i, j) then begin
    writeln ('x[', i:2, '] !~ x[', j:2, ']');
    inc (k);
  end;
  writeln ('ih kolichestvo: ', k);
  readkey;
end.