Graham scan implementation in Haskell

Question

It looks like this is a really classical question, but I'd like to ask it one more time as all those solutions look quite long and complicated for me (maybe because I am dumb :) )

So this is a Graham convex hull algorithm from the very beginning of the "Real World Haskell" book. And a perimeter function just for the sake of implementing it.

Why did the authors define the Direction datatype when it only acts like Ordering?

Is there any more elegant way to traverse through lists considering pairs?

Any suggestions would be appreciated

import Text.Printf
import Data.List (sortBy)
data Point = Point Int Int deriving (Show, Eq, Ord)
turn :: Point -> Point -> Point -> Ordering
turn (Point x2 y2) (Point x1 y1) (Point x3 y3) = compare ((x2 - x1) * (y3 - y1) - (y2 - y1) * (x3 - x1)) 0
polarSort :: [Point] -> [Point]
polarSort points = sorted where
 pivot = minimum points
 sorted = pivot:(sortBy (\a b -> turn b pivot a) . filter (pivot /=)) points
grahamScan :: [Point] -> [Point]
grahamScan points = grahamScan' rest [p2, p1] where
 (p1:p2:rest) = polarSort points
 grahamScan' [] l = l
 grahamScan' (p:pointsLeft) (s1:s2:selectedPoints) = case turn s2 s1 p of
 GT -> grahamScan' (p:pointsLeft) (s2:selectedPoints) -- the turn is right, so we discard last selected point
 _ -> grahamScan' pointsLeft (p:s1:s2:selectedPoints) -- the turn is left, so we add another point to the list of selected ones
dist :: Point -> Point -> Double
dist (Point x1 y1) (Point x2 y2) = sqrt (fromIntegral ((x2 - x1)^(2 :: Int) + (y2 - y1)^(2 :: Int)))
perimeter :: [Point] -> Double
perimeter points@(p0:_) = dist p0 pn + rest where
 walk :: [Point] -> (Double, Point)
 walk [a] = (0, a)
 walk (p1:p2:ps) = (dist p1 p2 + next, lastPoint) where
 (next, lastPoint) = walk (p2:ps)
 (rest, pn) = walk points
main = do
 _ <- getLine
 content <- getContents
 putStrLn $ printf "%.1f" ((perimeter . grahamScan . map ((\([x, y]) -> Point x y) . map read . words) . lines) content)

• 200_success: Why are your points limited to Int coordinates?
• Petr: Regarding Direction, the reason is semantics. Ordering means something different than direction and the meaning should be reflected in naming.

Answer 1

A good foundation to build on

One nice thing about your code is that it needs no [arccos,arctan,arg,atan2,phase]-like floating point approximations until you already have your convex hull and demand its Euclidean perimeter and another that you got the Graham scan's stack shuffle pretty concise and \$\mathcal O(n)\$ everywhere outside the one and only \$\mathcal O(n \log n)\$ sortBy.

with a glitch

The worst thing to say about your code is that it is only partially correct and easily confusable by collinear EQ triples: Just to give an example proof of failure, instead of the correct 4·4=16.0 perimeter it calculates incorrect 20.5 perimeter for input point sample sequence

0 0
4 0
1 0
2 0
4 4
0 4

and other inelegances calling for a rewrite:

Aesthetically, your lambdas

(\a b -> turn b pivot a)
(\([x, y]) -> Point x y)

make me want to flip your argument order and core data type so that we get

compareFrom o l r=compare((x l-x o)*(y r-y o))((y l-y o)*(x r-x o))

mnemonically returning LT iff from o l looks "lefter than" = "left to" = "less right than" r, for example compareFrom (0,0) (1,2) (2,1) == LT [to answer your question about the need for data Direction=LEFT|STRAIGHT|RIGHT aliases] and together with a

distanceFrom from to = ((x to-x from)**2+(y to-y from)**2)**(1/2)

handy not only to reduce your over-individualized perimeter to a one-liner

totalDistance ps = sum(zipWith distanceFrom(last ps:init ps)ps)

but also to get your Graham preparation to lambda-free (but oververbosely pointed)

convexHull points =
 let{o = minimum points; -- maximum/By comparing sum would be equally fine
 presorted=sortBy(compareFrom o)(filter(/=o)points);
 collinears=groupBy(((EQ==).).compareFrom o)presorted;
 outmost=map(maximumBy(comparing(distanceFrom o)))collinears;
 }in dropConcavities[o]outmost

so that we can now easily catch all cases in the final convexity scan

dropConcavities (left:lefter) (right:righter:rightest) =
 case compareFrom left right righter of
 LT -> dropConcavities (right:left:lefter) (righter:rightest)
 EQ -> dropConcavities (left:lefter) (righter:rightest)
 GT -> dropConcavities lefter (left:righter:rightest)
dropConcavities output lastInput = lastInput++output

By hitherto restricting myself to abstract x and y accessor methods i can now take the postponed liberal pick of any representation for which i can provide such functions:

import Data.Ord;import Data.List;(x,y)=((!!0),(!!1));
compareFrom o l r=compare((x l-x o)*(y r-y o))((y l-y o)*(x r-x o));
distanceFrom from to = ((x to-x from)**2+(y to-y from)**2)**(1/2);
totalDistance ps = sum(zipWith distanceFrom(last ps:init ps)ps);
convexHull points =
 let{o = minimum points;
 presorted=sortBy(compareFrom o)(filter(/=o)points);
 collinears=groupBy(((EQ==).).compareFrom o)presorted;
 outmost=map(maximumBy(comparing(distanceFrom o)))collinears;
 }in dropConcavities[o]outmost;
dropConcavities (left:lefter) (right:righter:rightest) =
 case compareFrom left right righter of{
 LT -> dropConcavities (right:left:lefter) (righter:rightest);
 EQ -> dropConcavities (left:lefter) (righter:rightest);
 GT -> dropConcavities lefter (left:righter:rightest);}
dropConcavities output lastInput = lastInput++output;
main = interact(show.totalDistance.convexHull.map(map read.words).lines);

• Zeta: I've changed the big-O-notation format. By the way, it doesn't really matter whether you use \$\log_2\$ or any other \$\log_n, n \in \mathbb R_+\,ドル since they only differ by some constant, which gets handled by the notation already.
• Roman Czyborra: I tend to prefer utf-8 plaintext over more convoluted frameworks and used the subscript two as kind of no-break space.
• Roman Czyborra: I presume you also prefer \$\mathcal O(\exp n)\$ over \$\mathcal O(2^n)\,ドル O(2n), O(2n), or O(en).
• Zeta: No, I'd prefer O(2n), but that depends on the context.