Add some more utility functions for decimal expansions.

Euler.hs

@@ -1,8 +1,11 @@
-{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts #-}
+{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts, StandaloneDeriving #-}
 
 module Euler
   ( Digit
-  , Decimal(..)
+  , Decimal
+  , integerPart
+  , prefixDigits
+  , repeatingDigits
   , whenM
   , unlessM
   , primesTo
@@ -13,6 +16,14 @@ module Euler
   , divisors
   , properDivisors
   , toDecimal
+  , fromDecimal
+  , module Control.Applicative
+  , module Control.Arrow
+  , module Control.Monad
+  , module Data.Function
+  , module Data.List
+  , module Data.Ratio
+  , module Data.Word
   ) where
 
 import Control.Applicative
@@ -24,6 +35,7 @@ import Data.Array.ST
 import Data.Array.Unboxed
 import Data.Function
 import Data.List
+import Data.Ratio
 import Data.Word
 
 import qualified Control.Monad.ST.Lazy as LST
@@ -32,7 +44,7 @@ type Digit   = Word8
 data Decimal = Decimal { integerPart     :: Integer
                        , prefixDigits    :: [Digit]
                        , repeatingDigits :: [Digit]
-                       } deriving (Eq,Ord,Show)
+                       }
 
 whenM, unlessM :: Monad m => m Bool -> m () -> m ()
 whenM   mc m = mc >>= (\c -> when   c m)
@@ -75,11 +87,12 @@ properDivisors :: Integral a => a -> [a]
 properDivisors n | n < 1 = []
 properDivisors n = nub $ 1 : concat [ [m, q] | m <- takeWhile (\x -> x^2 <= n) [2..], let (q, r) = n `divMod` m, r == 0 ]
 
-toDecimal :: Integer -> Integer -> Decimal
-toDecimal n m = Decimal q ps rs
+toDecimal :: Rational -> Decimal
+toDecimal rat = Decimal q ps rs
    where
-      (q,r) = n `divMod` m
-      (ps,rs) = toDecimal' r m
+      (n,  m)  = (numerator rat, denominator rat)
+      (q,  r)  = n `divMod` m
+      (ps, rs) = toDecimal' r m
 
 toDecimal' :: Integer -> Integer -> ([Digit], [Digit])
 toDecimal' n m = first (map fst) $ second (map fst) $ collect [] xs
@@ -88,3 +101,18 @@ toDecimal' n m = first (map fst) $ second (map fst) $ collect [] xs
            | x <- takeWhile (/= 0) $ (n:) $ map snd xs ]
       collect ps []     = (ps, [])
       collect ps (x:xs) = if x `elem` ps then break (== x) ps else collect (ps ++ [x]) xs
+
+fromDecimal :: Decimal -> Rational
+fromDecimal (Decimal n ps rs) = (n % 1) + (p + r) * (1 % 10 ^ length ps)
+   where (p, r) = (fromDigits ps % 1, fromDigits rs % (10 ^ length rs - 1))
+         fromDigits = foldl' (\s d -> 10 * s + fromIntegral d) 0
+
+deriving instance Eq Decimal
+deriving instance Ord Decimal
+
+instance Show Decimal where
+   show (Decimal n ps rs)
+      | null (ps ++ rs) = show n
+      | null rs         = show n ++ "." ++ concat (map show ps)
+      | otherwise       = show n ++ "." ++ concat (map show ps)
+                                 ++ "(" ++ concat (map show rs) ++ ")"

Problem12.hs

@@ -1,7 +1,6 @@
 -- The sequence of triangle numbers is generated by adding the natural numbers.
 -- So the 7th triangle number would be 1 + 2 + 3 + 4 + 5 + 6 + 7 = 28. ...
 -- What is the value of the first triangle number to have over five hundred divisors?
-import Data.List
 import Euler
 
 triangles = scanl1 (+) [1..] :: [Int]

Problem26.hs

@@ -1,10 +1,6 @@
 -- Find the value of d < 1000 for which 1/d contains the longest recurring
 -- cycle in its decimal fraction part.
-
-import Control.Arrow
-import Data.Function
-import Data.List
 import Euler
 
 main = print $ fst $ maximumBy (compare `on` length . repeatingDigits . snd) $
-       map (id &&& toDecimal 1) [2..999]
+       map (id &&& toDecimal . (1%)) [2..999]