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

import Control.DeepSeq
import Control.Lens
import Data.Geometry.Line
import Data.Geometry.Point
import Data.Geometry.Properties
import Data.Geometry.Transformation
import Data.Geometry.Vector
import GHC.Generics (Generic)
import GHC.TypeLits

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

-- | Hyperplanes embedded in a \(d\) dimensional space.
data HyperPlane (d :: Nat) (r :: *) = HyperPlane { HyperPlane d r -> Point d r
_inPlane   :: !(Point d r)
                                                 , HyperPlane d r -> Vector d r
_normalVec :: !(Vector d r)
                                                 } deriving (forall x. HyperPlane d r -> Rep (HyperPlane d r) x)
-> (forall x. Rep (HyperPlane d r) x -> HyperPlane d r)
-> Generic (HyperPlane d r)
forall x. Rep (HyperPlane d r) x -> HyperPlane d r
forall x. HyperPlane d r -> Rep (HyperPlane d r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (d :: Nat) r x. Rep (HyperPlane d r) x -> HyperPlane d r
forall (d :: Nat) r x. HyperPlane d r -> Rep (HyperPlane d r) x
$cto :: forall (d :: Nat) r x. Rep (HyperPlane d r) x -> HyperPlane d r
$cfrom :: forall (d :: Nat) r x. HyperPlane d r -> Rep (HyperPlane d r) x
Generic
makeLenses ''HyperPlane

type instance Dimension (HyperPlane d r) = d
type instance NumType   (HyperPlane d r) = r

deriving instance (Arity d, Show r)   => Show    (HyperPlane d r)
deriving instance (NFData r, Arity d) => NFData  (HyperPlane d r)
deriving instance Arity d => Functor     (HyperPlane d)
deriving instance Arity d => Foldable    (HyperPlane d)
deriving instance Arity d => Traversable (HyperPlane d)

instance (Arity d, Eq r, Fractional r) => Eq (HyperPlane d r) where
  (HyperPlane Point d r
p Vector d r
u) == :: HyperPlane d r -> HyperPlane d r -> Bool
== h :: HyperPlane d r
h@(HyperPlane Point d r
_ Vector d r
v) = Point d r
p Point d r -> HyperPlane d r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` HyperPlane d r
h Bool -> Bool -> Bool
&& Vector d r
u Vector d r -> Vector d r -> Bool
forall r (d :: Nat).
(Eq r, Fractional r, Arity d) =>
Vector d r -> Vector d r -> Bool
`isScalarMultipleOf` Vector d r
v


instance (Arity d, Arity (d + 1), Fractional r) => IsTransformable (HyperPlane d r) where
  transformBy :: Transformation
  (Dimension (HyperPlane d r)) (NumType (HyperPlane d r))
-> HyperPlane d r -> HyperPlane d r
transformBy Transformation
  (Dimension (HyperPlane d r)) (NumType (HyperPlane d r))
t (HyperPlane Point d r
p Vector d r
v) = Point d r -> Vector d r -> HyperPlane d r
forall (d :: Nat) r. Point d r -> Vector d r -> HyperPlane d r
HyperPlane (Transformation (Dimension (Point d r)) (NumType (Point d r))
-> Point d r -> Point d r
forall g.
IsTransformable g =>
Transformation (Dimension g) (NumType g) -> g -> g
transformBy Transformation (Dimension (Point d r)) (NumType (Point d r))
Transformation
  (Dimension (HyperPlane d r)) (NumType (HyperPlane d r))
t Point d r
p) (Transformation (Dimension (Vector d r)) (NumType (Vector d r))
-> Vector d r -> Vector d r
forall g.
IsTransformable g =>
Transformation (Dimension g) (NumType g) -> g -> g
transformBy Transformation (Dimension (Vector d r)) (NumType (Vector d r))
Transformation
  (Dimension (HyperPlane d r)) (NumType (HyperPlane d r))
t Vector d r
v)

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

type instance IntersectionOf (Point d r) (HyperPlane d r) = [NoIntersection, Point d r]

instance (Num r, Eq r, Arity d) => Point d r `IsIntersectableWith` HyperPlane d r where
  nonEmptyIntersection :: proxy (Point d r)
-> proxy (HyperPlane d r)
-> Intersection (Point d r) (HyperPlane d r)
-> Bool
nonEmptyIntersection = proxy (Point d r)
-> proxy (HyperPlane d r)
-> Intersection (Point d r) (HyperPlane d r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
  Point d r
q intersects :: Point d r -> HyperPlane d r -> Bool
`intersects` (HyperPlane Point d r
p Vector d r
n) = Vector d r
n Vector d r -> Vector d r -> r
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` (Point d r
q Point d r -> Point d r -> Diff (Point d) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point d r
p) r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
0

  Point d r
q intersect :: Point d r
-> HyperPlane d r -> Intersection (Point d r) (HyperPlane d r)
`intersect` HyperPlane d r
h | Point d r
q Point d r -> HyperPlane d r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` HyperPlane d r
h = Point d r -> CoRec Identity '[NoIntersection, Point d r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point d r
q
                  | Bool
otherwise        = NoIntersection -> CoRec Identity '[NoIntersection, Point d r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection




-- -- | Compute a transformation that maps the last dimension (i.e. the d-axis) to
-- -- the normal vector of the plane. The origin of the coordinate system will
-- -- correspond to the inPlane point.
-- changeCoordinateSystem                  :: Floating r => HyperPlane 3 r -> Vector 3 r
--                                         -> Transformation 3 r
-- changeCoordinateSystem (HyperPlane p n) u = rotateTo (Vector3 u v w)
--                                        |.| translation (origin .-. p)
--   where
--     v = undefined
--     w = normalize n

-- toPlaneCoordinates :: HyperPlane d r ->

--------------------------------------------------------------------------------
-- * 3 Dimensional planes

type Plane = HyperPlane 3

pattern Plane     :: Point 3 r -> Vector 3 r -> Plane r
pattern $bPlane :: Point 3 r -> Vector 3 r -> Plane r
$mPlane :: forall r r.
Plane r -> (Point 3 r -> Vector 3 r -> r) -> (Void# -> r) -> r
Plane p n = HyperPlane p n
{-# COMPLETE Plane #-}

-- | Produces a plane. If r lies counter clockwise of q w.r.t. p then
-- the normal vector of the resulting plane is pointing "upwards".
--
-- >>> from3Points origin (Point3 1 0 0) (Point3 0 1 0)
-- HyperPlane {_inPlane = Point3 0 0 0, _normalVec = Vector3 0 0 1}
from3Points       :: Num r => Point 3 r -> Point 3 r -> Point 3 r -> HyperPlane 3 r
from3Points :: Point 3 r -> Point 3 r -> Point 3 r -> HyperPlane 3 r
from3Points Point 3 r
p Point 3 r
q Point 3 r
r = let u :: Diff (Point 3) r
u = Point 3 r
q Point 3 r -> Point 3 r -> Diff (Point 3) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 3 r
p
                        v :: Diff (Point 3) r
v = Point 3 r
r Point 3 r -> Point 3 r -> Diff (Point 3) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 3 r
p
                    in Point 3 r -> Vector 3 r -> HyperPlane 3 r
forall (d :: Nat) r. Point d r -> Vector d r -> HyperPlane d r
HyperPlane Point 3 r
p (Diff (Point 3) r
Vector 3 r
u Vector 3 r -> Vector 3 r -> Vector 3 r
forall r. Num r => Vector 3 r -> Vector 3 r -> Vector 3 r
`cross` Diff (Point 3) r
Vector 3 r
v)

instance OnSideUpDownTest (Plane r) where
  -- >>> (Point3 5 5 5) `onSideUpDown` from3Points origin (Point3 1 0 0) (Point3 0 1 0)
  -- Above
  -- >>> (Point3 5 5 (-5)) `onSideUpDown` from3Points origin (Point3 1 0 0) (Point3 0 1 0)
  -- Below
  -- >>> (Point3 5 5 0) `onSideUpDown` from3Points origin (Point3 1 0 0) (Point3 0 1 0)
  -- On
  Point d r
q onSideUpDown :: Point d r -> Plane r -> SideTestUpDown
`onSideUpDown` (Plane Point 3 r
p Vector 3 r
n) = let v :: Diff (Point d) r
v = Point d r
q Point d r -> Point d r -> Diff (Point d) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point d r
Point 3 r
p in case (Vector 3 r
n Vector 3 r -> Vector 3 r -> r
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` Diff (Point d) r
Vector 3 r
v) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` r
0 of
                                   Ordering
LT -> SideTestUpDown
Below
                                   Ordering
EQ -> SideTestUpDown
On
                                   Ordering
GT -> SideTestUpDown
Above

type instance IntersectionOf (Line 3 r) (Plane r) = [NoIntersection, Point 3 r, Line 3 r]

instance (Eq r, Fractional r) => Line 3 r `IsIntersectableWith` Plane r where
  nonEmptyIntersection :: proxy (Line 3 r)
-> proxy (Plane r) -> Intersection (Line 3 r) (Plane r) -> Bool
nonEmptyIntersection = proxy (Line 3 r)
-> proxy (Plane r) -> Intersection (Line 3 r) (Plane r) -> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
  l :: Line 3 r
l@(Line Point 3 r
p Vector 3 r
v) intersect :: Line 3 r -> Plane r -> Intersection (Line 3 r) (Plane r)
`intersect` (HyperPlane Point 3 r
q Vector 3 r
n)
      | r
denum r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
0 = if r
num r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
0 then Line 3 r -> CoRec Identity '[NoIntersection, Point 3 r, Line 3 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Line 3 r
l else NoIntersection
-> CoRec Identity '[NoIntersection, Point 3 r, Line 3 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection
      | Bool
otherwise  = Point 3 r -> CoRec Identity '[NoIntersection, Point 3 r, Line 3 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (Point 3 r
 -> CoRec Identity '[NoIntersection, Point 3 r, Line 3 r])
-> Point 3 r
-> CoRec Identity '[NoIntersection, Point 3 r, Line 3 r]
forall a b. (a -> b) -> a -> b
$ Point 3 r
p Point 3 r -> Diff (Point 3) r -> Point 3 r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (r
num r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
denum) r -> Vector 3 r -> Vector 3 r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Vector 3 r
v
    where
      num :: r
num   = (Point 3 r
q Point 3 r -> Point 3 r -> Diff (Point 3) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 3 r
p) Vector 3 r -> Vector 3 r -> r
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` Vector 3 r
n
      denum :: r
denum = Vector 3 r
v Vector 3 r -> Vector 3 r -> r
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` Vector 3 r
n
    -- see https://en.wikipedia.org/wiki/Line%E2%80%93plane_intersection


-- * Lines

-- | Convert between lines and hyperplanes
_asLine :: Num r => Iso' (HyperPlane 2 r) (Line 2 r)
_asLine :: Iso' (HyperPlane 2 r) (Line 2 r)
_asLine = (HyperPlane 2 r -> Line 2 r)
-> (Line 2 r -> HyperPlane 2 r) -> Iso' (HyperPlane 2 r) (Line 2 r)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso HyperPlane 2 r -> Line 2 r
forall r. Num r => HyperPlane 2 r -> Line 2 r
hyperplane2line Line 2 r -> HyperPlane 2 r
forall a. Num a => Line 2 a -> HyperPlane 2 a
line2hyperplane
  where
    hyperplane2line :: HyperPlane 2 r -> Line 2 r
hyperplane2line (HyperPlane Point 2 r
p Vector 2 r
n) = Line 2 r -> Line 2 r
forall r. Num r => Line 2 r -> Line 2 r
perpendicularTo (Line 2 r -> Line 2 r) -> Line 2 r -> Line 2 r
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Vector 2 r -> Line 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> Line d r
Line Point 2 r
p Vector 2 r
n
    line2hyperplane :: Line 2 a -> HyperPlane 2 a
line2hyperplane Line 2 a
l = let Line Point 2 a
p Vector 2 a
n = Line 2 a -> Line 2 a
forall r. Num r => Line 2 r -> Line 2 r
perpendicularTo Line 2 a
l in Point 2 a -> Vector 2 a -> HyperPlane 2 a
forall (d :: Nat) r. Point d r -> Vector d r -> HyperPlane d r
HyperPlane Point 2 a
p ((-a
1) a -> Vector 2 a -> Vector 2 a
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Vector 2 a
n)

--------------------------------------------------------------------------------
-- * Supporting Planes

-- | Types for which we can compute a supporting hyperplane, i.e. a hyperplane
-- that contains the thing of type t.
class HasSupportingPlane t where
  supportingPlane :: t -> HyperPlane (Dimension t) (NumType t)

instance HasSupportingPlane (HyperPlane d r) where
  supportingPlane :: HyperPlane d r
-> HyperPlane
     (Dimension (HyperPlane d r)) (NumType (HyperPlane d r))
supportingPlane = HyperPlane d r
-> HyperPlane
     (Dimension (HyperPlane d r)) (NumType (HyperPlane d r))
forall a. a -> a
id


-- | Given
-- * a plane,
-- * a unit vector in the plane that will represent the y-axis (i.e. the "view up" vector), and
-- * a point in the plane,
--
-- computes the plane coordinates of the given point, using the
-- inPlane point as the origin, the normal vector of the plane as the
-- unit vector in the "z-direction" and the view up vector as the
-- y-axis.
--
-- >>> planeCoordinatesWith (Plane origin (Vector3 0 0 1)) (Vector3 0 1 0) (Point3 10 10 0)
-- Point2 10.0 10.0
planeCoordinatesWith       :: Fractional r => Plane r -> Vector 3 r -> Point 3 r -> Point 2 r
planeCoordinatesWith :: Plane r -> Vector 3 r -> Point 3 r -> Point 2 r
planeCoordinatesWith Plane r
h Vector 3 r
vup = Point 3 r -> Point 2 r
forall (i :: Nat) (d :: Nat) r.
(Arity i, Arity d, i <= d) =>
Point d r -> Point i r
projectPoint (Point 3 r -> Point 2 r)
-> (Point 3 r -> Point 3 r) -> Point 3 r -> Point 2 r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation (Dimension (Point 3 r)) (NumType (Point 3 r))
-> Point 3 r -> Point 3 r
forall g.
IsTransformable g =>
Transformation (Dimension g) (NumType g) -> g -> g
transformBy (Plane r -> Vector 3 r -> Transformation 3 r
forall r. Num r => Plane r -> Vector 3 r -> Transformation 3 r
planeCoordinatesTransform Plane r
h Vector 3 r
vup)

planeCoordinatesTransform                    :: Num r => Plane r -> Vector 3 r -> Transformation 3 r
planeCoordinatesTransform :: Plane r -> Vector 3 r -> Transformation 3 r
planeCoordinatesTransform (HyperPlane Point 3 r
o Vector 3 r
n) Vector 3 r
v =   Vector 3 (Vector 3 r) -> Transformation 3 r
forall r. Num r => Vector 3 (Vector 3 r) -> Transformation 3 r
rotateTo (Vector 3 r -> Vector 3 r -> Vector 3 r -> Vector 3 (Vector 3 r)
forall r. r -> r -> r -> Vector 3 r
Vector3 (Vector 3 r
v Vector 3 r -> Vector 3 r -> Vector 3 r
forall r. Num r => Vector 3 r -> Vector 3 r -> Vector 3 r
`cross` Vector 3 r
n) Vector 3 r
v Vector 3 r
n)
                                             Transformation 3 r -> Transformation 3 r -> Transformation 3 r
forall r (d :: Nat).
(Num r, Arity (d + 1)) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| Vector 3 r -> Transformation 3 r
forall r (d :: Nat).
(Num r, Arity d, Arity (d + 1)) =>
Vector d r -> Transformation d r
translation ((-r
1) r -> Vector 3 r -> Vector 3 r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Point 3 r -> Vector 3 r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point 3 r
o)