{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.HyperPlane.NonVertical
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Non-vertical hyperplanes in d-dimensional space.
--
--------------------------------------------------------------------------------
module HGeometry.HyperPlane.NonVertical
  ( NonVerticalHyperPlane(NonVerticalHyperPlane, Plane)
  , asNonVerticalHyperPlane
  , Plane
  , module HGeometry.HyperPlane.Class
  ) where

import           Control.DeepSeq
import           Control.Lens hiding (snoc, uncons, unsnoc)
import qualified Data.Foldable as F
import           Data.Functor.Classes
import           Data.Type.Ord
import           GHC.TypeLits
import           HGeometry.HyperPlane.Class
import           HGeometry.HyperPlane.Internal (MkHyperPlaneConstraints)
import           HGeometry.Properties
import           HGeometry.Vector
import           Prelude hiding (last)
import           Text.Read ( Read (..), Lexeme(Ident), parens, prec, step
                           , readListPrecDefault,  readListDefault
                           )
import           GHC.Show (showSpace)
import           GHC.Read (expectP)

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

-- $setup
-- >>> import HGeometry.HyperPlane
-- >>> let myLineAsNV  = NonVerticalHyperPlane (Vector2 1 2) :: NonVerticalHyperPlane 2 Double
-- >>> let myOtherLine = HyperPlane2 4 3 2                   :: HyperPlane 2 Double
-- >>> let myPlane     = HyperPlane3 10 2 3 (-1)             :: HyperPlane 3 Double

-- | A non-vertical Hyperplane described by \( x_d = a_d + \sum_{i=1}^{d-1}
-- a_i * x_i \) where \(\langle a_1,..,a_d \rangle \) are the
-- coefficients of te hyperplane.
--
--
-- e.g. the 'myLineAsNV' defines the hyperplane (i.e. the line)
-- described by
--
-- y = 2 + 1*x
--
newtype NonVerticalHyperPlane d r = NonVerticalHyperPlane (Vector d r)

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

deriving newtype instance Eq     (Vector d r) => Eq     (NonVerticalHyperPlane d r)
deriving newtype instance Ord    (Vector d r) => Ord    (NonVerticalHyperPlane d r)
deriving newtype instance NFData (Vector d r) => NFData (NonVerticalHyperPlane d r)

deriving stock instance Functor     (Vector d) => Functor     (NonVerticalHyperPlane d)
deriving stock instance Foldable    (Vector d) => Foldable    (NonVerticalHyperPlane d)
deriving stock instance Traversable (Vector d) => Traversable (NonVerticalHyperPlane d)


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


instance (Show r, Foldable (Vector d)) => Show (NonVerticalHyperPlane d r) where
  showsPrec :: Int -> NonVerticalHyperPlane d r -> ShowS
showsPrec Int
k (NonVerticalHyperPlane Vector d r
v) = Bool -> ShowS -> ShowS
showParen (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                                            String -> ShowS
showString String
"NonVerticalHyperPlane " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            Int -> [r] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Vector d r -> [r]
forall a. Vector d a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector d r
v)
    where
      app_prec :: Int
app_prec = Int
10

instance ( Read r, Has_ Vector_ d r) => Read (NonVerticalHyperPlane d r) where
  readPrec :: ReadPrec (NonVerticalHyperPlane d r)
readPrec = ReadPrec (NonVerticalHyperPlane d r)
-> ReadPrec (NonVerticalHyperPlane d r)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (NonVerticalHyperPlane d r)
 -> ReadPrec (NonVerticalHyperPlane d r))
-> ReadPrec (NonVerticalHyperPlane d r)
-> ReadPrec (NonVerticalHyperPlane d r)
forall a b. (a -> b) -> a -> b
$ ReadPrec (Vector d r)
-> String
-> (Vector d r -> NonVerticalHyperPlane d r)
-> ReadPrec (NonVerticalHyperPlane d r)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith ReadPrec (Vector d r)
parseVec String
"NonVerticalHyperPlane" Vector d r -> NonVerticalHyperPlane d r
forall (d :: Nat) r. Vector d r -> NonVerticalHyperPlane d r
NonVerticalHyperPlane
    where
      parseVec :: ReadPrec (Vector d r)
parseVec = do lst <- ReadPrec [r]
forall a. Read a => ReadPrec a
readPrec
                    case vectorFromList @(Vector d r) lst of
                      Just Vector d r
v -> Vector d r -> ReadPrec (Vector d r)
forall a. a -> ReadPrec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector d r
v
                      Maybe (Vector d r)
_      -> String -> ReadPrec (Vector d r)
forall a. String -> ReadPrec a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"NonVerticalHyperPlane.read expected d reals"
  -- TODO, should we verify the hyperplane is non-vertical?
  readListPrec :: ReadPrec [NonVerticalHyperPlane d r]
readListPrec = ReadPrec [NonVerticalHyperPlane d r]
forall a. Read a => ReadPrec [a]
readListPrecDefault

----------------------------------------
-- Use a more compact representation for Planes in R^3

instance {-# OVERLAPPING #-} Show r => Show (NonVerticalHyperPlane 3 r) where
  showsPrec :: Int -> NonVerticalHyperPlane 3 r -> ShowS
showsPrec Int
d (Plane r
a r
b r
c) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"Plane " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> r -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 r
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> r -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 r
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> r -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 r
c

instance {-# OVERLAPPING #-} Read r => Read (NonVerticalHyperPlane 3 r) where
  readPrec :: ReadPrec (NonVerticalHyperPlane 3 r)
readPrec = ReadPrec (NonVerticalHyperPlane 3 r)
-> ReadPrec (NonVerticalHyperPlane 3 r)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (NonVerticalHyperPlane 3 r)
 -> ReadPrec (NonVerticalHyperPlane 3 r))
-> ReadPrec (NonVerticalHyperPlane 3 r)
-> ReadPrec (NonVerticalHyperPlane 3 r)
forall a b. (a -> b) -> a -> b
$ Int
-> ReadPrec (NonVerticalHyperPlane 3 r)
-> ReadPrec (NonVerticalHyperPlane 3 r)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (do Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"Plane")
                                  a <- ReadPrec r -> ReadPrec r
forall a. ReadPrec a -> ReadPrec a
step ReadPrec r
forall a. Read a => ReadPrec a
readPrec
                                  b <- step readPrec
                                  c <- step readPrec
                                  pure (Plane a b c)
                              )
  readList :: ReadS [NonVerticalHyperPlane 3 r]
readList = ReadS [NonVerticalHyperPlane 3 r]
forall a. Read a => ReadS [a]
readListDefault
  readListPrec :: ReadPrec [NonVerticalHyperPlane 3 r]
readListPrec = ReadPrec [NonVerticalHyperPlane 3 r]
forall a. Read a => ReadPrec [a]
readListPrecDefault


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


-- | Try to construct a Non-vertical hyperplane out of some generic hyperplane.
--
-- >>> asNonVerticalHyperPlane $ (HyperPlane2 10 1 2 :: HyperPlane 2 Double)
-- Just (NonVerticalHyperPlane [-0.5,-5.0])
-- >>> asNonVerticalHyperPlane $ (HyperPlane2 10 1 0 :: HyperPlane 2 Double)
-- Nothing
-- >>> asNonVerticalHyperPlane myOtherLine
-- Just (NonVerticalHyperPlane [-1.5,-2.0])
-- >>> asNonVerticalHyperPlane myPlane
-- Just (Plane 2.0 3.0 10.0)
asNonVerticalHyperPlane :: ( HyperPlane_ hyperPlane d r
                           , Fractional r, Eq r, 1 <= d
                           , Has_ Vector_ (d+1) r, d <= d + 1, KnownNat (d-1), 0 <= (d+1) - 1
                           )
                        => hyperPlane -> Maybe (NonVerticalHyperPlane d r)
asNonVerticalHyperPlane :: forall hyperPlane (d :: Nat) r.
(HyperPlane_ hyperPlane d r, Fractional r, Eq r, 1 <= d,
 Has_ Vector_ (d + 1) r, d <= (d + 1), KnownNat (d - 1),
 0 <= ((d + 1) - 1)) =>
hyperPlane -> Maybe (NonVerticalHyperPlane d r)
asNonVerticalHyperPlane = Vector (d + 1) r -> Maybe (NonVerticalHyperPlane d r)
forall (d :: Nat) r.
(Has_ Vector_ d r, Has_ Vector_ (d + 1) r, 1 <= d, Fractional r,
 Eq r, d <= (d + 1), 0 <= ((d + 1) - 1), KnownNat (d - 1)) =>
Vector (d + 1) r -> Maybe (NonVerticalHyperPlane d r)
asNonVerticalHyperPlane' (Vector (d + 1) r -> Maybe (NonVerticalHyperPlane d r))
-> (hyperPlane -> Vector (d + 1) r)
-> hyperPlane
-> Maybe (NonVerticalHyperPlane d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. hyperPlane -> Vector (d + 1) r
forall hyperPlane (d :: Nat) r.
(HyperPlane_ hyperPlane d r, Num r) =>
hyperPlane -> Vector (d + 1) r
hyperPlaneEquation
{-# INLINE asNonVerticalHyperPlane #-}

-- | Constructs a non-vertical hyperplane from a vector
asNonVerticalHyperPlane'   :: forall d r. ( Has_ Vector_ d r, Has_ Vector_ (d+1) r, 1 <= d
                                          , Fractional r, Eq r
                                          , d <= d + 1, 0 <= (d+1) - 1, KnownNat (d-1))
                           => Vector (d+1) r -> Maybe (NonVerticalHyperPlane d r)
asNonVerticalHyperPlane' :: forall (d :: Nat) r.
(Has_ Vector_ d r, Has_ Vector_ (d + 1) r, 1 <= d, Fractional r,
 Eq r, d <= (d + 1), 0 <= ((d + 1) - 1), KnownNat (d - 1)) =>
Vector (d + 1) r -> Maybe (NonVerticalHyperPlane d r)
asNonVerticalHyperPlane' Vector (d + 1) r
e
    | r
ad r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
0   = Maybe (NonVerticalHyperPlane d r)
forall a. Maybe a
Nothing
    | Bool
otherwise = NonVerticalHyperPlane d r -> Maybe (NonVerticalHyperPlane d r)
forall a. a -> Maybe a
Just (NonVerticalHyperPlane d r -> Maybe (NonVerticalHyperPlane d r))
-> NonVerticalHyperPlane d r -> Maybe (NonVerticalHyperPlane d r)
forall a b. (a -> b) -> a -> b
$ Vector d r -> NonVerticalHyperPlane d r
forall (d :: Nat) r. Vector d r -> NonVerticalHyperPlane d r
NonVerticalHyperPlane (Vector d r -> NonVerticalHyperPlane d r)
-> Vector d r -> NonVerticalHyperPlane d r
forall a b. (a -> b) -> a -> b
$ Vector d r
a Vector d r -> r -> Vector d r
forall vector (d :: Nat) r.
(Vector_ vector d r, Fractional r) =>
vector -> r -> vector
^/ r -> r
forall a. Num a => a -> a
negate r
ad
  where
    (r
a0 :: r, Vector d r
as :: Vector d r) = Vector (d + 1) r -> (r, Vector d r)
forall vector' vector (d :: Nat) r.
(Vector_ vector (d + 1) r, Vector_ vector' d r, 0 <= ((d + 1) - 1),
 d <= Dimension vector) =>
vector -> (r, vector')
uncons Vector (d + 1) r
e
    ad :: r
ad = Vector d r
asVector d r -> Getting r (Vector d r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Vector d r) r
forall vector (d :: Nat) r.
(Vector_ vector d r, 1 <= d, KnownNat (d - 1)) =>
IndexedLens' Int vector r
IndexedLens' Int (Vector d r) r
last
    a :: Vector d r
a  = Vector d r
asVector d r -> (Vector d r -> Vector d r) -> Vector d r
forall a b. a -> (a -> b) -> b
&(r -> Identity r) -> Vector d r -> Identity (Vector d r)
forall vector (d :: Nat) r.
(Vector_ vector d r, 1 <= d, KnownNat (d - 1)) =>
IndexedLens' Int vector r
IndexedLens' Int (Vector d r) r
last ((r -> Identity r) -> Vector d r -> Identity (Vector d r))
-> r -> Vector d r -> Vector d r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ r
a0
{-# INLINE asNonVerticalHyperPlane' #-}



instance ( MkHyperPlaneConstraints d r, Has_ Additive_ (d-1) r
         , 2 <= d
         , d - 1 <= d, 1 <= d, (1 + (d - 1) ~ d) -- these are rather silly :(
         , ((d - 1) + 1) ~ d
         ) => HyperPlane_ (NonVerticalHyperPlane d r) d r where

  -- normalVector h = let a = suffix $ hyperPlaneEquation h
  --                  in if signum (a^.last) == 1 then a else negated a

instance ( MkHyperPlaneConstraints d r, Has_ Additive_ (d-1) r
         , Fractional r, Eq r
         , 2 <= d
         , d - 1 <= d, 1 <= d, (1 + (d - 1) ~ d), 0 <= (d+1) - 1, KnownNat (d-1)
         , ((d - 1) + 1) ~ d
           -- these are rather silly :(
         ) => ConstructableHyperPlane_ (NonVerticalHyperPlane d r) d r where

  -- | pre: the last component is not zero
  --
  --
  -- >>> hyperPlaneFromEquation $ Vector3 2 1 (-1)
  -- NonVerticalHyperPlane [1,2]
  hyperPlaneFromEquation :: HyperPlaneFromEquationConstraint (NonVerticalHyperPlane d r) d r =>
Vector (d + 1) r -> NonVerticalHyperPlane d r
hyperPlaneFromEquation Vector (d + 1) r
e = case Vector (d + 1) r -> Maybe (NonVerticalHyperPlane d r)
forall (d :: Nat) r.
(Has_ Vector_ d r, Has_ Vector_ (d + 1) r, 1 <= d, Fractional r,
 Eq r, d <= (d + 1), 0 <= ((d + 1) - 1), KnownNat (d - 1)) =>
Vector (d + 1) r -> Maybe (NonVerticalHyperPlane d r)
asNonVerticalHyperPlane' Vector (d + 1) r
e of
      Just NonVerticalHyperPlane d r
h  -> NonVerticalHyperPlane d r
h
      Maybe (NonVerticalHyperPlane d r)
Nothing -> String -> NonVerticalHyperPlane d r
forall a. HasCallStack => String -> a
error String
"hyperPlaneFromEquation: Hyperplane is vertical!"
  {-# INLINE hyperPlaneFromEquation #-}


instance ( MkHyperPlaneConstraints d r, 1 + (d-1) ~ d, Has_ Additive_ (d-1) r
         , Num r
         , 2 <= d
         , d - 1 <= d, 1 <= d, (1 + (d - 1) ~ d) -- these are rather silly :(
         , ((d - 1) + 1) ~ d
         ) => NonVerticalHyperPlane_ (NonVerticalHyperPlane d r) d r where
  -- >>> myLineAsNV^.hyperPlaneCoefficients
  -- Vector2 1 2
  hyperPlaneCoefficients :: Lens' (NonVerticalHyperPlane d r) (Vector d r)
hyperPlaneCoefficients = (Vector d r -> f (Vector d r))
-> NonVerticalHyperPlane d r -> f (NonVerticalHyperPlane d r)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso
  (NonVerticalHyperPlane d r)
  (NonVerticalHyperPlane d r)
  (Vector d r)
  (Vector d r)
coerced





--------------------------------------------------------------------------------
-- * Specific 2D Functions

-- -- | Constructs a Line in R^2 for the equation y = ax + b
-- pattern Line2     :: r -> r -> NonVerticalHyperPlane 2 r
-- pattern Line2 a b = NonVerticalHyperPlane (Vector2 a b)
-- {-# COMPLETE Line2 #-}

--------------------------------------------------------------------------------
-- * Specific 3D Functions


-- | Shorthand for non-vertical hyperplanes in R^3
type Plane = NonVerticalHyperPlane 3

-- | Constructs a Plane in R^3 for the equation z = ax + by + c
pattern Plane       :: r -> r -> r -> Plane r
pattern $bPlane :: forall r. r -> r -> r -> Plane r
$mPlane :: forall {r} {r}. Plane r -> (r -> r -> r -> r) -> ((# #) -> r) -> r
Plane a b c = NonVerticalHyperPlane (Vector3 a b c)
{-# COMPLETE Plane #-}

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

-- | Access the last element of a vector
last :: forall vector d r. (Vector_ vector d r, 1 <= d, KnownNat (d-1)
                           ) => IndexedLens' Int vector r
last :: forall vector (d :: Nat) r.
(Vector_ vector d r, 1 <= d, KnownNat (d - 1)) =>
IndexedLens' Int vector r
last = forall (i :: Nat) vector r (d :: Nat).
(i <= (d - 1), KnownNat i, Vector_ vector d r) =>
IndexedLens' Int vector r
component @(d-1)