My Weblog

Blog about programming and math

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

July 20, 2011 - Posted by | Programming | , , ,

No comments yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: