{-# OPTIONS_GHC -O2 -fno-cse #-}
main
= print $ primes
!! (1000000-1)
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:y:z:zs) = f x (f y z) `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
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 = 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
ey0jIE9QVElPTlNfR0hDIC1PMiAtZm5vLWNzZSAjLX0KbWFpbiA9IHByaW50ICQgcHJpbWVzICEhICgxMDAwMDAwLTEpCgpkYXRhIFBlb3BsZSBhID0gVklQIGEgKFBlb3BsZSBhKSB8IENyb3dkIFthXQogCm1lcmdlUCA6OiBPcmQgYSA9PiBQZW9wbGUgYSAtPiBQZW9wbGUgYSAtPiBQZW9wbGUgYQptZXJnZVAgKFZJUCB4IHh0KSB5cyAgICAgICAgICAgICAgICAgICAgPSBWSVAgeCAkIG1lcmdlUCB4dCB5cwptZXJnZVAgKENyb3dkIHhzKSAoQ3Jvd2QgeXMpICAgICAgICAgICAgPSBDcm93ZCAkIG1lcmdlICB4cyB5cwptZXJnZVAgeHNAKENyb3dkICh4Onh0KSkgeXNAKFZJUCB5IHl0KSAgPSBjYXNlIGNvbXBhcmUgeCB5IG9mCiAgICBMVCAtPiBWSVAgeCAkIG1lcmdlUCAoQ3Jvd2QgeHQpIHlzCiAgICBFUSAtPiBWSVAgeCAkIG1lcmdlUCAoQ3Jvd2QgeHQpIHl0CiAgICBHVCAtPiBWSVAgeSAkIG1lcmdlUCB4cyB5dAogCm1lcmdlIDo6IE9yZCBhID0+IFthXSAtPiBbYV0gLT4gW2FdCm1lcmdlIHhzQCh4Onh0KSB5c0AoeTp5dCkgPSBjYXNlIGNvbXBhcmUgeCB5IG9mCiAgICBMVCAtPiB4IDogbWVyZ2UgeHQgeXMKICAgIEVRIC0+IHggOiBtZXJnZSB4dCB5dAogICAgR1QgLT4geSA6IG1lcmdlIHhzIHl0CiAKZGlmZiB4c0AoeDp4dCkgeXNAKHk6eXQpID0gY2FzZSBjb21wYXJlIHggeSBvZgogICAgTFQgLT4geCA6IGRpZmYgeHQgeXMKICAgIEVRIC0+ICAgICBkaWZmIHh0IHl0CiAgICBHVCAtPiAgICAgZGlmZiB4cyB5dAoKZm9sZFRyZWUgOjogKGEgLT4gYSAtPiBhKSAtPiBbYV0gLT4gYQpmb2xkVHJlZSBmIHhzID0gZ28geHMgLS0gKHBhaXJzIHhzKQogICAgd2hlcmUgcGFpcnMgKHg6eTp5cykgPSBmIHggeSA6IHBhaXJzIHlzCiAgICAgICAgICBnbyAoeDp5Ono6enMpID0gZiB4IChmIHkgeikgYGZgIGdvIChwYWlycyB6cykKICAgICAgICAgIAp3aGVlbCAgICAgID0gMjo0OjI6NDo2OjI6Njo0OjI6NDo2OjY6Mjo2OjQ6Mjo2OjQ6Njo4OjQ6Mjo0OjI6CiAgICAgICAgICAgICAgICAgNDo4OjY6NDo2OjI6NDo2OjI6Njo2OjQ6Mjo0OjY6Mjo2OjQ6Mjo0OjI6MTA6MjoxMDp3aGVlbApyb2xsICAgICAgID0gc2NhbmwgKCspCndoZWVsTnVtcyAgPSByb2xsIDAgd2hlZWwgICAgICAgICAtLSBbMCwyLDYsOCwxMiwxOCwgLi4uXSAKcm9sbEZyb20gbiA9IGdvIHdoZWVsTnVtcyB3aGVlbAogIHdoZXJlIG0gPSAobi0xMSkgYG1vZGAgMjEwCiAgICAgICAgZ28gKHg6eHMpICh3OndzKSA9IGlmIHg9PW0gdGhlbiByb2xsIChuK3cpIHdzIGVsc2UgZ28geHMgd3MKICAgICAgICAgICAgICAgICAgCnByaW1lcyA6OiBbSW50XQpwcmltZXMgICAgPSAyOjM6NTo3OnByaW1lcycKICB3aGVyZQogICAgcHJpbWVzJyA9IGRpZmYgKHJvbGwgMTEgd2hlZWwpIAogICAgICAgICAgICAgICAoIHNlcnZlIC4gZm9sZFRyZWUgbWVyZ2VQIC4gbWFwIG11bHRpcGxlcyAkIHByaW1lc18gKQoKICAgIHByaW1lc18gPSBoICsrIGRpZmYgdAogICAgICAgICAgICAgICAoIHNlcnZlIC4gZm9sZFRyZWUgbWVyZ2VQIC4gbWFwIG11bHRpcGxlcyAkIHByaW1lc18gKQogICAgICAgICAgICAgIHdoZXJlIChoLHQpID0gc3BsaXRBdCA2IChyb2xsIDExIHdoZWVsKSAKCiAgICBtdWx0aXBsZXMgcCA9IC0tIHZpcCAtLSBbcCpxfHE8LVtwLHArMi4uXV0gLS0gW3AqcCxwKnArMipwLi5dCiAgICAgICAgICAgICAgICAgIFZJUCAocCpwKSAkIENyb3dkIFtwKnF8cTwtcm9sbEZyb20gcF0KIAogICAgLS0gdmlwICh4OnhzKSAgICAgICA9IFZJUCB4ICQgQ3Jvd2QgeHMKICAgIHNlcnZlIChWSVAgeCB4cykgPSB4OnNlcnZlIHhzCiAgICBzZXJ2ZSAoQ3Jvd2QgeHMpID0geHM=