brush-strokes-0.1.0.0: src/lib/Math/Algebra/Dual.hs

{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE RebindableSyntax     #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans -O2 #-}

module Math.Algebra.Dual
  ( C(..), D, Dim
  , Differential(..)
  , HasChainRule(..), chainRule
  , uncurryD2, uncurryD3
  , linear, fun, var

  , chainRuleN1Q, chainRule1NQ

  , ApModule(..)
  , DiffModule(..)

  , D𝔸0(..)
  , D1𝔸1(..), D2𝔸1(..), D3𝔸1(..)
  , D1𝔸2(..), D2𝔸2(..), D3𝔸2(..)
  , D1𝔸3(..), D2𝔸3(..), D3𝔸3(..)
  , D1𝔸4(..), D2𝔸4(..), D3𝔸4(..)
  ) where

-- base
import Prelude
  hiding
  ( Num(..), Floating(..)
  , (^), recip, fromInteger, fromRational )
import Data.Coerce
  ( coerce )
import Data.Kind
  ( Constraint, Type )
import GHC.TypeNats
  ( Nat )

-- brush-strokes
import Math.Algebra.Dual.Internal
import Math.Interval.Internal
import Math.Linear
import Math.Module
import Math.Monomial
import Math.Ring

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

-- | @C n u v@ is the space of @C^k@-differentiable maps from @u@ to @v@.
type C :: Nat -> Type -> Type -> Type
newtype C k u v = D { runD :: u -> D k ( Dim u ) v }
deriving stock instance Functor ( D k ( Dim u ) ) => Functor ( C k u )

type Dim :: k -> Nat
type family Dim u
type instance Dim ( ℝ n ) = n

-- | @D k u v@ is the space of @k@-th order germs of functions from @u@ to @v@,
-- represented by the algebra:
--
-- \[ \mathbb{Z}[x_1, \ldots, x_n]/(x_1, \ldots, x_n)^{k+1} \otimes_\mathbb{Z} v \]
--
-- when @u@ is of dimension @n@.
type D :: Nat -> Nat -> Type -> Type
type family D k u

type instance D k 0 = D𝔸0
type instance D 0 1 = D𝔸0
type instance D 0 2 = D𝔸0
type instance D 0 3 = D𝔸0
type instance D 0 4 = D𝔸0

type instance D 1 1 = D1𝔸1
type instance D 1 2 = D1𝔸2
type instance D 1 3 = D1𝔸3
type instance D 1 4 = D1𝔸4

type instance D 2 1 = D2𝔸1
type instance D 2 2 = D2𝔸2
type instance D 2 3 = D2𝔸3
type instance D 2 4 = D2𝔸4

type instance D 3 1 = D3𝔸1
type instance D 3 2 = D3𝔸2
type instance D 3 3 = D3𝔸3
type instance D 3 4 = D3𝔸4

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

-- Weird instance needed in just one place;
-- see use of chain in 'Math.Bezier.Stroke.brushStrokeData'.
instance ( Applicative ( D k ( Dim u ) ), Module r ( T v ) )
       => Module r ( T ( C k u v ) ) where
  origin = T $ D \ _ -> pure $ coerce $ origin @r @( T v )
  T ( D f ) ^+^ T ( D g ) = T $ D \ t -> liftA2 ( coerce $ (^+^) @r @( T v ) ) ( f t ) ( g t )
  T ( D f ) ^-^ T ( D g ) = T $ D \ t -> liftA2 ( coerce $ (^-^) @r @( T v ) ) ( f t ) ( g t )
  a *^ T ( D f ) = T $ D \ t -> fmap ( coerce $ (*^) @r @( T v ) a ) $ f t

newtype DiffModule k n v = DiffModule { getDiffModule :: D k n v }

instance ( Applicative ( D k n ), Module r ( T v ) )
       => Module r ( T ( DiffModule k n v ) ) where
  origin = T $ DiffModule $ pure $ coerce $ origin @r @( T v )
  T ( DiffModule f ) ^+^ T ( DiffModule g ) = T $ DiffModule $ liftA2 ( coerce $ (^+^) @r @( T v ) ) f g
  T ( DiffModule f ) ^-^ T ( DiffModule g ) = T $ DiffModule $  liftA2 ( coerce $ (^-^) @r @( T v ) ) f g
  a *^ T ( DiffModule f ) = T $ DiffModule $ fmap ( coerce $ (*^) @r @( T v ) a ) f

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

type Differential :: Nat -> Nat -> Constraint
class Differential k n where
  konst   :: AbelianGroup w => w -> D k n w
  value   :: D k n w -> w

-- | @HasChainRule r k v@ means we have a chain rule
-- with @D k v w@ in the middle, for any @r@-module @w@.
class Differential k ( Dim v ) => HasChainRule r k v where
  chain   :: Module r ( T w )
          => D k 1 v -> D k ( Dim v ) w -> D k 1 w
  linearD :: Module r ( T w ) => ( v -> w ) -> v -> D k ( Dim v ) w

linear :: forall k r v w
       .  ( HasChainRule r k v, Module r ( T w ) )
       => ( v -> w ) -> C k v w
linear f = D \ x -> linearD @r @k @v @w f x

chainRule :: forall r k u v w
          .  ( HasChainRule r k v, Module r ( T w )
             , Dim u ~ 1, HasChainRule r k u
             )
          => C k u v -> C k v w -> C k u w
chainRule ( D df ) ( D dg ) =
  D \ x ->
    case df x of
      df_x ->
        chain @r @k @v df_x ( dg $ value @k @( Dim u ) df_x )

uncurryD2 :: D 2 1 ( D 2 1 b ) -> D 2 2 b
uncurryD2 ( D21 ( b_t0 ) ( T ( dbdt_t0 ) ) ( T ( d2bdt2_t0 ) ) ) =
  let D21 b_t0s0      dbds_t0s0    d2bds2_t0s0 = b_t0
      D21 dbdt_t0s0   d2bdtds_t0s0 _           = dbdt_t0
      D21 d2bdt2_t0s0 _            _           = d2bdt2_t0
  in D22
       b_t0s0
       ( T dbdt_t0s0 ) dbds_t0s0
       ( T d2bdt2_t0s0 ) d2bdtds_t0s0 d2bds2_t0s0

uncurryD3 :: D 3 1 ( D 3 1 b ) -> D 3 2 b
uncurryD3 ( D31 b_t0 ( T dbdt_t0 ) ( T d2bdt2_t0 ) ( T d3bdt3_t0 ) ) =
  let D31 b_t0s0      dbds_t0s0     d2bds2_t0s0   d3bds3_t0s0 = b_t0
      D31 dbdt_t0s0   d2bdtds_t0s0  d3bdtds2_t0s0 _           = dbdt_t0
      D31 d2bdt2_t0s0 d3bdt2ds_t0s0 _             _           = d2bdt2_t0
      D31 d3bdt3_t0s0 _             _             _           = d3bdt3_t0
  in D32
       b_t0s0
       ( T dbdt_t0s0 ) dbds_t0s0
       ( T d2bdt2_t0s0 ) d2bdtds_t0s0 d2bds2_t0s0
       ( T d3bdt3_t0s0 ) d3bdt2ds_t0s0 d3bdtds2_t0s0 d3bds3_t0s0

-- | Recover the underlying function, discarding all infinitesimal information.
fun :: forall k v w. Differential k ( Dim v ) => C k v w -> ( v -> w )
fun ( D df ) = value @k @( Dim v ) . df
{-# INLINE fun #-}

-- | The differentiable germ of a coordinate variable.
var :: forall r k v
    .  ( Module r ( T r ), Representable r v, HasChainRule r k v )
    => Fin ( RepDim v ) -> C k v r
var i = D $ linearD @r @k @v ( `index` i )
{-# INLINE var #-}

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

-- | Newtype for the module instance @Module r v => Module ( dr r ) ( dr v )@.
type ApModule :: Type -> ( Type -> Type ) -> Type -> Type
newtype ApModule r dr v = ApModule { unApModule :: dr v }

instance ( Ring ( dr r ), Module r ( T v ), Applicative dr )
       => Module ( dr r ) ( ApModule r dr v ) where
  ApModule !u ^+^ ApModule !v = ApModule $ liftA2 ( coerce $ (^+^) @r @( T v ) ) u v
  ApModule !u ^-^ ApModule !v = ApModule $ liftA2 ( coerce $ (^-^) @r @( T v ) ) u v
  origin = ApModule $ pure $ coerce $ origin @r @( T v )
  !k *^ ApModule !u = ApModule $ liftA2 ( coerce $ (*^) @r @( T v ) ) k u


deriving via ApModule r D𝔸0 v
  instance Module r ( T v ) => Module ( D𝔸0  r ) ( D𝔸0  v )
--deriving via ApModule r D1𝔸1 v
--  instance Module r ( T v ) => Module ( D1𝔸1 r ) ( D1𝔸1 v )
deriving via ApModule r D2𝔸1 v
  instance Module r ( T v ) => Module ( D2𝔸1 r ) ( D2𝔸1 v )
deriving via ApModule r D3𝔸1 v
  instance Module r ( T v ) => Module ( D3𝔸1 r ) ( D3𝔸1 v )
--deriving via ApModule r D1𝔸2 v
--  instance Module r ( T v ) => Module ( D1𝔸2 r ) ( D1𝔸2 v )
deriving via ApModule r D2𝔸2 v
  instance Module r ( T v ) => Module ( D2𝔸2 r ) ( D2𝔸2 v )
deriving via ApModule r D3𝔸2 v
  instance Module r ( T v ) => Module ( D3𝔸2 r ) ( D3𝔸2 v )
--deriving via ApModule r D1𝔸3 v
--  instance Module r ( T v ) => Module ( D1𝔸3 r ) ( D1𝔸3 v )
deriving via ApModule r D2𝔸3 v
  instance Module r ( T v ) => Module ( D2𝔸3 r ) ( D2𝔸3 v )
deriving via ApModule r D3𝔸3 v
  instance Module r ( T v ) => Module ( D3𝔸3 r ) ( D3𝔸3 v )
--deriving via ApModule r D1𝔸4 v
--  instance Module r ( T v ) => Module ( D1𝔸4 r ) ( D1𝔸4 v )
deriving via ApModule r D2𝔸4 v
  instance Module r ( T v ) => Module ( D2𝔸4 r ) ( D2𝔸4 v )
deriving via ApModule r D3𝔸4 v
  instance Module r ( T v ) => Module ( D3𝔸4 r ) ( D3𝔸4 v )

--------------------------------------------------------------------------------
-- AbelianGroup instances

newtype ApAp2 k u r = ApAp2 { unApAp2 :: D k ( Dim u ) r }

instance ( Applicative ( D k ( Dim u ) )
         , AbelianGroup r
         , HasChainRule Double k u
         ) => AbelianGroup ( ApAp2 k u r ) where
  ApAp2 !x + ApAp2 !y = ApAp2 $ liftA2 ( (+) @r ) x y
  ApAp2 !x - ApAp2 !y = ApAp2 $ liftA2 ( (-) @r ) x y
  negate ( ApAp2 !x ) = ApAp2 $ fmap ( negate @r ) x

  -- DO NOT USE PURE!!
  fromInteger !i = ApAp2 $ konst @k @( Dim u ) ( fromInteger @r i )

deriving newtype instance AbelianGroup r => AbelianGroup ( D𝔸0 r )

deriving via ApAp2 2 ( ℝ 1 ) r
  instance AbelianGroup r => AbelianGroup ( D2𝔸1 r )
deriving via ApAp2 3 ( ℝ 1 ) r
  instance AbelianGroup r => AbelianGroup ( D3𝔸1 r )
deriving via ApAp2 2 ( ℝ 2 ) r
  instance AbelianGroup r => AbelianGroup ( D2𝔸2 r )
deriving via ApAp2 3 ( ℝ 2 ) r
  instance AbelianGroup r => AbelianGroup ( D3𝔸2 r )
deriving via ApAp2 2 ( ℝ 3 ) r
  instance AbelianGroup r => AbelianGroup ( D2𝔸3 r )
deriving via ApAp2 3 ( ℝ 3 ) r
  instance AbelianGroup r => AbelianGroup ( D3𝔸3 r )
deriving via ApAp2 2 ( ℝ 4 ) r
  instance AbelianGroup r => AbelianGroup ( D2𝔸4 r )
deriving via ApAp2 3 ( ℝ 4 ) r
  instance AbelianGroup r => AbelianGroup ( D3𝔸4 r )

--------------------------------------------------------------------------------
-- Ring instances.

d1pow :: Ring r => Word -> r -> D1𝔸1 r
d1pow i x =
  let !j = fromInteger $ fromIntegral i
  in D11
       ( x ^ i )
       ( T $ j * x ^ (i - 1) )
{-# INLINE d1pow #-}
d2pow :: Ring r => Word -> r -> D2𝔸1 r
d2pow i x =
  let !j = fromInteger $ fromIntegral i
  in D21
       ( x ^ i )
       ( T $ j * x ^ (i - 1) )
       ( T $ j * (j - 1) * x ^ ( i - 2 ) )
{-# INLINE d2pow #-}
d3pow :: Ring r => Word -> r -> D3𝔸1 r
d3pow i x =
  let !j = fromInteger $ fromIntegral i
  in D31
       ( x ^ i )
       ( T $ j * x ^ (i - 1) )
       ( T $ j * (j - 1) * x ^ ( i - 2 ) )
       ( T $ j * (j - 1) * (j - 2) * x ^ ( i - 3 ) )
{-# INLINE d3pow #-}

deriving newtype instance Ring r => Ring ( D𝔸0 r )

--instance Ring r => Ring ( D1𝔸1 r ) where
--instance Ring r => Ring ( D1𝔸2 r ) where
--instance Ring r => Ring ( D1𝔸3 r ) where
--instance Ring r => Ring ( D1𝔸4 r ) where

instance Ring r => Ring ( D2𝔸1 r ) where
  !dr1 * !dr2 =
    let
      o :: r
      !o = fromInteger 0
      p :: r -> r -> r
      !p = (+) @r
      m :: r -> r -> r
      !m = (*) @r
   in
       $$( prodRuleQ
             [|| o ||] [|| p ||] [|| m ||]
             [|| dr1 ||] [|| dr2 ||] )
  df ^ i =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2pow @r i ( _D21_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Ring ( D2𝔸1 Double ) #-}
  {-# SPECIALISE instance Ring ( D2𝔸1 𝕀 ) #-}

instance Ring r => Ring ( D2𝔸2 r ) where
  !dr1 * !dr2 =
    let
      o :: r
      !o = fromInteger 0
      p :: r -> r -> r
      !p = (+) @r
      m :: r -> r -> r
      !m = (*) @r
   in
       $$( prodRuleQ
             [|| o ||] [|| p ||] [|| m ||]
             [|| dr1 ||] [|| dr2 ||] )
  df ^ i =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2pow @r i ( _D22_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Ring ( D2𝔸2 Double ) #-}
  {-# SPECIALISE instance Ring ( D2𝔸2 𝕀 ) #-}

instance Ring r => Ring ( D2𝔸3 r ) where
  !dr1 * !dr2 =
    let
      o :: r
      !o = fromInteger 0
      p :: r -> r -> r
      !p = (+) @r
      m :: r -> r -> r
      !m = (*) @r
   in
       $$( prodRuleQ
             [|| o ||] [|| p ||] [|| m ||]
             [|| dr1 ||] [|| dr2 ||] )
  df ^ i =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2pow @r i ( _D23_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Ring ( D2𝔸3 Double ) #-}
  {-# SPECIALISE instance Ring ( D2𝔸3 𝕀 ) #-}

instance Ring r => Ring ( D2𝔸4 r ) where
  !dr1 * !dr2 =
    let
      o :: r
      !o = fromInteger 0
      p :: r -> r -> r
      !p = (+) @r
      m :: r -> r -> r
      !m = (*) @r
   in
       $$( prodRuleQ
             [|| o ||] [|| p ||] [|| m ||]
             [|| dr1 ||] [|| dr2 ||] )
  df ^ i =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2pow @r i ( _D24_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Ring ( D2𝔸4 Double ) #-}
  {-# SPECIALISE instance Ring ( D2𝔸4 𝕀 ) #-}

instance Ring r => Ring ( D3𝔸1 r ) where
  !dr1 * !dr2 =
    let
      o :: r
      !o = fromInteger 0
      p :: r -> r -> r
      !p = (+) @r
      m :: r -> r -> r
      !m = (*) @r
   in
       $$( prodRuleQ
             [|| o ||] [|| p ||] [|| m ||]
             [|| dr1 ||] [|| dr2 ||] )
  df ^ i =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3pow @r i ( _D31_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Ring ( D3𝔸1 Double ) #-}
  {-# SPECIALISE instance Ring ( D3𝔸1 𝕀 ) #-}

instance Ring r => Ring ( D3𝔸2 r ) where
  !dr1 * !dr2 =
    let
      o :: r
      !o = fromInteger 0
      p :: r -> r -> r
      !p = (+) @r
      m :: r -> r -> r
      !m = (*) @r
   in
       $$( prodRuleQ
             [|| o ||] [|| p ||] [|| m ||]
             [|| dr1 ||] [|| dr2 ||] )
  df ^ i =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3pow @r i ( _D32_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Ring ( D3𝔸2 Double ) #-}
  {-# SPECIALISE instance Ring ( D3𝔸2 𝕀 ) #-}

instance Ring r => Ring ( D3𝔸3 r ) where
  !dr1 * !dr2 =
    let
      o :: r
      !o = fromInteger 0
      p :: r -> r -> r
      !p = (+) @r
      m :: r -> r -> r
      !m = (*) @r
   in
       $$( prodRuleQ
             [|| o ||] [|| p ||] [|| m ||]
             [|| dr1 ||] [|| dr2 ||] )
  df ^ i =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3pow @r i ( _D33_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Ring ( D3𝔸3 Double ) #-}
  {-# SPECIALISE instance Ring ( D3𝔸3 𝕀 ) #-}

instance Ring r => Ring ( D3𝔸4 r ) where
  !dr1 * !dr2 =
    let
      o :: r
      !o = fromInteger 0
      p :: r -> r -> r
      !p = (+) @r
      m :: r -> r -> r
      !m = (*) @r
   in
       $$( prodRuleQ
             [|| o ||] [|| p ||] [|| m ||]
             [|| dr1 ||] [|| dr2 ||] )
  df ^ i =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2pow @r i ( _D34_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Ring ( D3𝔸4 Double ) #-}
  {-# SPECIALISE instance Ring ( D3𝔸4 𝕀 ) #-}

--------------------------------------------------------------------------------
-- Field, floating & transcendental instances

d1recip :: Field r => r -> D1𝔸1 r
d1recip x =
  let !d = recip x
  in D11 d ( T $ -1 * d ^ 2 )
{-# INLINE d1recip #-}
d2recip :: Field r => r -> D2𝔸1 r
d2recip x =
  let !d = recip x
  in D21 d ( T $ -1 * d ^ 2 ) ( T $ 2 * d ^ 3 )
{-# INLINE d2recip #-}
d3recip :: Field r => r -> D3𝔸1 r
d3recip x =
  let !d = recip x
  in D31 d ( T $ -1 * d ^ 2 ) ( T $ 2 * d ^ 3 ) ( T $ -6 * d ^ 4 )
{-# INLINE d3recip #-}

deriving newtype instance Field r => Field ( D𝔸0 r )

--instance Field r => Field ( D1𝔸1 r ) where
--instance Field r => Field ( D1𝔸2 r ) where
--instance Field r => Field ( D1𝔸3 r ) where
--instance Field r => Field ( D1𝔸4 r ) where
instance Field r => Field ( D2𝔸1 r ) where
  fromRational q = konst @2 @1 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2recip @r ( _D21_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Field ( D2𝔸1 Double ) #-}
  {-# SPECIALISE instance Field ( D2𝔸1 𝕀 ) #-}
instance Field r => Field ( D2𝔸2 r ) where
  fromRational q = konst @2 @2 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2recip @r ( _D22_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Field ( D2𝔸2 Double ) #-}
  {-# SPECIALISE instance Field ( D2𝔸2 𝕀 ) #-}
instance Field r => Field ( D2𝔸3 r ) where
  fromRational q = konst @2 @3 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2recip @r ( _D23_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Field ( D2𝔸3 Double ) #-}
  {-# SPECIALISE instance Field ( D2𝔸3 𝕀 ) #-}
instance Field r => Field ( D2𝔸4 r ) where
  fromRational q = konst @2 @4 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2recip @r ( _D24_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Field ( D2𝔸4 Double ) #-}
  {-# SPECIALISE instance Field ( D2𝔸4 𝕀 ) #-}
instance Field r => Field ( D3𝔸1 r ) where
  fromRational q = konst @3 @1 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3recip @r ( _D31_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Field ( D3𝔸1 Double ) #-}
  {-# SPECIALISE instance Field ( D3𝔸1 𝕀 ) #-}
instance Field r => Field ( D3𝔸2 r ) where
  fromRational q = konst @3 @2 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3recip @r ( _D32_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Field ( D3𝔸2 Double ) #-}
  {-# SPECIALISE instance Field ( D3𝔸2 𝕀 ) #-}
instance Field r => Field ( D3𝔸3 r ) where
  fromRational q = konst @3 @3 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3recip @r ( _D33_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Field ( D3𝔸3 Double ) #-}
  {-# SPECIALISE instance Field ( D3𝔸3 𝕀 ) #-}
instance Field r => Field ( D3𝔸4 r ) where
  fromRational q = konst @3 @4 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3recip @r ( _D34_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Field ( D3𝔸4 Double ) #-}
  {-# SPECIALISE instance Field ( D3𝔸4 𝕀 ) #-}

d1sqrt :: Floating r => r -> D1𝔸1 r
d1sqrt x =
  let !v = sqrt x
      !d = recip v
  in D11 v ( T $ 0.5 * d )
{-# INLINE d1sqrt #-}
d2sqrt :: Floating r => r -> D2𝔸1 r
d2sqrt x =
  let !v = sqrt x
      !d = recip v
  in D21 v ( T $ 0.5 * d ) ( T $ -0.25 * d ^ 2 )
{-# INLINE d2sqrt #-}
d3sqrt :: Floating r => r -> D3𝔸1 r
d3sqrt x =
  let !v = sqrt x
      !d = recip v
  in D31 v ( T $ 0.5 * d ) ( T $ -0.25 * d ^ 2 ) ( T $ 0.375 * d ^ 3 )
{-# INLINE d3sqrt #-}

deriving newtype instance Floating r => Floating ( D𝔸0 r )
--instance Floating r => Floating ( D1𝔸1 r ) where
--instance Floating r => Floating ( D1𝔸2 r ) where
--instance Floating r => Floating ( D1𝔸3 r ) where
--instance Floating r => Floating ( D1𝔸4 r ) where
instance Floating r => Floating ( D2𝔸1 r ) where
  sqrt df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2sqrt @r ( _D21_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Floating ( D2𝔸1 Double ) #-}
  {-# SPECIALISE instance Floating ( D2𝔸1 𝕀 ) #-}
instance Floating r => Floating ( D2𝔸2 r ) where
  sqrt df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2sqrt @r ( _D22_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Floating ( D2𝔸2 Double ) #-}
  {-# SPECIALISE instance Floating ( D2𝔸2 𝕀 ) #-}
instance Floating r => Floating ( D2𝔸3 r ) where
  sqrt df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2sqrt @r ( _D23_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Floating ( D2𝔸3 Double ) #-}
  {-# SPECIALISE instance Floating ( D2𝔸3 𝕀 ) #-}
instance Floating r => Floating ( D2𝔸4 r ) where
  sqrt df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2sqrt @r ( _D24_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Floating ( D2𝔸4 Double ) #-}
  {-# SPECIALISE instance Floating ( D2𝔸4 𝕀 ) #-}
instance Floating r => Floating ( D3𝔸1 r ) where
  sqrt df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3sqrt @r ( _D31_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Floating ( D3𝔸1 Double ) #-}
  {-# SPECIALISE instance Floating ( D3𝔸1 𝕀 ) #-}
instance Floating r => Floating ( D3𝔸2 r ) where
  sqrt df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3sqrt @r ( _D32_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Floating ( D3𝔸2 Double ) #-}
  {-# SPECIALISE instance Floating ( D3𝔸2 𝕀 ) #-}
instance Floating r => Floating ( D3𝔸3 r ) where
  sqrt df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3sqrt @r ( _D33_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Floating ( D3𝔸3 Double ) #-}
  {-# SPECIALISE instance Floating ( D3𝔸3 𝕀 ) #-}
instance Floating r => Floating ( D3𝔸4 r ) where
  sqrt df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3sqrt @r ( _D34_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Floating ( D3𝔸4 Double ) #-}
  {-# SPECIALISE instance Floating ( D3𝔸4 𝕀 ) #-}

d1sin, d1cos, d1atan :: Transcendental r => r -> D1𝔸1 r
d1sin x =
  let !s = sin x
      !c = cos x
  in D11 s ( T c )
d1cos x =
  let !s = sin x
      !c = cos x
  in D11 c ( T -s )
d1atan x
  = let !d = recip $ 1 + x ^ 2
    in D11
        ( atan x )
        ( T $ d )
{-# INLINE d1sin #-}
{-# INLINE d1cos #-}
{-# INLINE d1atan #-}

d2sin, d2cos, d2atan :: Transcendental r => r -> D2𝔸1 r
d2sin x =
  let !s = sin x
      !c = cos x
  in D21 s ( T c ) ( T -s )
d2cos x =
  let !s = sin x
      !c = cos x
  in D21 c ( T -s ) ( T -c )
d2atan x
  = let !d = recip $ 1 + x ^ 2
    in D21
        ( atan x )
        ( T $ d )
        ( T $ -2 * x * d ^ 2 )
{-# INLINE d2sin #-}
{-# INLINE d2cos #-}
{-# INLINE d2atan #-}

d3sin, d3cos, d3atan :: Transcendental r => r -> D3𝔸1 r
d3sin x =
  let !s = sin x
      !c = cos x
  in D31 s ( T c ) ( T -s ) ( T -c )
d3cos x =
  let !s = sin x
      !c = cos x
  in D31 c ( T -s ) ( T -c ) ( T s )
d3atan x
  = let !d = recip $ 1 + x ^ 2
    in D31
        ( atan x )
        ( T $ d )
        ( T $ -2 * x * d ^ 2 )
        ( T $ ( -2 + 6 * x ^ 2 ) * d ^ 3 )
{-# INLINE d3sin #-}
{-# INLINE d3cos #-}
{-# INLINE d3atan #-}

deriving newtype instance Transcendental r => Transcendental ( D𝔸0 r )
--instance Transcendental r => Transcendental ( D1𝔸1 r ) where
--instance Transcendental r => Transcendental ( D1𝔸2 r ) where
--instance Transcendental r => Transcendental ( D1𝔸3 r ) where
--instance Transcendental r => Transcendental ( D1𝔸4 r ) where
instance Transcendental r => Transcendental ( D2𝔸1 r ) where
  pi = konst @2 @1 pi
  sin df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2sin @r ( _D21_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  cos df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2cos @r ( _D21_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  atan df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2atan @r ( _D21_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Transcendental ( D2𝔸1 Double ) #-}
  {-# SPECIALISE instance Transcendental ( D2𝔸1 𝕀 ) #-}
instance Transcendental r => Transcendental ( D2𝔸2 r ) where
  pi = konst @2 @2 pi
  sin df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2sin @r ( _D22_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  cos df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2cos @r ( _D22_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  atan df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2atan @r ( _D22_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Transcendental ( D2𝔸2 Double ) #-}
  {-# SPECIALISE instance Transcendental ( D2𝔸2 𝕀 ) #-}
instance Transcendental r => Transcendental ( D2𝔸3 r ) where
  pi = konst @2 @3 pi
  sin df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2sin @r ( _D23_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  cos df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2cos @r ( _D23_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  atan df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2atan @r ( _D23_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Transcendental ( D2𝔸3 Double ) #-}
  {-# SPECIALISE instance Transcendental ( D2𝔸3 𝕀 ) #-}

instance Transcendental r => Transcendental ( D2𝔸4 r ) where
  pi = konst @2 @4 pi
  sin df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2sin @r ( _D24_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  cos df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2cos @r ( _D24_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  atan df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d2atan @r ( _D24_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Transcendental ( D2𝔸4 Double ) #-}
  {-# SPECIALISE instance Transcendental ( D2𝔸4 𝕀 ) #-}

instance Transcendental r => Transcendental ( D3𝔸1 r ) where
  pi = konst @3 @1 pi
  sin df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3sin @r ( _D31_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  cos df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3cos @r ( _D31_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  atan df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3atan @r ( _D31_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Transcendental ( D3𝔸1 Double ) #-}
  {-# SPECIALISE instance Transcendental ( D3𝔸1 𝕀 ) #-}

instance Transcendental r => Transcendental ( D3𝔸2 r ) where
  pi = konst @3 @2 pi
  sin df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3sin @r ( _D32_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  cos df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3cos @r ( _D32_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  atan df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3atan @r ( _D32_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Transcendental ( D3𝔸2 Double ) #-}
  {-# SPECIALISE instance Transcendental ( D3𝔸2 𝕀 ) #-}

instance Transcendental r => Transcendental ( D3𝔸3 r ) where
  pi = konst @3 @3 pi
  sin df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3sin @r ( _D33_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  cos df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3cos @r ( _D33_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  atan df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3atan @r ( _D33_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Transcendental ( D3𝔸3 Double ) #-}
  {-# SPECIALISE instance Transcendental ( D3𝔸3 𝕀 ) #-}

instance Transcendental r => Transcendental ( D3𝔸4 r ) where
  pi = konst @3 @4 pi
  sin df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3sin @r ( _D34_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  cos df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3cos @r ( _D34_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  atan df =
    let
      fromInt = fromInteger @r
      add   = (+) @r
      times = (*) @r
      pow   = (^) @r
      dg    = d3atan @r ( _D34_v df )
   in $$( chainRuleN1Q [|| fromInt ||] [|| add ||] [|| times ||] [|| pow ||]
            [|| df ||] [|| dg ||] )
  {-# SPECIALISE instance Transcendental ( D3𝔸4 Double ) #-}
  {-# SPECIALISE instance Transcendental ( D3𝔸4 𝕀 ) #-}

--------------------------------------------------------------------------------
-- HasChainRule instances.

instance Differential 2 0 where
  konst w = D0 w
  value ( D0 v ) = v
  {-# INLINEABLE konst #-}

  {-# INLINEABLE value #-}
instance HasChainRule Double 2 ( ℝ 0 ) where
  linearD f v = D0 ( f v )
  chain _ ( D0 gfx ) = D21 gfx origin origin
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE chain #-}

instance Differential 3 0 where
  konst w = D0 w

  value ( D0 v ) = v
  {-# INLINEABLE konst #-}

  {-# INLINEABLE value #-}
instance HasChainRule Double 3 ( ℝ 0 ) where
  linearD f v = D0 ( f v )
  chain _ ( D0 gfx ) = D31 gfx origin origin origin
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE chain #-}

instance Differential 2 1 where
  konst   :: forall w. AbelianGroup w => w -> D2𝔸1 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )

  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
instance HasChainRule Double 2 ( ℝ 1 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 1 -> w ) -> ℝ 1 -> D2𝔸1 w
  linearD f v =
    let !o = origin @Double @( T w )
    in $$( monTabulateQ \ mon ->
              if | isZeroMonomial mon
                 -> [|| f v ||]
                 | Just i <- isLinear mon
                 -> [|| f $$( tabulateQ \ j ->
                                if | j == i
                                   -> [|| 1 ||]
                                   | otherwise
                                   -> [|| 0 ||]
                            ) ||]
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D2𝔸1 ( ℝ 1 ) -> D2𝔸1 w -> D2𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
        !p = (^+^)  @Double @( T w )
        !s = (^*)   @Double @( T w )
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE chain #-}

instance Differential 3 1 where
  konst   :: forall w. AbelianGroup w => w -> D3𝔸1 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )

  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
instance HasChainRule Double 3 ( ℝ 1 ) where

  chain :: forall w. Module Double ( T w ) => D3𝔸1 ( ℝ 1 ) -> D3𝔸1 w -> D3𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
        !p = (^+^)  @Double @( T w )
        !s = (^*)   @Double @( T w )
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  linearD :: forall w. Module Double ( T w ) => ( ℝ 1 -> w ) -> ℝ 1 -> D3𝔸1 w
  linearD f v =
    let !o = origin @Double @( T w )
    in $$( monTabulateQ \ mon ->
              if | isZeroMonomial mon
                 -> [|| f v ||]
                 | Just i <- isLinear mon
                 -> [|| f $$( tabulateQ \ j ->
                                if | j == i
                                   -> [|| 1 ||]
                                   | otherwise
                                   -> [|| 0 ||]
                            ) ||]
                 | otherwise
                 -> [|| unT o ||]
         )
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE chain #-}

instance Differential 2 2 where
  konst   :: forall w. AbelianGroup w => w -> D2𝔸2 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )

  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
instance HasChainRule Double 2 ( ℝ 2 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 2 -> w ) -> ℝ 2 -> D2𝔸2 w
  linearD f v =
    let !o = origin @Double @( T w )
    in $$( monTabulateQ \ mon ->
              if | isZeroMonomial mon
                 -> [|| f v ||]
                 | Just i <- isLinear mon
                 -> [|| f $$( tabulateQ \ j ->
                                if | j == i
                                   -> [|| 1 ||]
                                   | otherwise
                                   -> [|| 0 ||]
                            ) ||]
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D2𝔸1 ( ℝ 2 ) -> D2𝔸2 w -> D2𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
        !p = (^+^)  @Double @( T w )
        !s = (^*)   @Double @( T w )
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE chain #-}

instance Differential 3 2 where
  konst   :: forall w. AbelianGroup w => w -> D3𝔸2 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )

  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
instance HasChainRule Double 3 ( ℝ 2 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 2 -> w ) -> ℝ 2 -> D3𝔸2 w
  linearD f v =
    let !o = origin @Double @( T w )
    in $$( monTabulateQ \ mon ->
              if | isZeroMonomial mon
                 -> [|| f v ||]
                 | Just i <- isLinear mon
                 -> [|| f $$( tabulateQ \ j ->
                                if | j == i
                                   -> [|| 1 ||]
                                   | otherwise
                                   -> [|| 0 ||]
                            ) ||]
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D3𝔸1 ( ℝ 2 ) -> D3𝔸2 w -> D3𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
        !p = (^+^)  @Double @( T w )
        !s = (^*)   @Double @( T w )
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE chain #-}

instance Differential 2 3 where
  konst   :: forall w. AbelianGroup w => w -> D2𝔸3 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )

  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
instance HasChainRule Double 2 ( ℝ 3 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 3 -> w ) -> ℝ 3 -> D2𝔸3 w
  linearD f v =
    let !o = origin @Double @( T w )
    in $$( monTabulateQ \ mon ->
              if | isZeroMonomial mon
                 -> [|| f v ||]
                 | Just i <- isLinear mon
                 -> [|| f $$( tabulateQ \ j ->
                                if | j == i
                                   -> [|| 1 ||]
                                   | otherwise
                                   -> [|| 0 ||]
                            ) ||]
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D2𝔸1 ( ℝ 3 ) -> D2𝔸3 w -> D2𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
        !p = (^+^)  @Double @( T w )
        !s = (^*)   @Double @( T w )
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE chain #-}

instance Differential 3 3 where
  konst   :: forall w. AbelianGroup w => w -> D3𝔸3 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )

  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
instance HasChainRule Double 3 ( ℝ 3 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 3 -> w ) -> ℝ 3 -> D3𝔸3 w
  linearD f v =
    let !o = origin @Double @( T w )
    in $$( monTabulateQ \ mon ->
              if | isZeroMonomial mon
                 -> [|| f v ||]
                 | Just i <- isLinear mon
                 -> [|| f $$( tabulateQ \ j ->
                                if | j == i
                                   -> [|| 1 ||]
                                   | otherwise
                                   -> [|| 0 ||]
                            ) ||]
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D3𝔸1 ( ℝ 3 ) -> D3𝔸3 w -> D3𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
        !p = (^+^)  @Double @( T w )
        !s = (^*)   @Double @( T w )
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE chain #-}
  {-# INLINEABLE linearD #-}

instance Differential 2 4 where
  konst   :: forall w. AbelianGroup w => w -> D2𝔸4 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )

  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}

instance HasChainRule Double 2 ( ℝ 4 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 4 -> w ) -> ℝ 4 -> D2𝔸4 w
  linearD f v =
    let !o = origin @Double @( T w )
    in $$( monTabulateQ \ mon ->
              if | isZeroMonomial mon
                 -> [|| f v ||]
                 | Just i <- isLinear mon
                 -> [|| f $$( tabulateQ \ j ->
                                if | j == i
                                   -> [|| 1 ||]
                                   | otherwise
                                   -> [|| 0 ||]
                            ) ||]
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D2𝔸1 ( ℝ 4 ) -> D2𝔸4 w -> D2𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
        !p = (^+^)  @Double @( T w )
        !s = (^*)   @Double @( T w )
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE chain #-}

instance Differential 3 4 where
  konst   :: forall w. AbelianGroup w => w -> D3𝔸4 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )

  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
instance HasChainRule Double 3 ( ℝ 4 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 4 -> w ) -> ℝ 4 -> D3𝔸4 w
  linearD f v =
    let !o = origin @Double @( T w )
    in $$( monTabulateQ \ mon ->
              if | isZeroMonomial mon
                 -> [|| f v ||]
                 | Just i <- isLinear mon
                 -> [|| f $$( tabulateQ \ j ->
                                if | j == i
                                   -> [|| 1 ||]
                                   | otherwise
                                   -> [|| 0 ||]
                            ) ||]
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D3𝔸1 ( ℝ 4 ) -> D3𝔸4 w -> D3𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
        !p = (^+^)  @Double @( T w )
        !s = (^*)   @Double @( T w )
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE chain #-}