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)

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);