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

← →
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) (так как идем не в оба фрагмента поделенного на две части (относительно медианного элемента) массива, а только в ветку с искомым номером - отсюда линейность).

>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 попытками):

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