Safe Haskell | None |
---|---|
Language | Haskell2010 |
- class Floating a => ArcTan2 a where
- data Euler a = Euler {}
- data Quaternion a :: * -> * = Quaternion !a !(V3 a)
- data V3 a :: * -> * = V3 !a !a !a
- class Rotation g a where
- newtype Rot f1 f2 r a = Rot {
- unRot :: r a
- newtype V3T f a = V3T {}
- class R1 (t :: * -> *) where
- class R1 t => R2 (t :: * -> *) where
- class R2 t => R3 (t :: * -> *) where
- cross :: Num a => V3T f a -> V3T f a -> V3T f a
- orthonormalize :: Floating a => Rot f1 f2 (V3 :. V3) a -> Rot f1 f2 (V3 :. V3) a
- dcmOfQuat :: Num a => Rot f g Quaternion a -> Rot f g (V3 :. V3) a
- dcmOfEuler321 :: Floating a => Rot f g Euler a -> Rot f g (V3 :. V3) a
- quatOfDcm :: (Floating a, Ord a) => Rot f g (V3 :. V3) a -> Rot f g Quaternion a
- quatOfEuler321 :: Floating a => Rot f g Euler a -> Rot f g Quaternion a
- euler321OfDcm :: (ArcTan2 a, Ord a) => Rot f g (V3 :. V3) a -> Rot f g Euler a
- unsafeEuler321OfDcm :: ArcTan2 a => Rot f g (V3 :. V3) a -> Rot f g Euler a
- euler321OfQuat :: (ArcTan2 a, Ord a) => Rot f g Quaternion a -> Rot f g Euler a
- unsafeEuler321OfQuat :: ArcTan2 a => Rot f g Quaternion a -> Rot f g Euler a
- newtype ((g :: * -> *) :. (f :: * -> *)) a :: (* -> *) -> (* -> *) -> * -> * = O (g (f a))
- unO :: (:.) g f a -> g (f a)
Documentation
class Floating a => ArcTan2 a where Source #
doesn't require RealFloat, used for overloading symbolics
arctan2 :: a -> a -> a Source #
arctan2 y x
computes the arctangent from two arguments. The
Double
and Float
instances call out to a sufficiently recent
version of libm
to compute this.
The following test cases are the full set of recommended
function properties specified for function atan2Pi()
on page 45
of the IEEE Std 754-2008 document.
>>>
arctan2 0 (-0) :: Double
3.141592653589793>>>
arctan2 (-0) (-0) :: Double
-3.141592653589793>>>
arctan2 0 0 :: Double
0.0>>>
arctan2 (-0) 0 :: Double
-0.0
\x -> x < 0 ==> arctan2 (-0) x == (-pi :: Double)
\x -> x < 0 ==> arctan2 0 x == (pi :: Double)
\x -> x > 0 ==> arctan2 (-0) x == (-0 :: Double)
\x -> x > 0 ==> arctan2 0 x == (0 :: Double)
\y -> y < 0 ==> arctan2 y (-0) == (-pi / 2 :: Double)
\y -> y > 0 ==> arctan2 y 0 == (pi / 2 :: Double)
\y -> y > 0 && not (isNaN y || isInfinite y) ==> arctan2 y (negate $ 1/0) == (pi :: Double)
\y -> y < 0 && not (isNaN y || isInfinite y) ==> arctan2 y (negate $ 1/0) == (-pi :: Double)
\y -> y > 0 && not (isNaN y || isInfinite y) ==> arctan2 y (1/0) == (0 :: Double)
\y -> y < 0 && not (isNaN y || isInfinite y) ==> arctan2 y (1/0) == (-0 :: Double)
\x -> not (isNaN x || isInfinite x) ==> arctan2 (negate $ 1/0) x == (-pi/2 :: Double)
\x -> not (isNaN x || isInfinite x) ==> arctan2 (1/0) x == (pi/2 :: Double)
>>>
arctan2 neginf neginf :: Double
-2.356194490192345>>>
arctan2 inf neginf :: Double
2.356194490192345>>>
arctan2 neginf inf :: Double
-0.7853981633974483>>>
arctan2 inf inf :: Double
0.7853981633974483
3-2-1 Euler angle rotation sequence
Functor Euler Source # | |
Applicative Euler Source # | |
Foldable Euler Source # | |
Traversable Euler Source # | |
(ArcTan2 a, Floating a, Ord a) => Rotation Euler a Source # | |
Eq a => Eq (Euler a) Source # | |
Data a => Data (Euler a) Source # | |
Ord a => Ord (Euler a) Source # | |
Show a => Show (Euler a) Source # | |
Generic (Euler a) Source # | |
Binary a => Binary (Euler a) Source # | |
Serialize a => Serialize (Euler a) Source # | |
Generic1 * Euler Source # | |
type Rep (Euler a) Source # | |
type Rep1 * Euler Source # | |
data Quaternion a :: * -> * #
Quaternions
Quaternion !a !(V3 a) |
A 3-dimensional vector
V3 !a !a !a |
newtype Rot f1 f2 r a Source #
Generic1 * (Rot f1 f2 r) Source # | |
Functor r => Functor (Rot f1 f2 r) Source # | |
Applicative r => Applicative (Rot f1 f2 r) Source # | |
Foldable r => Foldable (Rot f1 f2 r) Source # | |
Traversable r => Traversable (Rot f1 f2 r) Source # | |
Eq (r a) => Eq (Rot f1 f2 r a) Source # | |
Fractional (r a) => Fractional (Rot f1 f2 r a) Source # | |
Num (r a) => Num (Rot f1 f2 r a) Source # | |
Ord (r a) => Ord (Rot f1 f2 r a) Source # | |
Show (r a) => Show (Rot f1 f2 r a) Source # | |
Generic (Rot f1 f2 r a) Source # | |
Storable (r a) => Storable (Rot f1 f2 r a) Source # | |
Binary (r a) => Binary (Rot f1 f2 r a) Source # | |
Serialize (r a) => Serialize (Rot f1 f2 r a) Source # | |
type Rep1 * (Rot f1 f2 r) Source # | |
type Rep (Rot f1 f2 r a) Source # | |
Functor (V3T f) Source # | |
Applicative (V3T f) Source # | |
Foldable (V3T f) Source # | |
Traversable (V3T f) Source # | |
R3 (V3T f) Source # | |
R2 (V3T f) Source # | |
R1 (V3T f) Source # | |
Metric (V3T f) Source # | |
Additive (V3T f) Source # | |
Generic1 * (V3T f) Source # | |
Eq a => Eq (V3T f a) Source # | |
Fractional a => Fractional (V3T f a) Source # | |
Num a => Num (V3T f a) Source # | |
Ord a => Ord (V3T f a) Source # | |
Show a => Show (V3T f a) Source # | |
Generic (V3T f a) Source # | |
Storable a => Storable (V3T f a) Source # | |
Binary a => Binary (V3T f a) Source # | |
Serialize a => Serialize (V3T f a) Source # | |
type Rep1 * (V3T f) Source # | |
type Rep (V3T f a) Source # | |
quatOfEuler321 :: Floating a => Rot f g Euler a -> Rot f g Quaternion a Source #
euler321OfQuat :: (ArcTan2 a, Ord a) => Rot f g Quaternion a -> Rot f g Euler a Source #
unsafeEuler321OfQuat :: ArcTan2 a => Rot f g Quaternion a -> Rot f g Euler a Source #
re-export for convenience
newtype ((g :: * -> *) :. (f :: * -> *)) a :: (* -> *) -> (* -> *) -> * -> * infixl 9 #
Composition of unary type constructors
There are (at least) two useful Monoid
instances, so you'll have to
pick one and type-specialize it (filling in all or parts of g
and/or f
).
-- standard Monoid instance for Applicative applied to Monoid instance (Applicative (g :. f), Monoid a) => Monoid ((g :. f) a) where { mempty = pure mempty; mappend = liftA2 mappend } -- Especially handy when g is a Monoid_f. instance Monoid (g (f a)) => Monoid ((g :. f) a) where { mempty = O mempty; mappend = inO2 mappend }
Corresponding to the first and second definitions above,
instance (Applicative g, Monoid_f f) => Monoid_f (g :. f) where { mempty_f = O (pure mempty_f); mappend_f = inO2 (liftA2 mappend_f) } instance Monoid_f g => Monoid_f (g :. f) where { mempty_f = O mempty_f; mappend_f = inO2 mappend_f }
Similarly, there are two useful Functor
instances and two useful
ContraFunctor
instances.
instance ( Functor g, Functor f) => Functor (g :. f) where fmap = fmapFF instance (ContraFunctor g, ContraFunctor f) => Functor (g :. f) where fmap = fmapCC instance ( Functor g, ContraFunctor f) => ContraFunctor (g :. f) where contraFmap = contraFmapFC instance (ContraFunctor g, Functor f) => ContraFunctor (g :. f) where contraFmap = contraFmapCF
However, it's such a bother to define the Functor instances per composition type, I've left the fmapFF case in. If you want the fmapCC one, you're out of luck for now. I'd love to hear a good solution. Maybe someday Haskell will do Prolog-style search for instances, subgoaling the constraints, rather than just matching instance heads.
O (g (f a)) |
Functor g => Generic1 * ((:.) g f) | |
(Functor g, Functor f) => Functor ((:.) g f) | |
(Applicative g, Applicative f) => Applicative ((:.) g f) | |
(Foldable g, Foldable f, Functor g) => Foldable ((:.) g f) | |
(Traversable g, Traversable f) => Traversable ((:.) g f) | |
Num a => Rotation ((:.) V3 V3) a Source # | |
Eq (g (f a)) => Eq ((:.) g f a) | |
Ord (g (f a)) => Ord ((:.) g f a) | |
Show (g (f a)) => Show ((:.) g f a) | |
Generic ((:.) g f a) | |
type Rep1 * ((:.) g f) | |
type Rep ((:.) g f a) | |