Add solutions for problems 21-25.

Euler.hs

@@ -8,6 +8,8 @@ module Euler
   , zipArraysWith
   , RangeIx(..)
   , digitsOf
+  , divisors
+  , properDivisors
   ) where
 
 import Control.Applicative
@@ -16,6 +18,7 @@ import Control.Monad.ST
 import Control.Monad.Writer
 import Data.Array.ST
 import Data.Array.Unboxed
+import Data.List
 import Data.Word
 
 import qualified Control.Monad.ST.Lazy as LST
@@ -53,3 +56,10 @@ zipArraysWith f as bs = array newRange $ [ (i, f (as!i) (bs!i)) | i <- range new
 
 digitsOf :: (Read a, Show a, Integral a) => a -> [a]
 digitsOf = map (read . (:[])) . show
+
+divisors :: Integral a => a -> [a]
+divisors n = nub $ concat [ [m, q] | m <- takeWhile (\x -> x^2 <= n) [1..], let (q, r) = n `divMod` m, r == 0 ]
+
+properDivisors :: Integral a => a -> [a]
+properDivisors n | n < 1 = []
+properDivisors n = nub $ 1 : concat [ [m, q] | m <- takeWhile (\x -> x^2 <= n) [2..], let (q, r) = n `divMod` m, r == 0 ]

Problem12.hs

@@ -2,7 +2,7 @@
 -- 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
+import Euler
 
 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 ]

Problem21.hs

@@ -0,0 +1,7 @@
+-- Let d(n) be defined as the sum of proper divisors of n (numbers less than n which divide evenly into n).
+-- If d(a) = b and d(b) = a, where a ≠ b, then a and b are an amicable pair and each of a and b are called amicable numbers.
+-- Evaluate the sum of all the amicable numbers under 10000.
+import Euler
+
+amicable = [ a | a <- [1..10000], let b = sum (properDivisors a), a /= b, sum (properDivisors b) == a ]
+main = print $ sum $ amicable

Problem22.hs

@@ -0,0 +1,11 @@
+import Control.Applicative
+import Control.Monad
+import Data.List
+import System.IO
+
+uncomma :: String -> [String]
+uncomma = filter ((/= ',') . head) . groupBy (\a b -> (a == ',') == (b == ','))
+
+main = do
+  names <- sort . uncomma . filter (not . (`elem` "\"\r\n")) <$> readFile "p022_names.txt"
+  print $ sum $ zipWith (*) (map (sum . map (\c -> fromEnum c - fromEnum 'A' + 1)) names) [1..]

Problem23.hs

@@ -0,0 +1,14 @@
+import Data.List
+import Data.Maybe
+import Euler
+
+isAbundant :: Int -> Bool
+isAbundant n = sum (properDivisors n) > n
+
+abundant :: [Int]
+abundant = filter isAbundant [1..]
+
+abundantPair :: Int -> Maybe (Int, Int)
+abundantPair n = listToMaybe [ (p,q) | p <- takeWhile (<n) abundant, let q = n - p, isAbundant q ]
+
+main = print $ sum $ filter (isNothing . abundantPair) [1..28123]

Problem24.hs

@@ -0,0 +1,14 @@
+-- What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?
+import Data.List
+
+factorial n = product [1..n]
+deleteAt n xs = let (as, b:bs) = splitAt n xs in (b, as ++ bs)
+
+nthPermut :: [a] -> Int -> [a]
+nthPermut xs 0 = xs
+nthPermut xs n = x : nthPermut xs' n'
+  where
+    (m, n')  = n `divMod` factorial (length xs - 1)
+    (x, xs') = deleteAt m xs
+
+main = putStrLn $ nthPermut ['0'..'9'] 999999

Problem25.hs

@@ -0,0 +1,5 @@
+-- The Fibonacci sequence is defined by the recurrence relation:
+--   F(n) = F(n−1) + F(n−2), where F(1) = 1 and F(2) = 1.
+-- What is the index of the first term in the Fibonacci sequence to contain 1000 digits?
+fibs = 1 : 1 : zipWith (+) (tail fibs) fibs
+main = print $ fst $ head $ filter ((>= 1000) . length . show . snd) $ zip [1..] fibs