Given the numbers N and K, print all lines of zeros and units of length N, containing exactly K units, in lexicographical order.

Input Format

Two numbers are given: N and K (0≤K≤N, 0≤N≤100)

Output format

It is necessary to print all the lines of zeros and units of length N, containing exactly K units, in lexicographical order. It is guaranteed that the response size does not exceed 10MiB.

Example

Ввод Вывод 4 2 0011 0101 0110 1001 1010 1100 

Here is my idea (my idea passes 59 of 62 tests, 3 tests work for more than 1 second)

  var kol : array[1..101] of Byte; n,k : Byte; s : String[120]; procedure vivod(sum:Byte); var i:Byte; begin Write(copy(s,1,n-(sum+k))); // вывод ведущих нулей for i := 1 to k do Write('1',copy(s,1,kol[i])); //вывод 1 а следом kol[i] - кол-во нулей идущих за этой единицей WriteLn; end; procedure perebor; var loc,sum,i,id,x:Byte; begin sum:=0; vivod(sum); //вывод начально перестановки (000...1111) while kol[k]<nk do //когда после последней единицы будет стоять nk нулей, т.е. больше нулей не может стоять, завершить перебор begin inc(sum);// кол-во нулей которых ставится первоночально после 1 единицы i := 1; fillchar(kol,n,0); //у всех других единиц кол-во нулей 0 kol[1] := sum; // после первой единицы должно стоять sum нулей while kol[k]<>sum do // пока sum нулей не окажется у последней единицы перебирать begin vivod(sum); //вывести очередную перестановку if i=k then // если мы дошли до последний(k-ой единицы) begin x:=kol[k]; //запоминаем кол-во единиц стоящих после последней единицы kol[k]:=0; //обнуляем его, ведь увеличивать некуда while kol[i-1]=0 do dec(i); //находим такую первую единицу у которой не стоят нули kol[i]:=x; //присваем ей кол-во которое было у последнего элемента dec(i); // уменьшаем указатель на предыдущий элемент end; {таким образом я уменьшаю kol нулей у i единицы, и увеличиваю кол-во нулей у следующей единицы} dec(kol[i]); inc(i); inc(kol[i]); end; vivod(sum); // вывожу перестановку последнюю когда массив kol=[0,0,0,..,0,0,sum] end; end; begin Assign(input,'input.txt'); Reset(input); REadLn(n,k); {чтобы выводить ведущие нули или нули между единицами не используя циклы, а тупо copy} s:='0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000'; close(input); Assign(output,'output.txt'); ReWrite(output); perebor; close(output); end. 
  • Yes, I decide for myself! I can even write my idea and decision! But it is made clumsily. - Eugene536
  • It looks like an Olympiad puzzle. Solution head-on: go through all binary numbers to the maximum with K units at the beginning and NK zeros, and check the number of units in each number, if it is equal to K, enter in response, if not, go further. - Specter
  • Eugene, really write your idea - we will continue to look. PS Thoughts also appeared, but have long passed the exam on this topic :). - Vyacheslav Kirichenko
  • clarified as he could, read! does not pass 3 tests and then only in time - Eugene536
  • 2
    Eugene, I'm sorry, I wrote: give an idea - I will look. But now the Euro 2012 match is coming :). If you have time until Monday, then skip me again your task at freestas@email.ua - I will try to solve it. But now it is clear to me that it is necessary to set a string variable of length N, and then “push” the units to the right, taking into account the digit capacity of K and reaching the end of the line. Although, I feel, there is a universal mathematical algorithm for solving a similar problem. - Vyacheslav Kirichenko

1 answer 1

 program test; {$APPTYPE CONSOLE} var ones: array of Integer; i: Integer; K: Integer; N: Integer; S: String; input, output: TextFile; procedure shiftones(idx: Integer); begin if (Idx<K-1) and (ones[Idx+1]=ones[Idx]+1) then begin shiftones(Idx+1);//двигаем индекс старшей единицы ones[Idx]:=Idx;//а текущий индекс возвращаем на начало. начало совпадает с индексом end else ones[Idx]:=ones[Idx]+1;//двигаем индекс текущей единицы end; function CurStr: String; var ii: Integer; begin Result:=S; for ii:=0 to K-1 do Result[N-ones[ii]]:='1';//вписываем единицы в индексы по массиву (с конца) end; begin AssignFile(input,'input.txt'); Reset(input); ReadLn(input,N,K); closeFile(input); S:=''; for i:=0 to N-1 do S:=S+'0';//Строка нулей SetLength(ones,K); for i:=0 to Length(ones)-1 do ones[i]:=i; //Массив индексов единиц AssignFile(output,'output.txt'); ReWrite(output); while (ones[K-1]<N) do begin WriteLn(output,CurStr); shiftones(0);//Двигаем единицы end; closeFile(output); end. 

With N = 22 and K = 11 (the maximum number of lines will be for n with k = n / 2) the time is 0.731, the file size is 16.1MB, i.e. more than you need.

  • cool solution, but it fails 10 tests, a runtime error says! I will think where is the mistake - Eugene536
  • Errors of this program: the case was not taken into account that can be k = 0 and can be n = 0; Thanks for this code! - Eugene536
  • Yes, I did not check the boundary conditions. Well, easy to fix, the main principle is clear. - Yura Ivanov