56 lines
2.2 KiB
Haskell
56 lines
2.2 KiB
Haskell
import Control.Monad (guard)
|
|
import Data.List (intersect, unfoldr, delete, nub, group, sort)
|
|
import Text.Printf (printf)
|
|
|
|
type Fraction = (Int, Int)
|
|
type Reduction = (Fraction, Fraction, Int)
|
|
|
|
validIntegers :: [Int] -> [Int]
|
|
validIntegers xs = [x | x <- xs, not $ hasZeros x, hasUniqueDigits x]
|
|
where
|
|
hasZeros = elem 0 . digits 10
|
|
hasUniqueDigits n = length ds == length ul
|
|
where
|
|
ds = digits 10 n
|
|
ul = nub ds
|
|
|
|
possibleFractions :: [Int] -> [Fraction]
|
|
possibleFractions = (\ys -> [(n,d) | n <- ys, d <- ys, n < d, gcd n d /= 1]) . validIntegers
|
|
|
|
digits :: Integral a => a -> a -> [a]
|
|
digits b = unfoldr (\n -> guard (n /= 0) >> pure (n `mod` b, n `div` b))
|
|
|
|
digitsToIntegral :: Integral a => [a] -> a
|
|
digitsToIntegral = sum . zipWith (*) (iterate (*10) 1)
|
|
|
|
findReductions :: Fraction -> [Reduction]
|
|
findReductions z@(n1, d1) = [ (z, (n2, d2), x)
|
|
| x <- digits 10 n1 `intersect` digits 10 d1,
|
|
let n2 = dropDigit x n1
|
|
d2 = dropDigit x d1
|
|
decimalWithDrop = realToFrac n2 / realToFrac d2,
|
|
decimalWithDrop == decimal ]
|
|
where dropDigit d = digitsToIntegral . delete d . digits 10
|
|
decimal = realToFrac n1 / realToFrac d1
|
|
|
|
findGroupReductions :: [Int] -> [Reduction]
|
|
findGroupReductions = (findReductions =<<) . possibleFractions
|
|
|
|
showReduction :: Reduction -> IO ()
|
|
showReduction ((n1,d1),(n2,d2),d) = printf "%d/%d = %d/%d by dropping %d\n" n1 d1 n2 d2 d
|
|
|
|
showCount :: [Reduction] -> Int -> IO ()
|
|
showCount xs n = do
|
|
printf "There are %d %d-digit fractions of which:\n" (length xs) n
|
|
mapM_ (uncurry (printf "%5d have %d's omitted\n")) (countReductions xs) >> printf "\n"
|
|
where
|
|
countReductions = fmap ((,) . length <*> head) . group . sort . fmap (\(_, _, x) -> x)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
mapM_ (\g -> mapM_ showReduction (take 12 g) >> printf "\n") groups
|
|
mapM_ (uncurry showCount) $ zip groups [2..]
|
|
where
|
|
groups = [ findGroupReductions [10^1..99], findGroupReductions [10^2..999]
|
|
, findGroupReductions [10^3..9999], findGroupReductions [10^4..99999] ]
|