BestApproximationDiv2 problem in Haskell The task is to write a function findFraction maxDen number to find a short but good rational approximation to a decimal representation of a number — problem statement on TopCoder:


  Given a fraction F = A/B, where 0 &lt;= A &lt; B, its quality of approximation with respect to number is calculated as follows:
  
  
  Let S be the decimal fraction (infinite or finite) representation of F.
  Let N be the number of digits after the decimal point in number. If number has trailing zeros, all of them are considered to be significant and are counted towards N.
  If S is infinite or the number of digits after the decimal point in S is greater than N, only consider the first N decimals after the decimal point in S. Truncate the rest of the digits without performing any kind of rounding.
  If the number of digits after the decimal point in S is less than N, append trailing zeroes to the right side until there are exactly N digits after the decimal point.
  The quality of approximation is the number of digits in the longest common prefix of S and number. The longest common prefix of two numbers is the longest string which is a prefix of the decimal representations of both numbers with no extra leading zeroes. For example, "3.14" is the longest common prefix of 3.1428 and 3.1415.
  
  
  […] You are only allowed to use fractions where the denominator is less than or equal to maxDen. Find an approximation F = A/B of number such that 1 &lt;= B &lt;= maxDen, 0 &lt;= A &lt; B, and the quality of approximation is maximized. Return a String formatted "A/B has X exact digits" (quotes for clarity) where A/B is the approximation you have found and X is its quality. If there are several such approximations, choose the one with the smallest denominator among all of them. If there is still a tie, choose the one among those with the smallest numerator.


import Data.Char
import Data.List
import Data.Maybe

showResult :: (Int, Int, Int) -&gt; String
showResult (a, b, x) = show a ++ "/" ++ show b ++ " has "
                    ++ show x ++ " exact digits"

compareDigits :: [Int] -&gt; [Int] -&gt; Ordering
compareDigits xs [] = EQ
compareDigits (x:xs) (y:ys) = case compare x y of
                                  EQ -&gt; compareDigits xs ys
                                  order -&gt; order

toDigit :: Char -&gt; Int
toDigit c = ord c - ord '0'

preciseDivision :: Int -&gt; Int -&gt; [Int]
preciseDivision a b = div a' b : preciseDivision (mod a' b) b
           where a' = 10 * a

estimate :: [Int] -&gt; Double
estimate = sum . zipWith (flip (/)) (iterate (*10) 10) .
           map fromIntegral

bestNumerator :: [Int] -&gt; Double -&gt; Int -&gt; Maybe Int
bestNumerator ds p b =
    case find atLeast . map (pair ds b) $ [pivot .. ] of
        Just (a, EQ) -&gt; Just a
        otherwise -&gt; Nothing
    where pivot = truncate $ p * fromIntegral b
          pair ds b a = (a, compareDigits (preciseDivision a b) ds)
          atLeast (a, order) = order /= LT

bestResult :: Int -&gt; [Int] -&gt; Maybe (Int, Int, Int)
bestResult n ds = fromMaybe Nothing . find isJust .
                  map (toResult ds $ estimate ds) $ [1..n]
    where toResult ds p b = case bestNumerator ds p b of
                                Just a -&gt; Just (a, b, 1 + length ds)
                                Nothing -&gt; Nothing

findFraction' :: Int -&gt; [Int] -&gt; (Int, Int, Int)
findFraction' n = fromJust . last . takeWhile isJust .
                  map (bestResult n) . inits

findFraction :: Int -&gt; String -&gt; String
findFraction n = showResult . findFraction' n .
                 map toDigit . tail . tail


I'm most worried by bestNumerator and bestResult here. I'm using a find idiom that I invented myself, and I wonder if cleaner, more Haskelly alternatives exist.
Hmmm, not much ideas, only syntax:

showResult :: (Int, Int, Int) -&gt; String
showResult (a, b, x) = concat [show a, "/", show b, " has ", show x, " exact digits"]


preciseDivision :: Int -&gt; Int -&gt; [Int]
preciseDivision a b = let (d,r) = divMod (10*a) b in d : preciseDivision r b 


...where toResult ds p b = fmap (\a -&gt; (a, b, 1 + length ds)) $ bestNumerator ds p b