diff --git a/Euler.hs b/Euler.hs index 4d9f0bb..c9382fc 100644 --- a/Euler.hs +++ b/Euler.hs @@ -11,6 +11,7 @@ module Euler , primesTo , isPrimeArray , primes + , primeFactors , zipArraysWith , RangeIx(..) , divisors @@ -22,6 +23,7 @@ module Euler , fromDigits , fromDigitsBase , isPalindrome + , (\\\) , module Control.Applicative , module Control.Arrow , module Control.Monad @@ -73,7 +75,20 @@ isPrimeArray n = runSTUArray $ do return isPrime primes :: [Integer] -primes = let go (!p:xs) = p : go [ x | x <- xs, x `mod` p /= 0 ] in go [2..] +--primes = let go (!p:xs) = p : go [ x | x <- xs, x `mod` p /= 0 ] in go [2..] +primes = go 1000000 + where + go n = primesTo n ++ dropWhile (<= n) (go (2*n)) + +primeFactors :: Integer -> [Integer] +primeFactors n = go n primes + where + go 0 _ = [0] + go 1 _ = [] + go n (p:ps) + | n < 0 = (-1) : go (negate n) (p:ps) + | (q, 0) <- n `divMod` p = p : go q (p:ps) + | otherwise = go n ps class Ix a => RangeIx a where intersectBounds :: (a, a) -> (a, a) -> (a, a) @@ -141,3 +156,11 @@ fromDigitsBase n = foldl' (\a b -> n * a + fromIntegral b) 0 isPalindrome :: Eq a => [a] -> Bool isPalindrome xs = xs == reverse xs + +-- Like (\\), but assumes both lists are sorted. +(\\\) :: Ord a => [a] -> [a] -> [a] +(a:as) \\\ (b:bs) = case compare a b of + LT -> a : (as \\\ (b:bs)) + EQ -> as \\\ (b:bs) + GT -> (a:as) \\\ bs +infix 5 \\\ diff --git a/Problem046.hs b/Problem046.hs new file mode 100644 index 0000000..6a2c544 --- /dev/null +++ b/Problem046.hs @@ -0,0 +1,11 @@ +-- What is the smallest odd composite that cannot be written as the sum of a +-- prime and twice a square? + +import Euler + +composites = [1..] \\\ primes +isTwiceSquare n = 2 * ((floor $ sqrt $ (/ 2) $ fromIntegral n) ^ 2) == n + +main = print $ head $ do + n <- tail $ filter odd composites + n <$ (guard $ not $ any isTwiceSquare $ map (n-) $ takeWhile (< n) primes) diff --git a/Problem047.hs b/Problem047.hs new file mode 100644 index 0000000..c07814c --- /dev/null +++ b/Problem047.hs @@ -0,0 +1,10 @@ +-- Find the first four consecutive integers to have four distinct prime +-- factors. What is the first of these numbers? + +import Euler + +distinct = map head . group +nFactors = map (id &&& length . distinct . primeFactors) [1..] + +main = print $ map fst $ head $ + filter (all (==4) . map snd) $ map (take 4) $ tails nFactors diff --git a/Problem048.hs b/Problem048.hs new file mode 100644 index 0000000..45f1b0a --- /dev/null +++ b/Problem048.hs @@ -0,0 +1,2 @@ +-- Find the last ten digits of the series, 1^1 + 2^2 + 3^3 + ... + 1000^1000. +main = print $ (`mod` 10000000000) $ sum $ map (\n -> n^n) [1..1000] diff --git a/Problem049.hs b/Problem049.hs new file mode 100644 index 0000000..2f468ee --- /dev/null +++ b/Problem049.hs @@ -0,0 +1,23 @@ +-- The arithmetic sequence, 1487, 4817, 8147, in which each of the terms +-- increases by 3330, is unusual in two ways: (i) each of the three terms are +-- prime, and, (ii) each of the 4-digit numbers are permutations of one +-- another. +-- +-- There are no arithmetic sequences made up of three 1-, 2-, or 3-digit +-- primes, exhibiting this property, but there is one other 4-digit increasing +-- sequence. +-- +-- What 12-digit number do you form by concatenating the three terms in this +-- sequence? + +import Euler + +main = print $ head $ do + p <- takeWhile (<= 9999) $ dropWhile (<= 1487) $ primes + p' <- takeWhile (<= 9999) $ dropWhile (<= p) $ primes + let p'' = 2 * p' - p + guard $ p'' <= 9999 + guard $ p'' `elem` takeWhile (<= p'') primes + guard $ sort (toDigits p) == sort (toDigits p') + guard $ sort (toDigits p') == sort (toDigits p'') + return $ fromDigits $ toDigits p ++ toDigits p' ++ toDigits p'' diff --git a/Problem050.hs b/Problem050.hs new file mode 100644 index 0000000..e7df452 --- /dev/null +++ b/Problem050.hs @@ -0,0 +1,19 @@ +-- Which prime, below one-million, can be written as the sum of the most +-- consecutive primes? + +import Euler + +intersectOn' :: (a -> b -> Ordering) -> [a] -> [b] -> [b] +intersectOn' _ [] _ = [] +intersectOn' _ _ [] = [] +intersectOn' f (x:xs) (y:ys) = case f x y of + LT -> intersectOn' f xs (y:ys) + EQ -> y : intersectOn' f xs ys + GT -> intersectOn' f (x:xs) ys + +primeSums = concat $ + map (intersectOn' (\p (_,q) -> compare p q) primes) $ + map (zip [1..] . takeWhile (< 1000000) . tail . scanl' (+) 0) $ + tails $ takeWhile (< 50000) $ primes + +main = print $ snd $ maximumBy (compare `on` fst) $ primeSums