My Weblog

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