├── .gitignore ├── src ├── ProjectEuler │ ├── Problem031.hs │ ├── Problem024.hs │ ├── Problem004.hs │ ├── Problem002.hs │ ├── Problem010.hs │ ├── Problem076.hs │ ├── Problem072.hs │ ├── Problem033.hs │ ├── Problem001.hs │ ├── Problem025.hs │ ├── Problem052.hs │ ├── Problem009.hs │ ├── Problem077.hs │ ├── Problem041.hs │ ├── Problem085.hs │ ├── Problem038.hs │ ├── Problem036.hs │ ├── Problem203.hs │ ├── Problem034.hs │ ├── Problem122.hs │ ├── Problem214.hs │ ├── Problem021.hs │ ├── Problem043.hs │ ├── Problem012.hs │ ├── Problem014.hs │ ├── Problem071.hs │ ├── Problem092.hs │ ├── Problem055.hs │ ├── Problem065.hs │ ├── Problem073.hs │ ├── Problem057.hs │ ├── Problem204.hs │ ├── Problem225.hs │ ├── Problem070.hs │ ├── Problem074.hs │ ├── Problem064.hs │ ├── Problem008.hs │ └── Problem093.hs ├── Main.hs └── Util.hs ├── test ├── TestAll.hs ├── TestProblems.hs └── TestUtil.hs ├── .project-settings.yml ├── .travis.yml ├── README.md ├── project-euler.cabal └── LICENSE /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | *.hp 3 | *.swp 4 | *.aux 5 | *.ps 6 | *.prof 7 | *.json 8 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem031.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem031 (solution031) where 2 | 3 | import Util 4 | 5 | solution031 :: Integer 6 | solution031 = sumCombinationCount 200 [1, 2, 5, 10, 20, 50, 100, 200] 7 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem024.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem024 (solution024) where 2 | 3 | import Data.Digits 4 | import Util 5 | 6 | solution024 :: Integer 7 | solution024 = unDigits 10 $ sortedPermutations [0..9] !! (1e6 - 1) 8 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem004.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem004 (solution004) where 2 | 3 | import Data.Digits 4 | import Data.List 5 | import Util 6 | 7 | solution004 :: Integer 8 | solution004 = last $ filter (isPalindrome . digits 10) $ sort [ x * y | x <- [100..999], y <- [x..999]] 9 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem002.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem002 (solution002) where 2 | 3 | import Util 4 | 5 | genericSolution :: Integer -> Integer 6 | genericSolution n = sum $ takeWhile (< n) (filter even fibs) 7 | 8 | solution002 :: Integer 9 | solution002 = genericSolution 4e6 10 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem010.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem010 (solution010) where 2 | 3 | import Data.Numbers.Primes 4 | 5 | genericSolution :: Integer -> Integer 6 | genericSolution n = sum $ takeWhile (< n) primes 7 | 8 | solution010 :: Integer 9 | solution010 = genericSolution 2e6 10 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem076.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem076 (solution076, genericSolution076) where 2 | 3 | import Util 4 | 5 | genericSolution076 :: Int -> Integer 6 | genericSolution076 n = countPartitions n - 1 7 | 8 | solution076 :: Integer 9 | solution076 = genericSolution076 100 10 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem072.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem072 (solution072) where 2 | 3 | import Control.Monad 4 | import Math.Sieve.Phi 5 | 6 | genericSolution :: Integer -> Integer 7 | genericSolution = sum . ap (map . phi . sieve) (enumFromTo 2) 8 | 9 | solution072 :: Integer 10 | solution072 = genericSolution 1e6 11 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem033.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem033 (solution033) where 2 | 3 | import Data.Ratio 4 | 5 | reductibleFractions :: [Ratio Integer] 6 | reductibleFractions = [(10 * a + b) / (10 * b + c) | a <- [1..9], b <- [1..9], c <- [1..9], 9 * a * c + b * c == 10 * a * b] 7 | 8 | solution033 :: Integer 9 | solution033 = denominator $ product reductibleFractions 10 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem001.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem001 (solution001) where 2 | 3 | multipleOf3or5 :: Integer -> Bool 4 | multipleOf3or5 x = x `mod` 3 == 0 || x `mod` 5 == 0 5 | 6 | genericSolution001 :: Integer -> Integer 7 | genericSolution001 = sum . filter multipleOf3or5 . enumFromTo 1 . subtract 1 8 | 9 | solution001 :: Integer 10 | solution001 = genericSolution001 1000 11 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem025.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem025 (solution025) where 2 | 3 | import Data.List 4 | import Util 5 | 6 | digitsCount :: Show a => a -> Int 7 | digitsCount = length . show 8 | 9 | hasThousandDigits :: Show a => a -> Bool 10 | hasThousandDigits = (== 1000) . digitsCount 11 | 12 | solution025 :: Integer 13 | solution025 = toInteger $ head $ findIndices hasThousandDigits fibs 14 | -------------------------------------------------------------------------------- /test/TestAll.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import System.Exit ( exitFailure, exitSuccess ) 4 | import TestProblems 5 | import TestUtil 6 | import Test.HUnit 7 | 8 | allTests :: [Test] 9 | allTests = [testUtil, testProblems] 10 | 11 | main :: IO Counts 12 | main = do 13 | cnt <- runTestTT (test allTests) 14 | if errors cnt + failures cnt == 0 15 | then exitSuccess 16 | else exitFailure 17 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem052.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem052 (solution052) where 2 | 3 | import Data.Digits 4 | import Data.List 5 | import Util 6 | 7 | allEqual :: Eq a => [a] -> Bool 8 | allEqual xs = and $ zipWith (==) xs (tail xs) 9 | 10 | sameDigits :: Integer -> Bool 11 | sameDigits = allEqual . map (sort . digits 10) . flip map [2..6] . (*) 12 | 13 | solution052 :: Integer 14 | solution052 = head . filter sameDigits $ ints 15 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem009.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem009 (solution009) where 2 | 3 | genericSolution :: Integer -> Integer -> Integer -> Integer -> Integer 4 | genericSolution a b c n 5 | | a * a + b * b == c * c = a * b * c 6 | | c < b = genericSolution (a + 1) (a + 2) (n - a - 3) n 7 | | otherwise = genericSolution a (b + 1) (n - a - b - 1) n 8 | 9 | solution009 :: Integer 10 | solution009 = genericSolution 1 2 997 1000 11 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem077.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem077 (solution077) where 2 | 3 | import Data.Numbers.Primes 4 | import Util 5 | 6 | combCountExceeds :: Integer -> Integer -> Bool 7 | combCountExceeds n x = n < sumCombinationCount x (takeWhile (<= x) primes) 8 | 9 | genericSolution077 :: Integer -> Integer 10 | genericSolution077 = head . flip filter [2..] . combCountExceeds 11 | 12 | solution077 :: Integer 13 | solution077 = genericSolution077 5000 14 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem041.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem041 (solution041) where 2 | 3 | import Data.Digits 4 | import Data.List 5 | import Data.Numbers.Primes 6 | 7 | pandigital :: Integer -> Bool 8 | pandigital x = 9 | let d = digits 10 $ fromIntegral x 10 | in sort d == [1..(length d)] 11 | 12 | -- no need to include leading 9 and 8 as they cannot form prime numbers 13 | solution041 :: Integer 14 | solution041 = last . filter pandigital . takeWhile (<= 7654321) $ primes 15 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem085.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem085 (solution085) where 2 | 3 | import Data.List 4 | import Data.Ord 5 | 6 | f :: (Int, Int) -> Int 7 | f (x, y) = x * (x + 1) * y * (y + 1) 8 | 9 | diff :: Int -> Int -> Int 10 | diff x y = abs $ x - y 11 | 12 | tuples :: Int -> [(Int, Int)] 13 | tuples limit = [(x, y) | x <- [1..limit], y <- [x..limit]] 14 | 15 | solution085 :: Integer 16 | solution085 = toInteger $ uncurry (*) $ minimumBy (comparing $ diff 8e6 . f) $ tuples 2000 17 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem038.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem038 (solution038) where 2 | 3 | import Data.Digits 4 | import Data.List 5 | 6 | isPandigital :: [Integer] -> Bool 7 | isPandigital = (== [1..9]) . sort 8 | 9 | applyProperty :: Integer -> [Integer] 10 | applyProperty = take 9 . concatMap (digits 10) . flip map [1..9] . (*) 11 | 12 | genericSolution :: [Integer] -> Integer 13 | genericSolution = unDigits 10 . last . filter isPandigital . map applyProperty 14 | 15 | solution038 :: Integer 16 | solution038 = genericSolution [1..10000] 17 | -------------------------------------------------------------------------------- /.project-settings.yml: -------------------------------------------------------------------------------- 1 | module-template: ! 'module MODULE_NAME where 2 | 3 | ' 4 | extensions: {} 5 | environment: ghc-7.4.2-stable-13.09 6 | cabal-file: project.cabal 7 | hidden-packages: '' 8 | version: 1 9 | extra-packages: ! 'Hackage: NumberSieves 0.1.2 10 | 11 | Hackage: primes 0.2.1.0 12 | 13 | Hackage: primitive 0.5.2.1 14 | 15 | Hackage: random 1.0.1.1 16 | 17 | Hackage: tf-random 0.4 18 | 19 | Hackage: QuickCheck 2.7.3 20 | 21 | Hackage: digits 0.2 22 | 23 | Hackage: memoize 0.6' 24 | ghc-args: [] 25 | excluded-modules: [] 26 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem036.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem036 (solution036) where 2 | 3 | import Data.Digits 4 | import Util 5 | 6 | isBasePalindrome :: Integer -> Integer -> Bool 7 | isBasePalindrome = (isPalindrome .) . digits 8 | 9 | isDecAndBinPalindrome :: Integer -> Bool 10 | isDecAndBinPalindrome = and . sequence [isBasePalindrome 10, isBasePalindrome 2] 11 | 12 | genericSolution :: Integer -> Integer 13 | genericSolution n = sum $ filter isDecAndBinPalindrome [1..n] 14 | 15 | solution036 :: Integer 16 | solution036 = genericSolution 1e6 17 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: haskell 2 | 3 | ghc: 7.8 4 | 5 | before_install: 6 | - sudo apt-get -q -y install hlint || cabal install hlint 7 | - sudo apt-get install llvm-dev 8 | - cabal install --only-dependencies --enable-tests 9 | 10 | script: 11 | - hlint . --ignore="Parse error" 12 | - cabal configure --enable-tests --enable-library-coverage 13 | - cabal build 14 | - cabal test --show-details=always 15 | 16 | after_script: 17 | - cabal install hpc-coveralls 18 | - hpc-coveralls --coverage-mode=StrictlyFullLines --exclude-dir=test test-all 19 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem203.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem203 (solution203) where 2 | 3 | import Data.List 4 | import Data.Numbers.Primes 5 | import Util 6 | 7 | pascal :: [[Integer]] 8 | pascal = iterate (map sum . clump 2 . (:) 0 . flip (++) [0]) [1] 9 | 10 | squareFree :: Integer -> Bool 11 | squareFree = all (== 1) . map length . group . primeFactors 12 | 13 | genericSolution203 :: Int -> Integer 14 | genericSolution203 = sum . filter squareFree . nub . concat . flip take pascal 15 | 16 | solution203 :: Integer 17 | solution203 = genericSolution203 51 18 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem034.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem034 (solution034) where 2 | 3 | import Control.Monad 4 | import Data.Digits 5 | import Data.Function.Memoize 6 | import Util 7 | 8 | mFact :: Integer -> Integer 9 | mFact = memoize fact 10 | 11 | equalToSumOfDigitsFactorials :: Integer -> Bool 12 | equalToSumOfDigitsFactorials = ap (==) (sum . map mFact . digits 10) 13 | 14 | genericSolution :: Integer -> Integer 15 | genericSolution = sum . filter equalToSumOfDigitsFactorials . enumFromTo 10 16 | 17 | solution034 :: Integer 18 | solution034 = genericSolution 1e5 19 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem122.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem122 (solution122) where 2 | 3 | import Data.List 4 | 5 | minMult :: Integer -> Int 6 | minMult x = minMult' [[1]] 7 | where minMult' l = case find ((== x) . head) l of 8 | Just result -> length result - 1 9 | Nothing -> minMult' $ concatMap next $ filter ((< x) . head) l 10 | next l = map ((: l) . (head l +)) l 11 | 12 | genericSolution122 :: Integer -> Integer 13 | genericSolution122 = toInteger . sum . map minMult . enumFromTo 1 14 | 15 | solution122 :: Integer 16 | solution122 = genericSolution122 200 17 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem214.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem214 (solution214) where 2 | 3 | import Data.Numbers.Primes 4 | import Math.Sieve.Phi 5 | import Util 6 | 7 | mPhi :: Int -> Int 8 | mPhi = phi (sieve (4e7 :: Integer)) 9 | 10 | phiChain :: Int -> [Int] 11 | phiChain = takeUntil (== 1) . iterate mPhi 12 | 13 | phiChainLength :: Int -> Int 14 | phiChainLength = length . phiChain 15 | 16 | genericSolution :: [Int] -> Integer 17 | genericSolution = toInteger . sum . filter (\ x -> 25 == phiChainLength x) 18 | 19 | solution214 :: Integer 20 | solution214 = genericSolution $ takeWhile (<= 4e7) primes 21 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem021.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem021 (solution021) where 2 | 3 | isDivisor :: Integer -> Integer -> Bool 4 | isDivisor x d = rem x d == 0 5 | 6 | properDivisors :: Integer -> [Integer] 7 | properDivisors x = filter (isDivisor x) [1..x `quot` 2] 8 | 9 | amicalNumber :: Integer -> Bool 10 | amicalNumber a = a /= b && a == sumB 11 | where b = sum $ properDivisors a 12 | sumB = sum $ properDivisors b 13 | 14 | genericSolution :: Integer -> Integer 15 | genericSolution n = sum $ filter amicalNumber [1..n] 16 | 17 | solution021 :: Integer 18 | solution021 = genericSolution 1e4 19 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem043.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem043 (solution043) where 2 | 3 | import Data.Digits 4 | import Util 5 | 6 | p :: [Integer] 7 | p = [2, 3, 5, 7, 11, 13, 17] 8 | 9 | toInt :: [Integer] -> Integer 10 | toInt = unDigits 10 11 | 12 | isDivisor :: Integral a => a -> a -> Bool 13 | isDivisor d x = rem x d == 0 14 | 15 | subStringDivisibilityProperty :: [Integer] -> Bool 16 | subStringDivisibilityProperty = and . zipWith isDivisor p . map (unDigits 10) . drop 1 . clump 3 17 | 18 | solution043 :: Integer 19 | solution043 = sum $ map toInt $ filter subStringDivisibilityProperty (sortedPermutations [0..9]) 20 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem012.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem012 (solution012) where 2 | 3 | import Math.NumberTheory.Powers 4 | 5 | triangleNumbers :: [Integer] 6 | triangleNumbers = 0 : zipWith (+) triangleNumbers [1..] 7 | 8 | isDivisor :: Integer -> Integer -> Bool 9 | isDivisor x d = rem x d == 0 10 | 11 | divisorsCount :: Integer -> Integer 12 | divisorsCount x = fromIntegral . (* 2) . length $ filter (isDivisor x) [1..integerSquareRoot x] 13 | 14 | genericSolution :: Integer -> Integer 15 | genericSolution n = head $ filter ((> n) . divisorsCount) triangleNumbers 16 | 17 | solution012 :: Integer 18 | solution012 = genericSolution 500 19 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem014.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem014 (solution014, genericSolution014) where 2 | 3 | import Util 4 | 5 | next :: Int -> Int 6 | next n = if odd n 7 | then 3 * n + 1 8 | else quot n 2 9 | 10 | collatzLength :: Int -> Int 11 | collatzLength start = collatzLength' start 2 12 | where collatzLength' n result = if n == 1 13 | then result 14 | else collatzLength' (next n) (result + 1) 15 | 16 | genericSolution014 :: Int -> Integer 17 | genericSolution014 = (+ 1) . findIndexBy (>) . map collatzLength . enumFromTo 1 18 | 19 | solution014 :: Integer 20 | solution014 = genericSolution014 1e6 21 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem071.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem071 (solution071) where 2 | 3 | import Data.Ratio 4 | 5 | genericSolution :: Integral a => Ratio a -> a -> a 6 | genericSolution target maxDen = loop initNum initDen 0 7 | where initNum = numerator target 8 | initDen = 1 + denominator target 9 | loop num den closest 10 | | den == maxDen = numerator closest 11 | | (nextNum % den) < target = loop nextNum den (nextNum % den) 12 | | otherwise = loop num (den + 1) closest 13 | where nextNum = num + 1 14 | 15 | solution071 :: Integer 16 | solution071 = genericSolution (3 % 7) 1e6 17 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem092.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem092 (solution092, genericSolution092) where 2 | 3 | import Data.Digits 4 | import Util 5 | 6 | digitsSquareSum :: Integer -> Integer 7 | digitsSquareSum = sum . map sq . digits 10 8 | 9 | chainEndsWith :: Integer -> Integer 10 | chainEndsWith x = 11 | let next = digitsSquareSum x in 12 | if next == 1 || next == 89 13 | then next 14 | else chainEndsWith next 15 | 16 | genericSolution092 :: Integer -> Integer 17 | genericSolution092 = toInteger . length . filter (== 89) . map chainEndsWith . enumFromTo 1 18 | 19 | solution092 :: Integer 20 | solution092 = genericSolution092 1e7 21 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem055.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem055 (solution055) where 2 | 3 | import Control.Monad 4 | import Data.Digits 5 | import Util 6 | 7 | reverseInteger :: Integer -> Integer 8 | reverseInteger = unDigits 10 . digitsRev 10 9 | 10 | isDecPalindrome :: Integer -> Bool 11 | isDecPalindrome = isPalindrome . digits 10 12 | 13 | isLychrel :: Integer -> Bool 14 | isLychrel = all (not . isDecPalindrome) . take 50 . tail . iterate next 15 | where next = ap (+) reverseInteger 16 | 17 | genericSolution :: Integer -> Integer 18 | genericSolution n = toInteger $ length $ filter isLychrel [1..n] 19 | 20 | solution055 :: Integer 21 | solution055 = genericSolution 1e4 22 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem065.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem065 (solution065) where 2 | 3 | import Data.Digits 4 | import Data.Ratio 5 | import Util 6 | 7 | eCF :: [Integer] 8 | eCF = 2 : 1 : interleave [iterate (+ 2) 2, repeat 1, repeat 1] 9 | 10 | eConvergent :: Int -> [Integer] 11 | eConvergent = flip take eCF 12 | 13 | eFracAccFunc :: Ratio Integer -> Ratio Integer -> Ratio Integer 14 | eFracAccFunc = ratioAdd . ratioDiv 1 15 | 16 | eFrac :: Int -> Ratio Integer 17 | eFrac = foldl1 eFracAccFunc . map (% 1) . reverse . eConvergent 18 | 19 | genericSolution :: Int -> Integer 20 | genericSolution = sum . digits 10 . numerator . eFrac 21 | 22 | solution065 :: Integer 23 | solution065 = genericSolution 100 24 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem073.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem073 (solution073) where 2 | 3 | endNumerator :: Int -> Int 4 | endNumerator d = if 2 * n < d 5 | then n 6 | else n - 1 7 | where n = quot d 2 8 | 9 | countForDenominator :: Int -> Int 10 | countForDenominator d = countForDenominator' (1 + quot d 3) 0 11 | where countForDenominator' n count = if n > endNum 12 | then count 13 | else countForDenominator' (n + 1) (if 1 == gcd d n then count + 1 else count) 14 | endNum = endNumerator d 15 | 16 | genericSolution :: Int -> Integer 17 | genericSolution = toInteger . sum . map countForDenominator . enumFromTo 4 18 | 19 | solution073 :: Integer 20 | solution073 = genericSolution 12000 21 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem057.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem057 (solution057) where 2 | 3 | import Data.Digits 4 | import Data.Ratio 5 | import Util 6 | 7 | next :: Ratio Integer -> Ratio Integer 8 | next = (+ 1) . ratioDiv 1 . (+ 1) 9 | 10 | piExpansions :: Int -> [Ratio Integer] 11 | piExpansions = tail . flip take (iterate next 1) 12 | 13 | numeratorHasMoreDigitsThanDenominator :: Ratio Integer -> Bool 14 | numeratorHasMoreDigitsThanDenominator x = 15 | length (digits 10 $ numerator x) > length (digits 10 $ denominator x) 16 | 17 | genericSolution :: Int -> Integer 18 | genericSolution = toInteger . length . filter numeratorHasMoreDigitsThanDenominator . piExpansions 19 | 20 | solution057 :: Integer 21 | solution057 = genericSolution 1000 22 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem204.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem204 (solution204) where 2 | 3 | import Data.Numbers.Primes 4 | 5 | prodCombinationCount :: Int -> [Int] -> Int 6 | prodCombinationCount limit = prodCombinationCount' 1 1 7 | where prodCombinationCount' count _ [] = count 8 | prodCombinationCount' count p (m:ms) = if p > limit 9 | then count - 1 10 | else prodCombinationCount' (count + 1) (p * m) (m:ms) 11 | + prodCombinationCount' 0 p ms 12 | 13 | genericSolution204 :: Int -> Int -> Int 14 | genericSolution204 hammingType limit = 15 | prodCombinationCount limit $ takeWhile (<= hammingType) primes 16 | 17 | solution204 :: Integer 18 | solution204 = toInteger $ genericSolution204 100 1e9 19 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem225.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem225 (solution225) where 2 | 3 | import Data.List 4 | 5 | takeUntilSubSeq :: Eq a => [a] -> [a] -> [a] 6 | takeUntilSubSeq _ [] = [] 7 | takeUntilSubSeq ss (x : xs) = if ss `isPrefixOf` xs 8 | then [x] 9 | else x : takeUntilSubSeq ss xs 10 | 11 | modTribs :: Integer -> [Integer] 12 | modTribs n = modTribs' 1 1 1 13 | where modTribs' x y z = x : modTribs' y z ((x + y + z) `mod` n) 14 | 15 | nonTribDivisor :: Integer -> Bool 16 | nonTribDivisor = notElem 0 . takeUntilSubSeq [1, 1, 1] . modTribs 17 | 18 | genericSolution225 :: Int -> Integer 19 | genericSolution225 = (filter nonTribDivisor [1,3..] !!) . subtract 1 20 | 21 | solution225 :: Integer 22 | solution225 = genericSolution225 124 23 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem070.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem070 (solution070, genericSolution070) where 2 | 3 | import Control.Monad 4 | import Data.Digits 5 | import Data.List 6 | import Data.Ratio 7 | import Math.Sieve.Phi 8 | 9 | phiSeq :: [Integer] -> [Integer] 10 | phiSeq = map =<< phi . sieve . last 11 | 12 | nPhiSeq :: [Integer] -> [(Integer, Integer)] 13 | nPhiSeq = ap zip phiSeq 14 | 15 | equalByPermutation :: Integral a => (a, a) -> Bool 16 | equalByPermutation (x, y) = null $ digits 10 x \\ digits 10 y 17 | 18 | minByRatio :: Integral a => (a, a) -> (a, a) -> (a, a) 19 | minByRatio (n1, p1) (n2, p2) = if n1 % p1 <= n2 % p2 then (n1, p1) else (n2, p2) 20 | 21 | genericSolution070 :: Integer -> Integer 22 | genericSolution070 = fst . foldl1 minByRatio . filter equalByPermutation . nPhiSeq . enumFromTo 2 23 | 24 | solution070 :: Integer 25 | solution070 = genericSolution070 1e7 26 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem074.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem074 (solution074) where 2 | 3 | import Data.Digits 4 | import Util hiding (fact) 5 | 6 | fact :: Int -> Int 7 | fact 0 = 1 8 | fact 1 = 1 9 | fact 2 = 2 10 | fact 3 = 6 11 | fact 4 = 24 12 | fact 5 = 120 13 | fact 6 = 720 14 | fact 7 = 5040 15 | fact 8 = 40320 16 | fact 9 = 362880 17 | fact _ = error "fact n where n > 9 is not needed for this problem" 18 | 19 | digitsFactSum :: Int -> Int 20 | digitsFactSum = sum . map fact . digits 10 21 | 22 | dfsChain :: Int -> [Int] 23 | dfsChain n = n : takeWhile (/= n) (tail $ iterate digitsFactSum n) 24 | 25 | dfsChainLength :: Int -> Int 26 | dfsChainLength = length . takeWhileUniq . dfsChain 27 | 28 | genericSolution :: Int -> Integer 29 | genericSolution = toInteger . length . filter (== 60) . map dfsChainLength . enumFromTo 1 30 | 31 | solution074 :: Integer 32 | solution074 = genericSolution 1e6 33 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem064.hs: -------------------------------------------------------------------------------- 1 | -- http://en.wikipedia.org/wiki/Methods_of_computing_square_roots 2 | 3 | module ProjectEuler.Problem064 (solution064) where 4 | 5 | import Math.NumberTheory.Powers 6 | import Util 7 | 8 | next :: (Integer, Integer, Integer, Integer) -> (Integer, Integer, Integer, Integer) 9 | next (m, d, a, s) = (nextM, nextD, nextA, s) 10 | where nextM = d * a - m 11 | nextD = quot (s - (nextM * nextM)) d 12 | nextA = quot (integerSquareRoot s + nextM) nextD 13 | 14 | initTuple :: Integer -> (Integer, Integer, Integer, Integer) 15 | initTuple s = (0, 1, integerSquareRoot s, s) 16 | 17 | fracPeriod :: Integer -> Int 18 | fracPeriod = subtract 1 . length . takeWhileUniq . iterate next . initTuple 19 | 20 | genericSolution064 :: Integer -> Int 21 | genericSolution064 = length . filter odd . map fracPeriod . filter (not . isSquare) . enumFromTo 2 22 | 23 | solution064 :: Integer 24 | solution064 = toInteger $ genericSolution064 1e4 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Haskell solutions to Project Euler 2 | ===================== 3 | 4 | [![Build Status](http://img.shields.io/travis/guillaume-nargeot/project-euler-haskell/master.svg)](https://travis-ci.org/guillaume-nargeot/project-euler-haskell) [![Coverage Status](http://img.shields.io/coveralls/guillaume-nargeot/project-euler-haskell/master.svg)](https://coveralls.io/r/guillaume-nargeot/project-euler-haskell?branch=master) 5 | 6 | Haskell solutions for problems 1, 2, 4, 9-10, 12, 14, 21, 24-25, 31, 33-34, 36, 38, 41, 43, 52, 55, 57, 64-65, 70-74, 77, 85, 92-93, 122, 203-204, 214, 225 7 | 8 | # Running a solution 9 | 10 | Use the following command line to run a solution: 11 | ```bash 12 | cabal run [number] 13 | ``` 14 | 15 | Example for solving problem 72: 16 | 17 | ```bash 18 | $ cabal run 72 19 | Preprocessing executable 'problem' for project-euler-0.1.0.0... 20 | 303963552391 21 | 961.09 ms 22 | ``` 23 | 24 | # Notes 25 | 26 | Solutions for other problems implemented in different languages are availabe in the following repository: http://github.com/guillaume-nargeot/project-euler 27 | 28 | 29 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem008.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem008 (solution008) where 2 | 3 | import Data.Digits 4 | import Util 5 | 6 | genericSolution008 :: Integer -> Integer 7 | genericSolution008 = maximum . map product . clump 5 . digits 10 8 | 9 | solution008 :: Integer 10 | solution008 = genericSolution008 7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450 11 | -------------------------------------------------------------------------------- /project-euler.cabal: -------------------------------------------------------------------------------- 1 | name: project-euler 2 | version: 0.1.0.0 3 | synopsis: Solutions to Project Euler problems. 4 | license: BSD3 5 | license-file: LICENSE 6 | author: Guillaume Nargeot 7 | maintainer: guillaume@nargeot.com 8 | copyright: (c) 2014 Guillaume Nargeot 9 | category: Algorithms 10 | build-type: Simple 11 | cabal-version: >= 1.10 12 | tested-with: GHC == 7.6, GHC == 7.8 13 | homepage: https://github.com/guillaume-nargeot/project-euler-haskell 14 | 15 | extra-source-files: 16 | README.md 17 | 18 | source-repository head 19 | type: git 20 | location: git://github.com/guillaume-nargeot/project-euler-haskell.git 21 | 22 | executable problem 23 | hs-source-dirs: src 24 | main-is: Main.hs 25 | build-depends: arithmoi, base, clock, containers, digits, formatting, memoize, primes, NumberSieves 26 | ghc-options: -Wall -Werror -O2 27 | default-extensions: NumDecimals 28 | 29 | test-suite test-all 30 | hs-source-dirs: src, test 31 | type: exitcode-stdio-1.0 32 | main-is: TestAll.hs 33 | build-depends: arithmoi, base, clock, containers, digits, formatting, memoize, primes, NumberSieves, HUnit, Cabal >= 1.9.2 34 | ghc-options: -Wall -Werror -O2 35 | default-extensions: NumDecimals 36 | -------------------------------------------------------------------------------- /src/ProjectEuler/Problem093.hs: -------------------------------------------------------------------------------- 1 | module ProjectEuler.Problem093 (solution093) where 2 | 3 | import Data.Digits hiding (digits) 4 | import Data.List 5 | import Data.Ord 6 | import Util 7 | 8 | isInt :: RealFrac a => a -> Bool 9 | isInt x = x == fromInteger (round x) 10 | 11 | foldF2 :: ([a -> a -> a], [a]) -> a 12 | foldF2 (f1 : f2 : fs, x1 : x2 : xs) = f1 (foldF [f2] [x1, x2]) (foldF fs xs) 13 | foldF2 _ = error "foldF2: illegal argument" 14 | 15 | fourDigitCombs :: [[Double]] 16 | fourDigitCombs = [[a, b, c, d] | a <- [0..9], b <- [a+1..9], c <- [b+1..9], d <- [c+1..9]] 17 | 18 | opsCombs :: [[Double -> Double -> Double]] 19 | opsCombs = [[x, y, z] | x <- ops, y <- ops, z <- ops] 20 | where ops = [(+), (-), (*), (/)] 21 | 22 | filterNaturalCandidates :: [Double] -> [Int] 23 | filterNaturalCandidates = map floor . sort . nub . filter isInt . filter (>= 1) 24 | 25 | matchingNaturalsCount :: [Int] -> Int 26 | matchingNaturalsCount = length . takeWhile (uncurry (==)) . zip [1..] 27 | 28 | generatedNaturals :: [Double] -> Int 29 | generatedNaturals = matchingNaturalsCount . filterNaturalCandidates . generate 30 | where generate digits = generate1 digits ++ generate2 digits 31 | generate1 = map (uncurry foldF) . allCombs 32 | generate2 = map foldF2 . allCombs 33 | allCombs digits = [(o, d) | o <- opsCombs, d <- permutations digits] 34 | 35 | solution093 :: Integer 36 | solution093 = convert $ maximumBy (comparing generatedNaturals) fourDigitCombs 37 | where convert = unDigits 10 . map floor 38 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, Guillaume Nargeot 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Guillaume Nargeot nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /test/TestProblems.hs: -------------------------------------------------------------------------------- 1 | module TestProblems (testProblems) where 2 | 3 | import ProjectEuler.Problem001 4 | import ProjectEuler.Problem002 5 | import ProjectEuler.Problem004 6 | import ProjectEuler.Problem008 7 | import ProjectEuler.Problem009 8 | import ProjectEuler.Problem010 9 | import ProjectEuler.Problem012 10 | import ProjectEuler.Problem014 11 | import ProjectEuler.Problem021 12 | import ProjectEuler.Problem024 13 | import ProjectEuler.Problem025 14 | import ProjectEuler.Problem031 15 | import ProjectEuler.Problem033 16 | import ProjectEuler.Problem034 17 | import ProjectEuler.Problem036 18 | import ProjectEuler.Problem038 19 | import ProjectEuler.Problem041 20 | import ProjectEuler.Problem043 21 | import ProjectEuler.Problem052 22 | import ProjectEuler.Problem055 23 | import ProjectEuler.Problem057 24 | import ProjectEuler.Problem064 25 | import ProjectEuler.Problem065 26 | import ProjectEuler.Problem070 27 | import ProjectEuler.Problem071 28 | import ProjectEuler.Problem072 29 | import ProjectEuler.Problem073 30 | import ProjectEuler.Problem074 31 | import ProjectEuler.Problem076 32 | import ProjectEuler.Problem077 33 | import ProjectEuler.Problem085 34 | import ProjectEuler.Problem092 35 | import ProjectEuler.Problem093 36 | import ProjectEuler.Problem122 37 | import ProjectEuler.Problem203 38 | import ProjectEuler.Problem204 39 | import ProjectEuler.Problem214 40 | import ProjectEuler.Problem225 41 | import Test.HUnit 42 | import Util 43 | 44 | testProblems :: Test 45 | testProblems = "Problems" ~: fmap testProblem [ 46 | (solution001, 233168), 47 | (solution002, 4613732), 48 | (solution004, 906609), 49 | (solution008, 40824), 50 | (solution009, 31875000), 51 | (solution010, 142913828922), 52 | (solution012, 76576500), 53 | (solution014, 837799), 54 | (solution021, 31626), 55 | (solution024, 2783915460), 56 | (solution025, 4782), 57 | (solution031, 73682), 58 | (solution033, 100), 59 | (solution034, 40730), 60 | (solution036, 872187), 61 | (solution038, 932718654), 62 | (solution041, 7652413), 63 | (solution043, 16695334890), 64 | (solution052, 142857), 65 | (solution055, 249), 66 | (solution057, 153), 67 | (solution064, 1322), 68 | (solution065, 272), 69 | (genericSolution070 100000, 75841), 70 | -- solution070 ~=? 8319823, -- slow 71 | (solution071, 428570), 72 | (solution072, 303963552391), 73 | (solution073, 7295372), 74 | (solution074, 402), 75 | (solution076, 190569291), 76 | (solution077, 71), 77 | (solution085, 2772), 78 | (genericSolution092 100000, 85623), 79 | -- solution092 ~=? 8581146, -- slow 80 | (solution093, 1258), 81 | (solution122, 1582), 82 | (solution203, 34029210557338), 83 | (solution204, 2944730), 84 | (solution214, 1677366278943), 85 | (solution225, 2009)] 86 | 87 | testProblem :: (Show a, Eq a) => (a, a) -> IO Assertion 88 | testProblem (actual, expected) = return $ time actual >>= (@=? expected) 89 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Data.Map as M 4 | import ProjectEuler.Problem001 5 | import ProjectEuler.Problem002 6 | import ProjectEuler.Problem004 7 | import ProjectEuler.Problem008 8 | import ProjectEuler.Problem009 9 | import ProjectEuler.Problem010 10 | import ProjectEuler.Problem012 11 | import ProjectEuler.Problem014 12 | import ProjectEuler.Problem021 13 | import ProjectEuler.Problem024 14 | import ProjectEuler.Problem025 15 | import ProjectEuler.Problem031 16 | import ProjectEuler.Problem033 17 | import ProjectEuler.Problem034 18 | import ProjectEuler.Problem036 19 | import ProjectEuler.Problem038 20 | import ProjectEuler.Problem041 21 | import ProjectEuler.Problem043 22 | import ProjectEuler.Problem052 23 | import ProjectEuler.Problem055 24 | import ProjectEuler.Problem057 25 | import ProjectEuler.Problem064 26 | import ProjectEuler.Problem065 27 | import ProjectEuler.Problem070 28 | import ProjectEuler.Problem071 29 | import ProjectEuler.Problem072 30 | import ProjectEuler.Problem073 31 | import ProjectEuler.Problem074 32 | import ProjectEuler.Problem076 33 | import ProjectEuler.Problem077 34 | import ProjectEuler.Problem085 35 | import ProjectEuler.Problem092 36 | import ProjectEuler.Problem093 37 | import ProjectEuler.Problem122 38 | import ProjectEuler.Problem203 39 | import ProjectEuler.Problem204 40 | import ProjectEuler.Problem214 41 | import ProjectEuler.Problem225 42 | import System.Environment (getArgs) 43 | import System.Exit (exitSuccess) 44 | import Util 45 | 46 | solutions :: M.Map Integer Integer 47 | solutions = M.fromList [ 48 | (1, solution001), 49 | (2, solution002), 50 | (4, solution004), 51 | (8, solution008), 52 | (9, solution009), 53 | (10, solution010), 54 | (12, solution012), 55 | (14, solution014), 56 | (21, solution021), 57 | (24, solution024), 58 | (25, solution025), 59 | (31, solution031), 60 | (33, solution033), 61 | (34, solution034), 62 | (36, solution036), 63 | (38, solution038), 64 | (41, solution041), 65 | (43, solution043), 66 | (52, solution052), 67 | (55, solution055), 68 | (57, solution057), 69 | (64, solution064), 70 | (65, solution065), 71 | (70, solution070), 72 | (71, solution071), 73 | (72, solution072), 74 | (73, solution073), 75 | (74, solution074), 76 | (76, solution076), 77 | (77, solution077), 78 | (85, solution085), 79 | (92, solution092), 80 | (93, solution093), 81 | (122, solution122), 82 | (203, solution203), 83 | (204, solution204), 84 | (214, solution214), 85 | (225, solution225)] 86 | 87 | solution :: Integer -> Maybe Integer 88 | solution number = M.lookup number solutions 89 | 90 | main :: IO () 91 | main = do 92 | args <- getArgs 93 | case args of 94 | ["--help"] -> usage >> exitSuccess 95 | ["-h"] -> usage >> exitSuccess 96 | [number] -> case solution (read number :: Integer) of 97 | Just result -> time result >>= print 98 | Nothing -> putStrLn "There is no solution yet for this problem" 99 | _ -> usage >> exitSuccess 100 | where 101 | usage = putStrLn "Usage: cabal run problem [number]" 102 | -------------------------------------------------------------------------------- /src/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Util where 4 | 5 | import Data.List (delete, maximumBy, group, tails, transpose) 6 | import Data.Ord 7 | import Data.Ratio 8 | import qualified Data.Set as Set 9 | import qualified Formatting as F 10 | import Formatting.Clock 11 | import System.Clock 12 | 13 | ints :: (Enum t, Num t) => [t] 14 | ints = [1..] 15 | 16 | sq :: Integer -> Integer 17 | sq x = x * x 18 | 19 | fpow :: Int -> (a -> a) -> a -> a 20 | fpow n = foldr (.) id . replicate n 21 | 22 | foldF :: [a -> a -> a] -> [a] -> a 23 | foldF fs (x : xs) = foldl (flip id) x $ zipWith flip fs xs 24 | foldF _ _ = error "Util.foldF: illegal arguments" 25 | 26 | ratioAdd :: Integral a => Ratio a -> Ratio a -> Ratio a 27 | ratioAdd x y = 28 | let nx = numerator x in 29 | let ny = numerator y in 30 | let dx = denominator x in 31 | let dy = denominator y in 32 | (nx * dy + ny * dx) % (dx * dy) 33 | 34 | ratioDiv :: Integral a => Ratio a -> Ratio a -> Ratio a 35 | ratioDiv x y = 36 | let nx = numerator x in 37 | let ny = numerator y in 38 | let dx = denominator x in 39 | let dy = denominator y in 40 | (nx * dy) % (dx * ny) 41 | 42 | fact :: (Enum a, Num a) => a -> a 43 | fact n = product [1..n] 44 | 45 | fibs :: [Integer] 46 | fibs = 0 : scanl (+) 1 fibs 47 | 48 | tribs :: [Integer] 49 | tribs = 1 : 1 : 1 : zipWith (+) tribs (tail $ zipWith (+) tribs (tail tribs)) 50 | 51 | interleave :: [[a]] -> [a] 52 | interleave = concat . transpose 53 | 54 | isPalindrome :: Eq a => [a] -> Bool 55 | isPalindrome xs = xs == reverse xs 56 | 57 | -- Splits the list into overlapping clumps of n elements 58 | -- http://docs.factorcode.org/content/word-clump%2Cgrouping.html 59 | clump :: Int -> [a] -> [[a]] 60 | clump n = fpow n init . map (take n) . tails 61 | 62 | takeUntil :: (a -> Bool) -> [a] -> [a] 63 | takeUntil _ [] = [] 64 | takeUntil p (x:xs) | p x = [x] 65 | | otherwise = x : takeUntil p xs 66 | 67 | -- the input list has to be sorted 68 | uniq :: Eq a => [a] -> [a] 69 | uniq = map head . group 70 | 71 | takeWhileUniq :: Ord a => [a] -> [a] 72 | takeWhileUniq [] = [] 73 | takeWhileUniq (x:xs) = x : takeWhileUniq' (Set.singleton x) xs 74 | where takeWhileUniq' _ [] = [] 75 | takeWhileUniq' set (y:ys) = if Set.member y set 76 | then [] 77 | else y : takeWhileUniq' (Set.insert y set) ys 78 | 79 | indexOfMax :: (Ord a) => [a] -> Integer 80 | indexOfMax = fst . maximumBy (comparing snd) . zip [0..] 81 | 82 | findIndexBy :: (Ord a) => (a -> a -> Bool) -> [a] -> Integer 83 | findIndexBy _ [] = error "Util.findIndexBy: empty list" 84 | findIndexBy comp (x:xs) = findIndexBy' xs x 1 0 85 | where 86 | findIndexBy' [] _ _ i = i 87 | findIndexBy' (y:ys) z yi zi = yi `seq` if comp y z 88 | then findIndexBy' ys y (yi + 1) yi 89 | else findIndexBy' ys z (yi + 1) zi 90 | 91 | reversedHeads :: [a] -> [[a]] 92 | reversedHeads = scanl (flip (:)) [] 93 | 94 | combinations :: Int -> [a] -> [[a]] 95 | combinations 0 _ = [[]] 96 | combinations m l = [x:ys | x:xs <- tails l, ys <- combinations (m - 1) xs] 97 | 98 | sortedPermutations :: Eq a => [a] -> [[a]] 99 | sortedPermutations [] = [[]] 100 | sortedPermutations xs = [ x:ys | x <- xs, ys <- sortedPermutations (delete x xs)] 101 | 102 | sumCombinationCount :: Integer -> [Integer] -> Integer 103 | sumCombinationCount 0 _ = 1 104 | sumCombinationCount _ [] = 0 105 | sumCombinationCount r (c:cs) = if r < 0 106 | then 0 107 | else sumCombinationCount (r - c) (c:cs) + sumCombinationCount r cs 108 | 109 | -- Count integer partitions using Euler's pentagonal number theorem 110 | countPartitions :: Int -> Integer 111 | countPartitions = (map p' [0..] !!) 112 | where p' n | n == 0 = 1 113 | | otherwise = sum $ zipWith (*) (map (countPartitions . (n-)) (pent n)) $ cycle [1, 1, -1, -1] 114 | where pent x = takeWhile (<= x) $ concatMap f [1..] 115 | where f k = [(m - k) `div` 2, (m + k) `div` 2] 116 | where m = 3 * k * k 117 | 118 | time :: a -> IO a 119 | time x = do 120 | start <- getTime Monotonic 121 | end <- x `seq` getTime Monotonic 122 | F.fprint (timeSpecs F.% "\n") start end 123 | return x 124 | -------------------------------------------------------------------------------- /test/TestUtil.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-} 2 | {-# OPTIONS_GHC -fno-warn-type-defaults #-} 3 | 4 | module TestUtil (testUtil) where 5 | 6 | import Util 7 | import Test.HUnit 8 | 9 | testSq = "sq" ~: map sq [0..4] @?= [0, 1, 4, 9, 16] 10 | 11 | testFpow = "fpow" ~: [ 12 | fpow 5 (^2) 2 @?= 2 ^ 2 ^ 5, 13 | fpow 2 (++ "+") "i" @?= "i++", 14 | fpow 0 (++ "+") "i" @?= "i"] 15 | 16 | testFoldF = "foldF" ~: [ 17 | foldF [] [2] @?= 2, 18 | foldF [(+), (*), (-)] [2, 3, 5, 7] @?= 18] 19 | 20 | testFact = "fact" ~: [map fact [0..7] @?= [1, 1, 2, 6, 24, 120, 720, 5040]] 21 | 22 | testFibs = "fibs" ~: take 8 fibs @?= [0, 1, 1, 2, 3, 5, 8, 13] 23 | 24 | testTribs = "tribs" ~: take 8 tribs @?= [1, 1, 1, 3, 5, 9, 17, 31] 25 | 26 | testInterleave = "interleave" ~: [ 27 | interleave [] @?= ([] :: [Int]), 28 | interleave [[2]] @?= [2], 29 | interleave [[2, 3]] @?= [2, 3], 30 | interleave [[2], [3]] @?= [2, 3], 31 | interleave [[2], []] @?= [2], 32 | interleave [[], [2]] @?= [2], 33 | interleave [[2, 5], [3]] @?= [2, 3, 5], 34 | interleave [[2], [3, 5]] @?= [2, 3, 5], 35 | interleave [[2, 5], [3, 7]] @?= [2, 3, 5, 7], 36 | interleave [[2, 5, 7], [3]] @?= [2, 3, 5, 7], 37 | interleave [[2, 7, 17], [3, 11, 19], [5, 13, 23]] @?= [2, 3, 5, 7, 11, 13, 17, 19, 23]] 38 | 39 | testIsPalindrome = "isPalindrome" ~: [ 40 | isPalindrome "" @?= True, 41 | isPalindrome "a" @?= True, 42 | isPalindrome "aba" @?= True, 43 | isPalindrome "abba" @?= True, 44 | isPalindrome "abcba" @?= True, 45 | isPalindrome "ab" @?= False, 46 | isPalindrome "abb" @?= False, 47 | isPalindrome "abc" @?= False] 48 | 49 | testClump = "clump" ~: [ 50 | clump 1 [] @?= ([] :: [[Int]]), 51 | clump 1 [2] @?= [[2]], 52 | clump 1 [2, 3] @?= [[2], [3]], 53 | clump 2 [2] @?= [], 54 | clump 2 [2, 3] @?= [[2, 3]], 55 | clump 2 [2, 3, 5] @?= [[2, 3], [3, 5]], 56 | clump 2 [2, 3, 5, 7] @?= [[2, 3], [3, 5], [5, 7]], 57 | clump 3 [2, 3] @?= [], 58 | clump 3 [2, 3, 5] @?= [[2, 3, 5]], 59 | clump 3 [2, 3, 5, 7] @?= [[2, 3, 5], [3, 5, 7]], 60 | clump 3 [2, 3, 5, 7, 11] @?= [[2, 3, 5], [3, 5, 7], [5, 7, 11]]] 61 | 62 | testTakeUntil = "takeUntil" ~: [ 63 | takeUntil undefined [] @?= ([] :: [Int]), 64 | takeUntil odd [2] @?= [2], 65 | takeUntil odd [2, 3] @?= [2, 3], 66 | takeUntil odd [2, 3, 5] @?= [2, 3], 67 | takeUntil even [2] @?= [2], 68 | takeUntil even [2, 3] @?= [2], 69 | takeUntil even [2, 3, 5] @?= [2]] 70 | 71 | testUniq = "uniq" ~: [ 72 | uniq [] @?= ([] :: [Int]), 73 | uniq [2] @?= [2], 74 | uniq [2, 3] @?= [2, 3], 75 | uniq [2, 2, 3] @?= [2, 3], 76 | uniq [2, 3, 3] @?= [2, 3], 77 | uniq [2, 2, 3, 3] @?= [2, 3], 78 | uniq [2, 3, 2] @?= [2, 3, 2], 79 | uniq [2, 2, 3, 2] @?= [2, 3, 2], 80 | uniq [2, 3, 2, 2] @?= [2, 3, 2], 81 | uniq [2, 3, 3, 2] @?= [2, 3, 2], 82 | uniq [2, 2, 3, 3, 3, 5, 5, 5, 5, 5] @?= [2, 3, 5]] 83 | 84 | testTakeWhileUniq = "takeWhileUniq" ~: [ 85 | takeWhileUniq [] @?= ([] :: [Int]), 86 | takeWhileUniq [2, 2] @?= [2], 87 | takeWhileUniq [2, 3] @?= [2, 3], 88 | takeWhileUniq [3, 3] @?= [3], 89 | takeWhileUniq [2, 3, 2] @?= [2, 3], 90 | takeWhileUniq [3, 2, 3] @?= [3, 2], 91 | takeWhileUniq [2, 3, 5, 2] @?= [2, 3, 5], 92 | takeWhileUniq [2, 3, 5, 3] @?= [2, 3, 5], 93 | takeWhileUniq [2, 3, 5, 5] @?= [2, 3, 5]] 94 | 95 | testIndexOfMax = "indexOfMax" ~: [ 96 | indexOfMax [2] @?= 0, 97 | indexOfMax [2, 3] @?= 1, 98 | indexOfMax [3, 2] @?= 0, 99 | indexOfMax [2, 3, 5] @?= 2, 100 | indexOfMax [2, 5, 3] @?= 1, 101 | indexOfMax [5, 2, 3] @?= 0, 102 | indexOfMax [5, 3, 2] @?= 0, 103 | indexOfMax [3, 2, 5] @?= 2, 104 | indexOfMax [3, 5, 2] @?= 1] 105 | 106 | testFindIndexBy = "findIndexBy" ~: [ 107 | findIndexBy (>) [2] @=? 0, 108 | findIndexBy (<) [2] @=? 0, 109 | findIndexBy (<) [2, 3] @=? 0, 110 | findIndexBy (<) [3, 2] @=? 1, 111 | findIndexBy (<) [2, 3, 5] @=? 0, 112 | findIndexBy (<) [2, 5, 3] @=? 0, 113 | findIndexBy (<) [3, 2, 5] @=? 1, 114 | findIndexBy (<) [5, 2, 3] @=? 1, 115 | findIndexBy (<) [3, 5, 2] @=? 2, 116 | findIndexBy (<) [5, 3, 2] @=? 2] 117 | 118 | testReversedHeads = "reversedHeads" ~: [ 119 | reversedHeads [] @?= ([[]] :: [[Int]]), 120 | reversedHeads [2, 3, 5, 7, 11] @?= [[], [2], [3, 2], [5, 3, 2], [7, 5, 3, 2], [11, 7, 5, 3, 2]]] 121 | 122 | testCombinations = "combinations" ~: [ 123 | combinations 0 [] @?= ([[]] :: [[Int]]), 124 | combinations 1 [] @?= ([] :: [[Int]]), 125 | combinations 0 [2, 3, 5] @?= [[]], 126 | combinations 1 [2, 3, 5] @?= [[2], [3], [5]], 127 | combinations 2 [2, 3, 5] @?= [[2, 3], [2, 5], [3, 5]], 128 | combinations 3 [2, 3, 5] @?= [[2, 3, 5]], 129 | combinations 4 [2, 3, 5] @?= []] 130 | 131 | testSumCombinationCount = "sumCombinationCount" ~: [ 132 | sumCombinationCount 2 [2] @=? 1, 133 | sumCombinationCount 2 [2, 3] @=? 1, 134 | sumCombinationCount 3 [2, 3] @=? 1, 135 | sumCombinationCount 5 [2, 3] @=? 1, 136 | sumCombinationCount 6 [2, 3] @=? 2, 137 | sumCombinationCount 12 [2, 3] @=? 3, 138 | sumCombinationCount 5 [2, 3, 5] @=? 2, 139 | sumCombinationCount 12 [2, 3, 5] @=? 5] 140 | 141 | testCountPartitions = "countPartitions" ~: [ 142 | map countPartitions [0..9] @?= [1,1,2,3,5,7,11,15,22,30]] 143 | 144 | testUtil = "Util" ~: [ 145 | testSq, 146 | testFpow, 147 | testFoldF, 148 | testFact, 149 | testFibs, 150 | testTribs, 151 | testInterleave, 152 | testIsPalindrome, 153 | testClump, 154 | testTakeUntil, 155 | testUniq, 156 | testTakeWhileUniq, 157 | testIndexOfMax, 158 | testFindIndexBy, 159 | testReversedHeads, 160 | testCombinations, 161 | testSumCombinationCount, 162 | testCountPartitions] 163 | --------------------------------------------------------------------------------