Skip to content

Instantly share code, notes, and snippets.

@byorgey
Created June 3, 2013 20:05
Show Gist options
  • Save byorgey/5700933 to your computer and use it in GitHub Desktop.
Save byorgey/5700933 to your computer and use it in GitHub Desktop.
Decomposing rationals as prefix + repeating
import qualified Data.Map as M
import Data.Maybe
import Data.Ratio
import Data.List
import Data.Char
import Control.Arrow
import Test.QuickCheck
f n (d,r) = ((10*r) `divMod` n)
-- Given a list and a way to extract a tag for each element, find the
-- indices of the list giving the first and second occurrence of the
-- first element to repeat, or Nothing if there are no repeats.
findRep :: Ord b => (a -> b) -> [a] -> Maybe (Int,Int)
findRep = findRep' M.empty 0
findRep' :: Ord b => M.Map b Int -> Int -> (a -> b) -> [a] -> Maybe (Int,Int)
findRep' _ _ _ [] = Nothing
findRep' prevs ix tag (x:xs) | t `M.member` prevs = Just (prevs M.! t, ix)
| otherwise = findRep' (M.insert t ix prevs) (ix+1) tag xs
where t = tag x
slice :: (Int,Int) -> [a] -> [a]
slice (s,f) = drop s . take f
type Decimal = ([Integer],[Integer])
toDecimal :: Integer -> Integer -> Decimal
toDecimal n d = (prefix,rep)
where res = tail $ iterate (f d) (0,n)
digits = map fst res
Just lims = findRep id res
rep = slice lims digits
prefix = take (fst lims) digits
fromDigits :: [Integer] -> Integer
fromDigits = foldl' (\d r -> 10*d + r) 0
fromDecimal :: Decimal -> Rational
fromDecimal (prefix, rep) = (fromDigits rep % (10^(length rep) - 1) + fromDigits prefix % 1) / (10^(length prefix))
showDecimal :: Decimal -> String
showDecimal (pre,[0]) = "." ++ concatMap show pre
showDecimal (pre,rep) = "." ++ concatMap show pre ++ "[" ++ concatMap show rep ++ "]"
showDecEq :: Decimal -> String
showDecEq d = showRat (fromDecimal d) ++ " = " ++ showDecimal d
showRat :: Rational -> String
showRat r | denominator r == 1 = show $ numerator r
| otherwise = show (numerator r) ++ "/" ++ show (denominator r)
prop_to_from_decimal :: Integer -> Integer -> Property
prop_to_from_decimal p q = (q > 0) ==> fromDecimal (toDecimal p q) == p%q
rotate :: [a] -> [a]
rotate (x:xs) = xs ++ [x]
rotateD :: Decimal -> Decimal
rotateD (pre,rep) = (pre, rotate rep)
rotations :: Decimal -> [Decimal]
rotations xs = take (length (snd xs)) (iterate rotateD xs)
displayRotations :: Integer -> Integer -> String
displayRotations p q = unlines . map showDecEq . rotations $ toDecimal p q
printRotations :: Integer -> Integer -> IO ()
printRotations p q = putStr $ displayRotations p q
spectrum :: Integer -> [(Int, Int)]
spectrum n = map (length . snd . flip toDecimal n) >>> sort >>> group >>> map (length &&& head) $ [1..n-1]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment