Euler Projesi 253. Soru:

Etrafı derleyip toplamak

Bir çocuğun kırk parçadan oluşan oyuncak bir "sayı tırtılı" var, her yapboz parçasının üzerinde bir sayı olup birleştirildiklerinde sırayla 1 den 40 a sayılar açığa çıkıyor.

Her gece çocuğun babası etrafa dağılan parçaları alıp topluyor. Parçaları rastgele alıp doğru sırada yerleştiriyor.

Tırtıl bu şekilde oluşturulurken, gittikçe birbiriyle birleşen segmentler oluşturuyor.

Segmentlerin sayısı 0 dan başlayıp (hiçbir parça yerleştirilmemiş) genellikle 11 ya da 12 ye kadar yükseliyor, sonra tekrar düşme eğilimine girerek tek bir segment olarak bitiyor (tüm parçalar yerleştirilmiş).

Örneğin:

Yerleştirilen Parça	O ana kadarki segmentler
12	1
4	2
29	3
6	4
34	5
5	4
35	4
…	…

Tırtılın rastgele derlenip toparlanması sırasındaki karşılaşılan maksimum segment sayısı M olsun.

10 parçalı bir tırtıl için her M için olasılıkların sayısı şöyledir:

M	Olasılıklar
1	512
2	250912
3	1815264
4	1418112
5	144000

Böylece M nin en olası değeri 3 ve ortalama değer ise altı ondalık basamağa kadar $385643/113400=3,400732$ dir.

40 parçalı bir tırtıl için M nin en olası değeri 11 dir; ancak M nin ortalama değeri kaçtır?

Cevabınızı altı ondalık basamağa yuvarlayarak veriniz.

Cevap: 11,492847

PASCAL: const maxx=40; var zan:array[1..maxx] of boolean; var i:longint; var vykus,vs,itmaxkus,maxkus,kus,vzya:int64; var sred,sred2,del:real; begin vs:=0; itmaxkus:=0; repeat maxkus:=0; kus:=0; for i:=1 to maxx do zan[i]:=false; vzya:=0; repeat repeat vykus:=1+random(maxx); until zan[vykus]=false; zan[vykus]:=true; inc(kus); inc(vzya); if (vykus<>1) and (zan[vykus-1]=true) then dec(kus); if (vykus<>maxx) and (zan[vykus+1]=true) then dec(kus); if kus>maxkus then maxkus:=kus; until vzya=maxx; itmaxkus:=itmaxkus+maxkus; inc(vs); sred2:=sred; sred:=itmaxkus/vs; del:=abs(sred2-sred); if vs mod 10000 = 0 then writeln ('Srednee znachenie ',sred:10:9, ' Delta: ',del:15:14); until 2=1; end. PYTHON: from math import factorial from copy import copy class Memoize: """Memoize(fn) - an instance which acts like fn but memoizes its arguments Will only work on functions with non-mutable arguments """ def __init__(self, fn): self.fn = fn self.memo = {} def __call__(self, *args): if not self.memo.has_key(args): self.memo[args] = self.fn(*args) return self.memo[args] def splitseg(x): if x == 1: yield () for a in range(x): b = x - a - 1 if a == 0: yield (b,) elif b == 0: yield (a,) else: yield (b,a) @Memoize def f(segs,m,achieved=False): if len(segs) == 0: return achieved elif len(segs) > m: return 0 elif len(segs) == m and not achieved: return f(segs,m,True) else: tot = 0 mysegs = copy(segs) segs = list(segs) for x in mysegs: segs.remove(x) for e in splitseg(x): tot += f(tuple(sorted(tuple(segs) + e)),m,achieved) segs.append(x) return tot x = [f((40,),i) for i in range(1,22)] HASKELL: import Data.List (sort, group, genericLength) import Data.MemoTrie (memo2) main :: IO () main = print $ p253 40 fact' :: Integral a => a -> Integer fact' n = product [1..toInteger n] divid :: Integral a => a -> a -> [[a]] divid k m = dpart k m 1 where dpart :: Integral a => a -> a -> a -> [[a]] dpart 0 0 _ = [[]] dpart _ 0 _ = [] dpart k m n | k < m * n = [] | otherwise = concat [map (l:) $ dpart (k - l) (m - 1) l | l <- [n..div k m]] count :: Eq a => [a] -> Integer count xs = div n d where n = fact'.length $ xs d = product.map (fact'.length).group $ xs hMemo, h :: [Int] -> Int -> Integer hMemo = memo2 h h [] _ = 1 h (0:ss) m = h ss m h ss m | length ss == m = hTight [] ss | otherwise = hLoose [] ss where hTight _ [] = 0 hTight qs (1:rs) = hMemo (sort $ qs ++ rs) m + hTight (qs ++ [1]) rs hTight qs (r:rs) = 2 * hMemo (sort $ qs ++ r-1 : rs) m + hTight (qs ++ [r]) rs hLoose _ [] = 0 hLoose qs (r:rs) = sum [hMemo (sort $ qs ++ r - k : k - 1: rs) m | k <- [1..r]] + hLoose (qs ++ [r]) rs f :: Int -> Int -> Int -> Integer f n (k+1) (m+1) = sum [h ss m * count (1:ss) * ones (1:ss)| ss <- divid k m] * (div num den) where num = fact' (n-k) * fact' (n-k-1) den = fact' (m+1) * fact' (n-k-m-1) ones = genericLength.filter (1==) p253 :: Fractional a => Int -> a p253 n = fromInteger num / fromInteger den where num = sum $ [f n k m | m <- [1..div (n+1) 2], k <- [1..n-m+1]] den = fact' n RUBY: def outcomes(n, m) return 0 if m == 0 ways = Array.new(n + 2, 0) ways[1] = 1 2.upto(n) {|s| tmp = Array.new(n + 2, 0) 1.upto(m) {|h| tmp[h] += h * (ways[h] * 2 + ways[h - 1] + ways[h + 1]) } ways = tmp } ways[1] end def fact(x) return 1 if x == 0 x * fact(x - 1) end def p253(n) (1..(n + 1) / 2).inject(0.0){|sum, m| sum + m * (outcomes(n, m) - outcomes(n, m - 1))} / fact(n) end puts p253(40) C++: #include <stdio.h> #define N 40 int main(int argc, char **argv) { int i, j; long long int count = 0; int max; int t; int card[N]; int flag[N]; int tmp; int part; long long int max_sum = 0; while(1) { for (i=0; i<N; i++) { card[i] = i; flag[i] = 0; } for (i=N; i>=2; i--) { t = (int)(rand() % i); tmp = card[t]; card[t] = card[i-1]; card[i-1] = tmp; } max = 0; count++; part = 0; for (i=0; i<N; i++) { tmp = 1; if ((card[i] != 0) && flag[card[i]-1]) tmp--; if ((card[i] != N-1) && flag[card[i]+1]) tmp--; part += tmp; flag[card[i]] = 1; if (max < part) max = part; } max_sum += max; if (!(count % 100000)) { printf ("%lld / %lld ", max_sum, count); printf("%.7f \n", (double)max_sum/(double)count); } } }