module Euler.Problems (answers) where
import Euler.Prelude
import Euler.Util.Amicable (amicableNumbers)
import Euler.Util.Arithmetic (divides, factorial, intSqrt, million, square)
import Euler.Util.Collatz (collatzLengths)
import Euler.Util.Decimal (repetendLength)
import Euler.Util.Digit
(digits, intPalindrome, textDigits, textIntMaybe, unDigits)
import Euler.Util.Fibonacci (fibs)
import Euler.Util.List (countDistinct, maximumOn, mode, sliding)
import Euler.Util.Map (keyWithMaxValue)
import Euler.Util.Pandigital (pandigitalsRev)
import Euler.Util.Prime (countDivisors, isPrime, largestPrimeFactor, primes)
import Euler.Util.FigurateNumbers
import qualified Euler.Util.NumberWords as NumberWords
import qualified Euler.Util.PellEquation as PellEquation
import qualified Euler.Util.TrianglePath as TrianglePath
import qualified Euler.Problems.Problem11 as Problem11
import qualified Euler.Problems.Problem15 as Problem15
import qualified Euler.Problems.Problem19 as Problem19
import qualified Euler.Problems.Problem22 as Problem22
import qualified Euler.Problems.Problem23 as Problem23
import qualified Euler.Problems.Problem31 as Problem31
import qualified Euler.Problems.Problem33 as Problem33
import qualified Euler.Problems.Problem42 as Problem42
import qualified Euler.Problems.Problem43 as Problem43
import qualified Euler.Problems.Problem46 as Problem46
import qualified Euler.Problems.Problem68 as Problem68
import qualified Euler.Problems.Problem69 as Problem69
import qualified Euler.Problems.Problem9 as Problem9
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.IO as TextIO
inputText :: Int -> IO Text
inputText i = TextIO.readFile ("../problems/" <> show i <> "-data.txt")
(~>) :: a -> b -> (a, b)
(~>) a b = (a, b)
infixr 0 ~>
answers :: Map Integer (IO String)
answers = Map.fromList
[ 1 ~>
[1..999] &
List.filter (\n -> List.any (`divides` n) ([3, 5] :: [Integer])) &
List.sum & showInteger & pure
, 2 ~>
fibs &
List.takeWhile (< 4 * million) &
List.filter even &
List.sum & showInteger & pure
, 3 ~>
(600851475143 :: Integer) &
largestPrimeFactor &
showInteger & pure
, 4 ~>
([1 .. 999] >>= \a -> [1 .. a] <&> \b -> a * b) &
List.filter (intPalindrome (10 :: Integer)) &
List.maximum & showInteger & pure
, 5 ~>
let
factors :: [Integer]
factors = fmap powerUp (List.takeWhile (<= bound) primes)
powerUp n = List.last (List.takeWhile (<= bound) (powersOf n))
powersOf n = fmap (n^) [(1 :: Int) ..]
bound = 20
in
factors & List.product & showInteger & pure
, 6 ~>
(let xs = [1..100] in square (List.sum xs) - List.sum (fmap square xs)) &
showInteger & pure
, 7 ~> primes List.!! 10000 & showInteger & pure
, 8 ~>
inputText 8 <&> \text ->
text & textDigits & fmap toInteger & sliding 5 & fmap List.product &
List.maximum & showInteger
, 9 ~> Problem9.answer & showNatural & pure
, 10 ~>
primes & List.takeWhile (< 2 * million) &
List.sum & showInteger & pure
, 11 ~> inputText 11 <&> \text -> text & Problem11.answer & show
, 12 ~>
List.scanl1 (+) [1..] &
List.find (\n -> countDivisors n > (500 :: Integer)) &
fromJust & showInteger & pure
, 13 ~>
inputText 13 <&> \text ->
text &
Text.lines & mapMaybe textIntMaybe &
List.sum & showInteger & List.take 10
, 14 ~>
[1 .. million] & collatzLengths & keyWithMaxValue &
showNatural & pure
, 15 ~> Problem15.answer & showInteger & pure
, 16 ~>
(2 ^ (1000 :: Int) :: Integer) & digits 10 & List.sum &
showInteger & pure
, 17 ~>
[1..1000] & foldMap NumberWords.word &
fmap (NumberWords.getLetterCount >>> showNatural)
, 18 ~>
inputText 18 <&> \text ->
text &
TrianglePath.parseTriangle & TrianglePath.reduceTriangle &
showInteger
, 19 ~> Problem19.answer & showInteger & pure
, 20 ~>
(100 :: Integer) & factorial & digits 10 &
List.sum & showInteger & pure
, 21 ~> amicableNumbers 9999 & List.sum & showInteger & pure
, 22 ~>
inputText 22 <&> \text ->
text & Problem22.answer & showInteger
, 23 ~> Problem23.answer & showInteger & pure
, 24 ~> pure $ sort (permutations ['0'..'9']) List.!! (million - 1)
, 25 ~>
(fibs :: [Integer]) &
findIndex (>= 10 ^ (999 :: Integer)) &
fromJust & fromIntegral & showInteger & pure
, 26 ~>
[1..999] &
maximumOn (repetendLength . (1 /) . fromIntegral) &
showInteger & pure
, 27 ~>
let
expressions = let x = 999; range = [-x..x]
in liftA2 (,) range range
apply (a, b) n = n*n + a*n + b
nrOfPrimes e = (List.length . List.takeWhile (isPrime . apply e)) [0..]
in
expressions & maximumOn nrOfPrimes & uncurry (*) & showInteger & pure
, 28 ~>
[1..500] &
foldMap (\i -> let j = 2 * i; x = square (j + 1)
in [x, x - j, x - 2*j, x - 3*j]) &
List.sum & (+ 1) & showInteger & pure
, 29 ~>
let r = [2..100] :: [Integer]
in countDistinct [a ^ b | a <- r, b <- r] & showInteger & pure
, 30 ~>
let
maxPowerSum = (* (pow5 9 :: Integer))
minValue n = 10 ^ (n - 1)
isFeasible n = maxPowerSum n >= minValue n
maxNrOfDigits = (List.last . List.takeWhile isFeasible) [1..]
isMagic n = ((== n) . List.sum . fmap pow5 . digits 10) n
pow5 = (^ (5 :: Integer))
in
[2 .. (maxPowerSum maxNrOfDigits)] & List.filter isMagic &
List.sum & showInteger & pure
, 31 ~> Problem31.answer & showNatural & pure
, 32 ~>
let
zs = do
p <- permutations [1 .. 9 :: Integer]
let (q, zs') = List.splitAt 5 p
z = unDigits 10 zs'
xl <- [1, 2]
let (xs, ys) = List.splitAt xl q
x = unDigits 10 xs
y = unDigits 10 ys
guard $ x * y == z
pure z
in
zs & Set.fromList & List.sum & showInteger & pure
, 33 ~> Problem33.answer & showInteger & pure
, 34 ~>
let
maxDigits =
[1..] &
List.takeWhile (\i -> factorial (9 :: Integer) * i >= 10 ^ i) &
List.last
isCurious :: Integer -> Bool
isCurious n =
((== n) . List.sum . fmap factorial . digits (10 :: Integer)) n
in
[3 .. 10 ^ maxDigits] & List.filter isCurious &
List.sum & showInteger & pure
, 35 ~>
let
digitRotations :: Integer -> [Integer]
digitRotations = fmap (unDigits 10) . listRotations . digits 10
listRotations :: [Integer] -> [[Integer]]
listRotations xs =
(fmap (List.take l) . List.take l . List.tails . List.cycle) xs
where
l = List.length xs
in
([2 .. million - 1] :: [Integer]) &
List.filter (List.all isPrime . digitRotations) &
List.length & fromIntegral & showInteger & pure
, 36 ~>
[1 .. million - 1] &
List.filter (\x -> intPalindrome ( 2 :: Int) x &&
intPalindrome (10 :: Int) x) &
List.sum & showInteger & pure
, 37 ~>
let
digitTruncations :: Integer -> [Integer]
digitTruncations =
fmap (unDigits (10 :: Integer)) . truncations . digits 10
truncations xs =
List.filter (not . List.null) (List.tails xs <> List.inits xs)
in
[11 :: Integer ..] &
List.filter (List.all isPrime . digitTruncations) &
List.take 11 & List.sum & showInteger & pure
, 38 ~>
let
xs =
foldMap (\k -> List.takeWhile (< 10^(9 :: Integer))
(fmap (catProduct k) [2 :: Integer ..])) [1 .. 10^(5 :: Integer) - 1]
catProduct k n =
unDigits (10 :: Integer) $ foldMap (digits 10 . (* k)) [1..n]
pan9 x =
let ds = digits 10 x
in List.length ds == 9 && List.all (`List.elem` ds) [1..9 :: Integer]
in
xs & List.filter pan9 & List.maximum & showInteger & pure
, 39 ~>
let
maxPerimeter = 1000
xs =
catMaybes $
[1 .. maxPerimeter] >>= \a ->
[1 .. maxPerimeter] <&> \b ->
intSqrt (square a + square b) <&> \c ->
a + b + c
in
xs & List.filter (<= maxPerimeter) & mode & showInteger & pure
, 40 ~>
let d i = foldMap (digits 10) [1 :: Integer ..] List.!! (i - 1)
in ([0..6] :: [Integer]) & fmap (d . (10 ^)) &
List.product & showInteger & pure
, 41 ~>
pandigitalsRev & List.filter isPrime & List.head &
showInteger & pure
, 42 ~>
inputText 42 <&> \text ->
text & Problem42.answer & showInteger
, 43 ~> Problem43.answer & showInteger & pure
, 44 ~>
let
ans = List.head $ do
(n, a) <- List.zip [0..] pentagonals
b <- List.take n pentagonals
guard $ isPentagonal (a + b)
let c = a - b
guard $ isPentagonal c
pure c
in
ans & showInteger & pure
, 45 ~>
hexagonals &
List.filter (liftA2 (&&) isPentagonal isTriangle) &
List.dropWhile (<= 40755) & List.head & showInteger & pure
, 46 ~> Problem46.answer & showInteger & pure
, 66 ~>
[2..1000] &
maximumOn PellEquation.fundamentalSolution &
showInteger & pure
, 67 ~>
inputText 67 <&> \text ->
text &
TrianglePath.parseTriangle & TrianglePath.reduceTriangle &
showInteger
, 68 ~> Problem68.answer & pure
, 69 ~> (Problem69.answer :: Int) & show & pure
]