// PascalABC.NET 3.0, сборка 1128 procedure DeleteRow(var a:array[,] of integer; r:integer); begin var rows:=a.GetLength(0); var cols:=a.GetLength(1); for var i:=r to rows-2 do for var j:=0 to cols-1 do a[i,j]:=a[i+1,j]; SetLength(a,rows-1,cols) end;
begin var b:array[,] of integer:=((1,2,3,0),(5,6,0,8), (9,10,11,12),(13,0,15,16),(17,18,19,20)); Writeln('Исходный массив: ',b); var n:=b.GetLength(0); var m:=b.GetLength(1); // удаляем строки без нулевых элементов for var i:=n-1 downto 0 do begin var FoundZero:=False; for var j:=0 to m-1 do if b[i,j]=0 then begin FoundZero:=True; Break end; if not FoundZero then DeleteRow(b,i) // удалить строку end; Writeln('Результирующий массив: ',b); end.
Я буду думать, что сочетание - набор нулей и единиц, в котором на i-м месте стоит 0, если i-й буквы нет в сочетании, и 1, если она есть. Тогда, например, (0111) соответствует bcd. Общее число чисел по условию N, число единиц равно K. Этот список упорядочен по убыванию, и нам необходимо найти M-е число в этом списке. Всего число выбрать K элементов из N равно C_N^K ("цэ из N по K"). Поймем, например, надо ли брать 1-й элемент. Всего сочетаний, где первый элемент взят: C_(N-1)^(K-1) {в самом деле, в этом случае осталось выбрать K-1 из оставшихся N-1}; не взят: C_(N-1)^K. Учитывая, что те, в которые первый элемент входит, идут перед теми, в которые он не входит, решаем: если M > C_(N-1)^(K-1), 1-й элемент не берём, иначе берём. Дальше если 1-й взяли, M оставляем таким же, если нет - уменьшаем на C_(N-1)^(K-1). Процесс повторяем, пока не найдем все буквы. Осталось понять, как считать C_N^K. Исходя из рассуждений выше, C_N^K = C_(N-1)^(K-1) + C_(N-1)^K. Кроме того, C_N^0 = 1 для всех N, C_N^K = 0 при K < 0 или K > N. Пользуясь этим, можно найти все C_N^K. Не забываем про длинную арифметику: C_N^K может не влезать в обычные типы данных. Я буду писать на PascalABC.NET, там длинная арифметика есть - тип BigInteger, если нет - легко найти, как это писать. (Update: в данном случае всё влезет в longint - биномиальные коэффициенты не превысят 10 миллионов с небольшим). Итак, вот и искомый код: begin var N, K: integer; read(N, K); var M := ReadString().ToBigInteger(); var C: array[,] of BigInteger := new BigInteger[N, K]; for var j := 1 to K - 1 do C[0, j] := 0; for var i := 0 to N - 1 do C[i, 0] := 1; for var i := 1 to N - 1 do for var j := 1 to K - 1 do C[i, j] := C[i - 1, j] + C[i - 1, j - 1]; var possible := 'a'; while K > 0 do begin if M <= C[N - 1, K - 1] then begin write(possible); dec(K); end else M := M - C[N - 1, K - 1]; dec(N); inc(possible); end; end.
Без BigInteger: begin var N, K: integer; var M: longint; read(N, K, M); var C: array[,] of longint := new longint[N, K]; for var j := 1 to K - 1 do C[0, j] := 0; for var i := 0 to N - 1 do C[i, 0] := 1; for var i := 1 to N - 1 do for var j := 1 to K - 1 do C[i, j] := C[i - 1, j] + C[i - 1, j - 1]; var possible := 'a'; while K > 0 do begin if M <= C[N - 1, K - 1] then begin write(possible); dec(K); end else M := M - C[N - 1, K - 1]; dec(N); inc(possible); end; end.
procedure writesymbol(j:longint); begin write(chr(ord('a')+j-1)); end;
procedure print(x:longint); var z,h,p:longint; begin z := 0; p := 0; while true do begin p := p + 1; if b[p] = false then z := z + 1; if z = x then break; end; x := p; b[x] := true; writesymbol(x); end;
function fa_l(a,b:longint):longint; var s,h:longint; begin s := 1; for h := a to b do s := s * h; fa_l := s; end;
begin read(n,k,m);
d := fa_l(n-k+1,n-1);
for i := k downto 1 do begin print((m - 1) div d + 1); if m mod d = 0 then m := d else m := m mod d; d := d div (n - (k - i + 1)); end; end.
procedure DeleteRow(var a:array[,] of integer; r:integer);
begin
var rows:=a.GetLength(0);
var cols:=a.GetLength(1);
for var i:=r to rows-2 do
for var j:=0 to cols-1 do a[i,j]:=a[i+1,j];
SetLength(a,rows-1,cols)
end;
begin
var b:array[,] of integer:=((1,2,3,0),(5,6,0,8),
(9,10,11,12),(13,0,15,16),(17,18,19,20));
Writeln('Исходный массив: ',b);
var n:=b.GetLength(0);
var m:=b.GetLength(1);
// удаляем строки без нулевых элементов
for var i:=n-1 downto 0 do begin
var FoundZero:=False;
for var j:=0 to m-1 do
if b[i,j]=0 then begin FoundZero:=True; Break end;
if not FoundZero then DeleteRow(b,i) // удалить строку
end;
Writeln('Результирующий массив: ',b);
end.
Тестовое решение:
Исходный массив: [[1,2,3,0],[5,6,0,8],[9,10,11,12],[13,0,15,16],[17,18,19,20]]
Результирующий массив: [[1,2,3,0],[5,6,0,8],[13,0,15,16]]