module Graham where

import List
import Ratio
--import Debug.Trace	(trace)

type Vertex = (Rational, Rational)

-- Removes double elements in a sorted list.
remDoubles :: Eq a => [a] -> [a]
remDoubles [] = []
remDoubles (x:xs) = x:rD x xs
  where
    rD _ [] = []
    rD last (x:xs) | x==last = rD last xs
                   | otherwise = x:rD x xs
 
-- Extract the point with the smallest y and largest x coordinate.
getHullVertex :: [Vertex] -> Vertex
getHullVertex [] = error "getHullVertex: empty set of points"
getHullVertex ps = foldl1 maxVertex ps
  where
    maxVertex :: Vertex -> Vertex -> Vertex
    maxVertex p1@(x1, y1) p2@(x2, y2)
      | y1<y2 = p1
      | y2<y1 = p2
      | x1>x2 = p1
      | otherwise = p2


-- Test three points for being ordered clockwise. If the argument simple is
-- false pair this test lexicographically with the distance of the second
-- and the thirds point.
isCW :: Vertex -> Vertex -> Vertex -> Ordering
isCW (a, b) (c, d) (e, f) = let
  dx21 = c-a
  dy21 = d-b
  dx31 = e-a
  dy31 = f-b
  in case compare (dy31*dx21) (dy21*dx31) of
    LT -> LT
    GT -> GT
    EQ -> compare (dx21*dx21+dy21*dy21) (dx31*dx31+dy31*dy31)


  
-- Sort the list of points according to one point on the hull.
preprocess :: [Vertex] -> [Vertex]
preprocess [] = []
preprocess pts = mp:sortBy (isCW mp) (filter ((/=) mp) pts)
 where
   mp = getHullVertex pts

-- Remove points in the interior.
graham :: [Vertex] -> [Vertex]
graham = gh . remDoubles . preprocess
  where
    gh points@[] = points
    gh points@[_] = points
    gh points@[_,_] = points
    gh (p:o:ints) = init $ walk [o,p] (ints++[p])

    -- Unfortunately lists all grow to the left in Haskell. Imagine the
    -- first argument to be written in reverse order. We are traversing
    -- the point set clockwise, so that the result does not have to be
    -- reversed.
    walk :: [Vertex] -> [Vertex] -> [Vertex]
    walk ps [] = ps
    walk (pM:pL:out) (pF:inp) | isCW pL pM pF/=GT 
				          = walk (pF:pM:pL:out) inp
			      | otherwise = walk (pL:out) (pF:inp)
    walk point@[_] (pF:inp) = walk (pF:point) inp
    walk ps ps' = error $ "weird point sets: "++show (length ps)++" and "++
			  show (length ps')++" long."