problem 044 haskell, some wip

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