My Weblog

Blog about programming and math

Monotone Chain Convex Hull

Monotone Chain Convex Hull algorithm does not need angular sorting. Wikipedia suggest ” The same basic idea works also if the input is sorted on x-coordinate instead of angle, and the hull is computed in two steps producing the upper and the lower parts of the hull respectively. This modification was devised by A. M. Andrew and is known as Andrew’s Monotone Chain Algorithm. It has the same basic properties as Graham’s Scan but eschews costly comparisons between polar angles “. Also tested this code on SPOJ 3421. Garden Hull and accepted . Also have look at Algorithmist.

import Data.List

data Point a = P a  a deriving ( Show , Ord , Eq ) 
data Turn = S | L | R deriving ( Show , Ord , Eq , Enum )

--start of monotone convex hull 
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 

sortPoint :: ( Num a , Ord a ) => [ Point a ] -> [ Point a ]
sortPoint xs = sortBy ( \ x y -> compPoint x y ) 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 


hullComputation :: ( Num a , Ord a ) => [ Point a ] -> [ Point a ] -> [ Point a ]
hullComputation [x] ( z:ys ) = hullComputation [z,x] ys
hullComputation xs [] = xs 
hullComputation  ( y : x : xs ) ( z : ys ) 
  |  findTurn x y z == R = hullComputation ( x:xs ) ( z : ys ) 
  |  findTurn x y z == S = hullComputation ( x:xs ) ( z : ys ) 
  |  otherwise = hullComputation ( z : y : x : xs ) ys 


convexHull :: ( Num a , Ord a ) => [ Point a ] -> [ Point a ]
convexHull xs = final  where 
	txs = sortPoint xs 
	( x : y : ys  ) = txs 
        lhull = hullComputation [y,x] ys  
	( x': y' : xs' ) = reverse txs 
	uhull = hullComputation [ y' , x' ] xs' 
	final = nub $  ( reverse lhull )  ++  uhull 
--end of monotone 



--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: