PolyLine.hs

{-# LANGUAGE UndecidableInstances  #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.PolyLine
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.Geometry.PolyLine where

import           Control.Lens
import           Data.Aeson
import           Data.Bifoldable
import           Data.Bifunctor
import           Data.Bitraversable
import           Data.Ext
import qualified Data.Foldable as F
import           Data.Geometry.Box
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import           Data.Geometry.Properties
import           Data.Geometry.Transformation
import           Data.Geometry.Vector
import           Data.LSeq (LSeq, pattern (:<|))
import qualified Data.LSeq as LSeq
import qualified Data.List.NonEmpty as NE
import           Data.Ord (comparing)
import           GHC.Generics (Generic)
import           GHC.TypeLits

--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- $setup
-- >>> :{
-- let myPolyLine = fromPointsUnsafe $ map ext [origin, Point2 10.0 10.0, Point2 10.0 20.0]
-- :}

--------------------------------------------------------------------------------
-- * d-dimensional Polygonal Lines (PolyLines)

-- | A Poly line in R^d has at least 2 vertices
newtype PolyLine d p r = PolyLine { _points :: LSeq 2 (Point d r :+ p) } deriving (Generic)

-- | PolyLines are isomorphic to a sequence of points with at least 2 members.
points :: Iso (PolyLine d1 p1 r1) (PolyLine d2 p2 r2) (LSeq 2 (Point d1 r1 :+ p1)) (LSeq 2 (Point d2 r2 :+ p2))
points = iso (\(PolyLine s) -> s) PolyLine

deriving instance (Show r, Show p, Arity d) => Show    (PolyLine d p r)
deriving instance (Eq r, Eq p, Arity d)     => Eq      (PolyLine d p r)
deriving instance (Ord r, Ord p, Arity d)   => Ord     (PolyLine d p r)

instance Arity d => Functor (PolyLine d p) where
  fmap f (PolyLine ps) = PolyLine $ fmap (first (fmap f)) ps

type instance Dimension (PolyLine d p r) = d
type instance NumType   (PolyLine d p r) = r

instance Semigroup (PolyLine d p r) where
  (PolyLine pts) <> (PolyLine pts') = PolyLine $ pts <> pts'

instance Arity d => IsBoxable (PolyLine d p r) where
  boundingBox = boundingBoxList . NE.fromList . toListOf (points.traverse.core)

instance (Fractional r, Arity d, Arity (d + 1)) => IsTransformable (PolyLine d p r) where
  transformBy = transformPointFunctor

instance PointFunctor (PolyLine d p) where
  pmap f = over points (fmap (first f))

instance Arity d => Bifunctor (PolyLine d) where
  bimap = bimapDefault
instance Arity d => Bifoldable (PolyLine d) where
  bifoldMap = bifoldMapDefault
instance Arity d => Bitraversable (PolyLine d) where
  bitraverse f g (PolyLine pts) = PolyLine <$> traverse (bitraverse (traverse g) f) pts

instance (ToJSON p, ToJSON r, Arity d) => ToJSON (PolyLine d p r) where
    toEncoding = genericToEncoding defaultOptions
instance (FromJSON p, FromJSON r, Arity d, KnownNat d) => FromJSON (PolyLine d p r)

instance HasStart (PolyLine d p r) where
  type StartCore (PolyLine d p r)  = Point d r
  type StartExtra (PolyLine d p r) = p
  start = points.head1

instance HasEnd (PolyLine d p r) where
  type EndCore (PolyLine d p r)  = Point d r
  type EndExtra (PolyLine d p r) = p
  end = points.last1

instance (Fractional r, Arity d, Ord r) => HasSquaredEuclideanDistance (PolyLine d p r) where
  pointClosestToWithDistance q = F.minimumBy (comparing snd)
                               . fmap (pointClosestToWithDistance q)
                               . edgeSegments


-- | Builds a Polyline from a list of points, if there are sufficiently many points
fromPoints :: [Point d r :+ p] -> Maybe (PolyLine d p r)
fromPoints = fmap PolyLine . LSeq.eval @2 . LSeq.fromList

-- | pre: The input list contains at least two points
fromPointsUnsafe :: [Point d r :+ p] -> PolyLine d p r
fromPointsUnsafe = PolyLine . LSeq.forceLSeq (C @2) . LSeq.fromList

-- | pre: The input list contains at least two points. All extra vields are
-- initialized with mempty.
fromPointsUnsafe' :: (Monoid p) => [Point d r] -> PolyLine d p r
fromPointsUnsafe' = fromPointsUnsafe . map (:+ mempty)


-- | We consider the line-segment as closed.
fromLineSegment                     :: LineSegment d p r -> PolyLine d p r
fromLineSegment ~(LineSegment' p q) = fromPointsUnsafe [p,q]

-- | Convert to a closed line segment by taking the first two points.
asLineSegment                            :: PolyLine d p r -> LineSegment d p r
asLineSegment (PolyLine (p :<| q :<| _)) = ClosedLineSegment p q

-- | Stricter version of asLineSegment that fails if the Polyline contains more
-- than two points.
asLineSegment'                :: PolyLine d p r -> Maybe (LineSegment d p r)
asLineSegment' (PolyLine pts) = case F.toList pts of
                                  [p,q] -> Just $ ClosedLineSegment p q
                                  _     -> Nothing

-- | Computes the edges, as linesegments, of an LSeq
edgeSegments    :: Arity d => PolyLine d p r -> LSeq 1 (LineSegment d p r)
edgeSegments pl = let vs = pl^.points
                  in LSeq.zipWith ClosedLineSegment (LSeq.init vs) (LSeq.tail vs)


-- | Linearly interpolate the polyline with a value in the range
-- \([0,n-1]\), where \(n\) is the number of vertices of the polyline.
--
-- running time: \(O(\log n)\)
--
-- >>> interpolatePoly 0.5 myPolyLine
-- Point2 5.0 5.0
-- >>> interpolatePoly 1.5 myPolyLine
-- Point2 10.0 15.0
interpolatePoly      :: (RealFrac r, Arity d) => r -> PolyLine d p r -> Point d r
interpolatePoly t pl = let i = floor t in case edgeSegments pl^?ix i of
                         Nothing -> pl^.points.to LSeq.last.core
                         Just e  -> interpolate (t-fromIntegral i) e