{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_HADDOCK hide #-}

-- | Space types
module NumHask.Space.Types
  ( Space (..),
    Union (..),
    Intersection (..),
    FieldSpace (..),
    mid,
    interpolate,
    project,
    Pos (..),
    space1,
    unsafeSpace1,
    memberOf,
    contains,
    disjoint,
    width,
    (+/-),
    monotone,
    eps,
    widen,
    widenEps,
    scale,
    move,
    Transform (..),
    inverseTransform,
    Affinity (..),
    (|.),
    rotate,
  )
where

import Control.Monad
import NumHask.Prelude
import Prelude qualified as P

-- $setup
-- >>> :m -Prelude
-- >>> :set -XRebindableSyntax
-- >>> import NumHask.Prelude
-- >>> import NumHask.Space

-- | A 'Space' is a continuous set of numbers. Continuous here means that the set has an upper and lower bound, and an element that is between these two bounds is a member of the 'Space'.
--
-- > a `union` b == b `union` a
-- > a `intersection` b == b `intersection` a
-- > (a `union` b) `intersection` c == (a `intersection` b) `union` (a `intersection` c)
-- > (a `intersection` b) `union` c == (a `union` b) `intersection` (a `union` c)
-- > norm (norm a) = norm a
-- > a |>| b == b |<| a
-- > a |.| singleton a
class Space s where
  -- | the underlying element in the space
  type Element s :: Type

  -- | lower boundary
  lower :: s -> Element s

  -- | upper boundary
  upper :: s -> Element s

  -- | space containing a single element
  singleton :: Element s -> s
  singleton Element s
s = Element s
s Element s -> Element s -> s
forall s. Space s => Element s -> Element s -> s
>.< Element s
s

  -- | the intersection of two spaces
  intersection :: s -> s -> s
  default intersection :: (Ord (Element s)) => s -> s -> s
  intersection s
a s
b = Element s
l Element s -> Element s -> s
forall s. Space s => Element s -> Element s -> s
>.< Element s
u
    where
      l :: Element s
l = s -> Element s
forall s. Space s => s -> Element s
lower s
a Element s -> Element s -> Element s
forall a. Ord a => a -> a -> a
`max` s -> Element s
forall s. Space s => s -> Element s
lower s
b
      u :: Element s
u = s -> Element s
forall s. Space s => s -> Element s
upper s
a Element s -> Element s -> Element s
forall a. Ord a => a -> a -> a
`min` s -> Element s
forall s. Space s => s -> Element s
upper s
b

  -- | the union of two spaces
  union :: s -> s -> s
  default union :: (Ord (Element s)) => s -> s -> s
  union s
a s
b = Element s
l Element s -> Element s -> s
forall s. Space s => Element s -> Element s -> s
>.< Element s
u
    where
      l :: Element s
l = s -> Element s
forall s. Space s => s -> Element s
lower s
a Element s -> Element s -> Element s
forall a. Ord a => a -> a -> a
`min` s -> Element s
forall s. Space s => s -> Element s
lower s
b
      u :: Element s
u = s -> Element s
forall s. Space s => s -> Element s
upper s
a Element s -> Element s -> Element s
forall a. Ord a => a -> a -> a
`max` s -> Element s
forall s. Space s => s -> Element s
upper s
b

  -- | Normalise a space so that
  --
  -- > lower a \/ upper a == lower a
  -- > lower a /\ upper a == upper a
  normalise :: s -> s
  normalise s
s = s -> Element s
forall s. Space s => s -> Element s
lower s
s Element s -> Element s -> s
forall s. Space s => Element s -> Element s -> s
... s -> Element s
forall s. Space s => s -> Element s
upper s
s

  -- | create a normalised space from two elements
  infix 3 ...

  (...) :: Element s -> Element s -> s
  default (...) :: (Ord (Element s)) => Element s -> Element s -> s
  (...) Element s
a Element s
b = (Element s
a Element s -> Element s -> Element s
forall a. Ord a => a -> a -> a
`min` Element s
b) Element s -> Element s -> s
forall s. Space s => Element s -> Element s -> s
>.< (Element s
a Element s -> Element s -> Element s
forall a. Ord a => a -> a -> a
`max` Element s
b)

  -- | create a space from two elements without normalising
  infix 3 >.<

  (>.<) :: Element s -> Element s -> s

  -- | is an element in the space
  infixl 7 |.|

  (|.|) :: Element s -> s -> Bool
  default (|.|) :: (Ord (Element s)) => Element s -> s -> Bool
  (|.|) Element s
a s
s = (Element s
a Element s -> Element s -> Bool
forall a. Ord a => a -> a -> Bool
>= s -> Element s
forall s. Space s => s -> Element s
lower s
s) Bool -> Bool -> Bool
&& (s -> Element s
forall s. Space s => s -> Element s
upper s
s Element s -> Element s -> Bool
forall a. Ord a => a -> a -> Bool
>= Element s
a)

  -- | is one space completely above the other
  infixl 7 |>|

  (|>|) :: s -> s -> Bool
  default (|>|) :: (Ord (Element s)) => s -> s -> Bool
  (|>|) s
s0 s
s1 =
    s -> Element s
forall s. Space s => s -> Element s
lower s
s0 Element s -> Element s -> Bool
forall a. Ord a => a -> a -> Bool
>= s -> Element s
forall s. Space s => s -> Element s
upper s
s1

  -- | is one space completely below the other
  infixl 7 |<|

  (|<|) :: s -> s -> Bool
  default (|<|) :: (Ord (Element s)) => s -> s -> Bool
  (|<|) s
s0 s
s1 =
    s -> Element s
forall s. Space s => s -> Element s
lower s
s1 Element s -> Element s -> Bool
forall a. Ord a => a -> a -> Bool
<= s -> Element s
forall s. Space s => s -> Element s
upper s
s0

-- | is a space contained within another?
--
-- > (a `union` b) `contains` a
-- > (a `union` b) `contains` b
contains :: (Space s) => s -> s -> Bool
contains :: forall s. Space s => s -> s -> Bool
contains s
s0 s
s1 =
  s -> Element s
forall s. Space s => s -> Element s
lower s
s1 Element s -> s -> Bool
forall s. Space s => Element s -> s -> Bool
|.| s
s0
    Bool -> Bool -> Bool
&& s -> Element s
forall s. Space s => s -> Element s
upper s
s1 Element s -> s -> Bool
forall s. Space s => Element s -> s -> Bool
|.| s
s0

-- | are two spaces disjoint?
disjoint :: (Space s) => s -> s -> Bool
disjoint :: forall s. Space s => s -> s -> Bool
disjoint s
s0 s
s1 = s
s0 s -> s -> Bool
forall s. Space s => s -> s -> Bool
|>| s
s1 Bool -> Bool -> Bool
|| s
s0 s -> s -> Bool
forall s. Space s => s -> s -> Bool
|<| s
s1

-- | is an element contained within a space
memberOf :: (Space s) => Element s -> s -> Bool
memberOf :: forall s. Space s => Element s -> s -> Bool
memberOf = Element s -> s -> Bool
forall s. Space s => Element s -> s -> Bool
(|.|)

-- | distance between boundaries
width :: (Space s, Subtractive (Element s)) => s -> Element s
width :: forall s. (Space s, Subtractive (Element s)) => s -> Element s
width s
s = s -> Element s
forall s. Space s => s -> Element s
upper s
s Element s -> Element s -> Element s
forall a. Subtractive a => a -> a -> a
- s -> Element s
forall s. Space s => s -> Element s
lower s
s

-- | create a space centered on a plus or minus b
infixl 6 +/-

(+/-) :: (Space s, Subtractive (Element s)) => Element s -> Element s -> s
Element s
a +/- :: forall s.
(Space s, Subtractive (Element s)) =>
Element s -> Element s -> s
+/- Element s
b = Element s
a Element s -> Element s -> Element s
forall a. Subtractive a => a -> a -> a
- Element s
b Element s -> Element s -> s
forall s. Space s => Element s -> Element s -> s
... Element s
a Element s -> Element s -> Element s
forall a. Additive a => a -> a -> a
+ Element s
b

-- | a convex hull
newtype Union a = Union {forall a. Union a -> a
getUnion :: a}

instance (Space a) => Semigroup (Union a) where
  <> :: Union a -> Union a -> Union a
(<>) (Union a
a) (Union a
b) = a -> Union a
forall a. a -> Union a
Union (a
a a -> a -> a
forall s. Space s => s -> s -> s
`union` a
b)

-- | https://en.wikipedia.org/wiki/Intersection_(set_theory)
newtype Intersection a = Intersection {forall a. Intersection a -> a
getIntersection :: a}

instance (Space a) => Semigroup (Intersection a) where
  <> :: Intersection a -> Intersection a -> Intersection a
(<>) (Intersection a
a) (Intersection a
b) = a -> Intersection a
forall a. a -> Intersection a
Intersection (a
a a -> a -> a
forall s. Space s => s -> s -> s
`union` a
b)

-- | a space that can be divided neatly
--
-- > unsafeSpace1 (grid OuterPos s g) == s
-- > getUnion (sconcat (Union <$> (gridSpace s g))) == s
class (Space s, Field (Element s)) => FieldSpace s where
  -- | the type that divides or quotients the space
  type Grid s :: Type

  -- | create equally-spaced elements across a space
  grid :: Pos -> s -> Grid s -> [Element s]

  -- | create equally-spaced spaces from a space
  gridSpace :: s -> Grid s -> [s]

-- | Pos suggests where points should be placed in forming a grid across a field space.
data Pos
  = -- | include boundaries
    OuterPos
  | -- | don't include boundaries
    InnerPos
  | -- | include the lower boundary
    LowerPos
  | -- | include the upper boundary
    UpperPos
  | -- | use the mid-point of the space
    MidPos
  deriving (Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
(Int -> Pos -> ShowS)
-> (Pos -> String) -> ([Pos] -> ShowS) -> Show Pos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pos -> ShowS
showsPrec :: Int -> Pos -> ShowS
$cshow :: Pos -> String
show :: Pos -> String
$cshowList :: [Pos] -> ShowS
showList :: [Pos] -> ShowS
Show, Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
/= :: Pos -> Pos -> Bool
Eq)

-- | middle element of the space
mid :: (Space s, Field (Element s)) => s -> Element s
mid :: forall s. (Space s, Field (Element s)) => s -> Element s
mid s
s = (s -> Element s
forall s. Space s => s -> Element s
lower s
s Element s -> Element s -> Element s
forall a. Additive a => a -> a -> a
+ s -> Element s
forall s. Space s => s -> Element s
upper s
s) Element s -> Element s -> Element s
forall a. Divisive a => a -> a -> a
/ (Element s
forall a. Multiplicative a => a
one Element s -> Element s -> Element s
forall a. Additive a => a -> a -> a
+ Element s
forall a. Multiplicative a => a
one)

-- | interpolate a space
--
-- > interpolate s x == project s (zero ... one) x
interpolate :: (Space s, Ring (Element s)) => s -> Element s -> Element s
interpolate :: forall s.
(Space s, Ring (Element s)) =>
s -> Element s -> Element s
interpolate s
s Element s
x = s -> Element s
forall s. Space s => s -> Element s
lower s
s Element s -> Element s -> Element s
forall a. Additive a => a -> a -> a
+ Element s
x Element s -> Element s -> Element s
forall a. Multiplicative a => a -> a -> a
* s -> Element s
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width s
s

-- | project an element from one space to another, preserving relative position.
--
-- > project o n (lower o) = lower n
-- > project o n (upper o) = upper n
-- > project o n (mid o) = mid n
-- > project a a x = x
project :: (Space s, Field (Element s)) => s -> s -> Element s -> Element s
project :: forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project s
s0 s
s1 Element s
p =
  ((Element s
p Element s -> Element s -> Element s
forall a. Subtractive a => a -> a -> a
- s -> Element s
forall s. Space s => s -> Element s
lower s
s0) Element s -> Element s -> Element s
forall a. Divisive a => a -> a -> a
/ (s -> Element s
forall s. Space s => s -> Element s
upper s
s0 Element s -> Element s -> Element s
forall a. Subtractive a => a -> a -> a
- s -> Element s
forall s. Space s => s -> Element s
lower s
s0)) Element s -> Element s -> Element s
forall a. Multiplicative a => a -> a -> a
* (s -> Element s
forall s. Space s => s -> Element s
upper s
s1 Element s -> Element s -> Element s
forall a. Subtractive a => a -> a -> a
- s -> Element s
forall s. Space s => s -> Element s
lower s
s1) Element s -> Element s -> Element s
forall a. Additive a => a -> a -> a
+ s -> Element s
forall s. Space s => s -> Element s
lower s
s1

-- | the containing space of a non-empty Traversable.
--
-- partial function.
--
-- > all $ unsafeSpace1 a `contains` <$> a
unsafeSpace1 :: (Space s, Traversable f) => f (Element s) -> s
unsafeSpace1 :: forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 = (s -> s -> s) -> f s -> s
forall a. (a -> a -> a) -> f a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
P.foldr1 s -> s -> s
forall s. Space s => s -> s -> s
union (f s -> s) -> (f (Element s) -> f s) -> f (Element s) -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element s -> s) -> f (Element s) -> f s
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element s -> s
forall s. Space s => Element s -> s
singleton

-- | Maybe containing space of a traversable.
space1 :: (Space s, Traversable f) => f (Element s) -> Maybe s
space1 :: forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 f (Element s)
s = Maybe s -> Maybe s -> Bool -> Maybe s
forall a. a -> a -> Bool -> a
bool (s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ f (Element s) -> s
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 f (Element s)
s) Maybe s
forall a. Maybe a
Nothing (f (Element s) -> Bool
forall a. f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f (Element s)
s)

-- | lift a monotone function (increasing or decreasing) over a given space
monotone :: (Space a, Space b) => (Element a -> Element b) -> a -> b
monotone :: forall a b.
(Space a, Space b) =>
(Element a -> Element b) -> a -> b
monotone Element a -> Element b
f a
s = [Element b] -> b
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [Element a -> Element b
f (a -> Element a
forall s. Space s => s -> Element s
lower a
s), Element a -> Element b
f (a -> Element a
forall s. Space s => s -> Element s
upper a
s)]

-- | a small space
eps ::
  ( Space s,
    FromRational (Element s),
    Field (Element s)
  ) =>
  Element s ->
  Element s ->
  s
eps :: forall s.
(Space s, FromRational (Element s), Field (Element s)) =>
Element s -> Element s -> s
eps Element s
accuracy Element s
a = Element s
a Element s -> Element s -> s
forall s.
(Space s, Subtractive (Element s)) =>
Element s -> Element s -> s
+/- (Element s
accuracy Element s -> Element s -> Element s
forall a. Multiplicative a => a -> a -> a
* Element s
a Element s -> Element s -> Element s
forall a. Multiplicative a => a -> a -> a
* Element s
1e-6)

-- | widen a space
widen ::
  ( Space s,
    Ring (Element s)
  ) =>
  Element s ->
  s ->
  s
widen :: forall s. (Space s, Ring (Element s)) => Element s -> s -> s
widen Element s
a s
s = (s -> Element s
forall s. Space s => s -> Element s
lower s
s Element s -> Element s -> Element s
forall a. Subtractive a => a -> a -> a
- Element s
a) Element s -> Element s -> s
forall s. Space s => Element s -> Element s -> s
>.< (s -> Element s
forall s. Space s => s -> Element s
upper s
s Element s -> Element s -> Element s
forall a. Additive a => a -> a -> a
+ Element s
a)

-- | widen by a small amount
widenEps ::
  ( Space s,
    FromRational (Element s),
    Ring (Element s)
  ) =>
  Element s ->
  s ->
  s
widenEps :: forall s.
(Space s, FromRational (Element s), Ring (Element s)) =>
Element s -> s -> s
widenEps Element s
accuracy = Element s -> s -> s
forall s. (Space s, Ring (Element s)) => Element s -> s -> s
widen (Element s
accuracy Element s -> Element s -> Element s
forall a. Multiplicative a => a -> a -> a
* Element s
1e-6)

-- | Scale a Space. (scalar multiplication)
scale :: (Multiplicative (Element s), Space s) => Element s -> s -> s
scale :: forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale Element s
e s
s = (Element s
e Element s -> Element s -> Element s
forall a. Multiplicative a => a -> a -> a
* s -> Element s
forall s. Space s => s -> Element s
lower s
s) Element s -> Element s -> s
forall s. Space s => Element s -> Element s -> s
... (Element s
e Element s -> Element s -> Element s
forall a. Multiplicative a => a -> a -> a
* s -> Element s
forall s. Space s => s -> Element s
upper s
s)

-- | Move a Space. (scalar addition)
move :: (Additive (Element s), Space s) => Element s -> s -> s
move :: forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Element s
e s
s = (Element s
e Element s -> Element s -> Element s
forall a. Additive a => a -> a -> a
+ s -> Element s
forall s. Space s => s -> Element s
lower s
s) Element s -> Element s -> s
forall s. Space s => Element s -> Element s -> s
... (Element s
e Element s -> Element s -> Element s
forall a. Additive a => a -> a -> a
+ s -> Element s
forall s. Space s => s -> Element s
upper s
s)

-- | linear transform + translate of a point-like number
--
-- > (x, y) -> (ax + by + c, dx + ey + d)
--
-- or
--
-- \[
-- \begin{pmatrix}
-- a & b & c\\
-- d & e & f\\
-- 0 & 0 & 1
-- \end{pmatrix}
-- \begin{pmatrix}
-- x\\
-- y\\
-- 1
-- \end{pmatrix}
-- \]
data Transform a = Transform
  { forall a. Transform a -> a
ta :: !a,
    forall a. Transform a -> a
tb :: !a,
    forall a. Transform a -> a
tc :: !a,
    forall a. Transform a -> a
td :: !a,
    forall a. Transform a -> a
te :: !a,
    forall a. Transform a -> a
tf :: !a
  }
  deriving (Transform a -> Transform a -> Bool
(Transform a -> Transform a -> Bool)
-> (Transform a -> Transform a -> Bool) -> Eq (Transform a)
forall a. Eq a => Transform a -> Transform a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Transform a -> Transform a -> Bool
== :: Transform a -> Transform a -> Bool
$c/= :: forall a. Eq a => Transform a -> Transform a -> Bool
/= :: Transform a -> Transform a -> Bool
Eq, Int -> Transform a -> ShowS
[Transform a] -> ShowS
Transform a -> String
(Int -> Transform a -> ShowS)
-> (Transform a -> String)
-> ([Transform a] -> ShowS)
-> Show (Transform a)
forall a. Show a => Int -> Transform a -> ShowS
forall a. Show a => [Transform a] -> ShowS
forall a. Show a => Transform a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Transform a -> ShowS
showsPrec :: Int -> Transform a -> ShowS
$cshow :: forall a. Show a => Transform a -> String
show :: Transform a -> String
$cshowList :: forall a. Show a => [Transform a] -> ShowS
showList :: [Transform a] -> ShowS
Show, (forall a b. (a -> b) -> Transform a -> Transform b)
-> (forall a b. a -> Transform b -> Transform a)
-> Functor Transform
forall a b. a -> Transform b -> Transform a
forall a b. (a -> b) -> Transform a -> Transform b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Transform a -> Transform b
fmap :: forall a b. (a -> b) -> Transform a -> Transform b
$c<$ :: forall a b. a -> Transform b -> Transform a
<$ :: forall a b. a -> Transform b -> Transform a
Functor, (forall m. Monoid m => Transform m -> m)
-> (forall m a. Monoid m => (a -> m) -> Transform a -> m)
-> (forall m a. Monoid m => (a -> m) -> Transform a -> m)
-> (forall a b. (a -> b -> b) -> b -> Transform a -> b)
-> (forall a b. (a -> b -> b) -> b -> Transform a -> b)
-> (forall b a. (b -> a -> b) -> b -> Transform a -> b)
-> (forall b a. (b -> a -> b) -> b -> Transform a -> b)
-> (forall a. (a -> a -> a) -> Transform a -> a)
-> (forall a. (a -> a -> a) -> Transform a -> a)
-> (forall a. Transform a -> [a])
-> (forall a. Transform a -> Bool)
-> (forall a. Transform a -> Int)
-> (forall a. Eq a => a -> Transform a -> Bool)
-> (forall a. Ord a => Transform a -> a)
-> (forall a. Ord a => Transform a -> a)
-> (forall a. Num a => Transform a -> a)
-> (forall a. Num a => Transform a -> a)
-> Foldable Transform
forall a. Eq a => a -> Transform a -> Bool
forall a. Num a => Transform a -> a
forall a. Ord a => Transform a -> a
forall m. Monoid m => Transform m -> m
forall a. Transform a -> Bool
forall a. Transform a -> Int
forall a. Transform a -> [a]
forall a. (a -> a -> a) -> Transform a -> a
forall m a. Monoid m => (a -> m) -> Transform a -> m
forall b a. (b -> a -> b) -> b -> Transform a -> b
forall a b. (a -> b -> b) -> b -> Transform a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Transform m -> m
fold :: forall m. Monoid m => Transform m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Transform a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Transform a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Transform a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Transform a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Transform a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Transform a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Transform a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Transform a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Transform a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Transform a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Transform a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Transform a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Transform a -> a
foldr1 :: forall a. (a -> a -> a) -> Transform a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Transform a -> a
foldl1 :: forall a. (a -> a -> a) -> Transform a -> a
$ctoList :: forall a. Transform a -> [a]
toList :: forall a. Transform a -> [a]
$cnull :: forall a. Transform a -> Bool
null :: forall a. Transform a -> Bool
$clength :: forall a. Transform a -> Int
length :: forall a. Transform a -> Int
$celem :: forall a. Eq a => a -> Transform a -> Bool
elem :: forall a. Eq a => a -> Transform a -> Bool
$cmaximum :: forall a. Ord a => Transform a -> a
maximum :: forall a. Ord a => Transform a -> a
$cminimum :: forall a. Ord a => Transform a -> a
minimum :: forall a. Ord a => Transform a -> a
$csum :: forall a. Num a => Transform a -> a
sum :: forall a. Num a => Transform a -> a
$cproduct :: forall a. Num a => Transform a -> a
product :: forall a. Num a => Transform a -> a
Foldable, Functor Transform
Foldable Transform
(Functor Transform, Foldable Transform) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Transform a -> f (Transform b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Transform (f a) -> f (Transform a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Transform a -> m (Transform b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Transform (m a) -> m (Transform a))
-> Traversable Transform
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Transform (m a) -> m (Transform a)
forall (f :: * -> *) a.
Applicative f =>
Transform (f a) -> f (Transform a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Transform a -> m (Transform b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Transform a -> f (Transform b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Transform a -> f (Transform b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Transform a -> f (Transform b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Transform (f a) -> f (Transform a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Transform (f a) -> f (Transform a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Transform a -> m (Transform b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Transform a -> m (Transform b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Transform (m a) -> m (Transform a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Transform (m a) -> m (Transform a)
Traversable)

-- | Calculate the inverse of a transformation.
inverseTransform :: (Eq a, Field a) => Transform a -> Maybe (Transform a)
inverseTransform :: forall a. (Eq a, Field a) => Transform a -> Maybe (Transform a)
inverseTransform (Transform a
a a
b a
c a
d a
e a
f) =
  let det :: a
det = a
a a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
e a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
b a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
d
   in Maybe (Transform a)
-> Maybe (Transform a) -> Bool -> Maybe (Transform a)
forall a. a -> a -> Bool -> a
bool
        ( Transform a -> Maybe (Transform a)
forall a. a -> Maybe a
Just
            ( a -> a -> a -> a -> a -> a -> Transform a
forall a. a -> a -> a -> a -> a -> a -> Transform a
Transform
                (a
a a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
det)
                (a
d a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
det)
                (-(a
a a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
c a -> a -> a
forall a. Additive a => a -> a -> a
+ a
d a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
f) a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
det)
                (a
b a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
det)
                (a
e a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
det)
                (-(a
b a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
c a -> a -> a
forall a. Additive a => a -> a -> a
+ a
e a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
f) a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
det)
            )
        )
        Maybe (Transform a)
forall a. Maybe a
Nothing
        (a
det a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Additive a => a
zero)

-- | An 'Affinity' is something that can be subjected to an affine transformation in 2-dimensional space, where affine means a linear matrix operation or a translation (+).
--
-- https://en.wikipedia.org/wiki/Affine_transformation
class Affinity a b | a -> b where
  transform :: Transform b -> a -> a

infix 3 |.

-- | Apply a 'Transform' to an 'Affinity'
(|.) :: (Affinity a b) => Transform b -> a -> a
|. :: forall a b. Affinity a b => Transform b -> a -> a
(|.) = Transform b -> a -> a
forall a b. Affinity a b => Transform b -> a -> a
transform

instance (Multiplicative a, Additive a) => Affinity (Transform a) a where
  transform :: Transform a -> Transform a -> Transform a
transform (Transform a
a' a
b' a
c' a
d' a
e' a
f') (Transform a
a a
b a
c a
d a
e a
f) =
    a -> a -> a -> a -> a -> a -> Transform a
forall a. a -> a -> a -> a -> a -> a -> Transform a
Transform
      (a
a a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
a' a -> a -> a
forall a. Additive a => a -> a -> a
+ a
b' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
d)
      (a
a' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
b a -> a -> a
forall a. Additive a => a -> a -> a
+ a
b' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
e)
      (a
a' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
c a -> a -> a
forall a. Additive a => a -> a -> a
+ a
b' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
f a -> a -> a
forall a. Additive a => a -> a -> a
+ a
c')
      (a
d' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
a a -> a -> a
forall a. Additive a => a -> a -> a
+ a
e' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
d)
      (a
d' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
b a -> a -> a
forall a. Additive a => a -> a -> a
+ a
e' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
e)
      (a
d' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
c a -> a -> a
forall a. Additive a => a -> a -> a
+ a
e' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
f a -> a -> a
forall a. Additive a => a -> a -> a
+ a
f')

-- | Rotate an 'Affinity' (counter-clockwise)
rotate :: (TrigField a) => a -> Transform a
rotate :: forall a. TrigField a => a -> Transform a
rotate a
a = a -> a -> a -> a -> a -> a -> Transform a
forall a. a -> a -> a -> a -> a -> a -> Transform a
Transform (a -> a
forall a. TrigField a => a -> a
cos a
a) (-a -> a
forall a. TrigField a => a -> a
sin a
a) a
forall a. Additive a => a
zero (a -> a
forall a. TrigField a => a -> a
sin a
a) (a -> a
forall a. TrigField a => a -> a
cos a
a) a
forall a. Additive a => a
zero