## Convex Hull in Haskell

Implementation Convex hull using Graham scan algorithm and tested it on SPOJ 3421. Garden Hull. Accepted Haskell code.

import Data.List import qualified Data.Sequence as DS data Point a = P a a deriving ( Show , Eq , Ord ) data Turn = S | L | R deriving ( Show , Eq , Ord , Enum ) -- straight left right compPoint :: ( Num a , Ord a ) => Point a -> Point a -> Ordering compPoint ( P x1 y1 ) ( P x2 y2 ) | compare x1 x2 == EQ = compare y1 y2 | otherwise = compare x1 x2 findMinx :: ( Num a , Ord a ) => [ Point a ] -> [ Point a ] findMinx xs = sortBy ( \x y -> compPoint x y ) xs compAngle ::(Num a , Ord a ) => Point a -> Point a -> Point a -> Ordering compAngle ( P x1 y1 ) ( P x2 y2 ) ( P x0 y0 ) = compare ( ( y1 - y0 ) * ( x2 - x0 ) ) ( ( y2 - y0) * ( x1 - x0 ) ) sortByangle :: ( Num a , Ord a ) => [ Point a ] -> [ Point a ] sortByangle (z:xs) = z : sortBy ( \x y -> compAngle x y z ) xs convexHull ::( Num a , Ord a ) => [ Point a ] -> [ Point a ] convexHull xs = reverse . findHull [y,x] $ ys where (x:y:ys) = sortByangle.findMinx $ xs findTurn :: ( Num a , Ord a , Eq a ) => Point a -> Point a -> Point a -> Turn findTurn ( P x0 y0 ) ( P x1 y1 ) ( P x2 y2 ) | ( y1 - y0 ) * ( x2- x0 ) < ( y2 - y0 ) * ( x1 - x0 ) = L | ( y1 - y0 ) * ( x2- x0 ) == ( y2 - y0 ) * ( x1 - x0 ) = S | otherwise = R findHull :: ( Num a , Ord a ) => [ Point a ] -> [ Point a ] -> [ Point a ] findHull [x] ( z : ys ) = findHull [ z , x ] ys --incase of second point on line from x to z findHull xs [] = xs findHull ( y : x : xs ) ( z:ys ) | findTurn x y z == R = findHull ( x : xs ) ( z:ys ) | findTurn x y z == S = findHull ( x : xs ) ( z:ys ) | otherwise = findHull ( z : y : x : xs ) ys --from here on testing part for SPOJ format::(Num a , Ord a ) => [[a]] -> [Point a] format xs = map (\[x0 , y0] -> P x0 y0 ) xs helpSqrt :: ( Floating a ) => Point a -> Point a -> a helpSqrt ( P x0 y0 ) ( P x1 y1 ) = sqrt $ ( x0 - x1 ) ^ 2 + ( y0 - y1 ) ^ 2 solve :: ( Num a , RealFrac a , Floating a ) => [ Point a ] -> String solve xs = ( show . fromIntegral . truncate . snd . foldl ( \( P x0 y0 , s ) ( P x1 y1 ) -> ( P x1 y1 , s + helpSqrt ( P x0 y0 ) ( P x1 y1 ) ) ) ( head xs , 0 ) $ ( tail xs ++ [ head xs ] ) ) ++ "\n" readInt ::( Num a , Read a ) => String -> a readInt = read main = interact $ solve . convexHull . format . map ( map readInt . words ) . tail . lines

Advertisements

No comments yet.

## Leave a Reply