Hапечатать все перестановки чисел 1..N

First = (1, 2,..., N)
Last = (N, N-1,..., 1)

Всего таких перестановок будет N! =N*(N-1)*...*2*1. Для составления алгоритма Next зададимся вопросом: в каком случае i-ый член перестановки можно увеличить, не меняя предыдущих? Ответ: если он меньше какого-либо из следующих членов (членов с номерами больше i).

Мы должны найти наибольшее i, при котором это так, т.е. такое i, что X[i]< X[i+1]>...> X[N] (если такого i нет, то перестановка последняя). После этого X[i] нужно увеличить минимально возможным способом, т.е. найти среди X[i+1],..., X[N] наименьшее число, большее его. Поменяв X[i] с ним, остается расположить числа с номерами i+1,..., N так, чтобы перестановка была наименьшей, то есть в возрастающем порядке. Это облегчается тем, что они уже расположены в убывающем порядке:

procedure Next; begin {найти i: X[i]< X[i+1]> X[i+2]>...> X[N]}; {найти j: X[j]> X[i]> X[j+1]>...> X[N]}; {обменять X[i] и X[j]}; {X[i+1]> X[i+2]>...> X[N]}; {перевернуть X[i+1], X[i+2],..., X[N]};

end;

Теперь можно написать программу:

program Perestanovki; type Pere=array [byte] of byte; var N, i, j: byte; X: Pere; Yes: boolean; procedure Next(var X: Pere; var Yes: boolean); var i: byte; procedure Swap(var a, b: byte); {обмен переменных} var c: byte; begin c: =a; a: =b; b: =c end; begin i: =N-1; {поиск i} while (i> 0)and(X[i]> X[i+1]) do dec(i); if i> 0 then begin j: =i+1; {поиск j} while (j< N)and(X[j+1]> X[i]) do inc(j); Swap(X[i], X[j]); for j: =i+1 to (N+i) div 2 do Swap(X[j], X[N-j+i+1]); Yes: =true end else Yes: =false end; begin write('N='); readln(N); for i: =1 to N do X[i]: =i; repeat for i: =1 to N do write(X[i]); writeln; Next(X, Yes) until not Yes end.

Решение через рекурсию

Опишем рекурсивную процедуру Generate(k), предъявляющую все перестановки чисел 1,..., N, у которых фиксировано начало X[1], X[2],..., X[k]. После выхода из процедуры массив X будут иметь то же значение, что перед входом. Понятно, что при k=N мы снова имеем только тривиальное решение - саму перестановку. При k< N будем сводить задачу к k+1:

procedure Generate(k: byte); var i, j: byte; procedure Swap(var a, b: byte); var c: byte; begin c: =a; a: =b; b: =c end; begin if k=N then begin for i: =1 to N do write(X[i]); writeln end else for j: =k+1 to N do begin Swap(X[k+1], X[j]); Generate(k+1); Swap(X[k+1], X[j]) end

end;

Основная программа:

program PerestanovkiRecursion; type Pere=array [byte] of byte; var N, i, j: byte; X: Pere; procedure Generate(k: byte); ............... begin write('N='); readln(N); for i: =1 to N do X[i]: =i; Generate(0)

end.

Чтобы до конца разобраться в этой непростой программе, советуем выполнить ее на бумаге при N=3. Обратите внимание, что порядок вывода перестановок не будет лексикографическим!

Задача №3

Hапечатать все последовательности длины N из чисел 1, 2..M

First = (1, 1,..., 1) Last = (M, M,..., M)

Всего таких последовательностей будет M^N (докажите! ). Чтобы понять. как должна действовать процедура Next, начнем с примеров. Пусть N=4, M=3. Тогда:

Next(1, 1, 1, 1) -> (1, 1, 1, 2) Next(1, 1, 1, 3) -> (1, 1, 2, 1) Next(3, 1, 3, 3) -> (3, 2, 1, 1)

Теперь можно написать общую процедуру Next:

procedure Next; begin {найти i: X[i]< M, X[i+1]=M,..., X[N]=M}; X[i]: =X[i]+1; X[i+1]: =...: =X[N]: =1

end;

Если такого i найти не удается, то следующей последовательности нет - мы добрались до последней (M, M,..., M). Заметим также, что если бы членами последовательности были числа не от 1 до M, а от 0 до M-1, то переход к следующей означал бы прибавление 1 в M-ичной системе счисления. Полная программа на Паскале выглядит так:

program Sequences; type Sequence=array [byte] of byte; var M, N, i: byte; X: Sequence; Yes: boolean; procedure Next(var X: Sequence; var Yes: boolean); var i: byte; begin i: =N; {поиск i} while (i> 0)and(X[i]=M) do begin X[i]: =1; dec(i) end; if i> 0 then begin inc(X[i]); Yes: =true end else Yes: =false end; begin write('M, N='); readln(M, N); for i: =1 to N do X[i]: =1; repeat for i: =1 to N do write(X[i]); writeln; Next(X, Yes) until not Yes end.

Решение через рекурисю.

Опишем рекурсивную процедуру Generate(k), предъявляющую все последовательности длины N из чисел 1,..., M, у которых фиксировано начало X[1], X[2],..., X[k]. Понятно, что при k=N мы имеем тривиальное решение: есть только одна такая последовательность - это она сама.
При k< N будем сводить задачу к k+1:

procedure Generate(k: byte); var i, j: byte; begin if k=N then begin for i: =1 to N do write(X[i]); writeln end else for j: =1 to M do begin X[k+1]: =j; Generate(k+1) end

end;

Основная программа теперь выглядит очень просто:

program SequencesRecursion; type Sequence=array [byte] of byte; var M, N: byte; X: Sequence; procedure Generate(k: byte); ............ begin write('M, N='); readln(M, N); Generate(0) end.

Задача №4

⇐ Предыдущая 123 4 5 6 7 8 9 10 Следующая ⇒