content: module LB
    (
    hullSeries, dtwlb, naivedtw,
    ConvexHull
    ) where
  
  import Data.Maybe
  import Data.List (sortBy, transpose, nub, foldl', foldl1')
  import Strokes
  
  newtype ConvexHull = ConvexHull [Point] deriving (Show)
  
  -- lower bounding
  
  convex :: Point -> Point -> Point -> Bool
  convex (Point (vx, vy)) (Point (wx, wy)) (Point (ux, uy)) = ( wx - vx ) * ( uy - vy ) - ( wy - vy ) * ( ux - vx ) > 0
  concave :: Point -> Point -> Point -> Bool
  concave v w u = not (convex v w u)
  
  angle (Point (0, 0)) = 1/0 -- Infinity
  angle (Point (x, y)) = x/y
  
  -- ccw trajectory of the convex hull
  grahamConvexHull :: Points -> ConvexHull
  -- grahamConvexHull [_] = [_]
  grahamConvexHull points | length points < 4 = ConvexHull $ nub points
  grahamConvexHull points = ConvexHull $ reverse $ nub $ foldl' step [] sortedPoints where
                          minP = foldl1' st points where -- checked!
                            st (Point (minPx, minPy)) (Point (px, py)) | py < minPy || (py == minPy && px < minPx) = Point (px, py)
                                                       | otherwise = Point (minPx, minPy)
                          comp v w = compare (negate $ angle v, norm v) (negate $ angle w, norm w)
                          sortedPoints = map (`add` minP) $ sortBy comp $ map (`sub` minP) points
                          step :: Points -> Point -> Points
                          step hull point | length hull <= 2 = point:hull -- p0 and p1 already convex!
                                          | convex (head (tail hull)) (head hull) point = point:hull
                                          | otherwise = point:(tail hull) -- drop point in the middle
  
  toMaybeList :: [a] -> [Maybe a]
  toMaybeList [] = []
  toMaybeList (x:xs) = (Just x):(toMaybeList xs)
  
  -- the MaybeLists must habe equal lengths for this
  -- to work as intended
  zipMaybeList :: [[Maybe a]] -> [[a]]
  zipMaybeList = (map catMaybes) . transpose
  
  shiftLeft :: [Maybe a] -> [Maybe a]
  shiftLeft list = (tail list) ++ [Nothing]
  
  shiftRight :: [Maybe a] -> [Maybe a]
  shiftRight list = [Nothing] ++ (init list)
  
  shiftedSeries :: [a] -> Int -> [[a]]
  shiftedSeries list width = zipMaybeList $ [maybelist] ++ leftshifted ++ rightshifted where
                              maybelist = toMaybeList list
                              leftshifted = take width $ iterate shiftLeft (shiftLeft maybelist)
                              rightshifted = take width $ iterate shiftRight (shiftRight maybelist)
  
  hullSeries :: Int -> Stroke -> [ConvexHull]
  hullSeries width list = map grahamConvexHull $ shiftedSeries list width
  
  -- hull distance -- THIS IS THE PART WORTH OPTIMIZING
  pairs :: [a] -> [(a,a)]
  pairs list = zip list (tail list)
  
  minimumDistancePoint :: Point -> (Point, Point) -> Point
  minimumDistancePoint point (l1, l2) = nearest where
                        param = ((point `sub` l1) `dot` (l2 `sub` l1)) / ((euclideanDistance l1 l2)**2)
                        nearest = case param of
                          u | u <= 0 -> l1
                            | u >= 1 -> l2
                            | otherwise -> l1 `add` (u `scalar` (l2 `sub` l1))
                            
  pointLineSegmentDistance :: Point -> (Point, Point) -> Double
  pointLineSegmentDistance point (l1, l2) = euclideanDistance point nearest where
                            nearest = minimumDistancePoint point (l1, l2)
  
  -- relevantLines may be empty if point lies inside the hull
  minimumOrZero [] = 0.0
  minimumOrZero l = minimum l
  
  removeRepeating l = foldl' step [] l where
    step [] n = [n]
    step l@(e:es) n | e == n = l
                    | otherwise = n:l
  
  -- FIXME This is the function that needs optimization!
  pointHullDistance :: Point -> ConvexHull -> Double
  pointHullDistance point (ConvexHull []) = error "Empty Hull!?"
  pointHullDistance point (ConvexHull [other]) = euclideanDistance point other
  -- pointHullDistance point (ConvexHull hull) = minimumOrZero $ map (pointLineSegmentDistance point) relevantLines where
  pointHullDistance point (ConvexHull hull) =
      minimumOrZero $
      map ((euclideanDistance point) . (minimumDistancePoint point)) relevantLines where
        relevantLines = filter predicate $ take (length hull) $ pairs $ cycle hull where
          predicate (l1, l2) = concave l1 l2 point
  
  -- Stroke -> Hulls -> Double
  dtwlb :: Stroke -> [ConvexHull] -> Double
  dtwlb stroke hulls = foldl' (+) 0 $ zipWith pointHullDistance stroke hulls
  
  for = flip map
  
  naivedtw :: Eq a => ( a -> a -> Double ) -> Int -> [a] -> [a] -> Double
  naivedtw measure w s o = foldl1' (+) $ for (zip s o') $ \(p, ps) ->
    minimum $ for ps $ \p' -> measure p p' 
    where
      o' = shiftedSeries o w
  