language: Haskell (ghc-7.4.1)
date: 876 days 6 hours ago
link:
visibility: private 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53

{-# OPTIONS_GHC -O2 -fno-cse #-}
main = getLine >>= print . (primes !!) . (+ (-1)) . read
 
data People a = VIP a (People a) | Crowd [a]
 
mergeP :: Ord a => People a -> People a -> People a
mergeP (VIP x xt) ys                    = VIP x $ mergeP xt ys
mergeP (Crowd xs) (Crowd ys)            = Crowd $ merge  xs ys
mergeP xs@(Crowd (x:xt)) ys@(VIP y yt)  = case compare x y of
    LT -> VIP x $ mergeP (Crowd xt) ys
    EQ -> VIP x $ mergeP (Crowd xt) yt
    GT -> VIP y $ mergeP xs yt
 
merge :: Ord a => [a] -> [a] -> [a]
merge xs@(x:xt) ys@(y:yt) = case compare x y of
    LT -> x : merge xt ys
    EQ -> x : merge xt yt
    GT -> y : merge xs yt
 
diff xs@(x:xt) ys@(y:yt) = case compare x y of
    LT -> x : diff xt ys
    EQ ->     diff xt yt
    GT ->     diff xs yt
 
foldTree :: (a -> a -> a) -> [a] -> a
foldTree f xs = go xs -- (pairs xs)
    where pairs ~(x: ~(y:ys)) = f x y : pairs ys
          go ~(x:zs) = x `f` go (pairs zs)
          
wheel      = 2:4:2:4:6:2:6:4:2:4:6:6:2:6:4:2:6:4:6:8:4:2:4:2:
                 4:8:6:4:6:2:4:6:2:6:6:4:2:4:6:2:6:4:2:4:2:10:2:10:wheel
roll       = scanl (+)
wheelNums  = roll 0 wheel         -- [0,2,6,8,12,18, ...] 
rollFrom n = go wheelNums wheel
  where m = (n-11) `mod` 210
        go (x:xs) (w:ws) = if x==m then roll (n+w) ws else go xs ws
                  
primes :: [Int]
primes    = 2:3:5:7:primes'
  where
    primes' = diff (roll 11 wheel) 
               ( serve . foldTree mergeP . map multiples $ primes_ )
 
    primes_ = h ++ diff t
               ( serve . foldTree mergeP . map multiples $ primes_ )
              where (h,t) = splitAt 6 (roll 11 wheel) 
 
    multiples p = -- vip -- [p*q|q<-[p,p+2..]] -- [p*p,p*p+2*p..]
                  VIP (p*p) $ Crowd [p*q|q<-rollFrom p]
 
    -- vip (x:xs)       = VIP x $ Crowd xs
    serve (VIP x xs) = x:serve xs
    serve (Crowd xs) = xs
[1 of 1] Compiling Main             ( prog.hs, prog.o )
Linking prog ...