module Data.Geometry.Vector( module Data.Geometry.Vector.VectorFamily
, module LV
, C(..)
, Affine(..)
, qdA, distanceA
, dot, norm, signorm
, isScalarMultipleOf
, scalarMultiple
, FV.replicate
, FV.imap
, xComponent, yComponent, zComponent
) where
import Control.Applicative (liftA2)
import Control.Lens(Lens')
import qualified Data.Foldable as F
import Data.Geometry.Properties
import Data.Geometry.Vector.VectorFamily
import Data.Geometry.Vector.VectorFixed (C(..))
import Data.Maybe
import qualified Data.Vector.Fixed as FV
import GHC.TypeLits
import Linear.Affine (Affine(..), qdA, distanceA)
import Linear.Metric (dot,norm,signorm)
import Linear.Vector as LV
type instance Dimension (Vector d r) = d
type instance NumType (Vector d r) =r
isScalarMultipleOf :: (Eq r, Fractional r, Arity d)
=> Vector d r -> Vector d r -> Bool
u `isScalarMultipleOf` v = isJust $ scalarMultiple u v
scalarMultiple :: (Eq r, Fractional r, Arity d)
=> Vector d r -> Vector d r -> Maybe r
scalarMultiple u v
| allZero u || allZero v = Just 0
| otherwise = scalarMultiple' u v
allZero :: (Arity d, Eq r, Num r) => Vector d r -> Bool
allZero = F.all (== 0)
data ScalarMultiple r = No | Maybe | Yes r deriving (Eq,Show)
instance Eq r => Semigroup (ScalarMultiple r) where
No <> _ = No
_ <> No = No
Maybe <> x = x
x <> Maybe = x
(Yes x) <> (Yes y)
| x == y = Yes x
| otherwise = No
instance Eq r => Monoid (ScalarMultiple r) where
mempty = Maybe
mappend = (<>)
scalarMultiple' :: (Eq r, Fractional r, Arity d)
=> Vector d r -> Vector d r -> Maybe r
scalarMultiple' u v = g . F.foldr mappend mempty $ liftA2 f u v
where
f 0 0 = Maybe
f _ 0 = No
f ui vi = Yes $ ui / vi
g No = Nothing
g Maybe = error "scalarMultiple': found a Maybe, which means the vectors either have length zero, or one of them is all Zero!"
g (Yes x) = Just x
xComponent :: (1 <= d, Arity d) => Lens' (Vector d r) r
xComponent = element (C :: C 0)
{-# INLINABLE xComponent #-}
yComponent :: (2 <= d, Arity d) => Lens' (Vector d r) r
yComponent = element (C :: C 1)
{-# INLINABLE yComponent #-}
zComponent :: (3 <= d, Arity d) => Lens' (Vector d r) r
zComponent = element (C :: C 2)
{-# INLINABLE zComponent #-}