Пятничные задачки. Вася Пупкин и компания...

← →
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 + " è " + 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 не похоже. :( Где-то чего-то.

>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;

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

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

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

Это все Дуб.

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

>А кто расскажет почему так получается?
Набор номеров в коробках представляет собой перестановку.
Всего перестановок 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))

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

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

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

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

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

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

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-ю красиво раздраконили :) Все равно буду смотреть тож...

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

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

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

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

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

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

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

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

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

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

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

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

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

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

MBo © (13.10.09 13:23) [70]

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

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

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

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

Кстати, упрощенную версию 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 сохранена.

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

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

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

конечно.

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

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

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

MBo © (14.10.09 13:04) [74]

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

К 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 © (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]

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

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