Add solution for problem 26.

This commit is contained in:
Jesse D. McDonald 2015-08-08 16:00:40 -05:00
parent f8d2bb4a48
commit 950f08166f
2 changed files with 36 additions and 1 deletions

View File

@ -1,7 +1,9 @@
{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts #-} {-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts #-}
module Euler module Euler
( whenM ( Digit
, Decimal(..)
, whenM
, unlessM , unlessM
, primesTo , primesTo
, primes , primes
@ -10,19 +12,28 @@ module Euler
, digitsOf , digitsOf
, divisors , divisors
, properDivisors , properDivisors
, toDecimal
) where ) where
import Control.Applicative import Control.Applicative
import Control.Arrow
import Control.Monad import Control.Monad
import Control.Monad.ST import Control.Monad.ST
import Control.Monad.Writer import Control.Monad.Writer
import Data.Array.ST import Data.Array.ST
import Data.Array.Unboxed import Data.Array.Unboxed
import Data.Function
import Data.List import Data.List
import Data.Word import Data.Word
import qualified Control.Monad.ST.Lazy as LST import qualified Control.Monad.ST.Lazy as LST
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, unlessM :: Monad m => m Bool -> m () -> m ()
whenM mc m = mc >>= (\c -> when c m) whenM mc m = mc >>= (\c -> when c m)
unlessM mc m = mc >>= (\c -> unless c m) unlessM mc m = mc >>= (\c -> unless c m)
@ -63,3 +74,17 @@ divisors n = nub $ concat [ [m, q] | m <- takeWhile (\x -> x^2 <= n) [1..], let
properDivisors :: Integral a => a -> [a] properDivisors :: Integral a => a -> [a]
properDivisors n | n < 1 = [] 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 ] 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
where
(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

10
Problem26.hs Normal file
View File

@ -0,0 +1,10 @@
-- 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]