Add solutions for problems 9-12.

.gitignore

@@ -1,3 +1,5 @@
+.*.swp
+*~
 *.o
 *.hi
 Problem[0-9]

Euler.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts #-}
+
+module Euler
+  ( whenM
+  , unlessM
+  , primesTo
+  , primes
+  , zipArraysWith
+  , RangeIx(..)
+  ) where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.ST
+import Control.Monad.Writer
+import Data.Array.ST
+import Data.Array.Unboxed
+import Data.Word
+
+import qualified Control.Monad.ST.Lazy as LST
+
+whenM, unlessM :: Monad m => m Bool -> m () -> m ()
+whenM   mc m = mc >>= (\c -> when   c m)
+unlessM mc m = mc >>= (\c -> unless c m)
+
+primesTo n = LST.runST $ do
+   isPrime <- LST.strictToLazyST (newArray (2, n) 1 :: ST s (STUArray s Integer Word8))
+   let primesFrom m = if m > n then return [] else do
+         p <- LST.strictToLazyST (readArray isPrime m)
+         if p == 0 then primesFrom (m+1) else do
+            LST.strictToLazyST $ forM_ [2*m,3*m..n] $ \i -> writeArray isPrime i 0
+            (m:) <$> primesFrom (m+1)
+   primesFrom 2
+
+primes :: [Integer]
+primes = let go (!p:xs) = p : go [ x | x <- xs, x `mod` p /= 0 ] in go [2..]
+
+class Ix a => RangeIx a where
+   intersectBounds :: (a, a) -> (a, a) -> (a, a)
+
+instance RangeIx Int where
+   intersectBounds (al, au) (bl, bu) = (max al bl, min au bu)
+
+instance (RangeIx a, RangeIx b) => RangeIx (a, b) where
+   intersectBounds ((al,bl),(au,bu)) ((cl,dl),(cu,du)) =
+      ((max al cl, max bl dl), (min au cu, min bu du))
+
+zipArraysWith :: (IArray arrA a, IArray arrB b, IArray arrC c, RangeIx i)
+              => (a -> b -> c) -> arrA i a -> arrB i b -> arrC i c
+zipArraysWith f as bs = array newRange $ [ (i, f (as!i) (bs!i)) | i <- range newRange ]
+   where newRange = intersectBounds (bounds as) (bounds bs)

Problem10.hs

@@ -0,0 +1,4 @@
+-- Find the sum of all the primes below two million.
+import Euler
+
+main = print $ sum $ primesTo 1999999

Problem11.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+import Data.Array.Unboxed
+import Euler
+
+-- What is the greatest product of four adjacent numbers in the same direction
+-- (up, down, left, right, or diagonally) in the 20×20 grid?
+--
+grid :: UArray (Int, Int) Int
+grid = listArray ((1,1),(20,20)) $
+   [ 08, 02, 22, 97, 38, 15, 00, 40, 00, 75, 04, 05, 07, 78, 52, 12, 50, 77, 91, 08
+   , 49, 49, 99, 40, 17, 81, 18, 57, 60, 87, 17, 40, 98, 43, 69, 48, 04, 56, 62, 00
+   , 81, 49, 31, 73, 55, 79, 14, 29, 93, 71, 40, 67, 53, 88, 30, 03, 49, 13, 36, 65
+   , 52, 70, 95, 23, 04, 60, 11, 42, 69, 24, 68, 56, 01, 32, 56, 71, 37, 02, 36, 91
+   , 22, 31, 16, 71, 51, 67, 63, 89, 41, 92, 36, 54, 22, 40, 40, 28, 66, 33, 13, 80
+   , 24, 47, 32, 60, 99, 03, 45, 02, 44, 75, 33, 53, 78, 36, 84, 20, 35, 17, 12, 50
+   , 32, 98, 81, 28, 64, 23, 67, 10, 26, 38, 40, 67, 59, 54, 70, 66, 18, 38, 64, 70
+   , 67, 26, 20, 68, 02, 62, 12, 20, 95, 63, 94, 39, 63, 08, 40, 91, 66, 49, 94, 21
+   , 24, 55, 58, 05, 66, 73, 99, 26, 97, 17, 78, 78, 96, 83, 14, 88, 34, 89, 63, 72
+   , 21, 36, 23, 09, 75, 00, 76, 44, 20, 45, 35, 14, 00, 61, 33, 97, 34, 31, 33, 95
+   , 78, 17, 53, 28, 22, 75, 31, 67, 15, 94, 03, 80, 04, 62, 16, 14, 09, 53, 56, 92
+   , 16, 39, 05, 42, 96, 35, 31, 47, 55, 58, 88, 24, 00, 17, 54, 24, 36, 29, 85, 57
+   , 86, 56, 00, 48, 35, 71, 89, 07, 05, 44, 44, 37, 44, 60, 21, 58, 51, 54, 17, 58
+   , 19, 80, 81, 68, 05, 94, 47, 69, 28, 73, 92, 13, 86, 52, 17, 77, 04, 89, 55, 40
+   , 04, 52, 08, 83, 97, 35, 99, 16, 07, 97, 57, 32, 16, 26, 26, 79, 33, 27, 98, 66
+   , 88, 36, 68, 87, 57, 62, 20, 72, 03, 46, 33, 67, 46, 55, 12, 32, 63, 93, 53, 69
+   , 04, 42, 16, 73, 38, 25, 39, 11, 24, 94, 72, 18, 08, 46, 29, 32, 40, 62, 76, 36
+   , 20, 69, 36, 41, 72, 30, 23, 88, 34, 62, 99, 69, 82, 67, 59, 85, 74, 04, 36, 16
+   , 20, 73, 35, 29, 78, 31, 90, 01, 74, 31, 49, 71, 48, 86, 81, 16, 23, 57, 05, 54
+   , 01, 70, 54, 71, 83, 51, 54, 69, 16, 92, 33, 48, 61, 43, 52, 01, 89, 19, 67, 48
+   ]
+
+times :: (IArray a e, RangeIx i, Num e) => a i e -> a i e -> a i e
+a `times` b = zipArraysWith (*) a b
+infixl 7 `times`
+
+across n = ixmap ((1,1),( 20 ,20-n)) (\(a,b) -> ( a ,b+n)) grid
+down   n = ixmap ((1,1),(20-n, 20 )) (\(a,b) -> (a+n, b )) grid
+diag1  n = ixmap ((1,1),(20-n,20-n)) (\(a,b) -> (a+n,b+n)) grid
+diag2  n = ixmap ((1,1+n),(20-n,20)) (\(a,b) -> (a+n,b-n)) grid
+
+acrossProducts = grid `times` across 1 `times` across 2 `times` across 3
+downProducts   = grid `times` down   1 `times` down   2 `times` down   3
+diagProducts1  = grid `times` diag1  1 `times` diag1  2 `times` diag1  3
+diagProducts2  = grid `times` diag2  1 `times` diag2  2 `times` diag2  3
+
+main = print $ maximum $ concatMap elems $
+   [acrossProducts, downProducts, diagProducts1, diagProducts2]

Problem12.hs

@@ -0,0 +1,8 @@
+-- The sequence of triangle numbers is generated by adding the natural numbers.
+-- So the 7th triangle number would be 1 + 2 + 3 + 4 + 5 + 6 + 7 = 28. ...
+-- What is the value of the first triangle number to have over five hundred divisors?
+import Data.List
+
+triangles = scanl1 (+) [1..] :: [Int]
+divisors n = concat [ [m, q] | m <- takeWhile (\x -> x^2 <= n) [1..], let (q, r) = n `divMod` m, r == 0 ]
+main = print $ head $ [ n | n <- triangles, length (divisors n) > 500 ]

Problem3.hs

@@ -1,10 +1,9 @@
 -- What is the largest prime factor of the number 600851475143 ?
-n `divides` m = m `mod` n == 0
+import Euler
-primes = go [2..] where go (p:ps) = p : go (filter (\n -> not (p `divides` n)) ps)
 
-factors n = go primes n
+factors n = go (primes ()) n
    where go (p:ps) n | n < p          = []
-                     | p `divides` n = p : go (p:ps) (n `div` p)
+                     | n `mod` p == 0 = p : go (p:ps) (n `div` p)
                      | otherwise      = go ps n
 
 main = print $ last $ factors 600851475143

Problem7.hs

@@ -1,4 +1,3 @@
 -- What is the 10 001st prime number?
-primes :: [Int]
+import Euler
-primes = let go (p:ps) = p : go [ n | n <- ps, n `mod` p /= 0 ] in go [2..]
+main = print $ primesTo 1000000 !! 10000
-main = print $ primes !! 10000

Problem9.hs

@@ -0,0 +1,14 @@
+-- A Pythagorean triplet is a set of three natural numbers, a < b < c, for which,
+--
+--   a^2 + b^2 = c^2
+--
+-- For example, 3^2 + 4^2 = 9 + 16 = 25 = 5^2.
+--
+-- There exists exactly one Pythagorean triplet for which a + b + c = 1000.
+-- Find the product abc.
+
+main = print $ head [ a*b*c | a <- [1..1000]
+                    , b <- [a+1..1000-a]
+                    , let c = 1000 - (a + b)
+                    , a^2 + b^2 == c^2
+                    ]