From 548515a626ccd650b0f594eb48b19f9bef5b76cf Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Sat, 8 Aug 2015 17:33:36 -0500 Subject: [PATCH] Add some more utility functions for decimal expansions. --- Euler.hs | 42 +++++++++++++++++++++++++++++++++++------- Problem12.hs | 1 - Problem26.hs | 6 +----- 3 files changed, 36 insertions(+), 13 deletions(-) diff --git a/Euler.hs b/Euler.hs index c52db97..9b93e0f 100644 --- a/Euler.hs +++ b/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) ++ ")" diff --git a/Problem12.hs b/Problem12.hs index 0374308..a2077bd 100644 --- a/Problem12.hs +++ b/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] diff --git a/Problem26.hs b/Problem26.hs index 2e48fee..b6e8ed1 100644 --- a/Problem26.hs +++ b/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]