Anonymous user
Fraction reduction: Difference between revisions
added Haskell
(added Haskell) |
|||
Line 1,352:
Took 42.251172302s
</pre>
=={{header|Haskell}}==
<lang haskell>import Control.Monad (guard, join)
import Data.List (intersect, unfoldr, delete, nub, group, sort)
import Text.Printf (printf)
type Fraction = (Int, Int)
possibleFractions :: [Int] -> [Fraction]
possibleFractions xs =
[(n,d) | n <- xs
, d <- xs
, n < d
, gcd n d /= 1
, not (hasZeros n) && not (hasZeros d)
, hasCommonDigits (n, d)
, hasUniqueDigits n && hasUniqueDigits d ]
hasUniqueDigits :: Integral a => a -> Bool
hasUniqueDigits n = dl == ul
where
ds = digits 10 n
dl = length ds
ul = length $ nub ds
hasZeros :: Integral a => a -> Bool
hasZeros = elem 0 . digits 10
commonDigits :: Fraction -> [Int]
commonDigits (n1, n2) = digits 10 n1 `intersect` digits 10 n2
hasCommonDigits :: Fraction -> Bool
hasCommonDigits = not . null . commonDigits
dropDigit :: Integral a => a -> a -> a
dropDigit d = digitsToIntegral . delete d . digits 10
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)
findReduction :: Fraction -> [(Fraction, Fraction, Int)]
findReduction z@(n1, d1) = go $ commonDigits z
where
decimal = realToFrac n1 / realToFrac d1
go [] = []
go (x:xs)
| decimalWithDrop == decimal = (z, (n2, d2), x) : go xs
| otherwise = go xs
where
n2 = dropDigit x n1
d2 = dropDigit x d1
decimalWithDrop = realToFrac n2 / realToFrac d2
findReductions :: [Int] -> [(Fraction, Fraction, Int)]
findReductions = (findReduction =<<) . possibleFractions
displayResult :: (Fraction, Fraction, Int) -> IO ()
displayResult ((n1,d1),(n2,d2),d) = printf "%d/%d = %d/%d by dropping %d\n" n1 d1 n2 d2 d
countReductions :: [(Fraction, Fraction, Int)] -> [(Int, Int)]
countReductions = fmap (\ys -> (length ys, head ys)) . group . sort . fmap (\(_, _, x) -> x)
displayCount :: [(Fraction, Fraction, Int)] -> Int -> IO ()
displayCount 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"
main :: IO ()
main = do
mapM_ (\g -> mapM_ displayResult (take 12 g) >> printf "\n") [group1, group2, group3]
mapM_ (uncurry displayCount) [(group1, 2), (group2, 3), (group3, 4)]
where
group1 = findReductions [10..99]
group2 = findReductions [100..999]
group3 = findReductions [1000..9999]</lang>
{{out}}
<pre>16/64 = 1/4 by dropping 6
19/95 = 1/5 by dropping 9
26/65 = 2/5 by dropping 6
49/98 = 4/8 by dropping 9
132/231 = 12/21 by dropping 3
134/536 = 14/56 by dropping 3
134/938 = 14/98 by dropping 3
136/238 = 16/28 by dropping 3
138/345 = 18/45 by dropping 3
139/695 = 13/65 by dropping 9
143/341 = 13/31 by dropping 4
146/365 = 14/35 by dropping 6
149/298 = 14/28 by dropping 9
149/596 = 14/56 by dropping 9
149/894 = 14/84 by dropping 9
154/253 = 14/23 by dropping 5
1234/4936 = 124/496 by dropping 3
1239/6195 = 123/615 by dropping 9
1246/3649 = 126/369 by dropping 4
1249/2498 = 124/248 by dropping 9
1259/6295 = 125/625 by dropping 9
1279/6395 = 127/635 by dropping 9
1283/5132 = 128/512 by dropping 3
1297/2594 = 127/254 by dropping 9
1297/3891 = 127/381 by dropping 9
1298/2596 = 128/256 by dropping 9
1298/3894 = 128/384 by dropping 9
1298/5192 = 128/512 by dropping 9
There are 4 2-digit fractions of which:
2 have 6's omitted
2 have 9's omitted
There are 122 3-digit fractions of which:
9 have 3's omitted
1 have 4's omitted
6 have 5's omitted
15 have 6's omitted
16 have 7's omitted
15 have 8's omitted
60 have 9's omitted
There are 660 4-digit fractions of which:
14 have 1's omitted
25 have 2's omitted
92 have 3's omitted
14 have 4's omitted
29 have 5's omitted
63 have 6's omitted
16 have 7's omitted
17 have 8's omitted
390 have 9's omitted</pre>
=={{header|J}}==
The algorithm generates all potential rational fractions of given size in base 10 and successively applies conditions to restrict the candidates. By avoiding boxing and rational numbers this version is much quicker than that which may be found in the page history.
| |||