Graham scan exercise from ch3 Real World Haskell

grahamscan.hs

import           Data.List

-- Graham Scan

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

data Vector = Vector {
  x :: Double,
  y :: Double
} deriving (Show)

-- Consider three two-dimensional points, a, b, and c. If we look at the angle formed
-- by the line segment from a to b and the line segment from b to c, it turns left,
-- turns right, or forms a straight line. Define a Direction data type that lets you
-- represent these possibilities.

-- for example (0,0) -> (1,0) , (1,0) -> (1,1) turns left
-- for example (0,0) -> (1,0) , (1,0) -> (2,0) goes straight
-- for example (0,0) -> (1,0) , (1,0) -> (1,-1) turns right

dotProduct :: Vector -> Vector -> Double
dotProduct a b = x a * x b + y a * y b

subtractVector :: Vector -> Vector -> Vector
subtractVector a b = Vector (x a - x b) (y a - y b)

crossProduct :: Vector -> Vector
crossProduct a = Vector (- (y a)) (x a)

-- Firstly take a dot product of the vector to your target and the characters facing direction (just the X and Z components).
-- This gives you the cosine of the angle between the two vectors. Take an acos of that to get the angle in radians.
-- What's nice about that compared to the atan2 route is that it immediately gives you the angle you want, the angle between
-- the facing direction and the target position. You don't have to do anything more to make sure it's the shortest way around.

-- Then we want to know whether to turn left or right. Again looking only at the X and Z vectors, we can simply figure out
-- whether the target is to our left or right. First we need to get the 2d cross product of our facing direction. If the
-- facing vector is (x,y,z), a vector at right angles to this in 2d is just (-z, x).

-- If you then take the dot product of this and the vector to the target, the sign of that is whether you should turn left or right! Simple.

calculateTurn :: Vector -> Vector -> Vector -> Direction
calculateTurn a b c =
  let ab = subtractVector b a
      bc = subtractVector c b
      cross = crossProduct ab
      turn = dotProduct bc cross
  in if turn > 0
     then Main.Left
     else if turn < 0
          then Main.Right
          else Main.Straight

-- Define a function that takes a list of two-dimensional points and computes the direction of each successive triple.
-- Given a list of points [a,b,c,d,e], it should begin by computing the turn made by [a,b,c], then the turn made by [b,c,d],
-- then [c,d,e]. Your function should return a list of Direction.

calculateTurns :: [Vector] -> [Direction]
calculateTurns (a:b:c:xs) = calculateTurn a b c : calculateTurns (b : c : xs)
calculateTurns _          = []

instance Eq Vector where
  v1 == v2 = (compare (y v1) (y v2) == EQ) && (compare (x v1) (x v2) == EQ)

instance Ord Vector where
  compare v1 v2 =
    let comp12 = compare (y v1) (y v2) in
      if comp12 == EQ then
        compare (x v1) (x v2)
      else
        comp12

-- sort function: the set of points must be sorted in increasing order of the angle
-- they and the point P make with the x-axis

grahamScan :: [Vector] -> [Vector]
grahamScan points =
  let xAxis = Vector 1 0
      minPoint = minimum points
      withoutMinpoint = filter (\x -> x /= minPoint) points
      sortedCandidates = sortBy (\v1 v2 ->
                                   let v1p = subtractVector v1 minPoint
                                       v2p = subtractVector v2 minPoint
                                       dot1 = dotProduct v1p xAxis
                                       dot2 = dotProduct v2p xAxis
                                    in
                                      compare dot2 dot1) withoutMinpoint
      finalCandidates = minPoint : sortedCandidates
  in
    calculateHull finalCandidates []

calculateHull :: [Vector] -> [Vector] -> [Vector]
calculateHull (point:points) (top:next:rest) =
  let turn = calculateTurn next top point
  in
    if turn == Main.Left
    then
      calculateHull points (point:top:next:rest)
    else
      calculateHull points (point:next:rest)
calculateHull [] stack = stack
calculateHull (point:points) stack =
  calculateHull points (point:stack)

-- This sample approximates the one on the wikipedia page
-- https://en.wikipedia.org/wiki/Graham_scan
sampleP = Vector 0 0
sampleA = Vector 10 7
sampleB = Vector 7 12
sampleC = Vector 2 6
sampleD = Vector (-5) 8

samplePoints = [sampleP, sampleA, sampleB, sampleC, sampleD]

sampleP2 = Vector (-10) (-10)
sampleA2 = Vector 10 (-10)
sampleB2 = Vector 0 0
sampleC2 = Vector 10 10
sampleD2 = Vector (-10) 10

samplePoints2 = [sampleP2, sampleA2, sampleB2, sampleC2, sampleD2]