Add solutions for problems 33-42.

Euler.hs

@@ -9,6 +9,7 @@ module Euler
   , whenM
   , unlessM
   , primesTo
+  , isPrimeArray
   , primes
   , zipArraysWith
   , RangeIx(..)
@@ -17,7 +18,10 @@ module Euler
   , toDecimal
   , fromDecimal
   , toDigits
+  , toDigitsBase
   , fromDigits
+  , fromDigitsBase
+  , isPalindrome
   , module Control.Applicative
   , module Control.Arrow
   , module Control.Monad
@@ -62,6 +66,12 @@ primesTo n = LST.runST $ do
             (m:) <$> primesFrom (m+1)
    primesFrom 2
 
+isPrimeArray n = runSTUArray $ do
+   isPrime <- newArray (2, n) 1 :: ST s (STUArray s Integer Word8)
+   forM_ [2..n] $ \m -> whenM ((/= 0) <$> readArray isPrime m) $ do
+      forM_ [2*m,3*m..n] $ \i -> writeArray isPrime i 0
+   return isPrime
+
 primes :: [Integer]
 primes = let go (!p:xs) = p : go [ x | x <- xs, x `mod` p /= 0 ] in go [2..]
 
@@ -117,8 +127,17 @@ instance Show Decimal where
                                  ++ "(" ++ concat (map show rs) ++ ")"
 
 toDigits :: (Integral a, Integral b) => a -> [b]
-toDigits = reverse . unfoldr (\x ->
+toDigits = toDigitsBase 10
-   if x == 0 then Nothing else Just (first fromIntegral $ swap (x `divMod` 10)))
+
+toDigitsBase :: (Integral a, Integral b) => a -> a -> [b]
+toDigitsBase n = reverse . unfoldr (\x ->
+   if x == 0 then Nothing else Just (first fromIntegral $ swap (x `divMod` n)))
 
 fromDigits :: (Integral a, Integral b) => [a] -> b
-fromDigits = foldl' (\a b -> 10 * a + fromIntegral b) 0
+fromDigits = fromDigitsBase 10
+
+fromDigitsBase :: (Integral a, Integral b) => b -> [a] -> b
+fromDigitsBase n = foldl' (\a b -> n * a + fromIntegral b) 0
+
+isPalindrome :: Eq a => [a] -> Bool
+isPalindrome xs = xs == reverse xs

Problem033.hs

@@ -0,0 +1,30 @@
+-- The fraction 49/98 is a curious fraction, as an inexperienced mathematician
+-- in attempting to simplify it may incorrectly believe that 49/98 = 4/8, which
+-- is correct, is obtained by cancelling the 9s.
+--
+-- We shall consider fractions like, 30/50 = 3/5, to be trivial examples.
+--
+-- There are exactly four non-trivial examples of this type of fraction, less
+-- than one in value, and containing two digits in the numerator and
+-- denominator.
+--
+-- If the product of these four fractions is given in its lowest common terms,
+-- find the value of the denominator.
+
+import Euler
+
+main = print $ denominator $ product $
+   [ n
+   | a <- [1..9]
+   , b <- [1..9]
+   , c <- [1..9]
+   , d <- [1..9]
+   , let x = 10 * a + b
+   , let y = 10 * c + d
+   , let n = x % y
+   , n < 1
+   , (a == c && b % d == n) ||
+     (a == d && b % c == n) ||
+     (b == c && a % d == n) ||
+     (b == d && a % c == n)
+   ]

Problem034.hs

@@ -0,0 +1,10 @@
+-- Find the sum of all numbers which are equal to the sum of the factorial of their digits.
+--
+-- Note: as 1! = 1 and 2! = 2 are not sums they are not included.
+
+import Euler
+
+factorial n = product [1..n]
+factSum n = sum $ map factorial $ toDigits n
+
+main = print $ sum $ filter (\n -> n == factSum n) [10..2540160]

Problem035.hs

@@ -0,0 +1,23 @@
+-- The number, 197, is called a circular prime because all rotations of the
+-- digits: 197, 971, and 719, are themselves prime.
+--
+-- There are thirteen such primes below 100: 2, 3, 5, 7, 11, 13, 17, 31, 37,
+-- 71, 73, 79, and 97.
+--
+-- How many circular primes are there below one million?
+
+import Euler
+import Data.Array.Unboxed
+import Data.Array.ST
+
+rotations n = map (fromDigits . take (length digits))
+            $ take (length digits)
+            $ tails (cycle digits)
+   where digits = toDigits n
+
+main = do
+   let limit      = 1000000 - 1
+   let isPrimeArr = isPrimeArray limit
+   let isPrime n  = (isPrimeArr!n) /= 0
+   let circular n = all isPrime $ rotations n
+   print $ length $ filter circular [2..limit]

Problem036.hs

@@ -0,0 +1,7 @@
+-- Find the sum of all numbers, less than one million, which are palindromic in
+-- base 10 and base 2.
+
+import Euler
+
+main = print $ sum $ [ n | n <- [1..999999], isPalindrome (toDigits n),
+                                             isPalindrome (toDigitsBase 2 n) ]

Problem037.hs

@@ -0,0 +1,12 @@
+-- Find the sum of the only eleven primes that are both truncatable from left
+-- to right and right to left.
+
+import Euler
+import Data.Array.Unboxed
+
+truncations n = map fromDigits $ filter (not . null) $ inits (toDigits n) ++ tails (toDigits n)
+
+isPrimeArr = isPrimeArray 1000000
+isPrime n  = n >= 2 && isPrimeArr!n /= 0
+
+main = print $ sum $ take 11 $ filter (all isPrime . truncations) [11..]

Problem038.hs

@@ -0,0 +1,26 @@
+-- Take the number 192 and multiply it by each of 1, 2, and 3:
+--
+--   192 × 1 = 192
+--   192 × 2 = 384
+--   192 × 3 = 576
+--
+-- By concatenating each product we get the 1 to 9 pandigital, 192384576. We
+-- will call 192384576 the concatenated product of 192 and (1,2,3).
+--
+-- What is the largest 1 to 9 pandigital 9-digit number that can be formed as
+-- the concatenated product of an integer with (1,2, ... , n) where n > 1?
+
+import Euler
+
+pandigital n = sort (toDigits n) == [1..9]
+
+concatProduct n = fromDigits $ concat $ zipWith const products upTo9
+   where
+      products = map (toDigits . (n*)) [1..]
+      lengths  = map length products
+      totals   = scanl1 (+) lengths
+      upTo9    = takeWhile (<= 9) totals
+
+main = print $ maximum $ [ n | n <- map concatProduct [1..9999]
+                             , n >= 100000000
+                             , pandigital n ]

Problem039.hs

@@ -0,0 +1,18 @@
+-- If p is the perimeter of a right angle triangle with integral length sides,
+-- {a,b,c}, there are exactly three solutions for p = 120.
+--
+--   {20,48,52}, {24,45,51}, {30,40,50}
+--
+-- For which value of p ≤ 1000, is the number of solutions maximised?
+
+import Euler
+
+solutions :: Int -> [(Int, Int, Int)]
+solutions p = do
+   a <- [1 .. p `div` 2]
+   b <- [a .. p - 2 * a]
+   let c = p - (a + b)
+   guard $ a^2 + b^2 == c^2
+   return (a, b, c)
+
+main = print $ maximumBy (compare `on` snd) $ map (id &&& length . solutions) [3..1000]

Problem040.hs

@@ -0,0 +1,21 @@
+-- An irrational decimal fraction is created by concatenating the positive
+-- integers:
+--
+-- 0.123456789101112131415161718192021...
+--
+-- It can be seen that the 12th digit of the fractional part is 1.
+--
+-- If d[n] represents the nth digit of the fractional part, find the value of
+-- the following expression.
+--
+-- d[1] × d[10] × d[100] × d[1000] × d[10000] × d[100000] × d[1000000]
+
+import Euler
+
+nthDigit = go 1
+   where
+      go m n = if n < m*10^m
+               then toDigits (n `div` m) !! (n `mod` m)
+               else go (m + 1) (n + 10^m)
+
+main = print $ product $ map (nthDigit . (10^)) [0..6]

Problem041.hs

@@ -0,0 +1,15 @@
+-- We shall say that an n-digit number is pandigital if it makes use of all the
+-- digits 1 to n exactly once. For example, 2143 is a 4-digit pandigital and is
+-- also prime.
+--
+-- What is the largest n-digit pandigital prime that exists?
+
+import Euler
+
+pandigitals = map fromDigits $ go 9
+   where go 0 = []; go n = reverse (sort (permutations [1..n])) ++ go (n-1)
+
+isPrime n = not $ any (\p -> n `mod` p == 0) $
+   takeWhile (<= floor (sqrt (fromIntegral n))) primes
+
+main = print $ head $ filter isPrime pandigitals

Problem042.hs

@@ -0,0 +1,27 @@
+-- The nth term of the sequence of triangle numbers is given by, t[n] = ½n(n+1);
+-- so the first ten triangle numbers are:
+--
+--   1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...
+--
+-- By converting each letter in a word to a number corresponding to its
+-- alphabetical position and adding these values we form a word value. For
+-- example, the word value for SKY is 19 + 11 + 25 = 55 = t[10]. If the word
+-- value is a triangle number then we shall call the word a triangle word.
+--
+-- Using words.txt, a 16K text file containing nearly two-thousand common
+-- English words, how many are triangle words?
+
+import Euler
+import System.IO
+
+uncomma :: String -> [String]
+uncomma = filter ((/= ',') . head) . groupBy (\a b -> (a == ',') == (b == ','))
+
+wordValue :: [Char] -> Int
+wordValue = sum . map (\c -> 1 + (fromEnum c - fromEnum 'A'))
+
+isTriangle n = let m = floor (sqrt $ fromIntegral $ 2 * n) in m * (m + 1) == 2 * n
+
+main = do
+  words <- sort . uncomma . filter (not . (`elem` "\"\r\n")) <$> readFile "p042_words.txt"
+  print $ length $ filter isTriangle $ map wordValue words