ЦИКЛ В ЦИКЛЕ Опции

[ipconnect]

Столкнулся с проблемой такого порядка. Как ни крутил, решить оптимально не получается. Требуется мозговой штурм коллективного разума. Задача выглядит следующим образом.

Имеется одномерный массив с N ячейками. Необходимо, казалось бы, просто сделать следующее. По заданному максимальному взятому для использования количеству ячеек M (<=N), начинающихся с первой от начала массива, необходимо менять значения в них следующим образом. Объяснить могу только на примере.
Т.е. в начале необходимо взять две первые ячейки. Изначально в первую записать 1, во вторую - на единицу больше. Затем надо менять значение во второй ячейке до некоторого числа K (к примеру, 30)...
Выглядит это так
1 2
1 3
...
1 30
Будут образовываться пары чисел, которые нужно потом будет сохранить. Но это уже к делу не относится. Тут бы сделать основное. Далее, когда значение во второй ячейке достигнет К, надо значение в первой ячейке увеличить на 1. И повторить цикл заново. Т.е.
2 3
2 4
...
2 30 и т.д. До того момента пока последняя пара будет К-1 К (в примере 29 30).
Далее необходимо включить в цикл третью ячейку. И сделать тот же самый цикл по тем же самым критериям изменений. Т.е. изначально это 1 2 3, потом 1 2 4 ... вплоть до К-2 К-1 К (28 29 30). Итак пока мы не заполним все три ячейки таким перебором. Потом четыре ячейки и т.д.
Перебор из M ячеек закончится тогда, когда последним набором чисел будет
K-M+1 K-M ... K-2 K-1 K

Думал, что просто. Справлюсь на раз-два-три. Оказалось не всё так просто, как кажется. Задача имеет практическое значение, поэтому бросить не могу. Нужно решить. Сам не в состоянии. Впервые попал в ступор при решении подобных задач. Помогите выбраться из тупика.

[Федосеев Павел]

Или так

program Counter30;

const
  M = 5;
  K = 10;
type
  TArray = array [0..M - 1] of integer;

  procedure ShowArray(const a: TArray);
  var
    i: integer;
  begin
    for i := 0 to M - 1 do
      Write(a[i]: 3);
    writeln;
  end;

  function IsFinal(const a: TArray): boolean;
  var
    i: integer;
    Res: boolean;
  begin
    Res := True;
    for i := 0 to M - 1 do
      Res := Res and (a[i] = K - M + 1 + i);
    IsFinal := Res;
  end;

var
  a: TArray;
  i, j, n: integer;
begin
  for i := 0 to M - 1 do
    a[i] := 0;
  a[0] := 1;
  a[1] := 1;
  i := 1;
  while not IsFinal(a) do
  begin
    Inc(a[i]);
    if a[i] > K then
    begin
      a[i] := a[i - 1] + 1 + 1;
      {перенос}
      for j := i - 1 downto 0 do
      begin
        Inc(a[j]);
        if (a[j] <= K + j - i) then
        begin
          for n := j + 1 to i do
            a[n] := a[n - 1] + 1;
          break;
        end
        else
        if j = 0 then
        begin
          Inc(i);
          a[0] := 1;
          for n := j + 1 to i do
            a[n] := a[n - 1] + 1;
        end;
      end;
    end;
    ShowArray(a);
  end;
end.