Refactor toDecimal to extract a helper function for arbitrary periodic sequences.

Euler.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts, StandaloneDeriving #-}
+{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts #-}
+{-# LANGUAGE LambdaCase, StandaloneDeriving #-}
 
 module Euler
   ( Digit
@@ -18,6 +19,8 @@ module Euler
   , RangeIx(..)
   , divisors
   , properDivisors
+  , runPeriodicState
+  , unfoldPeriodicState
   , toDecimal
   , fromDecimal
   , toDigits
@@ -29,6 +32,9 @@ module Euler
   , module Control.Applicative
   , module Control.Arrow
   , module Control.Monad
+  , module Control.Monad.ST
+  , module Control.Monad.State
+  , module Control.Monad.Writer
   , module Data.Function
   , module Data.List
   , module Data.Ratio
@@ -40,6 +46,7 @@ import Control.Applicative
 import Control.Arrow
 import Control.Monad
 import Control.Monad.ST
+import Control.Monad.State
 import Control.Monad.Writer
 import Data.Array.ST
 import Data.Array.Unboxed
@@ -124,20 +131,24 @@ 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 ]
 
+runPeriodicState :: Eq s => State s (Maybe a) -> s -> (([a], [a]), s)
+runPeriodicState m s0 = runState (go []) s0
+  where
+    go ps = get >>= \s -> case break (\(s', _) -> s' == s) ps of
+      (as, []) -> m >>= maybe (return (map snd as, [])) (\x -> go $ ps ++ [(s, x)])
+      (as, bs) -> return (map snd as, map snd bs)
+
+unfoldPeriodicState :: Eq s => State s (Maybe a) -> s -> ([a], [a])
+unfoldPeriodicState m s0 = fst $ runPeriodicState m s0
+
 toDecimal :: Rational -> Decimal
 toDecimal rat = Decimal q ps rs
    where
       (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
-   where
-      xs = [ first fromInteger ((10*x) `divMod` m)
-           | 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
+      (ps, rs) = flip unfoldPeriodicState r $ get >>= \case
+        0 -> return Nothing
+        x -> Just . fromIntegral <$> state (const $ (10 * x) `divMod` m)
 
 fromDecimal :: Decimal -> Rational
 fromDecimal (Decimal n ps rs) = (n % 1) + (p + r) * (1 % 10 ^ length ps)