packages feed

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

{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE UndecidableInstances  #-}

module Math.Algebra.Dual.Internal
  ( 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(..)

  , chainRule1NQ, chainRuleN1Q
  ) where

-- base
import GHC.Generics
  ( Generic, Generic1, Generically1(..) )
import GHC.TypeNats
  ( KnownNat )

-- deepseq
import Control.DeepSeq
  ( NFData )

-- template-haskell
import Language.Haskell.TH
  ( CodeQ )
import Language.Haskell.TH.Syntax
  ( Lift(..) )

-- brush-strokes
import Math.Linear
  ( Vec(..), T(..)
  , RepresentableQ(..), RepDim
  , zipIndices
  )
import Math.Monomial
  ( Mon(..), MonomialBasisQ(..), MonomialBasis(..)
  , Vars, Deg
  , mons, zeroMonomial, isZeroMonomial, totalDegree
  , multiSubsetSumFaร , multiSubsetsSum
  , partitionFaร , partitions
  )
import Math.Ring
  ( Ring )
import qualified Math.Ring as Ring
import TH.Utils
  ( foldQ, powQ )

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

-- | \( \mathbb{Z} \).
newtype D๐”ธ0 v = D0 { _D0_v :: v }
  deriving stock   ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D๐”ธ0

-- | \( \mathbb{Z}[x]/(x)^2 \).
data D1๐”ธ1 v =
  D11 { _D11_v :: v
      , _D11_dx :: ( T v )
      }
  deriving stock ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D1๐”ธ1

-- | \( \mathbb{Z}[x]/(x)^3 \).
data D2๐”ธ1 v =
  D21 { _D21_v :: v
      , _D21_dx :: ( T v )
      , _D21_dxdx :: ( T v )
      }
  deriving stock ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D2๐”ธ1

-- | \( \mathbb{Z}[x]/(x)^4 \).
data D3๐”ธ1 v =
  D31 { _D31_v :: v
      , _D31_dx :: ( T v )
      , _D31_dxdx :: ( T v )
      , _D31_dxdxdx :: ( T v )
      }
  deriving stock ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D3๐”ธ1

-- | \( \mathbb{Z}[x, y]/(x, y)^2 \).
data D1๐”ธ2 v =
  D12 { _D12_v :: v
      , _D12_dx, _D12_dy :: ( T v )
      }
  deriving stock ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D1๐”ธ2

-- | \( \mathbb{Z}[x, y]/(x, y)^3 \).
data D2๐”ธ2 v =
  D22 { _D22_v :: v
      , _D22_dx, _D22_dy :: ( T v )
      , _D22_dxdx, _D22_dxdy, _D22_dydy :: ( T v )
      }
  deriving stock ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D2๐”ธ2

-- | \( \mathbb{Z}[x, y]/(x, y)^4 \).
data D3๐”ธ2 v =
  D32 { _D32_v :: v
      , _D32_dx, _D32_dy :: ( T v )
      , _D32_dxdx, _D32_dxdy, _D32_dydy :: ( T v )
      , _D32_dxdxdx, _D32_dxdxdy, _D32_dxdydy, _D32_dydydy :: ( T v )
      }
  deriving stock ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D3๐”ธ2

-- | \( \mathbb{Z}[x, y, z]/(x, y, z)^2 \).
data D1๐”ธ3 v =
  D13 { _D13_v :: v
      , _D13_dx, _D13_dy, _D13_dz :: ( T v )
      }
  deriving stock ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D1๐”ธ3

-- | \( \mathbb{Z}[x, y, z]/(x, y, z)^3 \).
data D2๐”ธ3 v =
  D23 { _D23_v :: v
      , _D23_dx, _D23_dy, _D23_dz :: ( T v )
      , _D23_dxdx, _D23_dxdy, _D23_dydy, _D23_dxdz, _D23_dydz, _D23_dzdz :: ( T v )
      }
  deriving stock ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D2๐”ธ3

-- | \( \mathbb{Z}[x, y, z]/(x, y, z)^4 \).
data D3๐”ธ3 v =
  D33 { _D33_v :: v
      , _D33_dx, _D33_dy, _D33_dz :: ( T v )
      , _D33_dxdx, _D33_dxdy, _D33_dydy, _D33_dxdz, _D33_dydz, _D33_dzdz :: ( T v )
      , _D33_dxdxdx, _D33_dxdxdy, _D33_dxdydy, _D33_dydydy
         , _D33_dxdxdz, _D33_dxdydz, _D33_dxdzdz, _D33_dydydz, _D33_dydzdz, _D33_dzdzdz :: ( T v )
      }
  deriving stock ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D3๐”ธ3

-- | \( \mathbb{Z}[x, y, z, w]/(x, y, z, w)^2 \).
data D1๐”ธ4 v =
  D14 { _D14_v :: v
      , _D14_dx, _D14_dy, _D14_dz, _D14_dw :: ( T v )
      }
  deriving stock ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D1๐”ธ4

-- | \( \mathbb{Z}[x, y, z, w]/(x, y, z, w)^3 \).
data D2๐”ธ4 v =
  D24 { _D24_v :: v
      , _D24_dx, _D24_dy, _D24_dz, _D24_dw :: ( T v )
      , _D24_dxdx, _D24_dxdy, _D24_dydy, _D24_dxdz
         , _D24_dydz, _D24_dzdz, _D24_dxdw, _D24_dydw, _D24_dzdw, _D24_dwdw :: ( T v )
      }
  deriving stock ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D2๐”ธ4

-- | \( \mathbb{Z}[x, y, z, w]/(x, y, z, w)^4 \).
data D3๐”ธ4 v =
  D34 { _D34_v :: v
      , _D34_dx, _D34_dy, _D34_dz, _D34_dw :: ( T v )
      , _D34_dxdx, _D34_dxdy, _D34_dydy, _D34_dxdz, _D34_dydz, _D34_dzdz
        , _D34_dxdw, _D34_dydw, _D34_dzdw, _D34_dwdw :: ( T v )
      , _D34_dxdxdx, _D34_dxdxdy, _D34_dxdydy, _D34_dydydy,
         _D34_dxdxdz, _D34_dxdydz, _D34_dxdzdz, _D34_dydzdz, _D34_dydydz, _D34_dzdzdz,
         _D34_dxdxdw, _D34_dxdydw, _D34_dydydw, _D34_dxdzdw, _D34_dydzdw, _D34_dzdzdw,
         _D34_dxdwdw, _D34_dydwdw, _D34_dzdwdw, _D34_dwdwdw :: ( T v )
      }
  deriving stock ( Show, Eq, Functor, Foldable, Traversable, Generic, Generic1 )
  deriving anyclass NFData
  deriving Applicative
    via Generically1 D3๐”ธ4

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

-- | The chain rule for a composition \( \mathbb{R}^1 \to \mathbb{R}^n \to W \)
--
-- (To be spliced in using Template Haskell.)
chainRule1NQ :: forall dr1 dv v r w d
             .  ( Ring r, RepresentableQ r v
                , MonomialBasisQ dr1, Vars dr1 ~ 1
                , MonomialBasisQ dv , Vars dv  ~ RepDim v
                , Deg dr1 ~ Deg dv
                , d ~ Vars dv, KnownNat d
                )
             => CodeQ ( T w )               -- Module r ( T w )
             -> CodeQ ( T w -> T w -> T w ) --
             -> CodeQ ( T w -> r -> T w )   -- (circumvent TH constraint issue)
             -> CodeQ ( dr1 v )
             -> CodeQ ( dv  w )
             -> CodeQ ( dr1 w )
chainRule1NQ zero_w sum_w scale_w code_df code_dg =
  -- Share df/dg to avoid repeatedly inlining the same large piece of code.
  [|| let { !df0 = $$code_df; !dg0 = $$code_dg } in $$(
      let { df = [|| df0 ||]; dg = [|| dg0 ||] } in
    monTabulateQ @dr1 \ mon ->
      case totalDegree mon of
        -- Set the value of the composition separately,
        -- as that isn't handled by the Faร  di Bruno formula.
        0 -> monIndexQ @dv dg zeroMonomial
        k ->
          -- TODO: explicitly share subexpressions, such as powers of monomials of df.
          [|| unT $
          $$( foldQ sum_w zero_w
              [ [|| $$scale_w ( T $$( monIndexQ @dv dg m_g ) )
                      $$( foldQ [|| (Ring.+) ||] [|| Ring.fromInteger ( 0 :: Integer ) ||]
                            [ [|| Ring.fromInteger $$( liftTyped $ fromIntegral $ multiSubsetSumFaร  k is ) Ring.*
                                 $$( foldQ [|| (Ring.*) ||] [|| Ring.fromInteger ( 1 :: Integer ) ||]
                                    [ foldQ [|| (Ring.*) ||] [|| Ring.fromInteger ( 1 :: Integer ) ||]
                                      [ ( indexQ @r @v ( monIndexQ @dr1 df ( Mon $ Vec [ f_deg ] ) ) v_index )
                                            `powQ` pow
                                      | ( f_deg, pow ) <- pows
                                      ]
                                    | ( v_index, pows ) <- zipIndices is
                                    ]
                                  ) ||]
                            | is <- mss
                            ]
                       )
                  ||]
              | m_g <- mons @_ @d k
              , let mss = multiSubsetsSum [ 1 .. k ] k ( monDegs m_g )
              , not ( null mss ) -- avoid terms of the form x * 0
              ]
            ) ||]
  ) ||]

-- | The chain rule for a composition \( \mathbb{R}^n \to \mathbb{R}^1 \to \mathbb{R}^1 \)
--
-- (To be spliced in using Template Haskell.)
chainRuleN1Q :: forall du dr1 r
             .  ( MonomialBasisQ du
                , MonomialBasisQ dr1, Vars dr1 ~ 1
                )
             => CodeQ ( Integer -> r )   -- ^ fromInteger (circumvent TH constraint issue)
             -> CodeQ ( r -> r -> r )    -- ^ (+) (circumvent TH constraint issue)
             -> CodeQ ( r -> r -> r )    -- ^ (*) (circumvent TH constraint issue)
             -> CodeQ ( r -> Word -> r ) -- ^ (^) (circumvent TH constraint issue)
             -> CodeQ ( du  r )
             -> CodeQ ( dr1 r )
             -> CodeQ ( du  r )
chainRuleN1Q fromInt add times pow code_df code_dg =
  -- Share df/dg to avoid repeatedly inlining the same large piece of code.
  [|| let { !df0 = $$code_df; !dg0 = $$code_dg } in $$(
      let { df = [|| df0 ||]; dg = [|| dg0 ||] } in
    monTabulateQ @du \ mon ->
      if
        | isZeroMonomial mon
        -- Set the value of the composition separately,
        -- as that isn't handled by the Faร  di Bruno formula.
        -> monIndexQ @dr1 dg zeroMonomial
        | otherwise
        -> foldQ add [|| $$fromInt ( 0 :: Integer ) ||]
            [ [|| $$times $$( monIndexQ @dr1 dg ( Mon ( Vec [ k ] ) ) )
                  $$( foldQ add [|| $$fromInt ( 0 :: Integer ) ||]
                      [ [|| $$times ( $$fromInt $$( liftTyped $ fromIntegral $ partitionFaร  mon is ) )
                            $$( foldQ times [|| $$fromInt ( 1 :: Integer ) ||]
                               [ [|| $$pow $$( monIndexQ @du df f_mon ) p ||]
                               | ( f_mon, p ) <- is
                               ]
                             ) ||]
                      | is <- mss
                      ]
                   )
                ||]
            | k <- [ 1 .. totalDegree mon ]
            , let mss = partitions k mon
            ] ) ||]

--------------------------------------------------------------------------------
-- MonomialBasisQ instances follow (nothing else).

type instance Deg  D๐”ธ0 = 0
type instance Vars D๐”ธ0 = 0
instance MonomialBasisQ D๐”ธ0 where
  monTabulateQ f =
    [|| let
          _D0_v = $$( f $ Mon ( Vec [ ] ) )
        in D0 { .. }
      ||]

  monIndexQ d _ = [|| _D0_v $$d ||]

type instance Deg  D1๐”ธ1 = 1
type instance Vars D1๐”ธ1 = 1
instance MonomialBasisQ D1๐”ธ1 where
  monTabulateQ f =
    [|| let
          _D11_v    =   $$( f $ Mon ( Vec [ 0 ] ) )
          _D11_dx   = T $$( f $ Mon ( Vec [ 1 ] ) )
        in D11 { .. }
      ||]

  monIndexQ d = \ case
    Mon ( Vec [ 1 ] ) -> [|| unT $ _D11_dx   $$d ||]
    _                 -> [||       _D11_v    $$d ||]

instance MonomialBasis D1๐”ธ1 where
  monTabulate f =
    let
      _D11_v    =     f $ Mon ( Vec [ 0 ] )
      _D11_dx   = T $ f $ Mon ( Vec [ 1 ] )
    in D11 { .. }
  {-# INLINE monTabulate #-}

  monIndex d = \ case
    Mon ( Vec [ 1 ] ) -> unT $ _D11_dx d
    _                 ->       _D11_v  d
  {-# INLINE monIndex #-}

type instance Deg  D2๐”ธ1 = 2
type instance Vars D2๐”ธ1 = 1
instance MonomialBasisQ D2๐”ธ1 where
  monTabulateQ f =
    [|| let
          _D21_v    =   $$( f $ Mon ( Vec [ 0 ] ) )
          _D21_dx   = T $$( f $ Mon ( Vec [ 1 ] ) )
          _D21_dxdx = T $$( f $ Mon ( Vec [ 2 ] ) )
        in D21 { .. }
      ||]

  monIndexQ d = \ case
    Mon ( Vec [ 1 ] ) -> [|| unT $ _D21_dx   $$d ||]
    Mon ( Vec [ 2 ] ) -> [|| unT $ _D21_dxdx $$d ||]
    _                 -> [||       _D21_v    $$d ||]

type instance Deg  D3๐”ธ1 = 3
type instance Vars D3๐”ธ1 = 1
instance MonomialBasisQ D3๐”ธ1 where
  monTabulateQ f =
    [|| let
          _D31_v      =   $$( f $ Mon ( Vec [ 0 ] ) )
          _D31_dx     = T $$( f $ Mon ( Vec [ 1 ] ) )
          _D31_dxdx   = T $$( f $ Mon ( Vec [ 2 ] ) )
          _D31_dxdxdx = T $$( f $ Mon ( Vec [ 3 ] ) )
        in D31 { .. }
      ||]

  monIndexQ d = \ case
    Mon ( Vec [ 1 ] ) -> [|| unT $ _D31_dx     $$d ||]
    Mon ( Vec [ 2 ] ) -> [|| unT $ _D31_dxdx   $$d ||]
    Mon ( Vec [ 3 ] ) -> [|| unT $ _D31_dxdxdx $$d ||]
    _                 -> [||       _D31_v      $$d ||]

type instance Deg  D1๐”ธ2 = 1
type instance Vars D1๐”ธ2 = 2
instance MonomialBasisQ D1๐”ธ2 where
  monTabulateQ f =
    [|| let
          _D12_v    =   $$( f $ Mon ( Vec [ 0, 0 ] ) )
          _D12_dx   = T $$( f $ Mon ( Vec [ 1, 0 ] ) )
          _D12_dy   = T $$( f $ Mon ( Vec [ 0, 1 ] ) )
        in D12 { .. }
      ||]

  monIndexQ d = \ case
    Mon ( Vec [ 1, 0 ] ) -> [|| unT $ _D12_dx $$d ||]
    Mon ( Vec [ 0, 1 ] ) -> [|| unT $ _D12_dy $$d ||]
    _                    -> [||       _D12_v  $$d ||]


instance MonomialBasis D1๐”ธ2 where
  monTabulate f =
    let
      _D12_v    =     f $ Mon ( Vec [ 0, 0 ] )
      _D12_dx   = T $ f $ Mon ( Vec [ 1, 0 ] )
      _D12_dy   = T $ f $ Mon ( Vec [ 0, 1 ] )
    in D12 { .. }
  {-# INLINE monTabulate #-}

  monIndex d = \ case
    Mon ( Vec [ 1, 0 ] ) -> unT $ _D12_dx d
    Mon ( Vec [ 0, 1 ] ) -> unT $ _D12_dy d
    _                    ->       _D12_v  d
  {-# INLINE monIndex #-}

type instance Deg  D2๐”ธ2 = 2
type instance Vars D2๐”ธ2 = 2
instance MonomialBasisQ D2๐”ธ2 where
  monTabulateQ f =
    [|| let
          _D22_v    =   $$( f $ Mon ( Vec [ 0, 0 ] ) )
          _D22_dx   = T $$( f $ Mon ( Vec [ 1, 0 ] ) )
          _D22_dy   = T $$( f $ Mon ( Vec [ 0, 1 ] ) )
          _D22_dxdx = T $$( f $ Mon ( Vec [ 2, 0 ] ) )
          _D22_dxdy = T $$( f $ Mon ( Vec [ 1, 1 ] ) )
          _D22_dydy = T $$( f $ Mon ( Vec [ 0, 2 ] ) )
        in D22 { .. }
      ||]

  monIndexQ d = \ case
    Mon ( Vec [ 1, 0 ] ) -> [|| unT $ _D22_dx   $$d ||]
    Mon ( Vec [ 0, 1 ] ) -> [|| unT $ _D22_dy   $$d ||]
    Mon ( Vec [ 2, 0 ] ) -> [|| unT $ _D22_dxdx $$d ||]
    Mon ( Vec [ 1, 1 ] ) -> [|| unT $ _D22_dxdy $$d ||]
    Mon ( Vec [ 0, 2 ] ) -> [|| unT $ _D22_dydy $$d ||]
    _                    -> [||       _D22_v    $$d ||]

type instance Deg  D3๐”ธ2 = 3
type instance Vars D3๐”ธ2 = 2
instance MonomialBasisQ D3๐”ธ2 where
  monTabulateQ f =
    [|| let
          _D32_v      =   $$( f $ Mon ( Vec [ 0, 0 ] ) )
          _D32_dx     = T $$( f $ Mon ( Vec [ 1, 0 ] ) )
          _D32_dy     = T $$( f $ Mon ( Vec [ 0, 1 ] ) )
          _D32_dxdx   = T $$( f $ Mon ( Vec [ 2, 0 ] ) )
          _D32_dxdy   = T $$( f $ Mon ( Vec [ 1, 1 ] ) )
          _D32_dydy   = T $$( f $ Mon ( Vec [ 0, 2 ] ) )
          _D32_dxdxdx = T $$( f $ Mon ( Vec [ 3, 0 ] ) )
          _D32_dxdxdy = T $$( f $ Mon ( Vec [ 2, 1 ] ) )
          _D32_dxdydy = T $$( f $ Mon ( Vec [ 1, 2 ] ) )
          _D32_dydydy = T $$( f $ Mon ( Vec [ 0, 3 ] ) )
       in D32 { .. } ||]

  monIndexQ d = \ case
    Mon ( Vec [ 1, 0 ] ) -> [|| unT $ _D32_dx     $$d ||]
    Mon ( Vec [ 0, 1 ] ) -> [|| unT $ _D32_dy     $$d ||]
    Mon ( Vec [ 2, 0 ] ) -> [|| unT $ _D32_dxdx   $$d ||]
    Mon ( Vec [ 1, 1 ] ) -> [|| unT $ _D32_dxdy   $$d ||]
    Mon ( Vec [ 0, 2 ] ) -> [|| unT $ _D32_dydy   $$d ||]
    Mon ( Vec [ 3, 0 ] ) -> [|| unT $ _D32_dxdxdx $$d ||]
    Mon ( Vec [ 2, 1 ] ) -> [|| unT $ _D32_dxdxdy $$d ||]
    Mon ( Vec [ 1, 2 ] ) -> [|| unT $ _D32_dxdydy $$d ||]
    Mon ( Vec [ 0, 3 ] ) -> [|| unT $ _D32_dydydy $$d ||]
    _                    -> [||       _D32_v      $$d ||]

type instance Deg  D1๐”ธ3 = 1
type instance Vars D1๐”ธ3 = 3
instance MonomialBasisQ D1๐”ธ3 where
  monTabulateQ f =
    [|| let
          !_D13_v    =   $$( f ( Mon ( Vec [ 0, 0, 0 ] ) ) )
          !_D13_dx   = T $$( f ( Mon ( Vec [ 1, 0, 0 ] ) ) )
          !_D13_dy   = T $$( f ( Mon ( Vec [ 0, 1, 0 ] ) ) )
          !_D13_dz   = T $$( f ( Mon ( Vec [ 0, 0, 1 ] ) ) )
        in D13 { .. }
      ||]

  monIndexQ d = \ case
    Mon ( Vec [ 1, 0, 0 ] ) -> [|| unT $ _D13_dx $$d ||]
    Mon ( Vec [ 0, 1, 0 ] ) -> [|| unT $ _D13_dy $$d ||]
    Mon ( Vec [ 0, 0, 1 ] ) -> [|| unT $ _D13_dz $$d ||]
    _                       -> [||       _D13_v  $$d ||]

instance MonomialBasis D1๐”ธ3 where
  monTabulate f =
    let
      !_D13_v    =     f ( Mon ( Vec [ 0, 0, 0 ] ) )
      !_D13_dx   = T $ f ( Mon ( Vec [ 1, 0, 0 ] ) )
      !_D13_dy   = T $ f ( Mon ( Vec [ 0, 1, 0 ] ) )
      !_D13_dz   = T $ f ( Mon ( Vec [ 0, 0, 1 ] ) )
    in D13 { .. }
  {-# INLINE monTabulate #-}

  monIndex d = \ case
    Mon ( Vec [ 1, 0, 0 ] ) -> unT $ _D13_dx d
    Mon ( Vec [ 0, 1, 0 ] ) -> unT $ _D13_dy d
    Mon ( Vec [ 0, 0, 1 ] ) -> unT $ _D13_dz d
    _                       ->       _D13_v  d
  {-# INLINE monIndex #-}

type instance Deg  D2๐”ธ3 = 2
type instance Vars D2๐”ธ3 = 3
instance MonomialBasisQ D2๐”ธ3 where
  monTabulateQ f =
    [|| let
          _D23_v    =   $$( f $ Mon ( Vec [ 0, 0, 0 ] ) )
          _D23_dx   = T $$( f $ Mon ( Vec [ 1, 0, 0 ] ) )
          _D23_dy   = T $$( f $ Mon ( Vec [ 0, 1, 0 ] ) )
          _D23_dz   = T $$( f $ Mon ( Vec [ 0, 0, 1 ] ) )
          _D23_dxdx = T $$( f $ Mon ( Vec [ 2, 0, 0 ] ) )
          _D23_dxdy = T $$( f $ Mon ( Vec [ 1, 1, 0 ] ) )
          _D23_dydy = T $$( f $ Mon ( Vec [ 0, 2, 0 ] ) )
          _D23_dxdz = T $$( f $ Mon ( Vec [ 1, 0, 1 ] ) )
          _D23_dydz = T $$( f $ Mon ( Vec [ 0, 1, 1 ] ) )
          _D23_dzdz = T $$( f $ Mon ( Vec [ 0, 0, 2 ] ) )
        in D23 { .. }
      ||]

  monIndexQ d = \ case
    Mon ( Vec [ 1, 0, 0 ] ) -> [|| unT $ _D23_dx   $$d ||]
    Mon ( Vec [ 0, 1, 0 ] ) -> [|| unT $ _D23_dy   $$d ||]
    Mon ( Vec [ 0, 0, 1 ] ) -> [|| unT $ _D23_dz   $$d ||]
    Mon ( Vec [ 2, 0, 0 ] ) -> [|| unT $ _D23_dxdx $$d ||]
    Mon ( Vec [ 1, 1, 0 ] ) -> [|| unT $ _D23_dxdy $$d ||]
    Mon ( Vec [ 0, 2, 0 ] ) -> [|| unT $ _D23_dydy $$d ||]
    Mon ( Vec [ 1, 0, 1 ] ) -> [|| unT $ _D23_dxdz $$d ||]
    Mon ( Vec [ 0, 1, 1 ] ) -> [|| unT $ _D23_dydz $$d ||]
    Mon ( Vec [ 0, 0, 2 ] ) -> [|| unT $ _D23_dzdz $$d ||]
    _                       -> [||       _D23_v    $$d ||]


type instance Deg  D3๐”ธ3 = 3
type instance Vars D3๐”ธ3 = 3
instance MonomialBasisQ D3๐”ธ3 where
  monTabulateQ f =
    [|| let
          _D33_v      =   $$( f $ Mon ( Vec [ 0, 0, 0 ] ) )
          _D33_dx     = T $$( f $ Mon ( Vec [ 1, 0, 0 ] ) )
          _D33_dy     = T $$( f $ Mon ( Vec [ 0, 1, 0 ] ) )
          _D33_dz     = T $$( f $ Mon ( Vec [ 0, 0, 1 ] ) )
          _D33_dxdx   = T $$( f $ Mon ( Vec [ 2, 0, 0 ] ) )
          _D33_dxdy   = T $$( f $ Mon ( Vec [ 1, 1, 0 ] ) )
          _D33_dydy   = T $$( f $ Mon ( Vec [ 0, 2, 0 ] ) )
          _D33_dxdz   = T $$( f $ Mon ( Vec [ 1, 0, 1 ] ) )
          _D33_dydz   = T $$( f $ Mon ( Vec [ 0, 1, 1 ] ) )
          _D33_dzdz   = T $$( f $ Mon ( Vec [ 0, 0, 2 ] ) )
          _D33_dxdxdx = T $$( f $ Mon ( Vec [ 3, 0, 0 ] ) )
          _D33_dxdxdy = T $$( f $ Mon ( Vec [ 2, 1, 0 ] ) )
          _D33_dxdydy = T $$( f $ Mon ( Vec [ 1, 2, 0 ] ) )
          _D33_dydydy = T $$( f $ Mon ( Vec [ 0, 3, 0 ] ) )
          _D33_dxdxdz = T $$( f $ Mon ( Vec [ 2, 0, 1 ] ) )
          _D33_dxdydz = T $$( f $ Mon ( Vec [ 1, 1, 1 ] ) )
          _D33_dxdzdz = T $$( f $ Mon ( Vec [ 1, 0, 2 ] ) )
          _D33_dydydz = T $$( f $ Mon ( Vec [ 0, 2, 1 ] ) )
          _D33_dydzdz = T $$( f $ Mon ( Vec [ 0, 1, 2 ] ) )
          _D33_dzdzdz = T $$( f $ Mon ( Vec [ 0, 0, 3 ] ) )
       in D33 { .. } ||]

  monIndexQ d = \ case
    Mon ( Vec [ 1, 0, 0 ] ) -> [|| unT $ _D33_dx     $$d ||]
    Mon ( Vec [ 0, 1, 0 ] ) -> [|| unT $ _D33_dy     $$d ||]
    Mon ( Vec [ 0, 0, 1 ] ) -> [|| unT $ _D33_dz     $$d ||]
    Mon ( Vec [ 2, 0, 0 ] ) -> [|| unT $ _D33_dxdx   $$d ||]
    Mon ( Vec [ 1, 1, 0 ] ) -> [|| unT $ _D33_dxdy   $$d ||]
    Mon ( Vec [ 0, 2, 0 ] ) -> [|| unT $ _D33_dydy   $$d ||]
    Mon ( Vec [ 1, 0, 1 ] ) -> [|| unT $ _D33_dxdz   $$d ||]
    Mon ( Vec [ 0, 1, 1 ] ) -> [|| unT $ _D33_dydz   $$d ||]
    Mon ( Vec [ 0, 0, 2 ] ) -> [|| unT $ _D33_dzdz   $$d ||]
    Mon ( Vec [ 3, 0, 0 ] ) -> [|| unT $ _D33_dxdxdx $$d ||]
    Mon ( Vec [ 2, 1, 0 ] ) -> [|| unT $ _D33_dxdxdy $$d ||]
    Mon ( Vec [ 1, 2, 0 ] ) -> [|| unT $ _D33_dxdydy $$d ||]
    Mon ( Vec [ 0, 3, 0 ] ) -> [|| unT $ _D33_dydydy $$d ||]
    Mon ( Vec [ 2, 0, 1 ] ) -> [|| unT $ _D33_dxdxdz $$d ||]
    Mon ( Vec [ 1, 1, 1 ] ) -> [|| unT $ _D33_dxdydz $$d ||]
    Mon ( Vec [ 1, 0, 2 ] ) -> [|| unT $ _D33_dxdzdz $$d ||]
    Mon ( Vec [ 0, 2, 1 ] ) -> [|| unT $ _D33_dydydz $$d ||]
    Mon ( Vec [ 0, 1, 2 ] ) -> [|| unT $ _D33_dydzdz $$d ||]
    Mon ( Vec [ 0, 0, 3 ] ) -> [|| unT $ _D33_dzdzdz $$d ||]
    _                       -> [||       _D33_v      $$d ||]

type instance Deg  D1๐”ธ4 = 1
type instance Vars D1๐”ธ4 = 4
instance MonomialBasisQ D1๐”ธ4 where
  monTabulateQ f =
    [|| let
          _D14_v    =   $$( f $ Mon ( Vec [ 0, 0, 0, 0 ] ) )
          _D14_dx   = T $$( f $ Mon ( Vec [ 1, 0, 0, 0 ] ) )
          _D14_dy   = T $$( f $ Mon ( Vec [ 0, 1, 0, 0 ] ) )
          _D14_dz   = T $$( f $ Mon ( Vec [ 0, 0, 1, 0 ] ) )
          _D14_dw   = T $$( f $ Mon ( Vec [ 0, 0, 0, 1 ] ) )
        in D14 { .. } ||]

  monIndexQ d = \ case
    Mon ( Vec [ 1, 0, 0, 0 ] ) -> [|| unT $ _D14_dx   $$d ||]
    Mon ( Vec [ 0, 1, 0, 0 ] ) -> [|| unT $ _D14_dy   $$d ||]
    Mon ( Vec [ 0, 0, 1, 0 ] ) -> [|| unT $ _D14_dz   $$d ||]
    Mon ( Vec [ 0, 0, 0, 1 ] ) -> [|| unT $ _D14_dw   $$d ||]
    _                          -> [||       _D14_v    $$d ||]

type instance Deg  D2๐”ธ4 = 2
type instance Vars D2๐”ธ4 = 4
instance MonomialBasisQ D2๐”ธ4 where
  monTabulateQ f =
    [|| let
          _D24_v    =   $$( f $ Mon ( Vec [ 0, 0, 0, 0 ] ) )
          _D24_dx   = T $$( f $ Mon ( Vec [ 1, 0, 0, 0 ] ) )
          _D24_dy   = T $$( f $ Mon ( Vec [ 0, 1, 0, 0 ] ) )
          _D24_dz   = T $$( f $ Mon ( Vec [ 0, 0, 1, 0 ] ) )
          _D24_dw   = T $$( f $ Mon ( Vec [ 0, 0, 0, 1 ] ) )
          _D24_dxdx = T $$( f $ Mon ( Vec [ 2, 0, 0, 0 ] ) )
          _D24_dxdy = T $$( f $ Mon ( Vec [ 1, 1, 0, 0 ] ) )
          _D24_dydy = T $$( f $ Mon ( Vec [ 0, 2, 0, 0 ] ) )
          _D24_dxdz = T $$( f $ Mon ( Vec [ 1, 0, 1, 0 ] ) )
          _D24_dydz = T $$( f $ Mon ( Vec [ 0, 1, 1, 0 ] ) )
          _D24_dzdz = T $$( f $ Mon ( Vec [ 0, 0, 2, 0 ] ) )
          _D24_dxdw = T $$( f $ Mon ( Vec [ 1, 0, 0, 1 ] ) )
          _D24_dydw = T $$( f $ Mon ( Vec [ 0, 1, 0, 1 ] ) )
          _D24_dzdw = T $$( f $ Mon ( Vec [ 0, 0, 1, 1 ] ) )
          _D24_dwdw = T $$( f $ Mon ( Vec [ 0, 0, 0, 2 ] ) )
        in D24 { .. } ||]

  monIndexQ d = \ case
    Mon ( Vec [ 1, 0, 0, 0 ] ) -> [|| unT $ _D24_dx   $$d ||]
    Mon ( Vec [ 0, 1, 0, 0 ] ) -> [|| unT $ _D24_dy   $$d ||]
    Mon ( Vec [ 0, 0, 1, 0 ] ) -> [|| unT $ _D24_dz   $$d ||]
    Mon ( Vec [ 0, 0, 0, 1 ] ) -> [|| unT $ _D24_dw   $$d ||]
    Mon ( Vec [ 2, 0, 0, 0 ] ) -> [|| unT $ _D24_dxdx $$d ||]
    Mon ( Vec [ 1, 1, 0, 0 ] ) -> [|| unT $ _D24_dxdy $$d ||]
    Mon ( Vec [ 0, 2, 0, 0 ] ) -> [|| unT $ _D24_dydy $$d ||]
    Mon ( Vec [ 1, 0, 1, 0 ] ) -> [|| unT $ _D24_dxdz $$d ||]
    Mon ( Vec [ 0, 1, 1, 0 ] ) -> [|| unT $ _D24_dydz $$d ||]
    Mon ( Vec [ 0, 0, 2, 0 ] ) -> [|| unT $ _D24_dzdz $$d ||]
    Mon ( Vec [ 1, 0, 0, 1 ] ) -> [|| unT $ _D24_dxdw $$d ||]
    Mon ( Vec [ 0, 1, 0, 1 ] ) -> [|| unT $ _D24_dydw $$d ||]
    Mon ( Vec [ 0, 0, 1, 1 ] ) -> [|| unT $ _D24_dzdw $$d ||]
    Mon ( Vec [ 0, 0, 0, 2 ] ) -> [|| unT $ _D24_dwdw $$d ||]
    _                          -> [||       _D24_v    $$d ||]


type instance Deg  D3๐”ธ4 = 3
type instance Vars D3๐”ธ4 = 4
instance MonomialBasisQ D3๐”ธ4 where
  monTabulateQ f =
    [|| let
          _D34_v      =   $$( f $ Mon ( Vec [ 0, 0, 0, 0 ] ) )
          _D34_dx     = T $$( f $ Mon ( Vec [ 1, 0, 0, 0 ] ) )
          _D34_dy     = T $$( f $ Mon ( Vec [ 0, 1, 0, 0 ] ) )
          _D34_dz     = T $$( f $ Mon ( Vec [ 0, 0, 1, 0 ] ) )
          _D34_dw     = T $$( f $ Mon ( Vec [ 0, 0, 0, 1 ] ) )
          _D34_dxdx   = T $$( f $ Mon ( Vec [ 2, 0, 0, 0 ] ) )
          _D34_dxdy   = T $$( f $ Mon ( Vec [ 1, 1, 0, 0 ] ) )
          _D34_dydy   = T $$( f $ Mon ( Vec [ 0, 2, 0, 0 ] ) )
          _D34_dxdz   = T $$( f $ Mon ( Vec [ 1, 0, 1, 0 ] ) )
          _D34_dydz   = T $$( f $ Mon ( Vec [ 0, 1, 1, 0 ] ) )
          _D34_dzdz   = T $$( f $ Mon ( Vec [ 0, 0, 2, 0 ] ) )
          _D34_dxdw   = T $$( f $ Mon ( Vec [ 1, 0, 0, 1 ] ) )
          _D34_dydw   = T $$( f $ Mon ( Vec [ 0, 1, 0, 1 ] ) )
          _D34_dzdw   = T $$( f $ Mon ( Vec [ 0, 0, 1, 1 ] ) )
          _D34_dwdw   = T $$( f $ Mon ( Vec [ 0, 0, 0, 2 ] ) )
          _D34_dxdxdx = T $$( f $ Mon ( Vec [ 3, 0, 0, 0 ] ) )
          _D34_dxdxdy = T $$( f $ Mon ( Vec [ 2, 1, 0, 0 ] ) )
          _D34_dxdydy = T $$( f $ Mon ( Vec [ 1, 2, 0, 0 ] ) )
          _D34_dydydy = T $$( f $ Mon ( Vec [ 0, 3, 0, 0 ] ) )
          _D34_dxdxdz = T $$( f $ Mon ( Vec [ 2, 0, 1, 0 ] ) )
          _D34_dxdydz = T $$( f $ Mon ( Vec [ 1, 1, 1, 0 ] ) )
          _D34_dxdzdz = T $$( f $ Mon ( Vec [ 1, 0, 2, 0 ] ) )
          _D34_dydydz = T $$( f $ Mon ( Vec [ 0, 2, 1, 0 ] ) )
          _D34_dydzdz = T $$( f $ Mon ( Vec [ 0, 1, 2, 0 ] ) )
          _D34_dzdzdz = T $$( f $ Mon ( Vec [ 0, 0, 3, 0 ] ) )
          _D34_dxdxdw = T $$( f $ Mon ( Vec [ 2, 0, 0, 1 ] ) )
          _D34_dxdydw = T $$( f $ Mon ( Vec [ 1, 1, 0, 1 ] ) )
          _D34_dydydw = T $$( f $ Mon ( Vec [ 0, 2, 0, 1 ] ) )
          _D34_dxdzdw = T $$( f $ Mon ( Vec [ 1, 0, 1, 1 ] ) )
          _D34_dydzdw = T $$( f $ Mon ( Vec [ 0, 1, 1, 1 ] ) )
          _D34_dzdzdw = T $$( f $ Mon ( Vec [ 0, 0, 2, 1 ] ) )
          _D34_dxdwdw = T $$( f $ Mon ( Vec [ 1, 0, 0, 2 ] ) )
          _D34_dydwdw = T $$( f $ Mon ( Vec [ 0, 1, 0, 2 ] ) )
          _D34_dzdwdw = T $$( f $ Mon ( Vec [ 0, 0, 1, 2 ] ) )
          _D34_dwdwdw = T $$( f $ Mon ( Vec [ 0, 0, 0, 3 ] ) )
        in D34 { .. } ||]

  monIndexQ d = \ case
    Mon ( Vec [ 1, 0, 0, 0 ] ) -> [|| unT $ _D34_dx     $$d ||]
    Mon ( Vec [ 0, 1, 0, 0 ] ) -> [|| unT $ _D34_dy     $$d ||]
    Mon ( Vec [ 0, 0, 1, 0 ] ) -> [|| unT $ _D34_dz     $$d ||]
    Mon ( Vec [ 0, 0, 0, 1 ] ) -> [|| unT $ _D34_dw     $$d ||]
    Mon ( Vec [ 2, 0, 0, 0 ] ) -> [|| unT $ _D34_dxdx   $$d ||]
    Mon ( Vec [ 1, 1, 0, 0 ] ) -> [|| unT $ _D34_dxdy   $$d ||]
    Mon ( Vec [ 0, 2, 0, 0 ] ) -> [|| unT $ _D34_dydy   $$d ||]
    Mon ( Vec [ 1, 0, 1, 0 ] ) -> [|| unT $ _D34_dxdz   $$d ||]
    Mon ( Vec [ 0, 1, 1, 0 ] ) -> [|| unT $ _D34_dydz   $$d ||]
    Mon ( Vec [ 0, 0, 2, 0 ] ) -> [|| unT $ _D34_dzdz   $$d ||]
    Mon ( Vec [ 1, 0, 0, 1 ] ) -> [|| unT $ _D34_dxdw   $$d ||]
    Mon ( Vec [ 0, 1, 0, 1 ] ) -> [|| unT $ _D34_dydw   $$d ||]
    Mon ( Vec [ 0, 0, 1, 1 ] ) -> [|| unT $ _D34_dzdw   $$d ||]
    Mon ( Vec [ 0, 0, 0, 2 ] ) -> [|| unT $ _D34_dwdw   $$d ||]
    Mon ( Vec [ 3, 0, 0, 0 ] ) -> [|| unT $ _D34_dxdxdx $$d ||]
    Mon ( Vec [ 2, 1, 0, 0 ] ) -> [|| unT $ _D34_dxdxdy $$d ||]
    Mon ( Vec [ 1, 2, 0, 0 ] ) -> [|| unT $ _D34_dxdydy $$d ||]
    Mon ( Vec [ 0, 3, 0, 0 ] ) -> [|| unT $ _D34_dydydy $$d ||]
    Mon ( Vec [ 2, 0, 1, 0 ] ) -> [|| unT $ _D34_dxdxdz $$d ||]
    Mon ( Vec [ 1, 1, 1, 0 ] ) -> [|| unT $ _D34_dxdydz $$d ||]
    Mon ( Vec [ 1, 0, 2, 0 ] ) -> [|| unT $ _D34_dxdzdz $$d ||]
    Mon ( Vec [ 0, 2, 1, 0 ] ) -> [|| unT $ _D34_dydydz $$d ||]
    Mon ( Vec [ 0, 1, 2, 0 ] ) -> [|| unT $ _D34_dydzdz $$d ||]
    Mon ( Vec [ 0, 0, 3, 0 ] ) -> [|| unT $ _D34_dzdzdz $$d ||]
    Mon ( Vec [ 2, 0, 0, 1 ] ) -> [|| unT $ _D34_dxdxdw $$d ||]
    Mon ( Vec [ 1, 1, 0, 1 ] ) -> [|| unT $ _D34_dxdydw $$d ||]
    Mon ( Vec [ 0, 2, 0, 1 ] ) -> [|| unT $ _D34_dydydw $$d ||]
    Mon ( Vec [ 1, 0, 1, 1 ] ) -> [|| unT $ _D34_dxdzdw $$d ||]
    Mon ( Vec [ 0, 1, 1, 1 ] ) -> [|| unT $ _D34_dydzdw $$d ||]
    Mon ( Vec [ 0, 0, 2, 1 ] ) -> [|| unT $ _D34_dzdzdw $$d ||]
    Mon ( Vec [ 1, 0, 0, 2 ] ) -> [|| unT $ _D34_dxdwdw $$d ||]
    Mon ( Vec [ 0, 1, 0, 2 ] ) -> [|| unT $ _D34_dydwdw $$d ||]
    Mon ( Vec [ 0, 0, 1, 2 ] ) -> [|| unT $ _D34_dzdwdw $$d ||]
    Mon ( Vec [ 0, 0, 0, 3 ] ) -> [|| unT $ _D34_dwdwdw $$d ||]
    _                          -> [||       _D34_v      $$d ||]