diff options
Diffstat (limited to 'haskell/044-pentagonal_numbers.hs')
| -rw-r--r-- | haskell/044-pentagonal_numbers.hs | 37 |
1 files changed, 37 insertions, 0 deletions
diff --git a/haskell/044-pentagonal_numbers.hs b/haskell/044-pentagonal_numbers.hs new file mode 100644 index 0000000..db479bc --- /dev/null +++ b/haskell/044-pentagonal_numbers.hs @@ -0,0 +1,37 @@ +-- Pentagon numbers +-- Problem 44 +-- +-- Pentagonal numbers are generated by the formula, Pn=n(3nā1)/2. +-- The first ten pentagonal numbers are: +-- +-- 1, 5, 12, 22, 35, 51, 70, 92, 117, 145, ... +-- +-- It can be seen that P4 + P7 = 22 + 70 = 92 = P8. However, their difference, +-- 70 ā 22 = 48, is not pentagonal. +-- +-- Find the pair of pentagonal numbers, Pj and Pk, for which their sum and difference +-- are pentagonal and D = |Pk ā Pj| is minimised; what is the value of D? + + +import Data.Maybe(isJust, fromJust) + +main = do + print(fromJust $ last $ takeUntil isJust [diffPentagonal p | p <- pentagonals]) + +pentagonals = [(3 * n ^ 2 - n) `div` 2 | n <- [1..]] + +diffPentagonal :: Int -> Maybe Int +diffPentagonal n + | length testBellow == 0 = Nothing + | otherwise = Just $ head testBellow + where testBellow = [k - (n - k) | k <- takeWhile (< n) pentagonals, + isPentagonal (n - k), isPentagonal (k - (n - k))] + +isPentagonal :: Int -> Bool +isPentagonal x = fromInteger (round n) == n + where n = (sqrt (fromIntegral (24 * x + 1)) + 1) / 6 + +takeUntil :: (a -> Bool) -> [a] -> [a] +takeUntil f (x : xs) + | f x = [x] + | otherwise = x : takeUntil f xs |