Одно число

[kim-im]

Добрый день.
Помогите собрать код для такой задачи.
Условие: В последовательности натуральных чисел от 1 до N сначала вычеркнули все нечетные, потом те, что стояли на нечетных местах в т.д., пока осталось только одно число. Какое это число?
Входные данные: Натуральное число N(от 2 до 2 в степени 63)
Исходные данные: Число, что останется.
Задача как бы несложная. Если заметить, то здесь всего два цикла, которые повторяются: 1-ый-удаляет нечётные элементы, 2-ой-элементы, стоящие на нечётных местах.
Я не могу собрать код для этой задачи так, что бы он работал.
Помогите пожалуйста.
Код для нечётных:

for i:= 1 to n do
   begin
    if odd (a[i]) then
      write(a[i], ' ');
   end;

Код для стоящих на нечётных местах:

for i:= 1 to n do
   begin
    if odd (i) then
      write(a[i], ' ');
   end;

[Serge_Bliznykov]

Сообщение от kim-im

Если заметить, то здесь всего два цикла, которые повторяются

если обратить внимание, что в начале нечётные числа стоят на нечётных местах, то очевидно, что достаточно ОДНОГО цикла.

а вообще, это известная задача, см. "Задача Иосифа Флавия или считалка Джозефуса"

[Black Fregat]

Зачем циклы? При такой постановке задачи останется максимальная степень двойки, входящая в набор.

Сообщение от Serge_Bliznykov

Задача Иосифа Флавия

Насколько я понял, это другая задача. Тут нет кольца

[Аватар]

  i:=1;
  while N>1 do begin i:=i*2; N:=N div 2; end;
  write(i);

и не нужно ни чего вычеркивать ))

Найти такое k, что бы 2^k <= N < 2^(k+1)
То 2^k и останется после вычеркиваний

[Serge_Bliznykov]

Сообщение от Black Fregat

Насколько я понял, это другая задача. Тут нет кольца

согласен.
просто очень похожая.

Сообщение от Black Fregat

Зачем циклы? При такой постановке задачи останется максимальная степень двойки, входящая в набор.

Гениально!!!

подтверждение (https://ideone.com/1HbAE7) (с "вычёркиваниями"):

program ideone;

var a: array of integer;
  i, n, k, prev : integer;
  
  procedure PrintA; var i:integer;
  begin
    for i:=1 to n do
      if a[i]>0 then Write(a[i],' ');
    writeLn
  end;  
  
begin
  repeat
    n := 33;
  until n>0;  
  if n=1 then WriteLn(1)
  else begin
    SetLength(a,n+1);
    for i:=1 to n do a[i]:=i; PrintA;
    repeat
      k:=0;
      prev := 1;
      for i:=1 to n do 
       if a[i]>0 then begin
         Inc(k);
         if prev>0 then begin a[i] := 0; prev := 0 end
         else inc(prev);
       end; 
      PrintA;
    until k=1;
    SetLength(a,0);
  end;
end.

[kim-im]

Спасибо. Вы мне очень помогли.
Код в принципе работает. И я уже в нете нашёл такую же задачу.
Действительно число останется максимальная степень 2.
Но код проходит на 95%.
Что нужно ещё учесть?. Спасибо

var i,n:integer;
begin
read(n);
i:=1;
  while N>1 do 
    begin
     i:=i*2; 
     N:=N div 2; 
    end;
  write(i);
end.

[kim-im]

Кстати тип я поставил int64 вместо integer

[Plague]

var
  n: int64;
begin
  Read(n);
  Write(1 shl Trunc(log2(n)));
end.

Не помню есть в TP log2