63 lines
2 KiB
Haskell
63 lines
2 KiB
Haskell
import qualified Data.List as L
|
|
import Data.Maybe
|
|
import Data.Ord
|
|
import Text.Printf
|
|
|
|
-- Determine if a number n is a perfect square and return its square root if so.
|
|
-- This is used instead of sqrt to avoid fixed sized floating point numbers.
|
|
perfectSqrt :: Integral a => a -> Maybe a
|
|
perfectSqrt n
|
|
| n == 1 = Just 1
|
|
| n < 4 = Nothing
|
|
| otherwise =
|
|
let search low high =
|
|
let guess = (low + high) `div` 2
|
|
square = guess ^ 2
|
|
next
|
|
| square == n = Just guess
|
|
| low == guess = Nothing
|
|
| square < n = search guess high
|
|
| otherwise = search low guess
|
|
in next
|
|
in search 0 n
|
|
|
|
-- Determine the area of a Heronian triangle if it is one.
|
|
heronTri :: Integral a => a -> a -> a -> Maybe a
|
|
heronTri a b c =
|
|
let -- Rewrite Heron's formula to factor out the term 16 under the root.
|
|
areaSq16 = (a + b + c) * (b + c - a) * (a + c - b) * (a + b - c)
|
|
(areaSq, r) = areaSq16 `divMod` 16
|
|
in if r == 0
|
|
then perfectSqrt areaSq
|
|
else Nothing
|
|
|
|
isPrimitive :: Integral a => a -> a -> a -> a
|
|
isPrimitive a b c = gcd a (gcd b c)
|
|
|
|
third (_, _, x, _, _) = x
|
|
fourth (_, _, _, x, _) = x
|
|
fifth (_, _, _, _, x) = x
|
|
|
|
orders :: Ord b => [(a -> b)] -> a -> a -> Ordering
|
|
orders [f] a b = comparing f a b
|
|
orders (f:fx) a b =
|
|
case comparing f a b of
|
|
EQ -> orders fx a b
|
|
n -> n
|
|
|
|
main :: IO ()
|
|
main = do
|
|
let range = [1 .. 200]
|
|
tris :: [(Integer, Integer, Integer, Integer, Integer)]
|
|
tris = L.sortBy (orders [fifth, fourth, third])
|
|
$ map (\(a, b, c, d, e) -> (a, b, c, d, fromJust e))
|
|
$ filter (isJust . fifth)
|
|
[(a, b, c, a + b + c, heronTri a b c)
|
|
| a <- range, b <- range, c <- range
|
|
, a <= b, b <= c, isPrimitive a b c == 1]
|
|
printTri (a, b, c, d, e) = printf "%3d %3d %3d %9d %4d\n" a b c d e
|
|
printf "Heronian triangles found: %d\n\n" $ length tris
|
|
putStrLn " Sides Perimeter Area"
|
|
mapM_ printTri $ take 10 tris
|
|
putStrLn ""
|
|
mapM_ printTri $ filter ((== 210) . fifth) tris
|