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

No comments yet.

## Leave a Reply