8
\$\begingroup\$

I'm beginning to learn Haskell. I've implemented the Graham Scan algorithm for detection of convex hull following the Real World Haskell book.

I'm looking for general advice regarding the style and convention of my code, as well as best practices and ways to refactor several ugly places:

  1. Vector2D and its accessors. It's structurally equivalent to Point2D but I want to typecheck its usage. Hence I use newtype and not type, but it makes me implement custom accessors to unwrap the underlying Point2D. The nesting looks redundant.
  2. Point-free usage (or possibility of it) in following places:

    sqrt . fromIntegral $ (vectorX v) ^ 2 + (vectorY v) ^ 2
    

    sortBy (\ (_,b1) (_,b2) -> (b1 :: Double) ``compare`` (b2 :: Double))
       (zip l (angleWithXByPoint2DList p l))
    
  3. Graham Scan implementation as two-level function — interface one and internal one. Maybe there's a way to merge them?

import Prelude hiding (Left, Right)

import Data.List

import Test.Framework (defaultMain, testGroup)
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2 (testProperty)

import Test.QuickCheck
import Test.HUnit

data Direction = Left
               | Right
               | Straight
                 deriving (Show, Eq)

data Point2D = Point2D { x :: Integer
                       , y :: Integer
                       } deriving (Show, Eq, Ord)

direction :: Point2D -> Point2D -> Point2D -> Direction
direction a b c =
    let x1  = x a
        x2  = x b
        x3  = x c
        y1  = y a
        y2  = y b
        y3  = y c
        s   = (x2 - x1) * (y3 - y1) - (y2 - y1) * (x3 - x1)
    in case compare s 0 of
        GT    -> Left
        LT    -> Right
        EQ    -> Straight

comparePoints :: Point2D -> Point2D -> Ordering
comparePoints a b
  | y1 <  y2             = LT
  | y1 == y2 && x1 <  x2 = LT
  | y1 == y2 && x1 == x2 = EQ
  | y1 == y2 && x1 >  x2 = GT
  | y1 >  y2             = GT
    where x1 = x a
          x2 = x b
          y1 = y a
          y2 = y b

sortPoints :: [Point2D] -> [Point2D]
sortPoints l = sortBy comparePoints l

newtype Vector2D = Vector2D Point2D
    deriving (Show, Eq, Ord)

vectorBy2Points :: Point2D -> Point2D -> Vector2D
vectorBy2Points a b =
    let dx = x b - x a
        dy = y b - y a
    in  Vector2D $ Point2D {x=dx, y=dy}

vectorX (Vector2D (Point2D {x=x, y=_})) = x
vectorY (Vector2D (Point2D {x=_, y=y})) = y

dotProduct2D :: Vector2D -> Vector2D -> Integer
dotProduct2D a b =
    vectorX a * vectorX b + vectorY a * vectorY b

euclideanNorm2D :: Vector2D -> Double
euclideanNorm2D v =
    sqrt . fromIntegral $ (vectorX v) ^ 2 + (vectorY v) ^ 2

angleBy3Points2D :: Point2D -> Point2D -> Point2D -> Double
angleBy3Points2D a b c =
    let ba = vectorBy2Points b a
        bc = vectorBy2Points b c
        dp = dotProduct2D ba bc
        n1 = euclideanNorm2D ba
        n2 = euclideanNorm2D bc
    in  acos( (fromIntegral dp) / (n1 * n2) )

angleWithXBy2Points2D :: Point2D -> Point2D -> Double
angleWithXBy2Points2D p@(Point2D {x=x1, y=y1}) a =
    let b = Point2D {x=x1+1, y=y1}
    in  angleBy3Points2D a p b

angleWithXByPoint2DList :: Point2D -> [Point2D] -> [Double]
angleWithXByPoint2DList p (a:[]) =
    [angleWithXBy2Points2D p a]
angleWithXByPoint2DList p (a:l) =
    [angleWithXBy2Points2D p a] ++ angleWithXByPoint2DList p l

sortedPointsByAngleWithPX :: Point2D -> [Point2D] -> [(Point2D,Double)]
sortedPointsByAngleWithPX p l =
    sortBy (\ (_,b1) (_,b2) -> (b1 :: Double) `compare` (b2 :: Double))
           (zip l (angleWithXByPoint2DList p l))

grahamScanInternal :: [Point2D] -> [Point2D] -> [Point2D]
grahamScanInternal acc [] = acc
grahamScanInternal acc l  =
    let b  = last acc
        a  = last (init acc)
        c  = head l
    in  if (direction a b c) /= Right
        then grahamScanInternal (acc ++ [c]) (tail l)
        else grahamScanInternal (init acc ++ [c]) (tail l)

grahamScan :: [Point2D] -> [Point2D]
grahamScan l =
    let sp   = sortPoints l
        p    = head sp
        spa  = sortedPointsByAngleWithPX p l
        bp   = head spa
        tspa = tail spa
        cp   = head tspa
        tsp' = [i | (i,j) <- tspa]
        b    = fst bp
        c    = fst cp
        li   = [p, b]
    in  grahamScanInternal li tsp'


class FPEq a where
    (=~) :: a -> a -> Bool

instance FPEq Double where
    x =~ y = abs ( x - y ) < (1.0e-8 :: Double)

(@?=~) :: (Show a, FPEq a) => a -> a -> Test.HUnit.Assertion
(@?=~) actual expected = actual =~ expected @? assertionMsg
    where
      assertionMsg = "Expected : "   ++ show expected ++
                     "\nActual   : " ++ show actual


test_Left =
    direction (Point2D {x=0, y=0}) (Point2D {x=1, y=1}) (Point2D {x=2, y=3})
    @?= Left

test_Straight =
    direction (Point2D {x=0, y=0}) (Point2D {x=1, y=1}) (Point2D {x=2, y=2})
    @?= Straight

test_Right =
    direction (Point2D {x=0, y=0}) (Point2D {x=1, y=1}) (Point2D {x=2, y=1})
    @?= Right

test_SortPoints =
    sortPoints [
        Point2D {x=1, y=3},
        Point2D {x=0, y=0},
        Point2D {x=5, y=4},
        Point2D {x=3, y=1},
        Point2D {x=2, y=2},
        Point2D {x=4, y=5}
    ] @?= [
        Point2D {x=0, y=0},
        Point2D {x=3, y=1},
        Point2D {x=2, y=2},
        Point2D {x=1, y=3},
        Point2D {x=5, y=4},
        Point2D {x=4, y=5}
    ]

test_SortPointsCoincident =
    sortPoints [
        Point2D {x=1, y=1},
        Point2D {x=0, y=0},
        Point2D {x=5, y=4},
        Point2D {x=3, y=1},
        Point2D {x=2, y=1},
        Point2D {x=4, y=4}
    ] @?= [
        Point2D {x=0, y=0},
        Point2D {x=1, y=1},
        Point2D {x=2, y=1},
        Point2D {x=3, y=1},
        Point2D {x=4, y=4},
        Point2D {x=5, y=4}
    ]

test_VectorBy2Points1 =
    vectorBy2Points Point2D {x=0,y=1} Point2D {x=1,y=0}
    @?= Vector2D (Point2D {x=1,y=(-1)})

test_VectorBy2Points2 =
    vectorBy2Points Point2D {x=2,y=3} Point2D {x=4,y=5}
    @?= Vector2D (Point2D {x=2,y=2})

test_DotProduct2D1 =
    dotProduct2D (Vector2D (Point2D {x=1,y=(-1)})) (Vector2D (Point2D {x=2,y=2}))
    @?= 0

test_DotProduct2D2 =
    dotProduct2D (Vector2D (Point2D {x=3,y=(-2)})) (Vector2D (Point2D {x=4,y=1}))
    @?= 10

test_RightAngleBy3Points =
    angleBy3Points2D Point2D {x=0,y=1} Point2D {x=0,y=0} Point2D {x=1,y=0}
    @?=~ (pi / 2)

test_AngleBy3Points1 =
    angleBy3Points2D Point2D {x=1,y=1} Point2D {x=0,y=0} Point2D {x=1,y=0}
    @?=~ (pi / 4)

test_GrahamScan1 =
    grahamScan [
        Point2D {x=0   , y=0} -- P
      , Point2D {x=5   , y=2} -- A
      , Point2D {x=4   , y=4} -- B
      , Point2D {x=1   , y=2} -- C
      , Point2D {x=(-1), y=3} -- D
    ] @?= [
        Point2D {x=0   , y=0} -- P
      , Point2D {x=5   , y=2} -- A
      , Point2D {x=4   , y=4} -- B
      , Point2D {x=(-1), y=3} -- D
      , Point2D {x=0   , y=0} -- P
    ]

main = defaultMain tests

tests = [
    testGroup "Direction" [
        testCase "Direction for left turn"
            test_Left,
        testCase "Direction for straight line"
            test_Straight,
        testCase "Direction for right turn"
            test_Right
        ],
    testGroup "Sort List of Points" [
        testCase "Sort Points works for all points with different y coordinates"
            test_SortPoints,
        testCase "Sort Points works for points with coincident y coordinates"
            test_SortPointsCoincident
        ],
    testGroup "Vector By 2 Points" [
        testCase "Vector By 2 Points case 1"
            test_VectorBy2Points1,
        testCase "Vector By 2 Points case 2"
            test_VectorBy2Points2
        ],
    testGroup "Dot Product 2D" [
        testCase "Dot Product 2D case 1"
            test_DotProduct2D1,
        testCase "Dot Product 2D case 2"
            test_DotProduct2D2
        ],
    testGroup "Calculate Angle by 3 points" [
        testCase "Angle calculation for right angle"
            test_RightAngleBy3Points,
        testCase "Angle calculation for Pi/4 angle"
            test_AngleBy3Points1
        ],
    testGroup "Graham Scan" [
        testCase "Graham scan for simple hull of 5 points"
            test_GrahamScan1
        ]
    ]
\$\endgroup\$
8
\$\begingroup\$

Some ideas:

  • When comparing points, you can use the fact that (,) is lexicographically ordered:

    comparePoints :: Point2D -> Point2D -> Ordering
    comparePoints a b = compare (y a, x a) (y b, x b)
    
  • Vector2D and it's accessors. It's structurally equivalent to Point2D but I want to typecheck its usage. Hence I use newtype and not type, but it makes me implement custom accessors to unwrap the underlying Point2D. The nesting looks redundant.

    I strongly encourage to keep this separation. The (un)wrapping can be somewhat avoided by defining all required operations and then use only those, hiding the internal representation. Actually, I'd make them completely distinct (saves one constructor) and instead define their mathematical relationship. The vector-space library provides the proper type classes:

    {-# LANGUAGE TypeFamilies #-}
    import Data.AffineSpace
    import Data.VectorSpace
    
    data Vector2D = Vector2D { x :: Integer
                           , y :: Integer
                           } deriving (Show, Eq, Ord)
    
    instance AdditiveGroup Vector2D where
        zeroV = Vector2D 0 0
        (Vector2D x1 y1) ^+^ (Vector2D x2 y2)
            = Vector2D (x1+x2) (y1+y2)
        negateV (Vector2D x1 y1)
            = Vector2D (-x1) (-y1)
    instance VectorSpace Vector2D where
        type Scalar Vector2D = Integer
        k *^ (Vector2D x1 y1)
            = Vector2D (k*x1) (k*y1)
    instance InnerSpace Vector2D where
        (Vector2D x1 y1) <.> (Vector2D x2 y2) = x1*x2 + y1*y2
    
    euclideanNorm2D :: Vector2D -> Double
    euclideanNorm2D = sqrt . fromIntegral . magnitudeSq
    
    
    data Point2D = Point2D { xv :: Integer
                           , yv :: Integer
                           } deriving (Show, Eq, Ord)
    
    instance AffineSpace Point2D where
        type Diff Point2D = Vector2D
        (Point2D x1 y1) .-. (Point2D x2 y2)
            = Vector2D (x2 - x1) (y2 - y1)
        (Point2D x1 y1) .+^ (Vector2D x y)
            = Point2D (x1 + x) (y1 + y)
    
  • Point-free usage (or possibility of it) in following places:

    It's possible to convert any term into the point-free notation, but in some cases it makes things actually worse. Like in those where a variable is repeated: Surely \x -> x * x is more readable than ((*) <*> id). Anyway, using magnitudeSq from vector-space we can make euclideanNorm2D point-free (see above).

    Function sortedPointsByAngleWithPX can be simplified using on from Data.Function:

    sortedPointsByAngleWithPX p l =
        sortBy (on compare snd) (zip l (angleWithXByPoint2DList p l))
    
  • It seems to me that angleWithXByPoint2DList can be simplified as

    angleWithXByPoint2DList :: Point2D -> [Point2D] -> [Double]
    angleWithXByPoint2DList p = map (angleWithXBy2Points2D p)
    

    using that we can make sortedPointsByAngleWithPX partially point-free using (&&&) from Control.Arrow, but I have doubts if it's really useful (for me readability is more important):

    sortedPointsByAngleWithPX p =
        sortBy (on compare snd) . map (id &&& angleWithXBy2Points2D p)
    
  • Graham Scan implementation as two-level function — interface one and internal one. Maybe there's a way to merge them?

    On the contrary, I'd recommend keeping them split. Splitting code into more smaller functions is usually better than having one big complex one.

  • Instead of having

    grahamScanInternal acc l  =
        let ...
            c  = head l
            ...
            ... (tail l)
    

    I'd strongly suggest using

    grahamScanInternal acc (c:cs)  =
        let ...
            ...
            ... cs
    

    Both head and tail are partial functions and can be source of exceptions when used accidentally on the empty list. Pattern matching instead makes it clear that it can't happen.

    Moreover, grahamScanInternal can be rewritten as a fold, which makes its design slightly more clear:

    grahamScanInternal :: [Point2D] -> [Point2D] -> [Point2D]
    grahamScanInternal = foldl f
      where
        f acc c | (direction a b c) == Right    = init acc ++ [c]
                | otherwise                     = acc ++ [c]
          where
            b  = last acc
            a  = last (init acc)
    
\$\endgroup\$
6
\$\begingroup\$

Please note that this program is buggy :

> grahamScan [Point2D {x = -4, y = -1},Point2D {x = -5, y = -4},Point2D {x = -4, y = 1},Point2D {x = -5, y = 0},Point2D {x = 5, y = -5}]
[Point2D {x = 5, y = -5},Point2D {x = 5, y = -5},Point2D {x = -4, y = 1},Point2D {x = -5, y = 0},Point2D {x = -5, y = -4}]
> grahamScan (grahamScan [Point2D {x = -4, y = -1},Point2D {x = -5, y = -4},Point2D {x = -4, y = 1},Point2D {x = -5, y = 0},Point2D {x = 5, y = -5}])
[Point2D {x = 5, y = -5},Point2D {x = -4, y = 1},Point2D {x = -5, y = 0},Point2D {x = -5, y = -4},Point2D {x = 5, y = -5},Point2D {x = 5, y = -5}]

Even without the strange duplications, the algorithm gives a wrong answer for :

[Point2D {x = -1, y = 8},Point2D {x = 8, y = 4},Point2D {x = -9, y = 6},Point2D {x = 3, y = 7},Point2D {x = 5, y = 7},Point2D {x = -4, y = -6},Point2D {x = -7, y = 6},Point2D {x = 5, y = -1},Point2D {x = -2, y = -2}]
\$\endgroup\$
  • \$\begingroup\$ Thank you for noticing. I don't think this qualifies for answer to this question, however. \$\endgroup\$ – Michael Pankov Apr 11 '14 at 9:34
  • \$\begingroup\$ You are right, this should have been a comment, but it wouldn't fit ... \$\endgroup\$ – bartavelle Apr 11 '14 at 10:26
  • 1
    \$\begingroup\$ @constantius - This is a great review. Identifying bugs is a very valuable component in a review. This review may not address your request for style and convention, etc., but as per the help center it is implied that you: ... want feedback about any or all facets of the code. This is good feedback on some facets of your code. bartavelle, feel free to review like this again (and again), but also feel free to review other items, and, if it makes sense, feel free to add multiple answers. \$\endgroup\$ – rolfl Apr 11 '14 at 10:35
  • \$\begingroup\$ @bartavelle Welcome to Code Review, and thank you for your contribution! Any remark that points out a deficiency in the code is a good answer — it deserves reputation points, and is too valuable to be merely a comment. \$\endgroup\$ – 200_success Apr 11 '14 at 10:49
  • \$\begingroup\$ I just wanted to point out that review done on style/convention provides not bare claims of deficiencies, but means to do better. I don't, however, say, that the reviewer should tell how to fix the bug in this particular case. This difference struck me at first. \$\endgroup\$ – Michael Pankov Apr 11 '14 at 11:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.