    {-# LANGUAGE ConstraintKinds            #-}
    {-# LANGUAGE FlexibleContexts           #-}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE ScopedTypeVariables        #-}
    {-# LANGUAGE TypeFamilies               #-}
    {-# LANGUAGE TypeOperators              #-}
    {-# LANGUAGE UndecidableInstances       #-}
    {-# OPTIONS_GHC -fno-warn-unused-imports #-}

    -- |
    -- Module      :  Diagrams.Core.Transform
    -- Copyright   :  (c) 2011-2015 diagrams-core team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- "Diagrams" defines the core library of primitives
    -- forming the basis of an embedded domain-specific language for
    -- describing and rendering diagrams.
    --
    -- The @Transform@ module defines generic transformations
    -- parameterized by any vector space.
    --
    -----------------------------------------------------------------------------

    module Diagrams.Core.Transform
           (
             -- * Transformations

             -- ** Invertible linear transformations
             (:-:)(..), (<->), linv, lapp

             -- ** General transformations
           , Transformation(..)
           , inv, transp, transl
           , dropTransl
           , apply
           , papply
           , fromLinear
           , fromOrthogonal
           , fromSymmetric
           , basis
           , dimension
           , onBasis
           , listRep
           , matrixRep
           , matrixHomRep
           , determinant
           , isReflection
           , avgScale
           , eye

             -- * The Transformable class

           , HasLinearMap
           , HasBasis
           , Transformable(..)

             -- * Translational invariance

           , TransInv(TransInv)

             -- * Vector space independent transformations
             -- | Most transformations are specific to a particular vector
             --   space, but a few can be defined generically over any
             --   vector space.

           , translation, translate
           , scaling, scale

           ) where

    import           Control.Lens            (Rewrapped, Traversable, Wrapped (..),
                                              iso, (&), (.~))
    import qualified Data.Map                as M
    import           Data.Semigroup
    import qualified Data.Set                as S

    import           Data.Monoid.Action
    import           Data.Monoid.Deletable

    import           Linear.Affine
    import           Linear.Vector

    import           Data.Foldable           (Foldable, toList)
    import           Data.Functor.Rep

    import           Diagrams.Core.HasOrigin
    import           Diagrams.Core.Measure
    import           Diagrams.Core.Points    ()
    import           Diagrams.Core.V

    ------------------------------------------------------------
    --  Transformations  ---------------------------------------
    ------------------------------------------------------------

    -------------------------------------------------------
    --  Invertible linear transformations  ----------------
    -------------------------------------------------------

    -- | @(v1 :-: v2)@ is a linear map paired with its inverse.
    data (:-:) u v = (u -> v) :-: (v -> u)
    infixr 7 :-:

    -- | Create an invertible linear map from two functions which are
    --   assumed to be linear inverses.
    (<->) :: (u -> v) -> (v -> u) -> (u :-: v)
    u -> v
    f <-> :: forall u v. (u -> v) -> (v -> u) -> u :-: v
    <-> v -> u
    g = u -> v
    f (u -> v) -> (v -> u) -> u :-: v
    forall u v. (u -> v) -> (v -> u) -> u :-: v
    :-: v -> u
    g

    instance Semigroup (a :-: a) where
      (a -> a
    f :-: a -> a
    f') <> :: (a :-: a) -> (a :-: a) -> a :-: a
    <> (a -> a
    g :-: a -> a
    g') = a -> a
    f (a -> a) -> (a -> a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> a
    g (a -> a) -> (a -> a) -> a :-: a
    forall u v. (u -> v) -> (v -> u) -> u :-: v
    :-: a -> a
    g' (a -> a) -> (a -> a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> a
    f'

    -- | Invertible linear maps from a vector space to itself form a
    --   monoid under composition.
    instance Monoid (v :-: v) where
      mempty :: v :-: v
    mempty  = v -> v
    forall a. a -> a
    id (v -> v) -> (v -> v) -> v :-: v
    forall u v. (u -> v) -> (v -> u) -> u :-: v
    :-: v -> v
    forall a. a -> a
    id
      mappend :: (v :-: v) -> (v :-: v) -> v :-: v
    mappend = (v :-: v) -> (v :-: v) -> v :-: v
    forall a. Semigroup a => a -> a -> a
    (<>)

    -- | Invert a linear map.
    linv :: (u :-: v) -> (v :-: u)
    linv :: forall u v. (u :-: v) -> v :-: u
    linv (u -> v
    f :-: v -> u
    g) = v -> u
    g (v -> u) -> (u -> v) -> v :-: u
    forall u v. (u -> v) -> (v -> u) -> u :-: v
    :-: u -> v
    f

    -- | Apply a linear map to a vector.
    lapp :: (u :-: v) -> u -> v
    lapp :: forall u v. (u :-: v) -> u -> v
    lapp (u -> v
    f :-: v -> u
    _) = u -> v
    f

    --------------------------------------------------
    --  Affine transformations  ----------------------
    --------------------------------------------------

    -- | General (affine) transformations, represented by an invertible
    --   linear map, its /transpose/, and a vector representing a
    --   translation component.
    --
    --   By the /transpose/ of a linear map we mean simply the linear map
    --   corresponding to the transpose of the map's matrix
    --   representation.  For example, any scale is its own transpose,
    --   since scales are represented by matrices with zeros everywhere
    --   except the diagonal.  The transpose of a rotation is the same as
    --   its inverse.
    --
    --   The reason we need to keep track of transposes is because it
    --   turns out that when transforming a shape according to some linear
    --   map L, the shape's /normal vectors/ transform according to L's
    --   inverse transpose.  (For a more detailed explanation and proof,
    --   see <https://wiki.haskell.org/Diagrams/Dev/Transformations>.)
    --   This is exactly what we need when transforming bounding
    --   functions, which are defined in terms of /perpendicular/
    --   (i.e. normal) hyperplanes.
    --
    --   For more general, non-invertible transformations, see
    --   @Diagrams.Deform@ (in @diagrams-lib@).

    data Transformation v n = Transformation (v n :-: v n) (v n :-: v n) (v n)

    type instance V (Transformation v n) = v
    type instance N (Transformation v n) = n

    -- | Identity matrix.
    eye :: (HasBasis v, Num n) => v (v n)
    eye :: forall (v :: * -> *) n. (HasBasis v, Num n) => v (v n)
    eye = (Rep v -> v n) -> v (v n)
    forall a. (Rep v -> a) -> v a
    forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
    tabulate ((Rep v -> v n) -> v (v n)) -> (Rep v -> v n) -> v (v n)
    forall a b. (a -> b) -> a -> b
    $ \(E forall x. Lens' (v x) x
    e) -> v n
    forall a. Num a => v a
    forall (f :: * -> *) a. (Additive f, Num a) => f a
    zero v n -> (v n -> v n) -> v n
    forall a b. a -> (a -> b) -> b
    & (n -> Identity n) -> v n -> Identity (v n)
    forall x. Lens' (v x) x
    e ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ n
    1

    -- | Invert a transformation.
    inv :: (Functor v, Num n) => Transformation v n -> Transformation v n
    inv :: forall (v :: * -> *) n.
    (Functor v, Num n) =>
    Transformation v n -> Transformation v n
    inv (Transformation v n :-: v n
    t v n :-: v n
    t' v n
    v) = (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    forall (v :: * -> *) n.
    (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    Transformation ((v n :-: v n) -> v n :-: v n
    forall u v. (u :-: v) -> v :-: u
    linv v n :-: v n
    t) ((v n :-: v n) -> v n :-: v n
    forall u v. (u :-: v) -> v :-: u
    linv v n :-: v n
    t')
                                                 (v n -> v n
    forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
    negated ((v n :-: v n) -> v n -> v n
    forall u v. (u :-: v) -> u -> v
    lapp ((v n :-: v n) -> v n :-: v n
    forall u v. (u :-: v) -> v :-: u
    linv v n :-: v n
    t) v n
    v))

    -- | Get the transpose of a transformation (ignoring the translation
    --   component).
    transp :: Transformation v n -> (v n :-: v n)
    transp :: forall (v :: * -> *) n. Transformation v n -> v n :-: v n
    transp (Transformation v n :-: v n
    _ v n :-: v n
    t' v n
    _) = v n :-: v n
    t'

    -- | Get the translational component of a transformation.
    transl :: Transformation v n -> v n
    transl :: forall (v :: * -> *) n. Transformation v n -> v n
    transl (Transformation v n :-: v n
    _ v n :-: v n
    _ v n
    v) = v n
    v

    -- | Drop the translational component of a transformation, leaving only
    --   the linear part.
    dropTransl :: (Additive v, Num n) => Transformation v n -> Transformation v n
    dropTransl :: forall (v :: * -> *) n.
    (Additive v, Num n) =>
    Transformation v n -> Transformation v n
    dropTransl (Transformation v n :-: v n
    a v n :-: v n
    a' v n
    _) = (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    forall (v :: * -> *) n.
    (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    Transformation v n :-: v n
    a v n :-: v n
    a' v n
    forall a. Num a => v a
    forall (f :: * -> *) a. (Additive f, Num a) => f a
    zero

    -- | Transformations are closed under composition; @t1 <> t2@ is the
    --   transformation which performs first @t2@, then @t1@.
    instance (Additive v, Num n) => Semigroup (Transformation v n) where
      Transformation v n :-: v n
    t1 v n :-: v n
    t1' v n
    v1 <> :: Transformation v n -> Transformation v n -> Transformation v n
    <> Transformation v n :-: v n
    t2 v n :-: v n
    t2' v n
    v2
        = (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    forall (v :: * -> *) n.
    (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    Transformation (v n :-: v n
    t1 (v n :-: v n) -> (v n :-: v n) -> v n :-: v n
    forall a. Semigroup a => a -> a -> a
    <> v n :-: v n
    t2) (v n :-: v n
    t2' (v n :-: v n) -> (v n :-: v n) -> v n :-: v n
    forall a. Semigroup a => a -> a -> a
    <> v n :-: v n
    t1') (v n
    v1 v n -> v n -> v n
    forall a. Num a => v a -> v a -> v a
    forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
    ^+^ (v n :-: v n) -> v n -> v n
    forall u v. (u :-: v) -> u -> v
    lapp v n :-: v n
    t1 v n
    v2)

    instance (Additive v, Num n) => Monoid (Transformation v n) where
      mempty :: Transformation v n
    mempty = (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    forall (v :: * -> *) n.
    (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    Transformation v n :-: v n
    forall a. Monoid a => a
    mempty v n :-: v n
    forall a. Monoid a => a
    mempty v n
    forall a. Num a => v a
    forall (f :: * -> *) a. (Additive f, Num a) => f a
    zero
      mappend :: Transformation v n -> Transformation v n -> Transformation v n
    mappend = Transformation v n -> Transformation v n -> Transformation v n
    forall a. Semigroup a => a -> a -> a
    (<>)

    -- | Transformations can act on transformable things.
    instance (Transformable a, V a ~ v, N a ~ n) => Action (Transformation v n) a where
      act :: Transformation v n -> a -> a
    act = Transformation v n -> a -> a
    Transformation (V a) (N a) -> a -> a
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform

    -- | Apply a transformation to a vector.  Note that any translational
    --   component of the transformation will not affect the vector, since
    --   vectors are invariant under translation.
    apply :: Transformation v n -> v n -> v n
    apply :: forall (v :: * -> *) n. Transformation v n -> v n -> v n
    apply (Transformation (v n -> v n
    t :-: v n -> v n
    _) v n :-: v n
    _ v n
    _) = v n -> v n
    t

    -- | Apply a transformation to a point.
    papply :: (Additive v, Num n) => Transformation v n -> Point v n -> Point v n
    papply :: forall (v :: * -> *) n.
    (Additive v, Num n) =>
    Transformation v n -> Point v n -> Point v n
    papply (Transformation v n :-: v n
    t v n :-: v n
    _ v n
    v) (P v n
    p) = v n -> Point v n
    forall (f :: * -> *) a. f a -> Point f a
    P (v n -> Point v n) -> v n -> Point v n
    forall a b. (a -> b) -> a -> b
    $ (v n :-: v n) -> v n -> v n
    forall u v. (u :-: v) -> u -> v
    lapp v n :-: v n
    t v n
    p v n -> v n -> v n
    forall a. Num a => v a -> v a -> v a
    forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
    ^+^ v n
    v

    -- | Create a general affine transformation from an invertible linear
    --   transformation and its transpose.  The translational component is
    --   assumed to be zero.
    fromLinear :: (Additive v, Num n) => (v n :-: v n) -> (v n :-: v n) -> Transformation v n
    fromLinear :: forall (v :: * -> *) n.
    (Additive v, Num n) =>
    (v n :-: v n) -> (v n :-: v n) -> Transformation v n
    fromLinear v n :-: v n
    l1 v n :-: v n
    l2 = (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    forall (v :: * -> *) n.
    (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    Transformation v n :-: v n
    l1 v n :-: v n
    l2 v n
    forall a. Num a => v a
    forall (f :: * -> *) a. (Additive f, Num a) => f a
    zero

    -- | An orthogonal linear map is one whose inverse is also its transpose.
    fromOrthogonal :: (Additive v, Num n) => (v n :-: v n) -> Transformation v n
    fromOrthogonal :: forall (v :: * -> *) n.
    (Additive v, Num n) =>
    (v n :-: v n) -> Transformation v n
    fromOrthogonal v n :-: v n
    t = (v n :-: v n) -> (v n :-: v n) -> Transformation v n
    forall (v :: * -> *) n.
    (Additive v, Num n) =>
    (v n :-: v n) -> (v n :-: v n) -> Transformation v n
    fromLinear v n :-: v n
    t ((v n :-: v n) -> v n :-: v n
    forall u v. (u :-: v) -> v :-: u
    linv v n :-: v n
    t)

    -- | A symmetric linear map is one whose transpose is equal to its self.
    fromSymmetric :: (Additive v, Num n) => (v n :-: v n) -> Transformation v n
    fromSymmetric :: forall (v :: * -> *) n.
    (Additive v, Num n) =>
    (v n :-: v n) -> Transformation v n
    fromSymmetric v n :-: v n
    t = (v n :-: v n) -> (v n :-: v n) -> Transformation v n
    forall (v :: * -> *) n.
    (Additive v, Num n) =>
    (v n :-: v n) -> (v n :-: v n) -> Transformation v n
    fromLinear v n :-: v n
    t v n :-: v n
    t

    -- | Get the dimension of an object whose vector space is an instance of
    --   @HasLinearMap@, e.g. transformations, paths, diagrams, etc.
    dimension :: forall a. (Additive (V a), Traversable (V a)) => a -> Int
    dimension :: forall a. (Additive (V a), Traversable (V a)) => a -> Int
    dimension a
    _ = [V a Int] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([V a Int]
    forall (t :: * -> *) a. (Additive t, Traversable t, Num a) => [t a]
    basis :: [V a Int])

    -- | Get the matrix equivalent of the linear transform,
    --   (as a list of columns) and the translation vector.  This
    --   is mostly useful for implementing backends.
    onBasis :: (Additive v, Traversable v, Num n) => Transformation v n -> ([v n], v n)
    onBasis :: forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> ([v n], v n)
    onBasis (Transformation (v n -> v n
    f :-: v n -> v n
    _) v n :-: v n
    _ v n
    t) = ((v n -> v n) -> [v n] -> [v n]
    forall a b. (a -> b) -> [a] -> [b]
    map v n -> v n
    f [v n]
    forall (t :: * -> *) a. (Additive t, Traversable t, Num a) => [t a]
    basis, v n
    t)

    -- Remove the nth element from a list
    remove :: Int -> [a] -> [a]
    remove :: forall a. Int -> [a] -> [a]
    remove Int
    n [a]
    xs = [a]
    ys [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    zs
      where
        ([a]
    ys, a
    _ : [a]
    zs) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    n [a]
    xs

    -- Minor matrix of cofactor C(i,j)
    minor :: Int -> Int -> [[a]] -> [[a]]
    minor :: forall a. Int -> Int -> [[a]] -> [[a]]
    minor Int
    i Int
    j [[a]]
    xs = Int -> [[a]] -> [[a]]
    forall a. Int -> [a] -> [a]
    remove Int
    j ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> [a]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    remove Int
    i) [[a]]
    xs

    -- The determinant of a square matrix represented as a list of lists
    -- representing column vectors, that is [column].
    det :: Num a => [[a]] -> a
    det :: forall a. Num a => [[a]] -> a
    det [a
    a : [a]
    _] = a
    a
    det m :: [[a]]
    m@([a]
    c1 : [[a]]
    _) = [a] -> a
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [(-a
    1) a -> Int -> a
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ Int
    i a -> a -> a
    forall a. Num a => a -> a -> a
    * ([a]
    c1 [a] -> Int -> a
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i) a -> a -> a
    forall a. Num a => a -> a -> a
    * [[a]] -> a
    forall a. Num a => [[a]] -> a
    det (Int -> Int -> [[a]] -> [[a]]
    forall a. Int -> Int -> [[a]] -> [[a]]
    minor Int
    i Int
    0 [[a]]
    m) | Int
    i <- [Int
    0 .. (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)]]
      where
        n :: Int
    n = [[a]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[a]]
    m

    -- | Convert a vector v to a list of scalars.
    listRep :: Foldable v => v n -> [n]
    listRep :: forall (v :: * -> *) n. Foldable v => v n -> [n]
    listRep = v n -> [n]
    forall a. v a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList

    -- | Convert the linear part of a `Transformation` to a matrix
    --   representation as a list of column vectors which are also lists.
    matrixRep :: (Additive v, Traversable v, Num n) => Transformation v n -> [[n]]
    matrixRep :: forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> [[n]]
    matrixRep (Transformation (v n -> v n
    f :-: v n -> v n
    _) v n :-: v n
    _ v n
    _) = (v n -> [n]) -> [v n] -> [[n]]
    forall a b. (a -> b) -> [a] -> [b]
    map (v n -> [n]
    forall a. v a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList (v n -> [n]) -> (v n -> v n) -> v n -> [n]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v n -> v n
    f) [v n]
    forall (t :: * -> *) a. (Additive t, Traversable t, Num a) => [t a]
    basis

    -- | Convert a `Transformation v` to a homogeneous matrix representation.
    --   The final list is the translation.
    --   The representation leaves off the last row of the matrix as it is
    --   always [0,0, ... 1] and this representation is the defacto standard
    --   for backends.
    matrixHomRep :: (Additive v, Traversable v, Num n) => Transformation v n -> [[n]]
    matrixHomRep :: forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> [[n]]
    matrixHomRep Transformation v n
    t = [[n]]
    mr [[n]] -> [[n]] -> [[n]]
    forall a. [a] -> [a] -> [a]
    ++ [v n -> [n]
    forall a. v a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList v n
    tl]
      where
        mr :: [[n]]
    mr = Transformation v n -> [[n]]
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> [[n]]
    matrixRep Transformation v n
    t
        tl :: v n
    tl = Transformation v n -> v n
    forall (v :: * -> *) n. Transformation v n -> v n
    transl Transformation v n
    t

    -- | The determinant of (the linear part of) a `Transformation`.
    determinant :: (Additive v, Traversable v, Num n) => Transformation v n -> n
    determinant :: forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> n
    determinant = [[n]] -> n
    forall a. Num a => [[a]] -> a
    det ([[n]] -> n)
    -> (Transformation v n -> [[n]]) -> Transformation v n -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transformation v n -> [[n]]
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> [[n]]
    matrixRep

    -- | Determine whether a `Transformation` includes a reflection
    --   component, that is, whether it reverses orientation.
    isReflection :: (Additive v, Traversable v, Num n, Ord n) => Transformation v n -> Bool
    isReflection :: forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n, Ord n) =>
    Transformation v n -> Bool
    isReflection = (n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    <n
    0) (n -> Bool)
    -> (Transformation v n -> n) -> Transformation v n -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transformation v n -> n
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> n
    determinant

    -- | Compute the \"average\" amount of scaling performed by a
    --   transformation.  Satisfies the properties
    --
    --   @
    --   avgScale (scaling k) == k
    --   avgScale (t1 <> t2)  == avgScale t1 * avgScale t2
    --   @
    --
    avgScale :: (Additive v, Traversable v, Floating n) => Transformation v n -> n
    avgScale :: forall (v :: * -> *) n.
    (Additive v, Traversable v, Floating n) =>
    Transformation v n -> n
    avgScale Transformation v n
    t = (n -> n
    forall a. Num a => a -> a
    abs (n -> n) -> (Transformation v n -> n) -> Transformation v n -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transformation v n -> n
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Num n) =>
    Transformation v n -> n
    determinant) Transformation v n
    t n -> n -> n
    forall a. Floating a => a -> a -> a
    ** (n -> n
    forall a. Fractional a => a -> a
    recip (n -> n) -> (Transformation v n -> n) -> Transformation v n -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> n
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> n)
    -> (Transformation v n -> Int) -> Transformation v n -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transformation v n -> Int
    forall a. (Additive (V a), Traversable (V a)) => a -> Int
    dimension) Transformation v n
    t

    {-

    avgScale is computed as the nth root of the positive determinant.
    This works because the determinant is the factor by which a transformation
    scales area/volume. See http://en.wikipedia.org/wiki/Determinant.

    Proofs for the specified properties:

    1. |det (scaling k)|^(1/n) = (k^n)^(1/n) = k
    2. |det t1|^(1/n) * |det t2|^(1/n)
       = (|det t1| * |det t2|)^(1/n)
       = |det t1 * det t2|^(1/n)
       = |det (t1 <> t2)|^(1/n)

    -}

    ------------------------------------------------------------
    --  The Transformable class  -------------------------------
    ------------------------------------------------------------

    -- | 'HasLinearMap' is a constraint synonym, just to
    --   help shorten some of the ridiculously long constraint sets.
    type HasLinearMap v = (HasBasis v, Traversable v)

    -- | An 'Additive' vector space whose representation is made up of basis elements.
    type HasBasis v = (Additive v, Representable v, Rep v ~ E v)

    -- | Type class for things @t@ which can be transformed.
    class Transformable t where

      -- | Apply a transformation to an object.
      transform :: Transformation (V t) (N t) -> t -> t

    instance (Additive v, Num n) => Transformable (Transformation v n) where
      transform :: Transformation (V (Transformation v n)) (N (Transformation v n))
    -> Transformation v n -> Transformation v n
    transform Transformation (V (Transformation v n)) (N (Transformation v n))
    t1 Transformation v n
    t2 = Transformation v n
    Transformation (V (Transformation v n)) (N (Transformation v n))
    t1 Transformation v n -> Transformation v n -> Transformation v n
    forall a. Semigroup a => a -> a -> a
    <> Transformation v n
    t2

    instance (Additive v, Num n) => HasOrigin (Transformation v n) where
      moveOriginTo :: Point (V (Transformation v n)) (N (Transformation v n))
    -> Transformation v n -> Transformation v n
    moveOriginTo Point (V (Transformation v n)) (N (Transformation v n))
    p = Vn (Transformation v n) -> Transformation v n -> Transformation v n
    forall t. Transformable t => Vn t -> t -> t
    translate (Point v n
    forall (f :: * -> *) a. (Additive f, Num a) => Point f a
    origin Point v n -> Point v n -> Diff (Point v) n
    forall a. Num a => Point v a -> Point v a -> Diff (Point v) a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
    .-. Point v n
    Point (V (Transformation v n)) (N (Transformation v n))
    p)

    instance (Transformable t, Transformable s, V t ~ V s, N t ~ N s)
          => Transformable (t, s) where
      transform :: Transformation (V (t, s)) (N (t, s)) -> (t, s) -> (t, s)
    transform Transformation (V (t, s)) (N (t, s))
    t (t
    x,s
    y) =  ( Transformation (V t) (N t) -> t -> t
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V t) (N t)
    Transformation (V (t, s)) (N (t, s))
    t t
    x
                           , Transformation (V s) (N s) -> s -> s
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V s) (N s)
    Transformation (V (t, s)) (N (t, s))
    t s
    y
                           )

    instance (Transformable t, Transformable s, Transformable u, V s ~ V t, N s ~ N t, V s ~ V u, N s ~ N u)
          => Transformable (t,s,u) where
      transform :: Transformation (V (t, s, u)) (N (t, s, u))
    -> (t, s, u) -> (t, s, u)
    transform Transformation (V (t, s, u)) (N (t, s, u))
    t (t
    x,s
    y,u
    z) = ( Transformation (V t) (N t) -> t -> t
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V t) (N t)
    Transformation (V (t, s, u)) (N (t, s, u))
    t t
    x
                            , Transformation (V s) (N s) -> s -> s
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V s) (N s)
    Transformation (V (t, s, u)) (N (t, s, u))
    t s
    y
                            , Transformation (V u) (N u) -> u -> u
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V u) (N u)
    Transformation (V (t, s, u)) (N (t, s, u))
    t u
    z
                            )

    -- Transform functions by conjugation. That is, reverse-transform argument and
    -- forward-transform result. Intuition: If someone shrinks you, you see your
    -- environment enlarged. If you rotate right, you see your environment
    -- rotating left. Etc. This technique was used extensively in Pan for modular
    -- construction of image filters. Works well for curried functions, since all
    -- arguments get inversely transformed.

    instance ( V t ~ v, N t ~ n, V t ~ V s, N t ~ N s, Functor v, Num n
             , Transformable t, Transformable s)
             => Transformable (s -> t) where
      transform :: Transformation (V (s -> t)) (N (s -> t)) -> (s -> t) -> s -> t
    transform Transformation (V (s -> t)) (N (s -> t))
    tr s -> t
    f = Transformation (V t) (N t) -> t -> t
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V t) (N t)
    Transformation (V (s -> t)) (N (s -> t))
    tr (t -> t) -> (s -> t) -> s -> t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . s -> t
    f (s -> t) -> (s -> s) -> s -> t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transformation (V s) (N s) -> s -> s
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform (Transformation v n -> Transformation v n
    forall (v :: * -> *) n.
    (Functor v, Num n) =>
    Transformation v n -> Transformation v n
    inv Transformation v n
    Transformation (V (s -> t)) (N (s -> t))
    tr)

    instance Transformable t => Transformable [t] where
      transform :: Transformation (V [t]) (N [t]) -> [t] -> [t]
    transform = (t -> t) -> [t] -> [t]
    forall a b. (a -> b) -> [a] -> [b]
    map ((t -> t) -> [t] -> [t])
    -> (Transformation (V t) (N t) -> t -> t)
    -> Transformation (V t) (N t)
    -> [t]
    -> [t]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transformation (V t) (N t) -> t -> t
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform

    instance (Transformable t, Ord t) => Transformable (S.Set t) where
      transform :: Transformation (V (Set t)) (N (Set t)) -> Set t -> Set t
    transform = (t -> t) -> Set t -> Set t
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    S.map ((t -> t) -> Set t -> Set t)
    -> (Transformation (V t) (N t) -> t -> t)
    -> Transformation (V t) (N t)
    -> Set t
    -> Set t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transformation (V t) (N t) -> t -> t
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform

    instance Transformable t => Transformable (M.Map k t) where
      transform :: Transformation (V (Map k t)) (N (Map k t)) -> Map k t -> Map k t
    transform = (t -> t) -> Map k t -> Map k t
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map ((t -> t) -> Map k t -> Map k t)
    -> (Transformation (V t) (N t) -> t -> t)
    -> Transformation (V t) (N t)
    -> Map k t
    -> Map k t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transformation (V t) (N t) -> t -> t
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform

    instance (Additive v, Num n) => Transformable (Point v n) where
      transform :: Transformation (V (Point v n)) (N (Point v n))
    -> Point v n -> Point v n
    transform = Transformation v n -> Point v n -> Point v n
    Transformation (V (Point v n)) (N (Point v n))
    -> Point v n -> Point v n
    forall (v :: * -> *) n.
    (Additive v, Num n) =>
    Transformation v n -> Point v n -> Point v n
    papply

    instance Transformable m => Transformable (Deletable m) where
      transform :: Transformation (V (Deletable m)) (N (Deletable m))
    -> Deletable m -> Deletable m
    transform = (m -> m) -> Deletable m -> Deletable m
    forall a b. (a -> b) -> Deletable a -> Deletable b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((m -> m) -> Deletable m -> Deletable m)
    -> (Transformation (V m) (N m) -> m -> m)
    -> Transformation (V m) (N m)
    -> Deletable m
    -> Deletable m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transformation (V m) (N m) -> m -> m
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform

    ------------------------------------------------------------
    --  Translational invariance  ------------------------------
    ------------------------------------------------------------

    -- | @TransInv@ is a wrapper which makes a transformable type
    --   translationally invariant; the translational component of
    --   transformations will no longer affect things wrapped in
    --   @TransInv@.
    newtype TransInv t = TransInv t
      deriving (TransInv t -> TransInv t -> Bool
    (TransInv t -> TransInv t -> Bool)
    -> (TransInv t -> TransInv t -> Bool) -> Eq (TransInv t)
    forall t. Eq t => TransInv t -> TransInv t -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall t. Eq t => TransInv t -> TransInv t -> Bool
    == :: TransInv t -> TransInv t -> Bool
    $c/= :: forall t. Eq t => TransInv t -> TransInv t -> Bool
    /= :: TransInv t -> TransInv t -> Bool
    Eq, Eq (TransInv t)
    Eq (TransInv t) =>
    (TransInv t -> TransInv t -> Ordering)
    -> (TransInv t -> TransInv t -> Bool)
    -> (TransInv t -> TransInv t -> Bool)
    -> (TransInv t -> TransInv t -> Bool)
    -> (TransInv t -> TransInv t -> Bool)
    -> (TransInv t -> TransInv t -> TransInv t)
    -> (TransInv t -> TransInv t -> TransInv t)
    -> Ord (TransInv t)
    TransInv t -> TransInv t -> Bool
    TransInv t -> TransInv t -> Ordering
    TransInv t -> TransInv t -> TransInv t
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall t. Ord t => Eq (TransInv t)
    forall t. Ord t => TransInv t -> TransInv t -> Bool
    forall t. Ord t => TransInv t -> TransInv t -> Ordering
    forall t. Ord t => TransInv t -> TransInv t -> TransInv t
    $ccompare :: forall t. Ord t => TransInv t -> TransInv t -> Ordering
    compare :: TransInv t -> TransInv t -> Ordering
    $c< :: forall t. Ord t => TransInv t -> TransInv t -> Bool
    < :: TransInv t -> TransInv t -> Bool
    $c<= :: forall t. Ord t => TransInv t -> TransInv t -> Bool
    <= :: TransInv t -> TransInv t -> Bool
    $c> :: forall t. Ord t => TransInv t -> TransInv t -> Bool
    > :: TransInv t -> TransInv t -> Bool
    $c>= :: forall t. Ord t => TransInv t -> TransInv t -> Bool
    >= :: TransInv t -> TransInv t -> Bool
    $cmax :: forall t. Ord t => TransInv t -> TransInv t -> TransInv t
    max :: TransInv t -> TransInv t -> TransInv t
    $cmin :: forall t. Ord t => TransInv t -> TransInv t -> TransInv t
    min :: TransInv t -> TransInv t -> TransInv t
    Ord, Int -> TransInv t -> ShowS
    [TransInv t] -> ShowS
    TransInv t -> String
    (Int -> TransInv t -> ShowS)
    -> (TransInv t -> String)
    -> ([TransInv t] -> ShowS)
    -> Show (TransInv t)
    forall t. Show t => Int -> TransInv t -> ShowS
    forall t. Show t => [TransInv t] -> ShowS
    forall t. Show t => TransInv t -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall t. Show t => Int -> TransInv t -> ShowS
    showsPrec :: Int -> TransInv t -> ShowS
    $cshow :: forall t. Show t => TransInv t -> String
    show :: TransInv t -> String
    $cshowList :: forall t. Show t => [TransInv t] -> ShowS
    showList :: [TransInv t] -> ShowS
    Show, NonEmpty (TransInv t) -> TransInv t
    TransInv t -> TransInv t -> TransInv t
    (TransInv t -> TransInv t -> TransInv t)
    -> (NonEmpty (TransInv t) -> TransInv t)
    -> (forall b. Integral b => b -> TransInv t -> TransInv t)
    -> Semigroup (TransInv t)
    forall b. Integral b => b -> TransInv t -> TransInv t
    forall t. Semigroup t => NonEmpty (TransInv t) -> TransInv t
    forall t. Semigroup t => TransInv t -> TransInv t -> TransInv t
    forall t b.
    (Semigroup t, Integral b) =>
    b -> TransInv t -> TransInv t
    forall a.
    (a -> a -> a)
    -> (NonEmpty a -> a)
    -> (forall b. Integral b => b -> a -> a)
    -> Semigroup a
    $c<> :: forall t. Semigroup t => TransInv t -> TransInv t -> TransInv t
    <> :: TransInv t -> TransInv t -> TransInv t
    $csconcat :: forall t. Semigroup t => NonEmpty (TransInv t) -> TransInv t
    sconcat :: NonEmpty (TransInv t) -> TransInv t
    $cstimes :: forall t b.
    (Semigroup t, Integral b) =>
    b -> TransInv t -> TransInv t
    stimes :: forall b. Integral b => b -> TransInv t -> TransInv t
    Semigroup, Semigroup (TransInv t)
    TransInv t
    Semigroup (TransInv t) =>
    TransInv t
    -> (TransInv t -> TransInv t -> TransInv t)
    -> ([TransInv t] -> TransInv t)
    -> Monoid (TransInv t)
    [TransInv t] -> TransInv t
    TransInv t -> TransInv t -> TransInv t
    forall a.
    Semigroup a =>
    a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
    forall t. Monoid t => Semigroup (TransInv t)
    forall t. Monoid t => TransInv t
    forall t. Monoid t => [TransInv t] -> TransInv t
    forall t. Monoid t => TransInv t -> TransInv t -> TransInv t
    $cmempty :: forall t. Monoid t => TransInv t
    mempty :: TransInv t
    $cmappend :: forall t. Monoid t => TransInv t -> TransInv t -> TransInv t
    mappend :: TransInv t -> TransInv t -> TransInv t
    $cmconcat :: forall t. Monoid t => [TransInv t] -> TransInv t
    mconcat :: [TransInv t] -> TransInv t
    Monoid)

    instance Wrapped (TransInv t) where
      type Unwrapped (TransInv t) = t
      _Wrapped' :: Iso' (TransInv t) (Unwrapped (TransInv t))
    _Wrapped' = (TransInv t -> t)
    -> (t -> TransInv t) -> Iso (TransInv t) (TransInv t) t t
    forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
    iso (\(TransInv t
    t) -> t
    t) t -> TransInv t
    forall t. t -> TransInv t
    TransInv

    instance Rewrapped (TransInv t) (TransInv t')

    type instance V (TransInv t) = V t
    type instance N (TransInv t) = N t

    instance HasOrigin (TransInv t) where
      moveOriginTo :: Point (V (TransInv t)) (N (TransInv t)) -> TransInv t -> TransInv t
    moveOriginTo = (TransInv t -> TransInv t)
    -> Point (V t) (N t) -> TransInv t -> TransInv t
    forall a b. a -> b -> a
    const TransInv t -> TransInv t
    forall a. a -> a
    id

    instance (Num (N t), Additive (V t), Transformable t) => Transformable (TransInv t) where
      transform :: Transformation (V (TransInv t)) (N (TransInv t))
    -> TransInv t -> TransInv t
    transform (Transformation V (TransInv t) (N (TransInv t)) :-: V (TransInv t) (N (TransInv t))
    a V (TransInv t) (N (TransInv t)) :-: V (TransInv t) (N (TransInv t))
    a' V (TransInv t) (N (TransInv t))
    _) (TransInv t
    t)
        = t -> TransInv t
    forall t. t -> TransInv t
    TransInv (Transformation (V t) (N t) -> t -> t
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform ((V t (N t) :-: V t (N t))
    -> (V t (N t) :-: V t (N t))
    -> V t (N t)
    -> Transformation (V t) (N t)
    forall (v :: * -> *) n.
    (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    Transformation V t (N t) :-: V t (N t)
    V (TransInv t) (N (TransInv t)) :-: V (TransInv t) (N (TransInv t))
    a V t (N t) :-: V t (N t)
    V (TransInv t) (N (TransInv t)) :-: V (TransInv t) (N (TransInv t))
    a' V t (N t)
    forall a. Num a => V t a
    forall (f :: * -> *) a. (Additive f, Num a) => f a
    zero) t
    t)

    instance (InSpace v n t, Transformable t, HasLinearMap v, Floating n)
        => Transformable (Measured n t) where
      transform :: Transformation (V (Measured n t)) (N (Measured n t))
    -> Measured n t -> Measured n t
    transform Transformation (V (Measured n t)) (N (Measured n t))
    t = n -> Measured n t -> Measured n t
    forall n a. Num n => n -> Measured n a -> Measured n a
    scaleLocal n
    n (Measured n t -> Measured n t)
    -> (Measured n t -> Measured n t) -> Measured n t -> Measured n t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (t -> t) -> Measured n t -> Measured n t
    forall a b. (a -> b) -> Measured n a -> Measured n b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Transformation (V t) (N t) -> t -> t
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation v n
    Transformation (V t) (N t)
    t')
        where
          t' :: Transformation v n
    t' = Transformation v n
    Transformation (V (Measured n t)) (N (Measured n t))
    t Transformation v n -> Transformation v n -> Transformation v n
    forall a. Semigroup a => a -> a -> a
    <> n -> Transformation v n
    forall (v :: * -> *) n.
    (Additive v, Fractional n) =>
    n -> Transformation v n
    scaling (n
    1 n -> n -> n
    forall a. Fractional a => a -> a -> a
    / Transformation v n -> n
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Floating n) =>
    Transformation v n -> n
    avgScale Transformation v n
    Transformation (V (Measured n t)) (N (Measured n t))
    t)
          n :: n
    n = Transformation v n -> n
    forall (v :: * -> *) n.
    (Additive v, Traversable v, Floating n) =>
    Transformation v n -> n
    avgScale Transformation v n
    Transformation (V (Measured n t)) (N (Measured n t))
    t

    ------------------------------------------------------------
    --  Generic transformations  -------------------------------
    ------------------------------------------------------------

    -- | Create a translation.
    translation :: v n -> Transformation v n
    translation :: forall (v :: * -> *) n. v n -> Transformation v n
    translation = (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    forall (v :: * -> *) n.
    (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
    Transformation v n :-: v n
    forall a. Monoid a => a
    mempty v n :-: v n
    forall a. Monoid a => a
    mempty

    -- | Translate by a vector.
    translate :: (Transformable t) => Vn t -> t -> t
    translate :: forall t. Transformable t => Vn t -> t -> t
    translate = Transformation (V t) (N t) -> t -> t
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform (Transformation (V t) (N t) -> t -> t)
    -> (V t (N t) -> Transformation (V t) (N t)) -> V t (N t) -> t -> t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . V t (N t) -> Transformation (V t) (N t)
    forall (v :: * -> *) n. v n -> Transformation v n
    translation

    -- | Create a uniform scaling transformation.
    scaling :: (Additive v, Fractional n) => n -> Transformation v n
    scaling :: forall (v :: * -> *) n.
    (Additive v, Fractional n) =>
    n -> Transformation v n
    scaling n
    s = (v n :-: v n) -> Transformation v n
    forall (v :: * -> *) n.
    (Additive v, Num n) =>
    (v n :-: v n) -> Transformation v n
    fromSymmetric v n :-: v n
    lin
      where lin :: v n :-: v n
    lin = (n
    s n -> v n -> v n
    forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
    *^) (v n -> v n) -> (v n -> v n) -> v n :-: v n
    forall u v. (u -> v) -> (v -> u) -> u :-: v
    <-> (v n -> n -> v n
    forall (f :: * -> *) a.
    (Functor f, Fractional a) =>
    f a -> a -> f a
    ^/ n
    s)

    -- | Scale uniformly in every dimension by the given scalar.
    scale :: (InSpace v n a, Eq n, Fractional n, Transformable a)
          => n -> a -> a
    scale :: forall (v :: * -> *) n a.
    (InSpace v n a, Eq n, Fractional n, Transformable a) =>
    n -> a -> a
    scale n
    0 = String -> a -> a
    forall a. HasCallStack => String -> a
    error String
    "scale by zero!  Halp!"  -- XXX what should be done here?
    scale n
    s = Transformation (V a) (N a) -> a -> a
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform (Transformation (V a) (N a) -> a -> a)
    -> Transformation (V a) (N a) -> a -> a
    forall a b. (a -> b) -> a -> b
    $ n -> Transformation v n
    forall (v :: * -> *) n.
    (Additive v, Fractional n) =>
    n -> Transformation v n
    scaling n
    s