Скачать: CL | DM;

Пятничные задачки. Вася Пупкин и компания...   Найти похожие ветки 

← →
MBo ©   (2009-10-09 09:46) [0]

1. Вася Пупкин пришел на карнавал. Оказалось, что он там никого не узнает,
а вот его гражданская наружность известна всем даже в маске.
Все люди пронумерованы от 1 до N. За какое минимальное время можно выяснить,
ху из мистер Пупкин, если единственное допустимое действие - вопрос i-му человеку,
знает ли он j-того (function Knows(i, j: Integer): Boolean)

2. Вася Пупкин наблюдал процесс подачи документов в ВУЗ по новым правилам.
Абитуры много, выстроилась огромная живая очередь. Каждый стоящий запоминает
стоящего прямо перед ним, и, возможно, еще кого-то одного в любом месте очереди.
Васю заинтересовала получающаяся структура данных, и он описал ее так:

Дан указатель на первый элемент односвязного прошитого списка из элементов типа
PNode = ^TNode;
TNode = record
 Name: string;
 Next: PNode;
 Any: PNode;
end;

Next - указывает на след. элемент списка или равен Nil для последнего элемента (первый в очереди)
Any - указывает на любой элемент списка (спереди или сзади) или равен Nil.

Теперь Васе необходимо за O(N) времени создать глубокую копию исходного списка такую,
что если в исходном списке Any i-го элемента указывает на j-й элемент,
то такое же отношение должно быть и между элементами копии списка.
Допускается выделять память только под N элементов для копии списка.
Исходный список после операции копирования должен быть в исходном состоянии.

3. Васе Пупкину нужно выделить группу студентов-первокурсников для
проведения педагогического эксперимента по следующим критериям:
Сумма баллов выбранной группы должна быть максимальной. Однако соседние в списке
студенты могут быть знакомы, и одновременно их брать для участия в эксперименте
нельзя. Вася формализовал задачу так:
Дан массив натуральных чисел. Как эффективно найти подпоследовательность
с максимальной суммой при условии, что соседние элементы не могут входить в
подпоследовательность. Например, для массива [1,51,3,1,100,199,3]
maxSum = 51 + 1 + 199 = 251

4. Васе Пупкину нужно написать программу, выводящую энное по порядку из крутых
чисел. Число является крутым, если в его разложении на множители присутствуют
только простые числа из заданного списка.
Например, крутые числа для списка [2, 3]: 1, 2, 3, 4, 6, 8, 9, 12, 16...
Функция может выглядеть так:
function Cool(const N: Integer; const Primes: array of Integer): Integer;
Cool(8, [2, 3]) должно выдать 12
ДЛя простоты можно, в принципе, ограничиться списком из трех чисел.
Чему равно, например, Cool(1000, [2, 3, 5]) ?

5. Вася Пупкин пишет программу для вывода списка файлов в папке красивым образом.
Красота должна быть такая -
а) Если файлов нет  - выводится {}
б) Один файл с именем A - {A}
в) Два файла A B - {A и B}
г) Более двух - {A, B и С}, или {A, B, C, D и E}
NB: запятой перед "и" нет.

Сохранять весь список и форматировать его потом - некошерно, считать файлы заранее - тоже.

P.S. В оригинале - дается нечто, поддерживающее IEnumerable. На мой взгляд, FindXXX
функции аналогичны существенным методам этого интерфейса, так что можно решать, кому как удобнее.

6. У каждого из 100 заключенных в тюрьме есть уникальный номер.
Номера всех заключенных разложили случайным образом в 100 коробок.
Коробки расставили в линию в коридоре, в который по одному пускают заключенных.
Каждый заключенный может посмотреть содержимое не более 50 коробок.
После этого он выходит из коридора через другую дверь, и никаким образом не
может передать информацию еще не входившим в комнату заключенным, т.к.
все содержимое коридора приводится к начальному состоянию.

Если все 100 заключенных найдут свои номера, их выпустят.
Если хотя бы один из 100 не найдет своего номера в 50 коробках, которые он открыл
- всех казнят. Зэки могут договориться между собой до похода первого из них в комнату
о том, как они будут открывать коробки.

Возможно ли создать стратегию, при которой у заключенных будут неплохие шансы спастись?

---

← →
MBo ©   (2009-10-09 09:58) [1]

Уточнение 1. на всякий случай:
Вася - единственный, которого знают все, а он не знает никого. Для остальных это неверно.

---

← →
KilkennyCat ©   (2009-10-09 10:26) [2]

я бы по первой задаче еще хотел бы уточнение: спрашивать вежливо?

---

← →
TUser ©   (2009-10-09 10:33) [3]

А что такое "глубокая копия"?

---

← →
Kolan ©   (2009-10-09 11:08) [4]

Глубокая копия, значить скопировать все полностью, чтобы новый список был точ-в-точ как первый.

---

← →
Дмитрий С ©   (2009-10-09 11:38) [5]

> 2. Вася Пупкин наблюдал процесс подачи документов в ВУЗ
> по новым правилам.
> Абитуры много, выстроилась огромная живая очередь. Каждый
> стоящий запоминает
> стоящего прямо перед ним, и, возможно, еще кого-то одного
> в любом месте очереди.

А в чем тут проблема? Найти самый первый элемент?

---

← →
Kolan ©   (2009-10-09 12:20) [6]

№ 5



function TForm3.FormatFileList(const Directory: string): string;
var
 CurrentFile: TSearchRec;
 Delimiter: string;
 PreviousDelimiterPos: Integer;
begin
 Result := "";

 if DirectoryExists(Directory) then
 begin
   try
     PreviousDelimiterPos := -1;
     if FindFirst(Directory + "*.*", faAnyFile, CurrentFile) = 0 then
     begin
       repeat
         if (CurrentFile.Name <> ".") and (CurrentFile.Name <> "..")
           and ((CurrentFile.Attr and faDirectory) = 0)
         then
         begin
           Delimiter := "";
           if Result <> "" then
           begin
             Delimiter := " и ";
             if PreviousDelimiterPos <> -1 then
             begin
               Result[PreviousDelimiterPos] := ",";
               Delete(Result, PreviousDelimiterPos+1, 1);
             end;
             PreviousDelimiterPos := Length(Result)+1;
           end;
           Result :=  Result + Delimiter + CurrentFile.Name
         end;
       until FindNext(CurrentFile) <> 0;
     end;
   finally
     FindClose(CurrentFile);
   end;
   Result := "{"+Result+"}";
 end;
end;

Хочется сказать Васи, что он извращенец, потому что считать список файлов сразу гораздо проще и понятнее.

---

← →
Bless ©   (2009-10-09 12:39) [7]

1) Ну, за N-1 точно можно :) Можно быстрее?

---

← →
Skyle ©   (2009-10-09 12:43) [8]

Дайте-ка я тоже попробую №5 :)

function SuperDir(AFolder : String) : String;
var
 SR : TSearchRec;
 LastName : String;
begin
 Result := "";
 LastName := "";
 if FindFirst(IncludeTrailingBackSlash(AFolder) + "*.*", faAnyFile, SR) = 0 then
 begin
   if (SR.Name <> ".") and (SR.name <> "..") then
     LastName := SR.Name;
   while FindNext(SR) = 0 do
   begin
     if (SR.Name <> ".") and (SR.name <> "..") and (SR.Attr and faDirectory = 0) then
     begin
       if Length(LastName) > 0 then
       begin
         if (Length(Result) = 0) then
           Result := LastName
         else
           Result := Result + ", " + LastName;
       end;
       LastName := SR.Name;
     end;
   end;
   if Length(Result) > 0 then
     Result := Result + " &#232; " + LastName
   else
     Result := LastName;
   FindClose(SR);
 end;
 Result := "{" + Result + "}";
end;

---

← →
MBo ©   (2009-10-09 12:45) [9]

>Kolan ©   (09.10.09 12:20) [6]
Отлично работает!
Интересно, можно ли без трюка с Delete обойтись....

---

← →
MBo ©   (2009-10-09 12:53) [10]

>Bless ©   (09.10.09 12:39) [7]
> Можно быстрее?
нет.

---

← →
Bless ©   (2009-10-09 12:56) [11]

2) Допускается выделять память только под N элементов для копии списка.

Кроме этих N элементов вообще больше ни одной переменной нельзя завести?

---

← →
MBo ©   (2009-10-09 12:58) [12]

>Skyle ©   (09.10.09 12:43) [8]

Работает.
Тоже хитрО использует информацию о выходной строке ;)

---

← →
MBo ©   (2009-10-09 12:59) [13]

>Кроме этих N элементов вообще больше ни одной переменной нельзя завести?

Можно.
Лишние O(N) нельзя.

---

← →
MBo ©   (2009-10-09 13:16) [14]

З.Ы.
к 5.
атрибут faAnyFile - faDirectory позволит не заморачиваться на папки и точки.

---

← →
Bless ©   (2009-10-09 14:16) [15]

2)
function Clone(list: PNode);
var
 p1, p2: PNode;
begin
 //вставляем в список после каждого текущего узла новый узел.
 //т.е. список вида node1 -> node2 -> node3 превращаем в список вида node1 -> new1 -> node2 -> new2 -> node3 -> new3
 p1 := list;
 while p1 <> nil do begin
   p2 := new(TNode);
   p2^.next := p1^.next;
   p1^.next := p2;
   p1 := p2^.next;
 end;
 
 //теперь разбираем наш удлиненный вдвое список на два:
 //- исходный
 //- и новый, состоящий из узлов new_i.
 p1 := list;
 if p1 <> nil then
   result := p1^.next;
 else
   result := nil;
 repeat
   p2^.name := p1^.name;
   p2 := p1^.next;
   p1^.next := p2^.next;
   if p1.next <> nil then
     p2^.next := p1^.next^.next;
   if p1^.any <> nil then
     p2^.any := p2.any^.next;
   p1 := p1^.next;
 until p1=nil;
end;

---

← →
Bless ©   (2009-10-09 14:25) [16]

Прошу прощения, вариант выше -  с ошибками. Вроде исправил. Хотя я в Delphi не проверял, поэтому уверенности, что исправил все, нет :) Но думаю, идея понятна.

function Clone(list: PNode);
var
 p1, p2: PNode;
begin
 //вставляем в список после каждого текущего узла новый узел.
 //т.е. список вида node1 -> node2 -> node3 превращаем в список вида node1 -> new1 -> node2 -> new2 -> node3 -> new3
 p1 := list;
 while p1 <> nil do begin
   p2 := new(TNode);
   p2^.next := p1^.next;
   p1^.next := p2;
   p1 := p2^.next;
 end;
 
 //теперь разбираем наш удлиненный вдвое список на два:
 //- исходный
 //- и новый, состоящий из узлов new_i.
 p1 := list;
 if p1 <> nil then
   result := p1^.next;
 else
   result := nil;
 repeat
   p2 := p1^.next;
   //восстанавливаем прежнее значеие поля next  у узла node_i
   p1^.next := p2^.next;
   //заполняем правильными значениеями поля name, next, any у узла new_i.
   p2^.name := p1^.name;
   
   if p1^.next <> nil then
     p2^.next := p1^.next^.next;
   else
     p2^.next := nil;
   
   if p1^.any <> nil then
     p2^.any := p2.any^.next;
   else
     p2^.any := nil;
   
   p1 := p1^.next;
 until p1=nil;
end;

---

← →
McSimm ©   (2009-10-09 14:27) [17]

> 1) Ну, за N-1 точно можно

А как ? Ведь единственное доказательство, что k - Вася это
Knows[k,j] = true, j=1..N без k;
Т.е. все N-1 вопросов надо задать Васе, но для этого надо знать кто он

---

← →
McSimm ©   (2009-10-09 14:28) [18]

> Knows[k,j] = true, j=1..N без k;

= false

---

← →
Kolan ©   (2009-10-09 14:29) [19]

Bless, вы считаете, что удлинив список в двое вы соблюли условие о том, что «допускается выделять память только под N элементов для копии списка»?

---

← →
MBo ©   (2009-10-09 14:30) [20]

>Bless ©   (09.10.09 14:16) [15]

Супер!

---

← →
Дуб ©   (2009-10-09 14:31) [21]

> McSimm ©   (09.10.09 14:27) [17]

Берес чела, задаем вопрос про другого. Если "Нет", то далее. Если все Нет, то Вася. Если да, то переходим к нему(потенциальный Вася) и задаем ему исключая его и тех кого он спрашивал до этого.

---

← →
Bless ©   (2009-10-09 14:31) [22]

> Kolan ©   (09.10.09 14:29) [19]
>
> Bless, вы считаете, что удлинив список в двое вы соблюли
> условие о том, что «допускается выделять память только под
> N элементов для копии списка»?


Ну да. Я и выделил N НОВЫХ элементов под копию списка.
Кстати, ошибки исправил не все:
нужно поменять
else
  result := nil;
на
else begin
  result := nil;
 exit;
end;

---

← →
MBo ©   (2009-10-09 14:32) [23]

>Kolan ©   (09.10.09 14:29) [19]
Да, ведь новый список все равно нужно создавать, а количество вставляемых узлов равно конечному количеству в новом списке.

---

← →
Дуб ©   (2009-10-09 14:33) [24]

> то переходим к нему(потенциальный Вася) и задаем ему исключая
> его и тех кого он спрашивал до этого.

то переходим к тому на кого да, и задаем оставшимся.

---

← →
McSimm ©   (2009-10-09 14:34) [25]

Поправка, есть два доказательства.
Knows[k,j] = false, j=1..N без k;
Knows[i,k] = true, i=1..N без k;

Например, N = 5, k = 2
* 1 1 0 1
0 * 0 0 0
1 1 * 1 1
1 1 1 * 0
0 1 0 1 *

Что-то не придумаю, как доказать любое из утверждений за N-1 просмотров

---

← →
Дуб ©   (2009-10-09 14:35) [26]

> то переходим к тому на кого да, и задаем оставшимся.

тьфу - опять криво написал. Ну, в общем понятно.

---

← →
Bless ©   (2009-10-09 14:36) [27]

> McSimm ©   (09.10.09 14:27) [17]
>
>
> > 1) Ну, за N-1 точно можно
>
> А как ? Ведь единственное доказательство, что k - Вася это
>
> Knows[k,j] = true, j=1..N без k;
> Т.е. все N-1 вопросов надо задать Васе, но для этого надо
> знать кто он


Берем любого человека с номером i и спрашиваем "знаешь ли ты человека с номером j?".
Если он отвечает "да", то он точно не Вася Пупкин, потому что Вася тут никого не знает и ответить "да" не может. Следовательно i-го можно исключить.
Если он отвечает "нет", то j-ый - точно не Вася Пупкин, потому что его знают все. Значит?, j-го можно исключить.
В любом случае в результате одного вопроса кого-то одного можно исключить :)

---

← →
MBo ©   (2009-10-09 14:36) [28]

>ошибки исправил не все
Главное, идея понятна.
Детали я пытался на бумажке отследить, были проблемки, но шлифовка-отладка спасет.

---

← →
MBo ©   (2009-10-09 14:44) [29]

>McSimm
Каждый вопрос обязательно исключает одного человека из пары.
Я когда решал, разбил список на пары (при нечетном числе один отдыхает), исключил половину, остаток снова поделил на пары и т.д. Для N = 2^M понятно, что N-1 вопрос, при некруглых числах тоже можно это показать.
A-B -
C-D
E

2 вопроса

оставшийся из AB
-\\- CD
3 вопроса

ABCD
E
4 вопроса

Но линейный подход, как Дуб и Bless  говорят, проще:

A-B-C-D-E
исключаем одного из A или B, оставшегося присоединяем к хвосту списка, повторяем с первой парой и т.д.

---

← →
McSimm ©   (2009-10-09 14:53) [30]

понял, спасибо

---

← →
oldman ©   (2009-10-09 15:59) [31]

№1


> За какое минимальное время можно выяснить


Если предположить, что кто-то, кроме Пупкина, знает только одного, то минимальное время равно N попыток.
Поскольку, если предположить, что сразу попадаем на этого кого-то, то за N-1 вопрос он знает 2 человек.
На следующем вопросе все становится ясно.

---

← →
Franzy   (2009-10-09 16:13) [32]

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

---

← →
MBo ©   (2009-10-09 17:11) [33]

>видимо, выигрышной стратегии нет
Есть стратегия с существенными шансами на успех.
Задача очень сложная, так что могу дать  первоначальную наводку...

---

← →
Дуб ©   (2009-10-09 17:20) [34]

> Но линейный подход, как Дуб и Bless  говорят, проще:
>
> A-B-C-D-E
> исключаем одного из A или B,

и по индукции показывается, что это минимальный ответ. Писал быстро - шел на собрание в школу, спешил.

> MBo ©   (09.10.09 17:11) [33]

У Шекспира кажется, почти такая же есть - при выборе жениха. По №6. 3 шкатулки и вагон участников. А вообще интересно - по теории игр.

---

← →
Дмитрий С ©   (2009-10-09 19:11) [35]

> Есть стратегия с существенными шансами на успех.
> Задача очень сложная, так что могу дать  первоначальную
> наводку...

На ум приходит только следующее:
1ый зек открывает ящики с 1-50
2ой - 2-51
3ий - 3-52
...
52ый - 1 и 52-100
53ий - 1-2 и 53-100
...
Но если подумать, то шанс при такой стратегии ничтожно мал.

---

← →
Дуб ©   (2009-10-10 04:57) [36]

> Дмитрий С ©   (09.10.09 19:11) [35]

Я думаю, что главное, что тут требуется, это с вероятностью 1 обеспечить выборку всех номеров. И возможно каждого номера равное число раз.

Вот доказательство пока не приведу.

> Но если подумать, то шанс при такой стратегии ничтожно мал.

Мал, но видимо выше если дать все на абс. случайный откуп. Т.к. при последнем существует ненулевая вероятность невыбрки всех номеров.

---

← →
SP   (2009-10-10 14:44) [37]

6. Если учесть то, в случае если первый заключенный не найдет своего номера - то всех все равно казнят, не зависимо от действий остальных,  то можно рассматривать только ситуацию когда он нашел свой номер. Тогда получается что второму имеет смысл искать свой номер в оставшихся 50-ти ящиках... ибо при этом вероятность будет 50/99.

Т.е. заключенные должны поделить ящики на 2 группы и искать свои номера в них по очереди.
Например:
1 зек. ящики 1-50 (вероятность 50/100=1/2).
2 зек. ящики 51-100 (если первый зек не влетел, то вероятность 50/99, иначе уже все пофиг).
3 зек. ящики 1-50 (если первые 2 зека не влетели, то вероятность 49/98, иначе уже все пофиг).
и т.д.

ИМХО

---

← →
Наиль ©   (2009-10-10 20:07) [38]

По номеру №3
Пишу, то что успел придумать 1 минуту.
Исходим из того, что все баллы положительные.
Начинаем с 2го по списку. Если число больше своих соседей, то делаем их отрицательными. Продолжаем сравнивать до предпоследнего. Находим сумму положительных чисел.
Возвращаемся в исходное состояние. Повторяем от конца к началу списка.
Сравниваем суммы и смотрим, какой из 2х вариантов лучше. Его и берём.
Метод не самый эффективный, но зато быстрый.

---

← →
SP   (2009-10-10 20:55) [39]

> McSimm ©   (09.10.09 14:34) [25]
>
> Поправка, есть два доказательства.
> Knows[k,j] = false, j=1..N без k;
> Knows[i,k] = true, i=1..N без k;
>
> Например, N = 5, k = 2
> * 1 1 0 1
> 0 * 0 0 0
> 1 1 * 1 1
> 1 1 1 * 0
> 0 1 0 1 *
>
> Что-то не придумаю, как доказать любое из утверждений за
> N-1 просмотров


Да тут вроде и без примеров ясно.
i:=1;
j:=N;
while i<j do if know(i,j) then inc(i) else dec(j);
и в результате имеем в i - номер Васи Пупкина, а вся эта беда выполнится за N-1 итераций.

---

← →
SP   (2009-10-10 21:09) [40]

№3
Сумму найти в принципе просто: SummaSubArray(0,A);

function SummaSubArray(i:integer; var A:array of integer):integer;
var
 S2:integer;
begin
if i>high(A) then Result:=0
 else if i=high(A) then Result:=A[i]
   else begin
         Result:=SummaSubArray(i+1,A);
         S2:=A[i]+SummaSubArray(i+2,A);          
         if Result<S2 then result:=S2;
         end;
end;

А вот как найти последовательность будет чуть труднее.

---

← →
Цитатник   (2009-10-10 22:28) [41]

> SP   (10.10.09 21:09) [40]

> А вот как найти последовательность будет чуть труднее.

За это не люблю рекурсию, что приходится передавать всё через параметры, либо заводить глобальную переменную:
if Result<S2 then begin
 result:=S2;
 GlobalArrayVar[i]:=a[i];
end
else GlobalArrayVar[i]:=0;

---

← →
MBo ©   (2009-10-11 19:15) [42]

Первая наводка к 6 задаче:
Заключенный знает, какую коробку открывать первой

---

← →
SP   (2009-10-11 21:55) [43]

> Первая наводка к 6 задаче:
> Заключенный знает, какую коробку открывать первой


Хм... Не уверен, что это имеет смысл...
ИМХО смысл задачи в том что:
Вероятность того что первый зэк надет правильную коробку =1/2
и нам нужно найти вариант при котором произведения вероятностей того что каждый из всех остальных зеков найдет свою коробку максимальное при условии что каждый предыдущий таки найдет свою коробку...

---

← →
MBo ©   (2009-10-11 22:27) [44]

>Вероятность того что первый зэк надет правильную коробку =1/2

В каком случае?

---

← →
SP   (2009-10-11 23:06) [45]

> В каком случае?


В любом. Если конечно, я правильно понял условие задачи...

---

← →
SP   (2009-10-11 23:07) [46]

> В каком случае


Ибо 50 из 100

---

← →
SP   (2009-10-12 04:05) [47]

> Номера всех заключенных разложили случайным образом в 100
> коробок.


Хотя первоначально я понимал так что по одному номеру в коробку. А вот сейчас перечитал и усомнился. Так что нужно уточнение: В каждой коробке по 1 номеру или могут быть коробки с несколькими номерами а также и пустые?

---

← →
MBo ©   (2009-10-12 06:11) [48]

> В каждой коробке по 1 номеру
Да

>или могут быть коробки с несколькими номерами а также и пустые
нет

---

← →
Дмитрий С ©   (2009-10-12 07:53) [49]

Я проверил перебором (100-1000 тыс попыток):
- Каждый четный зек открывает четные ящики, нечетный - нечетные:

Ok: 0
Total: 1000000
Percent (Veroyatnost): 0.00000000
Happy: 1002974
Happy avg: 1.00297400
FailStep avg: 2.00297400
Max FailStep: 21

Где:
Ok - Количество ситуаций, в которых все зеки нашли свои номера (искомая ситуация).
Total - Количество попыток.
Percent (Veroyatnost) - Процент успешных попыток.
Happy - Количество зеков, которые нашли свои номера (Всего. Зеки перестают считаться когда хоть один не нашел свой номер)
Happy avg - Среднее количество зеков, которые нашли свои номера.
FailStep avg - Средний номер зека, который первый не нашел своего номера.
Max FailStep - Максимальный номер зека, который нашел свой номер.

- Четные зеки открывают первую половину ящиков - нечетные - вторую:

Ok: 0
Total: 1000000
Percent (Veroyatnost): 0.00000000
Happy: 1007996
Happy avg: 1.00799600
FailStep avg: 2.00799600
Max FailStep: 21


- Зеки открывают ящики случайным образом:

Ok: 0
Total: 100000
Percent (Veroyatnost): 0.00000000
Happy: 99591
Happy avg: 0.99591000
FailStep avg: 1.99591000
Max FailStep: 18


- Первая половина зеков открывает первую половину ящиков:

Ok: 0
Total: 1000000
Percent (Veroyatnost): 0.00000000
Happy: 985164
Happy avg: 0.98516400
FailStep avg: 1.98516400
Max FailStep: 17


Код:

program zek;

{$APPTYPE CONSOLE}

uses
 Windows,
 Classes,
 Math;

type
 TBoxes = array[1..100] of Integer;

function RandomBoxes(Mx: Integer = 100):TBoxes;
{ Случайным образом заполняем коробки}
var
 I, J, X: integer;
begin
 { Сначала по-порядку, }
 for I := 1 to Mx do
   Result[I] := I;

 { затем перемешиваем. }
 for I := 1 to Mx do
 begin
   J := Random(Mx) + 1;
   Assert(J in [1..Mx], "J out of range");
   X := Result[I];
   Result[I] := Result[J];
   Result[J] := X;
 end;
end;

var
 I, Zek, Ok, Total: Integer;
 X, M: Integer;
 Boxes, ZekBoxes: TBoxes;
 Fail, OneZekOk: Boolean;
 Happy: Integer;
 FailStepSum: Integer;
 FailStepMax: Integer;
 Time: Cardinal;
begin
 Randomize;
 Ok := 0;
 Total := 0;
 Happy := 0; // Счастливые зеки (информационно)
 FailStepSum := 0; // Номер зека на котором получилася сбой (для среднего значения)
 FailStepMax := 0; // Максимальный номер зека, на котором случился сбой
 Time := GetTickCount;
 for I := 1 to 1000000 do
 begin
   // Запоняем коробки
   Boxes := RandomBoxes;

   // Если хоть один зек не найдет номер, то будет Fail = True
   Fail := False;

   // Перебераем всех зеков
   for Zek := 1 to 100 do
   begin
     // Проверка для каждого зека: нашел/не нашел
     OneZekOk := False;

     begin
       // Перебираем ящики
       { ///// Четные зеки - четные ящики
       for X := 1 to 100 do
         if (Zek and 1) = (X and 1) then // Если зек с четным номером, то он смотрит соответствующие ящики
           if Boxes[X] = Zek then  // Если нашел, то идем к следующему зеку.
           begin
             // Считаем удачливых:
             Inc(Happy);
             OneZekOk := True;
             Break;
           end;
       }
       { ///// Четные зеки - первая половина, нечетные - вторая
       if (Zek and 1) = 0 then M := 1 else M := 51;
       for X := M to M + 49 do
         if Boxes[X] = Zek then  // Если нашел, то идем к следующему зеку.
         begin
           // Считаем удачливых:
           Inc(Happy);
           OneZekOk := True;
           Break;
         end;
        }
       {///// Случайно
       ZekBoxes := RandomBoxes;
       for X := 1 to 50 do
         if Boxes[ZekBoxes[X]] = Zek then  // Если нашел, то идем к следующему зеку.
         begin
           // Считаем удачливых:
           Inc(Happy);
           OneZekOk := True;
           Break;
         end;
       }
       //{///// Первая половина открывает первую половину ящиков
       if Zek < 51 then M := 1 else M := 51;
       for X := M to M + 49 do
         if Boxes[X] = Zek then  // Если нашел, то идем к следующему зеку.
         begin
           // Считаем удачливых:
           Inc(Happy);
           OneZekOk := True;
           Break;
         end;
       //}
     end;

     if not OneZekOk then begin
       Inc(FailStepSum, Zek);
       if FailStepMax < Zek then FailStepMax := Zek;
       Fail := True;
       Break;
     end;
   end;
   if not Fail then begin
     Inc(Ok);
   end;
   Inc(Total);
   if ((I and $FFF) = 0) and (GetTickCount - Time > 1000) then
   begin
     Time := GetTickCount;
     Write(I*100/1000000:0:3, "%"#13);
   end;
 end;
 Writeln;
 writeln("Ok: ", Ok);
 writeln("Total: ", Total);
 writeln("Percent (Veroyatnost): ", Ok*100/Total:0:8);
 writeln("Happy: ", Happy);
 writeln("Happy avg: ", Happy/Total:0:8);
 writeln("FailStep avg: ", FailStepSum/Total:0:8);
 writeln("Max FailStep: ", FailStepMax);
 Readln;
end.



---

← →
Дмитрий С ©   (2009-10-12 07:54) [50]

Либо задача действительно сложная, либо зеки обречены :(

---

← →
Дуб ©   (2009-10-12 08:16) [51]

> Дмитрий С ©   (12.10.09 07:54) [50]

Можно, видимо, посмотреть на циклы внутри цепочек. Ящик в нем номер - ссылка на другой ящик. И смотреть вероятности тут. Какова вероятность, что все циклы меньше 50, интересно.

---

← →
Дуб ©   (2009-10-12 08:20) [52]

Или так: какова вероятность наличия цикла больше 50?

---

← →
Дмитрий С ©   (2009-10-12 08:23) [53]

> Дуб ©   (12.10.09 08:16) [51]

Невероятно :)
Вот результат предложенного тобой:

Ok: 149690
Total: 500000
Percent (Veroyatnost): 29.93800000
Happy: 15119109
Happy avg: 30.23821800
FailStep avg: 1.00083800
Max FailStep: 14

Вероятность спастись почти 1/3.

---

← →
Дуб ©   (2009-10-12 08:25) [54]

> Дмитрий С ©   (12.10.09 07:53) [49]

А так я смотрел. Там все сводится к тому, что часть зеков черная, другая белая поровну. Они не знают своего цвета и в комнате 2 кнопки. Остальное понятно. При таком варианте вероятность (1/2)^50 и выше не прыгнешь. :(

Рассмаривать же через стратегии тИгр - сумасшедствие получается, уже для 4 зеков число стратегий 20736. Хотя часть из них и откинется через доминирование, но все равно - грустно анализировать. :)

---

← →
Дуб ©   (2009-10-12 08:28) [55]

> Дмитрий С ©   (12.10.09 08:23) [53]

Можно идти в адвокаты. И пусть Ковалев нам завидует!! :)

---

← →
Дмитрий С ©   (2009-10-12 08:34) [56]

Вероятность цикла больше 50 у меня получилась:
0.00983000
Это менее 1 процента.

---

← →
Дуб ©   (2009-10-12 09:05) [57]

> Это менее 1 процента.

На 30 не похоже. :( Где-то чего-то.

---

← →
MBo ©   (2009-10-12 09:11) [58]

>SP   (10.10.09 21:09) [40]
Здорово, лаконично.
У меня  длиннее, т.к. без рекурсии, путь запоминается


function MaxSumNotAdj(A: array of Word; var Elements: string): Integer;
 var
   i: Integer;
   AdjacentMaxx: array[0..3] of Integer;
   MaxChains: array of Integer;

 begin
   SetLength(MaxChains, Length(A));
   FillChar(AdjacentMaxx, SizeOf(AdjacentMaxx), 0);

   for i := High(A) downto 0 do begin
     if AdjacentMaxx[(i + 2) mod 4] >= AdjacentMaxx[(i + 3) mod 4] then begin
       AdjacentMaxx[i mod 4] := A[i] + AdjacentMaxx[(i + 2) mod 4];
       MaxChains[i] := i + 2;
     end
     else begin
       AdjacentMaxx[i mod 4] := A[i] + AdjacentMaxx[(i + 3) mod 4];
       MaxChains[i] := i + 3;
     end;
   end;

   if AdjacentMaxx[0] >= AdjacentMaxx[1] then
     i := 0
   else
     i := 1;
   Result := AdjacentMaxx[i];
   Elements := "";

   repeat // restore max chain to string
     Elements := Elements + IntToStr(A[i]) + " ";
     i := MaxChains[i];
   until i > High(A);
 end;


---

← →
MBo ©   (2009-10-12 13:38) [59]

>посмотреть на циклы внутри цепочек. Ящик в нем номер - ссылка на другой ящик

Монстры ;)
Такую парадоксальную задачу расшерстили

---

← →
Дмитрий С ©   (2009-10-12 13:52) [60]

> Такую парадоксальную задачу расшерстили
>

Это все Дуб.

А кто расскажет почему так получается?

---

← →
MBo ©   (2009-10-12 15:30) [61]

>А кто расскажет почему так получается?
Набор номеров в коробках представляет собой перестановку.
Всего перестановок 100!
В перестановке из чисел выстраиваются циклы, т.н. разъединенные циклы.
Например, в перестановке 5 чисел 3 5 1 4 2 имеется 2 цикла длиной 2 и один цикл длиной 1 (стационарная точка).
Т.е. если k-й человек открывает k-й ящик, далее открывает ящик с номером, который там лежит, и так далее, то в конце концов он найдет свой номер.
   
 m := A[k];
 while m <> k do begin
    m := A[m];
    Inc(CycleLen);
  end;


Худший случай - цикл длиной 100, например, для перестановки 100, 1, 2,.. 99. Плохи также перестановки с циклами длиной более 50.
А доля таких плохих перестановок (при которых хотя бы один не найдет своего номера) - порядка 70% ( Sum[i=51..100] (1/i))

---

← →
Дуб ©   (2009-10-12 16:51) [62]

>  перестановке из чисел выстраиваются циклы, т.н. разъединенные
> циклы.

Вот. Я тебя потому потом и спросил. Сам посчитаю, или ты матерится начнешь? Посчитать я и сейчас не готов.

---

← →
oldman ©   (2009-10-12 17:11) [63]

> oldman ©   (09.10.09 15:59) [31]


Вах! проще...
Если первый попавшийся мен на все вопросы типа "ты его знаешь?" ответит "нет" это и есть Вася.
N-1 вопрос.

---

← →
Думкин ©   (2009-10-12 17:21) [64]

> Дмитрий С ©   (12.10.09 13:52) [60]

И..там подсказка про знание первого ...это все решение. Просто у нас солнце раньше встает. Но без этого .такие задачи придумываются с конца, через ответ. Красивая задача.

---

← →
Alx2 ©   (2009-10-12 18:25) [65]

4.

Cool возвращает массив показателей степеней для n-го значения. Сложность O(ln(N)^(n-1) * N) где n - длина массива степенных оснований

>Чему равно, например, Cool(1000, [2, 3, 5]) ?

Показатели: [14,0,5]. Результат:  51200000

Функция:

type TArrayOfInteger = array of integer;

 function cool(N: integer; const bases: array of integer): TArrayOfInteger;
 var
   logs: array of double; // Храним логарифмы оснований степеней
   powers, answer: TArrayOfInteger; // Храним текущие показатели степеней и ответ
   best: double; // Храним минимальное расстояние до плоскости от текущей целочисленной точки
   procedure getNth(idx: integer; const V: double);
   var k: integer;
     result: double;
   begin
     if idx = 0 then begin
       powers[0] := max(trunc(V / logs[0] + 1), 0);
       result := logs[0] * powers[0] - V;
       if result < 1E-10 then begin
         result := result + logs[0];
         inc(powers[0]);
       end;
       if result < best then begin
         best := result;
         for k := 0 to length(powers) - 1 do
           answer[k] := powers[k];
       end;
     end else
       for k := 0 to trunc(V / logs[idx] + 1) do begin
         powers[idx] := k;
         getNth(idx - 1, V - k * logs[idx]);
       end;
   end;
 var
   k: integer;
   currentValue: double;
 begin
   setlength(logs, length(bases));
   setlength(powers, length(bases));
   setlength(answer, length(bases));
   for k := 0 to length(bases) - 1 do logs[k] := ln(bases[k]);

   currentValue := 0;
   for k := 1 to N - 1 do begin
     best := 1E30;
     getNth(length(bases) - 1, currentValue);
     currentValue := currentValue + best;
   end;
   result := answer;
 end;
var
 ans: TArrayOfInteger;
 k: integer;
 S: string;
begin
 ans := cool(1000, [2, 3, 5]);
 S := "";
 for k := 0 to length(ans) - 1 do
   S := S + intToStr(ans[k]) + " ";
 Application.MessageBox(PChar(S), "Result");
end;

PS
Пока я тут тормозил, 6-ю красиво раздраконили :) Все равно буду смотреть тож...

---

← →
MBo ©   (2009-10-13 07:48) [66]

>Alx2 ©   (12.10.09 18:25) [65]
Вау!
Наконец за 4. взялись.
to All: Задача хитрая. В идеале хорошо было бы последовательно генерировать числа, но не так уж просто понять, какая комбинация степеней будет образовывать следующее по порядку число.
Когда я решал эту задачу несколько лет назад, самым простым для меня оказалось создать массив с небольшим запасом, сгенерировать все комбинации степеней, потом подсортировать массив. Код был чудесно прост, однако и памяти нужно O(N), и время O(NlogN) (ну или сортировка за линейное время ценой затрат еще памяти). Я пытался реализовать идею поиска следующего числа в тетраэдре из целых точек (по осям степени двойки, тройки, пятерки, а точки внутри, по сути - логарифмы искомых значений), но до ума не довел.

А вот Alx2 обошелся без затрат памяти ценой хитрого рекурсивного поиска в таком тетраэдре - какая комбинация степеней будет n-й по счету.

Добавлю, что существует очень изящный алгоритм с O(N) памяти без оверхеда, работающий за O(N*log(k)), где k - количество простых в начальном списке, в целых числах, и последовательно генерирующий очередные числа.

---

← →
MBo ©   (2009-10-13 07:50) [67]

> работающий за  O(N*log(k))
пардон, скорее за O(N * k)

---

← →
Alx2 ©   (2009-10-13 13:07) [68]

MBo ©   (13.10.09 7:48) [66]
однако и памяти нужно O(N), и время O(NlogN)

k-й по-порядку элемент в неупорядочненном массиве можно отыскать за линейное время по длине массива.

У меня были мысли генерировать массив с запасом, чтобы потом за линейное время отыскать нужный порядковый элемент, но я не смог гарантировать линейность "запаса". Если действительно "оверхед" будет линейным от N, то у нас уже "в кармане" алгоритм с памятью O(N) и временем O(N).

Идея поиска элемента с нужным порядковым номером проста:
Берем за основу алгоритм QuickSort, но рекурсию пускаем только в ту ветку, которая содержит искомый порядковый номер и останавливаемся когда длина сортируемого фрагмента равна единице. Элемент в том фрагменте и будет результатом.
Время работы этого алгоритма O(N) (так как идем не в оба фрагмента поделенного на две части (относительно медианного элемента) массива, а только в ветку с искомым номером - отсюда линейность).

---

← →
MBo ©   (2009-10-13 13:10) [69]

>k-й по-порядку элемент в неупорядочненном массиве можно отыскать за линейное время по длине массива.

Да, не подумал, т.к. тогда мысли были обо всем массиве

>только в ту ветку, которая содержит искомый порядковый номер
Этого не просек - как ветку выбрать?

---

← →
MBo ©   (2009-10-13 13:23) [70]

алгоритм по идее из книги Дейкстры "Дисциплина программирования"

при ShowCandidates = True в конце строки выводится самое ранний еще нужный индекс из aq, до него в принципе можно не хранить, но асимптотики по памяти это не изменит
program Hamming;
{$APPTYPE CONSOLE}

uses
 SysUtils, Math;

const
 N = 20;//1000
 ShowCandidates: Boolean = False;
var
 aq: array[1..N] of Int64;
 i2, i3, i5, ix: Integer;
 x2, x3, x5: Int64;
 xx: Extended;

begin
 aq[1] := 1;
 i2 := 1;
 i3 := 1;
 i5 := 1;
 x2 := 2;
 x3 := 3;
 x5 := 5;
 Write(1, ": ", aq[1]);
 if ShowCandidates then
   Writeln("    ", x2, " ",  x3, " ", x5)
 else
   Writeln;
 for ix := 2 to N do begin

   //минимум в очереди (в общем случае k чисел - очередь по приоритетам)
   if x2 <= x3 then
     if x2 <= x5 then
       aq[ix] := x2
     else
       aq[ix] := x5
   else if x3 <= x5 then
     aq[ix] := x3
   else
     aq[ix] := x5;

  //коррекция курсоров, следующие кандидаты
  //на самом деле нужно продвигать только ветки, в которых достигнуто текущее значение
   while x2 <= aq[ix] do begin
     Inc(i2);
     x2 := 2 * aq[i2];
   end;
   while x3 <= aq[ix] do begin
     Inc(i3);
     x3 := 3 * aq[i3];
   end;
   while x5 <= aq[ix] do begin
     Inc(i5);
     x5 := 5 * aq[i5];
   end;

   Write(ix, ": ", aq[ix]);
   if ShowCandidates then
     Writeln("    ", x2, " ",  x3, " ", x5, "   ", Round(MinValue([i2, i3, i5])))
   else
     Writeln;
 end;
//  xx := aq[N];

 Readln;
end.

---

← →
MBo ©   (2009-10-13 13:26) [71]

>MBo ©   (13.10.09 13:10) [69]
>только в ту ветку, которая содержит искомый порядковый номер
>Этого не просек - как ветку выбрать?

А, пардон, это ты о N-й порядковой статистике, тогда все ясно.

---

← →
Alx2 ©   (2009-10-14 11:04) [72]

MBo ©   (13.10.09 13:23) [70]

Так все просто! У меня дежавю: ты, кажется, несколько лет назад давал эту задачку. И я пробежался по тем же самым граблям, что и тогда. Кто-то из великих сказал: непомнящие истории обречены повторять ошибки. Явно мой случай. :)

---

← →
Думкин ©   (2009-10-14 11:12) [73]

>  Кто-то из великих сказал: непомнящие истории обречены повторять
> ошибки. Явно мой случай. :)

Он сказал грубее. НЕ льсти себе. :))))

---

← →
MBo ©   (2009-10-14 13:04) [74]

>ты, кажется, несколько лет назад давал эту задачку
Мне кажется, я ее еще не выкладывал. В задачах с 2005 года, по крайней мере, не нашел, а сам столкнулся с ней летом 2005

---

← →
MBo ©   (2009-10-14 13:26) [75]

Кстати, упрощенную версию Skyle ©   (09.10.09 12:43) [8] можно сделать:

function FormatFileListA(Dir: string): string;
 var
   SR: TSearchRec;
   LastName: string;
 begin
   Result := "{";
   Dir := IncludeTrailingBackSlash(Dir);
   if FindFirst(Dir + "*.*", faAnyFile - faDirectory, SR) = 0 then
     Result := Result + SR.Name;
   if FindNext(SR) = 0 then begin
     LastName := SR.Name;
     while FindNext(SR) = 0 do begin
       Result := Result + ", " + LastName;
       LastName := SR.Name;
     end;
     Result := Result + " и " + LastName;
   end;
   Result := Result + "}";
 end;

фишка с запоминанием LastName сохранена.

---

← →
Skyle ©   (2009-10-14 14:23) [76]

> MBo ©   (14.10.09 13:26) [75]
> Кстати, упрощенную версию Skyle ©   (09.10.09 12:43) [8]
> можно сделать:

Ну ты же понимаешь, главное - идею показать :)

---

← →
MBo ©   (2009-10-14 14:35) [77]

>ты же понимаешь, главное - идею показать :)

конечно.

---

← →
Alx2 ©   (2009-10-14 19:30) [78]

Думкин ©   (14.10.09 11:12) [73]

>Он сказал грубее. НЕ льсти себе. :))))

А как именно он сказал? :)

MBo ©   (14.10.09 13:04) [74]

Понял. Буду искать источник дежавю. :)

---

← →
Alx2 ©   (2009-10-18 01:21) [79]

К 6-й:
Нашел как считать вероятность выжить по той классной стратегии с циклами:


 function af(N, S: integer): double;
 var
   F: array of double;
   Sum: double;
   k: integer;
 begin
   setLength(f, N);
   for k := 0 to S - 1 do f[k] := 1;
   sum := S;
   for k := S to N - 1 do begin
     f[k] := sum / (k + 1);
     sum := sum + f[k] - f[k - S];
   end;
   result := f[N - 1];
 end;


Здесь N - кол-во ящиков. S - кол-во попыток.

---

← →
Alx2 ©   (2009-10-19 09:45) [80]

Вдогонку к Alx2 ©   (18.10.09 01:21) [79]
Довольно простой оказалась производящая функция вероятности:
exp(sum(x^(k+1)/(k+1),k=0..S-1));
(т.е. n-й член разложения этой функции в ряд Тейлора с центром в нуле (т.е. ряд Маклорена) даст вероятность выжить в конфигурации с n зеками (ящиками) и s попытками):

---

← →
имя   (2009-12-12 18:34) [81]

Удалено модератором

---

Страницы: 1 2 3 вся ветка

Скачать: CL | DM;



Память: 0.72 MB
Время: 0.014 c