Euler Problems solved with Haskell

euler001.hs

-- http://projecteuler.net/problem=1
sum [x | x <- [0..999], any (\d -> mod x d == 0) [3,5]]

euler002.hs

-- http://projecteuler.net/problem=2

module Euler2 where
  
  import Data.List

  result = sum [x | x <- fibonacci 4000000, x `mod` 2 == 0]

  fibonacci lim = [0,1] ++ (unfoldr fib (2,1))
    where
      fib (currSum, lastSum)
        | currSum >= lim = Nothing
        | otherwise = Just (currSum, ((currSum + lastSum), currSum))

euler003.hs

module Euler3 where
  
  import Data.List
  
  number :: Integer
  number = 600851475143

  -- Note the naive sieve is ridiculously inefficient by diving the same number many, many times
  -- For a more efficient version, see 
  -- http://en.literateprograms.org/Sieve_of_Eratosthenes_%28Haskell%29
  -- However, for the problem at hand, the naive version worked just fine
  sieveNaive :: [Integer]
  sieveNaive = runSieve [2..]
    where
      runSieve (n:ns) = n : runSieve [x | x <- ns, x `mod` n /= 0]

  primefacts = unfoldr f (firstPrime, number `div` firstPrime)
    where 
      f (p, rem)
        | rem == 0 = Nothing
        | rem == 1 = Just (p, (0,0))
        | otherwise = Just (p, (next, rem `div` next)) where next = nextPrimeFactor rem
      firstPrime = nextPrimeFactor number
      nextPrimeFactor rem = head [x | x <- sieveNaive, rem `mod` x == 0]

euler004.hs

module Euler4 where
  
  import Data.List
  
  largestPalindromic = maximum $ filter palindromic [x*y | x <- threeDigitNums, y <- threeDigitNums]
    where threeDigitNums = [999,998..100]

  palindromic n = digitized == reverse digitized
    where 
      digitized = digitize n

  digitize 0 = []
  digitize n = digitize (n `div` 10) ++ [n `mod` 10]

euler005.hs

module Euler5 where
  
  import Data.List
  import qualified Data.Map as M

  -- 4 -> [2,2] -> [(2,1),(2,1)] -> [(2,2)] -> 2^2 -> 4
  -- observation: getting the prime factors from all numbers 
  -- and keeping each prime once with the rule that the largest group of the same prime
  -- is preserved, one can multiply the remaining numbers to obtain the smallest
  -- evenly divisible number
  evenDivision n = multiply . keepBiggerCount . reducebyCount . primes $ [2..n]
    where
      multiply = M.foldrWithKey (\prm cnt agg -> agg * prm^cnt) 1
      keepBiggerCount = M.unionsWith biggerCount
      reducebyCount = map (foldl asMap M.empty)
      primes = map (provideCountBaseline . primefacts)
      provideCountBaseline prms = map (\x -> (x,1)) prms
      asMap m (prime,count) = M.insertWith (+) prime count m
      biggerCount n n'
        | n >= n' = n
        | otherwise = n'

  primefacts n = unfoldr f (firstPrime, n `div` firstPrime)
    where 
      f (p, rem)
        | rem == 0 = Nothing
        | rem == 1 = Just (p, (0,0))
        | otherwise = Just (p, (next, rem `div` next)) where next = nextPrimeFactor rem
      firstPrime = nextPrimeFactor n
      nextPrimeFactor rem = head [x | x <- sieveNaive, rem `mod` x == 0]

  sieveNaive :: [Integer]
  sieveNaive = runSieve [2..]
    where
      runSieve (n:ns) = n : runSieve [x | x <- ns, x `mod` n /= 0]

euler006.hs

module Euler6 where
  
  import Data.List
  import Control.Applicative
  
  sumOfSquares n = sum $ map (^2) [1..n]
  squareOfSum n = (sum [1..n])^2

  difference = (-) <$> squareOfSum <*> sumOfSquares

euler008.hs

module Euler8 where
  
  import Data.List
  
  theNumber = 
    [7,3,1,6,7,1,7,6,5,3,1,3,3,0,6,2,4,9,1,9,2,2,5,1,1,9,6,7,4,4,2,6,5,7,4,7,4,2,3,5,5,3,4,9,1,9,4,9,3,4,
    9,6,9,8,3,5,2,0,3,1,2,7,7,4,5,0,6,3,2,6,2,3,9,5,7,8,3,1,8,0,1,6,9,8,4,8,0,1,8,6,9,4,7,8,8,5,1,8,4,3,
    8,5,8,6,1,5,6,0,7,8,9,1,1,2,9,4,9,4,9,5,4,5,9,5,0,1,7,3,7,9,5,8,3,3,1,9,5,2,8,5,3,2,0,8,8,0,5,5,1,1,
    1,2,5,4,0,6,9,8,7,4,7,1,5,8,5,2,3,8,6,3,0,5,0,7,1,5,6,9,3,2,9,0,9,6,3,2,9,5,2,2,7,4,4,3,0,4,3,5,5,7,
    6,6,8,9,6,6,4,8,9,5,0,4,4,5,2,4,4,5,2,3,1,6,1,7,3,1,8,5,6,4,0,3,0,9,8,7,1,1,1,2,1,7,2,2,3,8,3,1,1,3,
    6,2,2,2,9,8,9,3,4,2,3,3,8,0,3,0,8,1,3,5,3,3,6,2,7,6,6,1,4,2,8,2,8,0,6,4,4,4,4,8,6,6,4,5,2,3,8,7,4,9,
    3,0,3,5,8,9,0,7,2,9,6,2,9,0,4,9,1,5,6,0,4,4,0,7,7,2,3,9,0,7,1,3,8,1,0,5,1,5,8,5,9,3,0,7,9,6,0,8,6,6,
    7,0,1,7,2,4,2,7,1,2,1,8,8,3,9,9,8,7,9,7,9,0,8,7,9,2,2,7,4,9,2,1,9,0,1,6,9,9,7,2,0,8,8,8,0,9,3,7,7,6,
    6,5,7,2,7,3,3,3,0,0,1,0,5,3,3,6,7,8,8,1,2,2,0,2,3,5,4,2,1,8,0,9,7,5,1,2,5,4,5,4,0,5,9,4,7,5,2,2,4,3,
    5,2,5,8,4,9,0,7,7,1,1,6,7,0,5,5,6,0,1,3,6,0,4,8,3,9,5,8,6,4,4,6,7,0,6,3,2,4,4,1,5,7,2,2,1,5,5,3,9,7,
    5,3,6,9,7,8,1,7,9,7,7,8,4,6,1,7,4,0,6,4,9,5,5,1,4,9,2,9,0,8,6,2,5,6,9,3,2,1,9,7,8,4,6,8,6,2,2,4,8,2,
    8,3,9,7,2,2,4,1,3,7,5,6,5,7,0,5,6,0,5,7,4,9,0,2,6,1,4,0,7,9,7,2,9,6,8,6,5,2,4,1,4,5,3,5,1,0,0,4,7,4,
    8,2,1,6,6,3,7,0,4,8,4,4,0,3,1,9,9,8,9,0,0,0,8,8,9,5,2,4,3,4,5,0,6,5,8,5,4,1,2,2,7,5,8,8,6,6,6,8,8,1,
    1,6,4,2,7,1,7,1,4,7,9,9,2,4,4,4,2,9,2,8,2,3,0,8,6,3,4,6,5,6,7,4,8,1,3,9,1,9,1,2,3,1,6,2,8,2,4,5,8,6,
    1,7,8,6,6,4,5,8,3,5,9,1,2,4,5,6,6,5,2,9,4,7,6,5,4,5,6,8,2,8,4,8,9,1,2,8,8,3,1,4,2,6,0,7,6,9,0,0,4,2,
    2,4,2,1,9,0,2,2,6,7,1,0,5,5,6,2,6,3,2,1,1,1,1,1,0,9,3,7,0,5,4,4,2,1,7,5,0,6,9,4,1,6,5,8,9,6,0,4,0,8,
    0,7,1,9,8,4,0,3,8,5,0,9,6,2,4,5,5,4,4,4,3,6,2,9,8,1,2,3,0,9,8,7,8,7,9,9,2,7,2,4,4,2,8,4,9,0,9,1,8,8,
    8,4,5,8,0,1,5,6,1,6,6,0,9,7,9,1,9,1,3,3,8,7,5,4,9,9,2,0,0,5,2,4,0,6,3,6,8,9,9,1,2,5,6,0,7,1,7,6,0,6,
    0,5,8,8,6,1,1,6,4,6,7,1,0,9,4,0,5,0,7,7,5,4,1,0,0,2,2,5,6,9,8,3,1,5,5,2,0,0,0,5,5,9,3,5,7,2,9,7,2,5,
    7,1,6,3,6,2,6,9,5,6,1,8,8,2,6,7,0,4,2,8,2,5,2,4,8,3,6,0,0,8,2,3,2,5,7,5,3,0,4,2,0,7,5,2,9,6,3,4,5,0]

  maxProduct n = maximum [product (take5 x) | x <- [0..(length n)]]
    where
      take5 x = take 5 (drop x n)

euler009.hs

module Euler9 where
  
  import Data.List
  
  result = head [a*b*c | 
    a <- [1..997], 
    b <- [(a+1)..(997-a)], 
    c <- [(b+1)..(997-b)], 
    a + b + c == 1000, 
    a^2 + b^2 == c^2]

euler013.hs

-- http://projecteuler.net/problem=13

module Euler13 where

  result = take 10 $ show $ sum nums

  nums :: [Integer]
  nums = [
    37107287533902102798797998220837590246510135740250,
    46376937677490009712648124896970078050417018260538,
    74324986199524741059474233309513058123726617309629,
    111
    ]
  -- For the whole list of numbers, see the website

euler017.hs

module Euler17 where
  
  import Data.List
  
  digitize 0 = []
  digitize n = digitize (n `div` 10) ++ [n `mod` 10]

  lastTwoDigits n
    | n < 100 = n
    | otherwise = (10 * digitized !! 1) + (digitized !! 2)
    where
      digitized = digitize n

  wordify n
    | n < 20 = singles n
    | n >= 20 && n < 100 = (tens $ digitized !! 0) ++ (singles $ digitized !! 1)
    | n `mod` 100 == 0 = (hundreds $ digitized !! 0)
    | n >= 100 && lastTwo < 20 = (hundreds $ digitized !! 0) ++ "and" ++ singles lastTwo
    | otherwise = (hundreds $ digitized !! 0) ++ "and" ++ (tens $ digitized !! 1) ++ (singles $ digitized !! 2)
    where
      digitized = digitize n
      lastTwo = lastTwoDigits n
      hundreds i = (numberRange1 !! i) ++ "hundred"
      tens i = numberRange2 !! i
      singles i = numberRange1 !! i
      numberRange1 = 
        ["", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", 
         "eleven", "twelve" ,"thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen"]
      numberRange2 = ["", "", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety"]

  result = length $ concat $ ((map wordify [1..999]) ++ ["onethousand"])