[Haskell-cafe] Re: Solving a geometry problem with Haskell

Andrei Formiga andrei.formiga at gmail.com
Sat Jan 12 17:28:30 EST 2008


On Jan 12, 2008 7:12 PM, Achim Schneider <barsoap at web.de> wrote:
> what about
>
> module Main where
>
> isPerfectSquare :: Integer -> Bool
> isPerfectSquare n = sqrrt == fromIntegral (truncate sqrrt)
>     where sqrrt = sqrt $ fromIntegral n
>
> ? It's a hell alot faster, but I have no idea if some numerical
> property of square roots could make it give different results than your
> version, in rare cases.
>

I did something similar:


isSquare :: Integer -> Bool
isSquare x = x == (sqx * sqx)
    where sqx = round $ sqrt $ fromInteger x

perfectSquares :: [Integer]
perfectSquares = zipWith (*) [1..] [1..]

findSorted :: [Integer] -> Integer -> Bool
findSorted xs x = h == x
    where h : _ = dropWhile (<x) xs

notPerfectSquares :: [Integer]
notPerfectSquares = filter (not . (findSorted perfectSquares)) [2..]

testSquares n =
    and $ map isSquare (take n perfectSquares)

testNonSquares n =
    or $ map isSquare (take n notPerfectSquares)

test n = (testSquares n, testNonSquares n)

As we're dealing with integers, I guess isSquare works correctly, but
I'm not an expert in numerical analysis. A little bit of testing
didn't bring any counterexamples:

*Main> test 100000
(True,False)

-- 
[]s, Andrei Formiga


More information about the Haskell-Cafe mailing list