{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE UnicodeSyntax        #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE Rank2Types           #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE EmptyCase            #-}
{-# LANGUAGE CPP                  #-}

module Data.Colour.Manifold (
         -- * Full colour space
           Colour, QuantisedColour(..)
         -- * 2D/1D projected colour space
         , ColourMap, planarColourMap, colourCurve, colourMapPlane, spectralSwing
         , ColourPlane, cpCold, cpNeutral, cpHot, spanColourPlane 
         -- * Mapping data to colours
         , ColourMappable(..)
         -- * Predefined colour maps
         , SimpleColourMap, blackBlueYellowRed, brightVsRed, redVsBlue
         ) where

import Data.Colour.Manifold.Internal

import Data.Functor (($>))
import Control.Applicative (empty)
import Control.Applicative.Constrained
import Control.Arrow.Constrained
import Data.Semigroup

import Data.Manifold.PseudoAffine
import Math.Manifold.Core.PseudoAffine (GenericNeedle(..))
import Data.Manifold.Types
import Data.Manifold.Atlas
import Data.Manifold.Riemannian
import Data.VectorSpace
import Data.Basis
import Data.AffineSpace
import Data.AdditiveGroup
import Data.Manifold.Shade (Shade(..), Shade'(..)
                           , rangeWithinVertices
                           )
#if MIN_VERSION_manifolds(0,6,0)
import Data.Manifold.WithBoundary
#endif
import Data.Colour.SRGB (toSRGB, toSRGB24)
import Data.Colour.SRGB.Linear
import Data.Colour.RGBSpace.HSL (hslView, hsl)
import Data.Colour hiding (AffineSpace)
import Data.Colour.Names

import Math.LinearMap.Category
import Linear.V2
import Linear.V3

import qualified Prelude as Hask
import Control.Category.Constrained.Prelude

import Codec.Picture.Types

import qualified Test.QuickCheck as QC

import Data.Coerce
import Data.Type.Coercion
import Data.CallStack

import Control.Lens
import GHC.Generics

instance QC.Arbitrary ColourNeedle where
  arbitrary :: Gen ColourNeedle
arbitrary = RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> Gen (RGB ℝ) -> Gen ColourNeedle
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> (
                   ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB (ℝ -> ℝ -> ℝ -> RGB ℝ) -> Gen ℝ -> Gen (ℝ -> ℝ -> RGB ℝ)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Gen ℝ
forall a. Arbitrary a => Gen a
QC.arbitrary Gen (ℝ -> ℝ -> RGB ℝ) -> Gen ℝ -> Gen (ℝ -> RGB ℝ)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
 ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
 ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
 Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*> Gen ℝ
forall a. Arbitrary a => Gen a
QC.arbitrary Gen (ℝ -> RGB ℝ) -> Gen ℝ -> Gen (RGB ℝ)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
 ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
 ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
 Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*> Gen ℝ
forall a. Arbitrary a => Gen a
QC.arbitrary )


asV3Tensor :: (ColourNeedle⊗w) -+> (V3 ℝ⊗w)
asV3Tensor :: (ColourNeedle ⊗ w) -+> (V3 ℝ ⊗ w)
asV3Tensor = (Tensor ℝ ColourNeedle w -> Tensor ℝ (V3 ℝ) w)
-> LinearFunction ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ (V3 ℝ) w)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((Tensor ℝ ColourNeedle w -> Tensor ℝ (V3 ℝ) w)
 -> LinearFunction ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ (V3 ℝ) w))
-> (Tensor ℝ ColourNeedle w -> Tensor ℝ (V3 ℝ) w)
-> LinearFunction ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ (V3 ℝ) w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (RGB r g b)) -> V3 w -> Tensor ℝ (V3 ℝ) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (V3 w -> Tensor ℝ (V3 ℝ) w) -> V3 w -> Tensor ℝ (V3 ℝ) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> V3 w
forall a. a -> a -> a -> V3 a
V3 w
r w
g w
b

fromV3Tensor :: (V3 ℝ⊗w) -+> (ColourNeedle⊗w)
fromV3Tensor :: (V3 ℝ ⊗ w) -+> (ColourNeedle ⊗ w)
fromV3Tensor = (Tensor ℝ (V3 ℝ) w -> Tensor ℝ ColourNeedle w)
-> LinearFunction ℝ (Tensor ℝ (V3 ℝ) w) (Tensor ℝ ColourNeedle w)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((Tensor ℝ (V3 ℝ) w -> Tensor ℝ ColourNeedle w)
 -> LinearFunction ℝ (Tensor ℝ (V3 ℝ) w) (Tensor ℝ ColourNeedle w))
-> (Tensor ℝ (V3 ℝ) w -> Tensor ℝ ColourNeedle w)
-> LinearFunction ℝ (Tensor ℝ (V3 ℝ) w) (Tensor ℝ ColourNeedle w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (V3 r g b)) -> RGB w -> Tensor ℝ ColourNeedle w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (RGB w -> Tensor ℝ ColourNeedle w)
-> RGB w -> Tensor ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB w
r w
g w
b

fromV3LinMap :: (V3 ℝ+>w) -+> (ColourNeedle+>w)
fromV3LinMap :: (V3 ℝ +> w) -+> (ColourNeedle +> w)
fromV3LinMap = (LinearMap ℝ (V3 ℝ) w -> LinearMap ℝ ColourNeedle w)
-> LinearFunction
     ℝ (LinearMap ℝ (V3 ℝ) w) (LinearMap ℝ ColourNeedle w)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((LinearMap ℝ (V3 ℝ) w -> LinearMap ℝ ColourNeedle w)
 -> LinearFunction
      ℝ (LinearMap ℝ (V3 ℝ) w) (LinearMap ℝ ColourNeedle w))
-> (LinearMap ℝ (V3 ℝ) w -> LinearMap ℝ ColourNeedle w)
-> LinearFunction
     ℝ (LinearMap ℝ (V3 ℝ) w) (LinearMap ℝ ColourNeedle w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(LinearMap (V3 r g b)) -> RGB w -> LinearMap ℝ ColourNeedle w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (RGB w -> LinearMap ℝ ColourNeedle w)
-> RGB w -> LinearMap ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB w
r w
g w
b

withRGBNeedle :: (RGB Double -> RGB Double) -> ColourNeedle -> ColourNeedle
withRGBNeedle :: (RGB ℝ -> RGB ℝ) -> ColourNeedle -> ColourNeedle
withRGBNeedle RGB ℝ -> RGB ℝ
f (ColourNeedle RGB ℝ
q) = RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ RGB ℝ -> RGB ℝ
f RGB ℝ
q

instance AdditiveGroup ColourNeedle where
  zeroV :: ColourNeedle
zeroV = RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
0 ℝ
0 ℝ
0
  negateV :: ColourNeedle -> ColourNeedle
negateV = (RGB ℝ -> RGB ℝ) -> ColourNeedle -> ColourNeedle
withRGBNeedle ((RGB ℝ -> RGB ℝ) -> ColourNeedle -> ColourNeedle)
-> (RGB ℝ -> RGB ℝ) -> ColourNeedle -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ -> ℝ) -> RGB ℝ -> RGB ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ℝ -> ℝ
forall a. Num a => a -> a
negate
  ColourNeedle RGB ℝ
q ^+^ :: ColourNeedle -> ColourNeedle -> ColourNeedle
^+^ ColourNeedle RGB ℝ
s = RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ -> ℝ -> ℝ) -> RGB ℝ -> RGB ℝ -> RGB ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) c b a.
(Applicative f r t, Object r c, ObjectMorphism r b c,
 Object t (f c), ObjectMorphism t (f b) (f c), ObjectPair r a b,
 ObjectPair t (f a) (f b)) =>
r a (r b c) -> t (f a) (t (f b) (f c))
liftA2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
(+) RGB ℝ
q RGB ℝ
s
instance VectorSpace ColourNeedle where
  type Scalar ColourNeedle = ℝ
  *^ :: Scalar ColourNeedle -> ColourNeedle -> ColourNeedle
(*^)Scalar ColourNeedle
μ = (RGB ℝ -> RGB ℝ) -> ColourNeedle -> ColourNeedle
withRGBNeedle ((RGB ℝ -> RGB ℝ) -> ColourNeedle -> ColourNeedle)
-> (RGB ℝ -> RGB ℝ) -> ColourNeedle -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ -> ℝ) -> RGB ℝ -> RGB ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (ℝ
Scalar ColourNeedle
μℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*)

instance TensorSpace ColourNeedle where
  type TensorProduct ColourNeedle w = RGB w
  scalarSpaceWitness :: ScalarSpaceWitness ColourNeedle
scalarSpaceWitness = ScalarSpaceWitness ColourNeedle
forall v.
(Num' (Scalar v), Scalar (Scalar v) ~ Scalar v) =>
ScalarSpaceWitness v
ScalarSpaceWitness
  linearManifoldWitness :: LinearManifoldWitness ColourNeedle
linearManifoldWitness = LinearManifoldWitness ColourNeedle
forall v.
(Needle v ~ v, AffineSpace v, Diff v ~ v) =>
LinearManifoldWitness v
LinearManifoldWitness
#if !MIN_VERSION_manifolds(0,6,0)
        BoundarylessWitness
#endif
  zeroTensor :: ColourNeedle ⊗ w
zeroTensor = TensorProduct ColourNeedle w -> Tensor ℝ ColourNeedle w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB w
forall v. AdditiveGroup v => v
zeroV w
forall v. AdditiveGroup v => v
zeroV w
forall v. AdditiveGroup v => v
zeroV)
  toFlatTensor :: ColourNeedle -+> (ColourNeedle ⊗ Scalar ColourNeedle)
toFlatTensor = (ColourNeedle -> Tensor ℝ ColourNeedle ℝ)
-> LinearFunction ℝ ColourNeedle (Tensor ℝ ColourNeedle ℝ)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((ColourNeedle -> Tensor ℝ ColourNeedle ℝ)
 -> LinearFunction ℝ ColourNeedle (Tensor ℝ ColourNeedle ℝ))
-> (ColourNeedle -> Tensor ℝ ColourNeedle ℝ)
-> LinearFunction ℝ ColourNeedle (Tensor ℝ ColourNeedle ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(ColourNeedle (RGB ℝ
r ℝ
g ℝ
b)) -> TensorProduct ColourNeedle ℝ -> Tensor ℝ ColourNeedle ℝ
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
r ℝ
g ℝ
b)
  fromFlatTensor :: (ColourNeedle ⊗ Scalar ColourNeedle) -+> ColourNeedle
fromFlatTensor = (Tensor ℝ ColourNeedle ℝ -> ColourNeedle)
-> LinearFunction ℝ (Tensor ℝ ColourNeedle ℝ) ColourNeedle
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((Tensor ℝ ColourNeedle ℝ -> ColourNeedle)
 -> LinearFunction ℝ (Tensor ℝ ColourNeedle ℝ) ColourNeedle)
-> (Tensor ℝ ColourNeedle ℝ -> ColourNeedle)
-> LinearFunction ℝ (Tensor ℝ ColourNeedle ℝ) ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (RGB r g b)) -> RGB ℝ -> ColourNeedle
ColourNeedle (ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
r ℝ
g ℝ
b)
  addTensors :: (ColourNeedle ⊗ w) -> (ColourNeedle ⊗ w) -> ColourNeedle ⊗ w
addTensors (Tensor (RGB r g b)) (Tensor (RGB r' g' b'))
                = RGB w -> Tensor ℝ ColourNeedle w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (RGB w -> Tensor ℝ ColourNeedle w)
-> RGB w -> Tensor ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB (w
rw -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^w
r') (w
gw -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^w
g') (w
bw -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^w
b')
  subtractTensors :: (ColourNeedle ⊗ w) -> (ColourNeedle ⊗ w) -> ColourNeedle ⊗ w
subtractTensors (Tensor (RGB r g b)) (Tensor (RGB r' g' b'))
                = RGB w -> Tensor ℝ ColourNeedle w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (RGB w -> Tensor ℝ ColourNeedle w)
-> RGB w -> Tensor ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB (w
rw -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^-^w
r') (w
gw -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^-^w
g') (w
bw -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^-^w
b')
  negateTensor :: (ColourNeedle ⊗ w) -+> (ColourNeedle ⊗ w)
negateTensor = (Tensor ℝ ColourNeedle w -> Tensor ℝ ColourNeedle w)
-> LinearFunction
     ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ ColourNeedle w)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((Tensor ℝ ColourNeedle w -> Tensor ℝ ColourNeedle w)
 -> LinearFunction
      ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ ColourNeedle w))
-> (Tensor ℝ ColourNeedle w -> Tensor ℝ ColourNeedle w)
-> LinearFunction
     ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ ColourNeedle w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (RGB r g b))
                       -> TensorProduct ColourNeedle w -> Tensor ℝ ColourNeedle w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB (w -> w
forall v. AdditiveGroup v => v -> v
negateV w
r) (w -> w
forall v. AdditiveGroup v => v -> v
negateV w
g) (w -> w
forall v. AdditiveGroup v => v -> v
negateV w
b))
  scaleTensor :: Bilinear
  (Scalar ColourNeedle) (ColourNeedle ⊗ w) (ColourNeedle ⊗ w)
scaleTensor = (ℝ -> Tensor ℝ ColourNeedle w -> Tensor ℝ ColourNeedle w)
-> LinearFunction
     ℝ
     ℝ
     (LinearFunction
        ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ ColourNeedle w))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((ℝ -> Tensor ℝ ColourNeedle w -> Tensor ℝ ColourNeedle w)
 -> LinearFunction
      ℝ
      ℝ
      (LinearFunction
         ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ ColourNeedle w)))
-> (ℝ -> Tensor ℝ ColourNeedle w -> Tensor ℝ ColourNeedle w)
-> LinearFunction
     ℝ
     ℝ
     (LinearFunction
        ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ ColourNeedle w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \ℝ
μ (Tensor (RGB r g b))
                       -> TensorProduct ColourNeedle w -> Tensor ℝ ColourNeedle w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB (ℝ
Scalar w
μScalar w -> w -> w
forall v. VectorSpace v => Scalar v -> v -> v
*^w
r) (ℝ
Scalar w
μScalar w -> w -> w
forall v. VectorSpace v => Scalar v -> v -> v
*^w
g) (ℝ
Scalar w
μScalar w -> w -> w
forall v. VectorSpace v => Scalar v -> v -> v
*^w
b))
  tensorProduct :: Bilinear ColourNeedle w (ColourNeedle ⊗ w)
tensorProduct = (ColourNeedle -> w -> Tensor ℝ ColourNeedle w)
-> LinearFunction
     ℝ ColourNeedle (LinearFunction ℝ w (Tensor ℝ ColourNeedle w))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((ColourNeedle -> w -> Tensor ℝ ColourNeedle w)
 -> LinearFunction
      ℝ ColourNeedle (LinearFunction ℝ w (Tensor ℝ ColourNeedle w)))
-> (ColourNeedle -> w -> Tensor ℝ ColourNeedle w)
-> LinearFunction
     ℝ ColourNeedle (LinearFunction ℝ w (Tensor ℝ ColourNeedle w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(ColourNeedle (RGB ℝ
r ℝ
g ℝ
b)) w
w
                       -> TensorProduct ColourNeedle w -> Tensor ℝ ColourNeedle w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB (ℝ
Scalar w
rScalar w -> w -> w
forall v. VectorSpace v => Scalar v -> v -> v
*^w
w) (ℝ
Scalar w
gScalar w -> w -> w
forall v. VectorSpace v => Scalar v -> v -> v
*^w
w) (ℝ
Scalar w
bScalar w -> w -> w
forall v. VectorSpace v => Scalar v -> v -> v
*^w
w))
  transposeTensor :: (ColourNeedle ⊗ w) -+> (w ⊗ ColourNeedle)
transposeTensor = (LinearFunction
  ℝ
  (LinearFunction ℝ (V3 ℝ) ColourNeedle)
  (LinearFunction ℝ (Tensor (Scalar w) w (V3 ℝ)) (w ⊗ ColourNeedle))
-> LinearFunction ℝ (V3 ℝ) ColourNeedle
-> LinearFunction ℝ (Tensor (Scalar w) w (V3 ℝ)) (w ⊗ ColourNeedle)
forall s v w. LinearFunction s v w -> v -> w
getLinearFunction LinearFunction
  ℝ
  (LinearFunction ℝ (V3 ℝ) ColourNeedle)
  (LinearFunction ℝ (Tensor (Scalar w) w (V3 ℝ)) (w ⊗ ColourNeedle))
forall v w x.
(TensorSpace v, TensorSpace w, TensorSpace x, Scalar w ~ Scalar v,
 Scalar x ~ Scalar v) =>
Bilinear (w -+> x) (v ⊗ w) (v ⊗ x)
fmapTensor LinearFunction ℝ (V3 ℝ) ColourNeedle
V3 ℝ -+> ColourNeedle
fromV3Needle)
                      LinearFunction ℝ (Tensor (Scalar w) w (V3 ℝ)) (w ⊗ ColourNeedle)
-> LinearFunction
     ℝ (Tensor ℝ ColourNeedle w) (Tensor (Scalar w) w (V3 ℝ))
-> LinearFunction ℝ (Tensor ℝ ColourNeedle w) (w ⊗ ColourNeedle)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. LinearFunction ℝ (Tensor ℝ (V3 ℝ) w) (Tensor (Scalar w) w (V3 ℝ))
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
(v ⊗ w) -+> (w ⊗ v)
transposeTensor LinearFunction ℝ (Tensor ℝ (V3 ℝ) w) (Tensor (Scalar w) w (V3 ℝ))
-> LinearFunction ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ (V3 ℝ) w)
-> LinearFunction
     ℝ (Tensor ℝ ColourNeedle w) (Tensor (Scalar w) w (V3 ℝ))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. LinearFunction ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ (V3 ℝ) w)
forall w. (ColourNeedle ⊗ w) -+> (V3 ℝ ⊗ w)
asV3Tensor
  fmapTensor :: Bilinear (w -+> x) (ColourNeedle ⊗ w) (ColourNeedle ⊗ x)
fmapTensor = (LinearFunction ℝ w x
 -> Tensor ℝ ColourNeedle w -> Tensor ℝ ColourNeedle x)
-> LinearFunction
     (Scalar x)
     (LinearFunction ℝ w x)
     (LinearFunction
        (Scalar x) (Tensor ℝ ColourNeedle w) (Tensor ℝ ColourNeedle x))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((LinearFunction ℝ w x
  -> Tensor ℝ ColourNeedle w -> Tensor ℝ ColourNeedle x)
 -> LinearFunction
      (Scalar x)
      (LinearFunction ℝ w x)
      (LinearFunction
         (Scalar x) (Tensor ℝ ColourNeedle w) (Tensor ℝ ColourNeedle x)))
-> (LinearFunction ℝ w x
    -> Tensor ℝ ColourNeedle w -> Tensor ℝ ColourNeedle x)
-> LinearFunction
     (Scalar x)
     (LinearFunction ℝ w x)
     (LinearFunction
        (Scalar x) (Tensor ℝ ColourNeedle w) (Tensor ℝ ColourNeedle x))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \LinearFunction ℝ w x
f (Tensor (RGB r g b))
                   -> RGB x -> Tensor ℝ ColourNeedle x
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (RGB x -> Tensor ℝ ColourNeedle x)
-> RGB x -> Tensor ℝ ColourNeedle x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x -> x -> x -> RGB x
forall a. a -> a -> a -> RGB a
RGB (LinearFunction ℝ w x
f LinearFunction ℝ w x -> w -> x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w
r) (LinearFunction ℝ w x
f LinearFunction ℝ w x -> w -> x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w
g) (LinearFunction ℝ w x
f LinearFunction ℝ w x -> w -> x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w
b)
  fzipTensorWith :: Bilinear
  ((w, x) -+> u)
  (ColourNeedle ⊗ w, ColourNeedle ⊗ x)
  (ColourNeedle ⊗ u)
fzipTensorWith = (LinearFunction ℝ (w, x) u
 -> (Tensor ℝ ColourNeedle w, Tensor ℝ ColourNeedle x)
 -> Tensor ℝ ColourNeedle u)
-> LinearFunction
     (Scalar u)
     (LinearFunction ℝ (w, x) u)
     (LinearFunction
        (Scalar u)
        (Tensor ℝ ColourNeedle w, Tensor ℝ ColourNeedle x)
        (Tensor ℝ ColourNeedle u))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((LinearFunction ℝ (w, x) u
  -> (Tensor ℝ ColourNeedle w, Tensor ℝ ColourNeedle x)
  -> Tensor ℝ ColourNeedle u)
 -> LinearFunction
      (Scalar u)
      (LinearFunction ℝ (w, x) u)
      (LinearFunction
         (Scalar u)
         (Tensor ℝ ColourNeedle w, Tensor ℝ ColourNeedle x)
         (Tensor ℝ ColourNeedle u)))
-> (LinearFunction ℝ (w, x) u
    -> (Tensor ℝ ColourNeedle w, Tensor ℝ ColourNeedle x)
    -> Tensor ℝ ColourNeedle u)
-> LinearFunction
     (Scalar u)
     (LinearFunction ℝ (w, x) u)
     (LinearFunction
        (Scalar u)
        (Tensor ℝ ColourNeedle w, Tensor ℝ ColourNeedle x)
        (Tensor ℝ ColourNeedle u))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \LinearFunction ℝ (w, x) u
f (Tensor (RGB r g b), Tensor (RGB r' g' b'))
                   -> RGB u -> Tensor ℝ ColourNeedle u
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (RGB u -> Tensor ℝ ColourNeedle u)
-> RGB u -> Tensor ℝ ColourNeedle u
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ u -> u -> u -> RGB u
forall a. a -> a -> a -> RGB a
RGB (LinearFunction ℝ (w, x) u
f LinearFunction ℝ (w, x) u -> (w, x) -> u
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (w
r,x
r')) (LinearFunction ℝ (w, x) u
f LinearFunction ℝ (w, x) u -> (w, x) -> u
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (w
g,x
g')) (LinearFunction ℝ (w, x) u
f LinearFunction ℝ (w, x) u -> (w, x) -> u
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (w
b,x
b'))
  coerceFmapTensorProduct :: p ColourNeedle
-> Coercion a b
-> Coercion
     (TensorProduct ColourNeedle a) (TensorProduct ColourNeedle b)
coerceFmapTensorProduct p ColourNeedle
_ Coercion a b
Coercion = Coercion
  (TensorProduct ColourNeedle a) (TensorProduct ColourNeedle b)
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  wellDefinedTensor :: (ColourNeedle ⊗ w) -> Maybe (ColourNeedle ⊗ w)
wellDefinedTensor t :: ColourNeedle ⊗ w
t@(Tensor (RGB r g b))
    = w -> Maybe w
forall v. TensorSpace v => v -> Maybe v
wellDefinedVector w
r Maybe w -> Maybe w -> Maybe w
forall (k :: * -> * -> *) (m :: * -> *) b a.
(WellPointed k, Monad m k, ObjectPair k b (UnitObject k),
 ObjectPair k (m b) (UnitObject k),
 ObjectPair k (UnitObject k) (m b), ObjectPair k b a,
 ObjectPair k a b, Object k (m (a, b)), ObjectPair k (m a) (m b),
 ObjectPoint k (m a)) =>
m a -> k (m b) (m b)
>> w -> Maybe w
forall v. TensorSpace v => v -> Maybe v
wellDefinedVector w
g Maybe w
-> Maybe (Tensor ℝ ColourNeedle w)
-> Maybe (Tensor ℝ ColourNeedle w)
forall (k :: * -> * -> *) (m :: * -> *) b a.
(WellPointed k, Monad m k, ObjectPair k b (UnitObject k),
 ObjectPair k (m b) (UnitObject k),
 ObjectPair k (UnitObject k) (m b), ObjectPair k b a,
 ObjectPair k a b, Object k (m (a, b)), ObjectPair k (m a) (m b),
 ObjectPoint k (m a)) =>
m a -> k (m b) (m b)
>> w -> Maybe w
forall v. TensorSpace v => v -> Maybe v
wellDefinedVector w
b Maybe w
-> Tensor ℝ ColourNeedle w -> Maybe (Tensor ℝ ColourNeedle w)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Tensor ℝ ColourNeedle w
ColourNeedle ⊗ w
t

instance LinearSpace ColourNeedle where
  type DualVector ColourNeedle = ColourNeedle
  linearId :: ColourNeedle +> ColourNeedle
linearId = RGB ColourNeedle -> LinearMap ℝ ColourNeedle ColourNeedle
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (RGB ColourNeedle -> LinearMap ℝ ColourNeedle ColourNeedle)
-> RGB ColourNeedle -> LinearMap ℝ ColourNeedle ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ColourNeedle -> ColourNeedle -> ColourNeedle -> RGB ColourNeedle
forall a. a -> a -> a -> RGB a
RGB (RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
1 ℝ
0 ℝ
0)
                             (RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
0 ℝ
1 ℝ
0)
                             (RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
0 ℝ
0 ℝ
1)
  tensorId :: (ColourNeedle ⊗ w) +> (ColourNeedle ⊗ w)
tensorId = DualSpaceWitness w
-> Tensor ℝ (DualVector w) w
-> Tensor ℝ ColourNeedle w +> Tensor ℝ ColourNeedle w
forall w.
(TensorSpace w, Scalar w ~ ℝ) =>
DualSpaceWitness w
-> Tensor ℝ (DualVector w) w
-> Tensor ℝ ColourNeedle w +> Tensor ℝ ColourNeedle w
ti DualSpaceWitness w
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness (LinearMap ℝ w w -> Tensor ℝ (DualVector w) w
forall s u v w.
(LinearSpace u, Scalar u ~ s) =>
LinearMap s u w -> Tensor s (DualVector u) w
asTensor (LinearMap ℝ w w -> Tensor ℝ (DualVector w) w)
-> LinearMap ℝ w w -> Tensor ℝ (DualVector w) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ w w
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
   where ti :: ∀ w . (TensorSpace w, Scalar w ~ ℝ)
               => DualSpaceWitness w -> Tensor ℝ (DualVector w) w
                 -> Tensor ℝ ColourNeedle w+>Tensor ℝ ColourNeedle w
         ti :: DualSpaceWitness w
-> Tensor ℝ (DualVector w) w
-> Tensor ℝ ColourNeedle w +> Tensor ℝ ColourNeedle w
ti DualSpaceWitness w
DualSpaceWitness Tensor ℝ (DualVector w) w
wid = RGB (Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w))
-> LinearMap ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ ColourNeedle w)
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (RGB (Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w))
 -> LinearMap ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ ColourNeedle w))
-> RGB (Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w))
-> LinearMap ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ ColourNeedle w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w)
-> Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w)
-> Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w)
-> RGB (Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w))
forall a. a -> a -> a -> RGB a
RGB
                  (LinearFunction ℝ w (Tensor ℝ ColourNeedle w)
-> LinearFunction
     ℝ
     (Tensor ℝ (DualVector w) w)
     (Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((w -> Tensor ℝ ColourNeedle w)
-> LinearFunction ℝ w (Tensor ℝ ColourNeedle w)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((w -> Tensor ℝ ColourNeedle w)
 -> LinearFunction ℝ w (Tensor ℝ ColourNeedle w))
-> (w -> Tensor ℝ ColourNeedle w)
-> LinearFunction ℝ w (Tensor ℝ ColourNeedle w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \w
w -> RGB w -> Tensor ℝ ColourNeedle w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (RGB w -> Tensor ℝ ColourNeedle w)
-> RGB w -> Tensor ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB w
w w
forall v. AdditiveGroup v => v
zeroV w
forall v. AdditiveGroup v => v
zeroV) LinearFunction
  ℝ
  (Tensor ℝ (DualVector w) w)
  (Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w))
-> Tensor ℝ (DualVector w) w
-> Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Tensor ℝ (DualVector w) w
wid)
                  (LinearFunction ℝ w (Tensor ℝ ColourNeedle w)
-> LinearFunction
     ℝ
     (Tensor ℝ (DualVector w) w)
     (Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((w -> Tensor ℝ ColourNeedle w)
-> LinearFunction ℝ w (Tensor ℝ ColourNeedle w)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((w -> Tensor ℝ ColourNeedle w)
 -> LinearFunction ℝ w (Tensor ℝ ColourNeedle w))
-> (w -> Tensor ℝ ColourNeedle w)
-> LinearFunction ℝ w (Tensor ℝ ColourNeedle w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \w
w -> RGB w -> Tensor ℝ ColourNeedle w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (RGB w -> Tensor ℝ ColourNeedle w)
-> RGB w -> Tensor ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB w
forall v. AdditiveGroup v => v
zeroV w
w w
forall v. AdditiveGroup v => v
zeroV) LinearFunction
  ℝ
  (Tensor ℝ (DualVector w) w)
  (Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w))
-> Tensor ℝ (DualVector w) w
-> Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Tensor ℝ (DualVector w) w
wid)
                  (LinearFunction ℝ w (Tensor ℝ ColourNeedle w)
-> LinearFunction
     ℝ
     (Tensor ℝ (DualVector w) w)
     (Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((w -> Tensor ℝ ColourNeedle w)
-> LinearFunction ℝ w (Tensor ℝ ColourNeedle w)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((w -> Tensor ℝ ColourNeedle w)
 -> LinearFunction ℝ w (Tensor ℝ ColourNeedle w))
-> (w -> Tensor ℝ ColourNeedle w)
-> LinearFunction ℝ w (Tensor ℝ ColourNeedle w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \w
w -> RGB w -> Tensor ℝ ColourNeedle w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (RGB w -> Tensor ℝ ColourNeedle w)
-> RGB w -> Tensor ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB w
forall v. AdditiveGroup v => v
zeroV w
forall v. AdditiveGroup v => v
zeroV w
w) LinearFunction
  ℝ
  (Tensor ℝ (DualVector w) w)
  (Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w))
-> Tensor ℝ (DualVector w) w
-> Tensor ℝ (DualVector w) (Tensor ℝ ColourNeedle w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Tensor ℝ (DualVector w) w
wid)
  coerceDoubleDual :: Coercion ColourNeedle (DualVector (DualVector ColourNeedle))
coerceDoubleDual = Coercion ColourNeedle (DualVector (DualVector ColourNeedle))
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  dualSpaceWitness :: DualSpaceWitness ColourNeedle
dualSpaceWitness = DualSpaceWitness ColourNeedle
forall v.
(LinearSpace (Scalar v), DualVector (Scalar v) ~ Scalar v,
 LinearSpace (DualVector v), Scalar (DualVector v) ~ Scalar v,
 DualVector (DualVector v) ~ v) =>
DualSpaceWitness v
DualSpaceWitness
  contractTensorMap :: (ColourNeedle +> (ColourNeedle ⊗ w)) -+> w
contractTensorMap = (LinearMap ℝ ColourNeedle (Tensor ℝ ColourNeedle w) -> w)
-> LinearFunction
     ℝ (LinearMap ℝ ColourNeedle (Tensor ℝ ColourNeedle w)) w
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((LinearMap ℝ ColourNeedle (Tensor ℝ ColourNeedle w) -> w)
 -> LinearFunction
      ℝ (LinearMap ℝ ColourNeedle (Tensor ℝ ColourNeedle w)) w)
-> (LinearMap ℝ ColourNeedle (Tensor ℝ ColourNeedle w) -> w)
-> LinearFunction
     ℝ (LinearMap ℝ ColourNeedle (Tensor ℝ ColourNeedle w)) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(LinearMap (RGB (Tensor (RGB r _ _))
                                                        (Tensor (RGB _ g _))
                                                        (Tensor (RGB _ _ b))))
                        -> w
r w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^ w
g w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^ w
b
  contractMapTensor :: (ColourNeedle ⊗ (ColourNeedle +> w)) -+> w
contractMapTensor = (Tensor ℝ ColourNeedle (LinearMap ℝ ColourNeedle w) -> w)
-> LinearFunction
     ℝ (Tensor ℝ ColourNeedle (LinearMap ℝ ColourNeedle w)) w
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((Tensor ℝ ColourNeedle (LinearMap ℝ ColourNeedle w) -> w)
 -> LinearFunction
      ℝ (Tensor ℝ ColourNeedle (LinearMap ℝ ColourNeedle w)) w)
-> (Tensor ℝ ColourNeedle (LinearMap ℝ ColourNeedle w) -> w)
-> LinearFunction
     ℝ (Tensor ℝ ColourNeedle (LinearMap ℝ ColourNeedle w)) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor (RGB (LinearMap (RGB r _ _))
                                                     (LinearMap (RGB _ g _))
                                                     (LinearMap (RGB _ _ b))))
                        -> w
r w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^ w
g w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^ w
b
  contractLinearMapAgainst :: Bilinear
  (ColourNeedle +> w) (w -+> ColourNeedle) (Scalar ColourNeedle)
contractLinearMapAgainst = (LinearMap ℝ ColourNeedle w
 -> LinearFunction ℝ w ColourNeedle -> ℝ)
-> LinearFunction
     ℝ
     (LinearMap ℝ ColourNeedle w)
     (LinearFunction ℝ (LinearFunction ℝ w ColourNeedle) ℝ)
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((LinearMap ℝ ColourNeedle w
  -> LinearFunction ℝ w ColourNeedle -> ℝ)
 -> LinearFunction
      ℝ
      (LinearMap ℝ ColourNeedle w)
      (LinearFunction ℝ (LinearFunction ℝ w ColourNeedle) ℝ))
-> (LinearMap ℝ ColourNeedle w
    -> LinearFunction ℝ w ColourNeedle -> ℝ)
-> LinearFunction
     ℝ
     (LinearMap ℝ ColourNeedle w)
     (LinearFunction ℝ (LinearFunction ℝ w ColourNeedle) ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(LinearMap (RGB r g b)) LinearFunction ℝ w ColourNeedle
f
                        -> RGB ℝ -> ℝ
forall a. RGB a -> a
channelRed (ColourNeedle -> RGB ℝ
getRGBNeedle (ColourNeedle -> RGB ℝ) -> ColourNeedle -> RGB ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ w ColourNeedle
f LinearFunction ℝ w ColourNeedle -> w -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w
r)
                         ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ RGB ℝ -> ℝ
forall a. RGB a -> a
channelGreen (ColourNeedle -> RGB ℝ
getRGBNeedle (ColourNeedle -> RGB ℝ) -> ColourNeedle -> RGB ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ w ColourNeedle
f LinearFunction ℝ w ColourNeedle -> w -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w
g)
                         ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ RGB ℝ -> ℝ
forall a. RGB a -> a
channelBlue (ColourNeedle -> RGB ℝ
getRGBNeedle (ColourNeedle -> RGB ℝ) -> ColourNeedle -> RGB ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ w ColourNeedle
f LinearFunction ℝ w ColourNeedle -> w -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w
b)
  applyDualVector :: Bilinear
  (DualVector ColourNeedle) ColourNeedle (Scalar ColourNeedle)
applyDualVector = (ColourNeedle -> ColourNeedle -> ℝ)
-> LinearFunction ℝ ColourNeedle (LinearFunction ℝ ColourNeedle ℝ)
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((ColourNeedle -> ColourNeedle -> ℝ)
 -> LinearFunction ℝ ColourNeedle (LinearFunction ℝ ColourNeedle ℝ))
-> (ColourNeedle -> ColourNeedle -> ℝ)
-> LinearFunction ℝ ColourNeedle (LinearFunction ℝ ColourNeedle ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
         \(ColourNeedle (RGB ℝ
r' ℝ
g' ℝ
b')) (ColourNeedle (RGB ℝ
r ℝ
g ℝ
b))
            -> ℝ
r'ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
r ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
g'ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
g ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
b'ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
b
  applyLinear :: Bilinear (ColourNeedle +> w) ColourNeedle w
applyLinear = (LinearMap ℝ ColourNeedle w -> ColourNeedle -> w)
-> LinearFunction
     ℝ (LinearMap ℝ ColourNeedle w) (LinearFunction ℝ ColourNeedle w)
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((LinearMap ℝ ColourNeedle w -> ColourNeedle -> w)
 -> LinearFunction
      ℝ (LinearMap ℝ ColourNeedle w) (LinearFunction ℝ ColourNeedle w))
-> (LinearMap ℝ ColourNeedle w -> ColourNeedle -> w)
-> LinearFunction
     ℝ (LinearMap ℝ ColourNeedle w) (LinearFunction ℝ ColourNeedle w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(LinearMap (RGB r' g' b')) (ColourNeedle (RGB ℝ
r ℝ
g ℝ
b))
            -> w
r'w -> ℝ -> w
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*ℝ
r w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^ w
g'w -> ℝ -> w
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*ℝ
g w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^ w
b'w -> ℝ -> w
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*ℝ
b
  applyTensorFunctional :: Bilinear
  (DualVector (ColourNeedle ⊗ u))
  (ColourNeedle ⊗ u)
  (Scalar ColourNeedle)
applyTensorFunctional = (LinearMap ℝ ColourNeedle (DualVector u)
 -> Tensor ℝ ColourNeedle u -> ℝ)
-> LinearFunction
     ℝ
     (LinearMap ℝ ColourNeedle (DualVector u))
     (LinearFunction ℝ (Tensor ℝ ColourNeedle u) ℝ)
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction
            ((LinearMap ℝ ColourNeedle (DualVector u)
  -> Tensor ℝ ColourNeedle u -> ℝ)
 -> LinearFunction
      ℝ
      (LinearMap ℝ ColourNeedle (DualVector u))
      (LinearFunction ℝ (Tensor ℝ ColourNeedle u) ℝ))
-> (LinearMap ℝ ColourNeedle (DualVector u)
    -> Tensor ℝ ColourNeedle u -> ℝ)
-> LinearFunction
     ℝ
     (LinearMap ℝ ColourNeedle (DualVector u))
     (LinearFunction ℝ (Tensor ℝ ColourNeedle u) ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(LinearMap (RGB r' g' b')) (Tensor (RGB r g b))
                   -> DualVector u
r'DualVector u -> u -> Scalar u
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^u
r ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ DualVector u
g'DualVector u -> u -> Scalar u
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^u
g ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ DualVector u
b'DualVector u -> u -> Scalar u
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^u
b
  applyTensorLinMap :: Bilinear ((ColourNeedle ⊗ u) +> w) (ColourNeedle ⊗ u) w
applyTensorLinMap = (LinearMap ℝ (Tensor ℝ ColourNeedle u) w
 -> Tensor ℝ ColourNeedle u -> w)
-> LinearFunction
     ℝ
     (LinearMap ℝ (Tensor ℝ ColourNeedle u) w)
     (LinearFunction ℝ (Tensor ℝ ColourNeedle u) w)
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction
            ((LinearMap ℝ (Tensor ℝ ColourNeedle u) w
  -> Tensor ℝ ColourNeedle u -> w)
 -> LinearFunction
      ℝ
      (LinearMap ℝ (Tensor ℝ ColourNeedle u) w)
      (LinearFunction ℝ (Tensor ℝ ColourNeedle u) w))
-> (LinearMap ℝ (Tensor ℝ ColourNeedle u) w
    -> Tensor ℝ ColourNeedle u -> w)
-> LinearFunction
     ℝ
     (LinearMap ℝ (Tensor ℝ ColourNeedle u) w)
     (LinearFunction ℝ (Tensor ℝ ColourNeedle u) w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(LinearMap (RGB r' g' b')) (Tensor (RGB r g b))
                -> (Tensor (Scalar w) (DualVector u) w
r'Tensor (Scalar w) (DualVector u) w -> u -> w
forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
Tensor (Scalar w) (DualVector v) w -> v -> w
+$u
r) w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^ (Tensor (Scalar w) (DualVector u) w
g'Tensor (Scalar w) (DualVector u) w -> u -> w
forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
Tensor (Scalar w) (DualVector v) w -> v -> w
+$u
g) w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^ (Tensor (Scalar w) (DualVector u) w
b'Tensor (Scalar w) (DualVector u) w -> u -> w
forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
Tensor (Scalar w) (DualVector v) w -> v -> w
+$u
b)
   where Tensor (Scalar w) (DualVector v) w
f+$ :: Tensor (Scalar w) (DualVector v) w -> v -> w
+$v
x = LinearFunction (Scalar w) v w -> v -> w
forall s v w. LinearFunction s v w -> v -> w
getLinearFunction (LinearFunction
  (Scalar w)
  (LinearMap (Scalar v) v w)
  (LinearFunction (Scalar v) v w)
-> LinearMap (Scalar v) v w -> LinearFunction (Scalar v) v w
forall s v w. LinearFunction s v w -> v -> w
getLinearFunction LinearFunction
  (Scalar w)
  (LinearMap (Scalar v) v w)
  (LinearFunction (Scalar v) v w)
forall v w.
(LinearSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
Bilinear (v +> w) v w
applyLinear (LinearMap (Scalar v) v w -> LinearFunction (Scalar w) v w)
-> LinearMap (Scalar v) v w -> LinearFunction (Scalar w) v w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Tensor (Scalar w) (DualVector v) w -> LinearMap (Scalar v) v w
forall s u v w.
(LinearSpace u, Scalar u ~ s) =>
Tensor s (DualVector u) w -> LinearMap s u w
fromTensor (Tensor (Scalar w) (DualVector v) w -> LinearMap (Scalar v) v w)
-> Tensor (Scalar w) (DualVector v) w -> LinearMap (Scalar v) v w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Tensor (Scalar w) (DualVector v) w
f) v
x
  composeLinear :: Bilinear (w +> x) (ColourNeedle +> w) (ColourNeedle +> x)
composeLinear = ((w +> x)
 -> LinearMap ℝ ColourNeedle w -> LinearMap ℝ ColourNeedle x)
-> LinearFunction
     ℝ
     (w +> x)
     (LinearFunction
        ℝ (LinearMap ℝ ColourNeedle w) (LinearMap ℝ ColourNeedle x))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction (((w +> x)
  -> LinearMap ℝ ColourNeedle w -> LinearMap ℝ ColourNeedle x)
 -> LinearFunction
      ℝ
      (w +> x)
      (LinearFunction
         ℝ (LinearMap ℝ ColourNeedle w) (LinearMap ℝ ColourNeedle x)))
-> ((w +> x)
    -> LinearMap ℝ ColourNeedle w -> LinearMap ℝ ColourNeedle x)
-> LinearFunction
     ℝ
     (w +> x)
     (LinearFunction
        ℝ (LinearMap ℝ ColourNeedle w) (LinearMap ℝ ColourNeedle x))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \w +> x
f (LinearMap (RGB r' g' b'))
            -> RGB x -> LinearMap ℝ ColourNeedle x
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (RGB x -> LinearMap ℝ ColourNeedle x)
-> RGB x -> LinearMap ℝ ColourNeedle x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x -> x -> x -> RGB x
forall a. a -> a -> a -> RGB a
RGB (w +> x
f (w +> x) -> w -> x
forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
LinearMap (Scalar v) v w -> v -> w
+$ w
r') (w +> x
f (w +> x) -> w -> x
forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
LinearMap (Scalar v) v w -> v -> w
+$ w
g') (w +> x
f (w +> x) -> w -> x
forall v w.
(LinearSpace v, TensorSpace w, Scalar v ~ Scalar w) =>
LinearMap (Scalar v) v w -> v -> w
+$ w
b')
   where LinearMap (Scalar v) v w
f+$ :: LinearMap (Scalar v) v w -> v -> w
+$v
x = LinearFunction (Scalar w) v w -> v -> w
forall s v w. LinearFunction s v w -> v -> w
getLinearFunction (LinearFunction
  (Scalar w)
  (LinearMap (Scalar v) v w)
  (LinearFunction (Scalar w) v w)
-> LinearMap (Scalar v) v w -> LinearFunction (Scalar w) v w
forall s v w. LinearFunction s v w -> v -> w
getLinearFunction LinearFunction
  (Scalar w)
  (LinearMap (Scalar v) v w)
  (LinearFunction (Scalar w) v w)
forall v w.
(LinearSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
Bilinear (v +> w) v w
applyLinear LinearMap (Scalar v) v w
f) v
x
  useTupleLinearSpaceComponents :: ((LinearSpace x, LinearSpace y, Scalar x ~ Scalar y) => φ) -> φ
useTupleLinearSpaceComponents (LinearSpace x, LinearSpace y, Scalar x ~ Scalar y) => φ
_ = φ
forall a. HasCallStack => a
undefined

instance SemiInner ColourNeedle where
  dualBasisCandidates :: [(Int, ColourNeedle)] -> Forest (Int, DualVector ColourNeedle)
dualBasisCandidates = [DualVector ColourNeedle]
-> (ColourNeedle -> [ℝ])
-> [(Int, ColourNeedle)]
-> Forest (Int, DualVector ColourNeedle)
forall v.
[DualVector v]
-> (v -> [ℝ]) -> [(Int, v)] -> Forest (Int, DualVector v)
cartesianDualBasisCandidates
           [RGB ℝ -> ColourNeedle
ColourNeedle (ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
1 ℝ
0 ℝ
0), RGB ℝ -> ColourNeedle
ColourNeedle (ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
0 ℝ
1 ℝ
0), RGB ℝ -> ColourNeedle
ColourNeedle (ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
0 ℝ
0 ℝ
1)]
           (\(ColourNeedle (RGB ℝ
r ℝ
g ℝ
b)) -> ℝ -> ℝ
forall a. Num a => a -> a
abs (ℝ -> ℝ) -> [ℝ] -> [ℝ]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [ℝ
r,ℝ
g,ℝ
b])
  tensorDualBasisCandidates :: [(Int, ColourNeedle ⊗ w)]
-> Forest (Int, DualVector (ColourNeedle ⊗ w))
tensorDualBasisCandidates = ((Int, Tensor ℝ ColourNeedle w) -> (Int, Tensor ℝ (V3 ℝ) w))
-> [(Int, Tensor ℝ ColourNeedle w)] -> [(Int, Tensor ℝ (V3 ℝ) w)]
forall a b. (a -> b) -> [a] -> [b]
map ((Tensor ℝ ColourNeedle w -> Tensor ℝ (V3 ℝ) w)
-> (Int, Tensor ℝ ColourNeedle w) -> (Int, Tensor ℝ (V3 ℝ) w)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Tensor ℝ ColourNeedle w -> Tensor ℝ (V3 ℝ) w)
 -> (Int, Tensor ℝ ColourNeedle w) -> (Int, Tensor ℝ (V3 ℝ) w))
-> (Tensor ℝ ColourNeedle w -> Tensor ℝ (V3 ℝ) w)
-> (Int, Tensor ℝ ColourNeedle w)
-> (Int, Tensor ℝ (V3 ℝ) w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ (V3 ℝ) w)
-> Tensor ℝ ColourNeedle w -> Tensor ℝ (V3 ℝ) w
forall s v w. LinearFunction s v w -> v -> w
getLinearFunction LinearFunction ℝ (Tensor ℝ ColourNeedle w) (Tensor ℝ (V3 ℝ) w)
forall w. (ColourNeedle ⊗ w) -+> (V3 ℝ ⊗ w)
asV3Tensor)
                           ([(Int, Tensor ℝ ColourNeedle w)] -> [(Int, Tensor ℝ (V3 ℝ) w)])
-> ([(Int, Tensor ℝ (V3 ℝ) w)]
    -> [Tree (Int, LinearMap ℝ ColourNeedle (DualVector w))])
-> [(Int, Tensor ℝ ColourNeedle w)]
-> [Tree (Int, LinearMap ℝ ColourNeedle (DualVector w))]
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> [(Int, Tensor ℝ (V3 ℝ) w)]
-> [Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))]
forall v w.
(SemiInner v, SemiInner w, Scalar w ~ Scalar v) =>
[(Int, v ⊗ w)] -> Forest (Int, DualVector (v ⊗ w))
tensorDualBasisCandidates
                           ([(Int, Tensor ℝ (V3 ℝ) w)]
 -> [Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))])
-> ([Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))]
    -> [Tree (Int, LinearMap ℝ ColourNeedle (DualVector w))])
-> [(Int, Tensor ℝ (V3 ℝ) w)]
-> [Tree (Int, LinearMap ℝ ColourNeedle (DualVector w))]
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))
 -> Tree (Int, LinearMap ℝ ColourNeedle (DualVector w)))
-> [Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))]
-> [Tree (Int, LinearMap ℝ ColourNeedle (DualVector w))]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, LinearMap ℝ (V3 ℝ) (DualVector w))
 -> (Int, LinearMap ℝ ColourNeedle (DualVector w)))
-> Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))
-> Tree (Int, LinearMap ℝ ColourNeedle (DualVector w))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (((Int, LinearMap ℝ (V3 ℝ) (DualVector w))
  -> (Int, LinearMap ℝ ColourNeedle (DualVector w)))
 -> Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))
 -> Tree (Int, LinearMap ℝ ColourNeedle (DualVector w)))
-> ((Int, LinearMap ℝ (V3 ℝ) (DualVector w))
    -> (Int, LinearMap ℝ ColourNeedle (DualVector w)))
-> Tree (Int, LinearMap ℝ (V3 ℝ) (DualVector w))
-> Tree (Int, LinearMap ℝ ColourNeedle (DualVector w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (LinearMap ℝ (V3 ℝ) (DualVector w)
 -> LinearMap ℝ ColourNeedle (DualVector w))
-> (Int, LinearMap ℝ (V3 ℝ) (DualVector w))
-> (Int, LinearMap ℝ ColourNeedle (DualVector w))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((LinearMap ℝ (V3 ℝ) (DualVector w)
  -> LinearMap ℝ ColourNeedle (DualVector w))
 -> (Int, LinearMap ℝ (V3 ℝ) (DualVector w))
 -> (Int, LinearMap ℝ ColourNeedle (DualVector w)))
-> (LinearMap ℝ (V3 ℝ) (DualVector w)
    -> LinearMap ℝ ColourNeedle (DualVector w))
-> (Int, LinearMap ℝ (V3 ℝ) (DualVector w))
-> (Int, LinearMap ℝ ColourNeedle (DualVector w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction
  ℝ
  (LinearMap ℝ (V3 ℝ) (DualVector w))
  (LinearMap ℝ ColourNeedle (DualVector w))
-> LinearMap ℝ (V3 ℝ) (DualVector w)
-> LinearMap ℝ ColourNeedle (DualVector w)
forall s v w. LinearFunction s v w -> v -> w
getLinearFunction LinearFunction
  ℝ
  (LinearMap ℝ (V3 ℝ) (DualVector w))
  (LinearMap ℝ ColourNeedle (DualVector w))
forall w. (V3 ℝ +> w) -+> (ColourNeedle +> w)
fromV3LinMap)

instance FiniteDimensional ColourNeedle where
  data SubBasis ColourNeedle = ColourNeedleBasis
  entireBasis :: SubBasis ColourNeedle
entireBasis = SubBasis ColourNeedle
ColourNeedleBasis
  enumerateSubBasis :: SubBasis ColourNeedle -> [ColourNeedle]
enumerateSubBasis SubBasis ColourNeedle
ColourNeedleBasis
          = RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> [RGB ℝ] -> [ColourNeedle]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
1 ℝ
0 ℝ
0, ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
0 ℝ
1 ℝ
0, ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
0 ℝ
0 ℝ
1]
  decomposeLinMap :: (ColourNeedle +> w) -> (SubBasis ColourNeedle, DList w)
decomposeLinMap (LinearMap (RGB r g b)) = (SubBasis ColourNeedle
ColourNeedleBasis, ([w
r,w
g,w
b][w] -> DList w
forall a. [a] -> [a] -> [a]
++))
  decomposeLinMapWithin :: SubBasis ColourNeedle
-> (ColourNeedle +> w)
-> Either (SubBasis ColourNeedle, DList w) (DList w)
decomposeLinMapWithin SubBasis ColourNeedle
ColourNeedleBasis (LinearMap (RGB r g b)) = DList w -> Either (SubBasis ColourNeedle, DList w) (DList w)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure ([w
r,w
g,w
b][w] -> DList w
forall a. [a] -> [a] -> [a]
++)
  recomposeSB :: SubBasis ColourNeedle
-> [Scalar ColourNeedle] -> (ColourNeedle, [Scalar ColourNeedle])
recomposeSB SubBasis ColourNeedle
ColourNeedleBasis [] = (RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
0 ℝ
0 ℝ
0, [])
  recomposeSB SubBasis ColourNeedle
ColourNeedleBasis [Scalar ColourNeedle
r] = (RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
Scalar ColourNeedle
r ℝ
0 ℝ
0, [])
  recomposeSB SubBasis ColourNeedle
ColourNeedleBasis [Scalar ColourNeedle
r,Scalar ColourNeedle
g] = (RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
Scalar ColourNeedle
r ℝ
Scalar ColourNeedle
g ℝ
0, [])
  recomposeSB SubBasis ColourNeedle
ColourNeedleBasis (Scalar ColourNeedle
r:Scalar ColourNeedle
g:Scalar ColourNeedle
b:[Scalar ColourNeedle]
l) = (RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB ℝ
Scalar ColourNeedle
r ℝ
Scalar ColourNeedle
g ℝ
Scalar ColourNeedle
b, [Scalar ColourNeedle]
l)
  recomposeSBTensor :: SubBasis ColourNeedle
-> SubBasis w
-> [Scalar ColourNeedle]
-> (ColourNeedle ⊗ w, [Scalar ColourNeedle])
recomposeSBTensor SubBasis ColourNeedle
ColourNeedleBasis SubBasis w
sbw [Scalar ColourNeedle]
l
          = let (w
r,[ℝ]
l') = SubBasis w -> [Scalar w] -> (w, [Scalar w])
forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis w
sbw [Scalar w]
[Scalar ColourNeedle]
l
                (w
g,[ℝ]
l'') = SubBasis w -> [Scalar w] -> (w, [Scalar w])
forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis w
sbw [ℝ]
[Scalar w]
l'
                (w
b,[ℝ]
l''') = SubBasis w -> [Scalar w] -> (w, [Scalar w])
forall v.
FiniteDimensional v =>
SubBasis v -> [Scalar v] -> (v, [Scalar v])
recomposeSB SubBasis w
sbw [ℝ]
[Scalar w]
l''
            in (RGB w -> Tensor ℝ ColourNeedle w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (RGB w -> Tensor ℝ ColourNeedle w)
-> RGB w -> Tensor ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB w
r w
g w
b, [ℝ]
[Scalar ColourNeedle]
l''')
  recomposeLinMap :: SubBasis ColourNeedle -> [w] -> (ColourNeedle +> w, [w])
recomposeLinMap SubBasis ColourNeedle
ColourNeedleBasis [] = (RGB w -> LinearMap ℝ ColourNeedle w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (RGB w -> LinearMap ℝ ColourNeedle w)
-> RGB w -> LinearMap ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB w
forall v. AdditiveGroup v => v
zeroV w
forall v. AdditiveGroup v => v
zeroV w
forall v. AdditiveGroup v => v
zeroV, [])
  recomposeLinMap SubBasis ColourNeedle
ColourNeedleBasis [w
r] = (RGB w -> LinearMap ℝ ColourNeedle w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (RGB w -> LinearMap ℝ ColourNeedle w)
-> RGB w -> LinearMap ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB w
r w
forall v. AdditiveGroup v => v
zeroV w
forall v. AdditiveGroup v => v
zeroV, [])
  recomposeLinMap SubBasis ColourNeedle
ColourNeedleBasis [w
r,w
g] = (RGB w -> LinearMap ℝ ColourNeedle w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (RGB w -> LinearMap ℝ ColourNeedle w)
-> RGB w -> LinearMap ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB w
r w
g w
forall v. AdditiveGroup v => v
zeroV, [])
  recomposeLinMap SubBasis ColourNeedle
ColourNeedleBasis (w
r:w
g:w
b:[w]
l) = (RGB w -> LinearMap ℝ ColourNeedle w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (RGB w -> LinearMap ℝ ColourNeedle w)
-> RGB w -> LinearMap ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB w
r w
g w
b, [w]
l)
  recomposeContraLinMap :: (f (Scalar w) -> w)
-> f (DualVector ColourNeedle) -> ColourNeedle +> w
recomposeContraLinMap f (Scalar w) -> w
f f (DualVector ColourNeedle)
l = RGB w -> LinearMap ℝ ColourNeedle w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (RGB w -> LinearMap ℝ ColourNeedle w)
-> RGB w -> LinearMap ℝ ColourNeedle w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> w -> w -> RGB w
forall a. a -> a -> a -> RGB a
RGB (f ℝ -> w
f (Scalar w) -> w
f (f ℝ -> w) -> f ℝ -> w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ColourNeedle -> ℝ) -> f ColourNeedle -> f ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (RGB ℝ -> ℝ
forall a. RGB a -> a
channelRed (RGB ℝ -> ℝ) -> (ColourNeedle -> RGB ℝ) -> ColourNeedle -> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ColourNeedle -> RGB ℝ
getRGBNeedle) f (DualVector ColourNeedle)
f ColourNeedle
l)
                                              (f ℝ -> w
f (Scalar w) -> w
f (f ℝ -> w) -> f ℝ -> w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ColourNeedle -> ℝ) -> f ColourNeedle -> f ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (RGB ℝ -> ℝ
forall a. RGB a -> a
channelGreen (RGB ℝ -> ℝ) -> (ColourNeedle -> RGB ℝ) -> ColourNeedle -> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ColourNeedle -> RGB ℝ
getRGBNeedle) f (DualVector ColourNeedle)
f ColourNeedle
l)
                                              (f ℝ -> w
f (Scalar w) -> w
f (f ℝ -> w) -> f ℝ -> w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ColourNeedle -> ℝ) -> f ColourNeedle -> f ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (RGB ℝ -> ℝ
forall a. RGB a -> a
channelBlue (RGB ℝ -> ℝ) -> (ColourNeedle -> RGB ℝ) -> ColourNeedle -> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ColourNeedle -> RGB ℝ
getRGBNeedle) f (DualVector ColourNeedle)
f ColourNeedle
l)
  tensorEquality :: (ColourNeedle ⊗ w) -> (ColourNeedle ⊗ w) -> Bool
tensorEquality (Tensor TensorProduct ColourNeedle w
t) (Tensor TensorProduct ColourNeedle w
τ) = RGB w
TensorProduct ColourNeedle w
t RGB w -> RGB w -> Bool
forall a. Eq a => a -> a -> Bool
== RGB w
TensorProduct ColourNeedle w
τ
  recomposeContraLinMapTensor :: (f (Scalar w) -> w)
-> f (ColourNeedle +> DualVector u) -> (ColourNeedle ⊗ u) +> w
recomposeContraLinMapTensor = DualSpaceWitness u
-> (f ℝ -> w)
-> f (ColourNeedle +> DualVector u)
-> (ColourNeedle ⊗ u) +> w
forall u w (f :: * -> *).
(Functor f, FiniteDimensional u, LinearSpace w, Scalar u ~ ℝ,
 Scalar w ~ ℝ) =>
DualSpaceWitness u
-> (f ℝ -> w)
-> f (ColourNeedle +> DualVector u)
-> (ColourNeedle ⊗ u) +> w
rclmt DualSpaceWitness u
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
   where rclmt :: ∀ u w f . ( Hask.Functor f
                            , FiniteDimensional u, LinearSpace w
                            , Scalar u ~ ℝ, Scalar w ~ ℝ )
                          => DualSpaceWitness u
                         -> (f ℝ -> w) -> f (ColourNeedle+>DualVector u)
                            -> (ColourNeedle⊗u)+>w
         rclmt :: DualSpaceWitness u
-> (f ℝ -> w)
-> f (ColourNeedle +> DualVector u)
-> (ColourNeedle ⊗ u) +> w
rclmt DualSpaceWitness u
DualSpaceWitness f ℝ -> w
fw f (ColourNeedle +> DualVector u)
mv = RGB (Tensor ℝ (DualVector u) w)
-> LinearMap ℝ (Tensor ℝ ColourNeedle u) w
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (RGB (Tensor ℝ (DualVector u) w)
 -> LinearMap ℝ (Tensor ℝ ColourNeedle u) w)
-> RGB (Tensor ℝ (DualVector u) w)
-> LinearMap ℝ (Tensor ℝ ColourNeedle u) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
           (\RGB (DualVector u) -> DualVector u
c -> LinearMap ℝ (DualVector (DualVector u)) w
-> Tensor ℝ (DualVector u) w
forall s u v w.
(LinearSpace u, Scalar u ~ s) =>
LinearMap s (DualVector u) w -> Tensor s u w
fromLinearMap (LinearMap ℝ (DualVector (DualVector u)) w
 -> Tensor ℝ (DualVector u) w)
-> LinearMap ℝ (DualVector (DualVector u)) w
-> Tensor ℝ (DualVector u) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (f (Scalar w) -> w) -> f (DualVector u) -> u +> w
forall v w (f :: * -> *).
(FiniteDimensional v, LinearSpace w, Scalar w ~ Scalar v,
 Functor f) =>
(f (Scalar w) -> w) -> f (DualVector v) -> v +> w
recomposeContraLinMap f ℝ -> w
f (Scalar w) -> w
fw
                (f (DualVector u) -> LinearMap ℝ (DualVector (DualVector u)) w)
-> f (DualVector u) -> LinearMap ℝ (DualVector (DualVector u)) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (LinearMap ℝ ColourNeedle (DualVector u) -> DualVector u)
-> f (LinearMap ℝ ColourNeedle (DualVector u)) -> f (DualVector u)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (\(LinearMap TensorProduct (DualVector ColourNeedle) (DualVector u)
q) -> RGB (DualVector u) -> DualVector u
c RGB (DualVector u)
TensorProduct (DualVector ColourNeedle) (DualVector u)
q) f (LinearMap ℝ ColourNeedle (DualVector u))
f (ColourNeedle +> DualVector u)
mv)
                       ((RGB (DualVector u) -> DualVector u) -> Tensor ℝ (DualVector u) w)
-> RGB (RGB (DualVector u) -> DualVector u)
-> RGB (Tensor ℝ (DualVector u) w)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> (RGB (DualVector u) -> DualVector u)
-> (RGB (DualVector u) -> DualVector u)
-> (RGB (DualVector u) -> DualVector u)
-> RGB (RGB (DualVector u) -> DualVector u)
forall a. a -> a -> a -> RGB a
RGB RGB (DualVector u) -> DualVector u
forall a. RGB a -> a
channelRed RGB (DualVector u) -> DualVector u
forall a. RGB a -> a
channelGreen RGB (DualVector u) -> DualVector u
forall a. RGB a -> a
channelBlue
  uncanonicallyFromDual :: DualVector ColourNeedle -+> ColourNeedle
uncanonicallyFromDual = DualVector ColourNeedle -+> ColourNeedle
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  uncanonicallyToDual :: ColourNeedle -+> DualVector ColourNeedle
uncanonicallyToDual = ColourNeedle -+> DualVector ColourNeedle
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id

fromLinearMap :: ∀ s u v w . (LinearSpace u, Scalar u ~ s)
                 => LinearMap s (DualVector u) w -> Tensor s u w
fromLinearMap :: LinearMap s (DualVector u) w -> Tensor s u w
fromLinearMap = case DualSpaceWitness u
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness u of
    DualSpaceWitness u
DualSpaceWitness -> LinearMap s (DualVector u) w -> Tensor s u w
coerce
asTensor :: ∀ s u v w . (LinearSpace u, Scalar u ~ s)
                 => LinearMap s u w -> Tensor s (DualVector u) w
asTensor :: LinearMap s u w -> Tensor s (DualVector u) w
asTensor = LinearMap s u w -> Tensor s (DualVector u) w
coerce
fromTensor :: ∀ s u v w . (LinearSpace u, Scalar u ~ s)
                 => Tensor s (DualVector u) w -> LinearMap s u w
fromTensor :: Tensor s (DualVector u) w -> LinearMap s u w
fromTensor = Tensor s (DualVector u) w -> LinearMap s u w
coerce

  

instance Semimanifold ColourNeedle where
  type Needle ColourNeedle = ColourNeedle
#if MIN_VERSION_manifolds(0,6,0)
  .+~^ :: ColourNeedle -> Needle ColourNeedle -> ColourNeedle
(.+~^) = ColourNeedle -> Needle ColourNeedle -> ColourNeedle
forall v. AdditiveGroup v => v -> v -> v
(^+^)
#else
  fromInterior = id; toInterior = pure
  translateP = pure (^+^)
#endif

instance PseudoAffine ColourNeedle where
  ColourNeedle RGB ℝ
q .-~! :: ColourNeedle -> ColourNeedle -> Needle ColourNeedle
.-~! ColourNeedle RGB ℝ
s = RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ -> ℝ -> ℝ) -> RGB ℝ -> RGB ℝ -> RGB ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) c b a.
(Applicative f r t, Object r c, ObjectMorphism r b c,
 Object t (f c), ObjectMorphism t (f b) (f c), ObjectPair r a b,
 ObjectPair t (f a) (f b)) =>
r a (r b c) -> t (f a) (t (f b) (f c))
liftA2 (-) RGB ℝ
q RGB ℝ
s
  ColourNeedle
q .-~. :: ColourNeedle -> ColourNeedle -> Maybe (Needle ColourNeedle)
.-~. ColourNeedle
s = ColourNeedle -> Maybe ColourNeedle
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (ColourNeedle
qColourNeedle -> ColourNeedle -> Needle ColourNeedle
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!ColourNeedle
s)

instance Atlas ColourNeedle where
  type ChartIndex ColourNeedle = ()
#if !MIN_VERSION_manifolds(0,6,0)
  interiorChartReferencePoint _ () = zeroV
#else
  chartReferencePoint :: ChartIndex ColourNeedle -> ColourNeedle
chartReferencePoint () = ColourNeedle
forall v. AdditiveGroup v => v
zeroV
#endif
  lookupAtlas :: ColourNeedle -> ChartIndex ColourNeedle
lookupAtlas ColourNeedle
_ = ()

#if MIN_VERSION_manifolds(0,6,0)
instance SemimanifoldWithBoundary ColourNeedle where
  type Interior ColourNeedle = ColourNeedle
  type Boundary ColourNeedle = EmptyMfd ℝ⁰
  type HalfNeedle ColourNeedle = ℝay
  smfdWBoundWitness :: SmfdWBoundWitness ColourNeedle
smfdWBoundWitness = SmfdWBoundWitness ColourNeedle
forall m. OpenManifold m => SmfdWBoundWitness m
OpenManifoldWitness
  |+^ :: Boundary ColourNeedle -> HalfNeedle ColourNeedle -> ColourNeedle
(|+^) Boundary ColourNeedle
b = case Boundary ColourNeedle
b of {}
  ColourNeedle
_ .+^| :: ColourNeedle
-> Needle (Interior ColourNeedle)
-> Either
     (Boundary ColourNeedle, Scalar (Needle (Interior ColourNeedle)))
     (Interior ColourNeedle)
.+^| Needle (Interior ColourNeedle)
b = case Needle (Interior ColourNeedle)
b of {}
  fromBoundary :: Boundary ColourNeedle -> ColourNeedle
fromBoundary Boundary ColourNeedle
b = case Boundary ColourNeedle
b of {}
  fromInterior :: Interior ColourNeedle -> ColourNeedle
fromInterior = Interior ColourNeedle -> ColourNeedle
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id

instance PseudoAffineWithBoundary ColourNeedle where
  ColourNeedle
_ !-| :: ColourNeedle -> Boundary ColourNeedle -> HalfNeedle ColourNeedle
!-| Boundary ColourNeedle
b = case Boundary ColourNeedle
b of {}
  .--! :: ColourNeedle -> ColourNeedle -> Needle (Interior ColourNeedle)
(.--!) = ColourNeedle -> ColourNeedle -> Needle (Interior ColourNeedle)
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
(.-~!)

instance ProjectableBoundary ColourNeedle where
  projectToBoundary :: ColourNeedle
-> Boundary ColourNeedle
-> Maybe
     (Needle (Boundary ColourNeedle),
      Scalar (Needle (Interior ColourNeedle)))
projectToBoundary ColourNeedle
_ Boundary ColourNeedle
b = case Boundary ColourNeedle
b of {}
  marginFromBoundary :: Boundary ColourNeedle
-> Scalar (Needle (Interior ColourNeedle)) -> ColourNeedle
marginFromBoundary Boundary ColourNeedle
b Scalar (Needle (Interior ColourNeedle))
_ = case Boundary ColourNeedle
b of {}
#endif

instance AffineSpace ColourNeedle where
  type Diff ColourNeedle = ColourNeedle
  .-. :: ColourNeedle -> ColourNeedle -> Diff ColourNeedle
(.-.) = ColourNeedle -> ColourNeedle -> Diff ColourNeedle
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
(.-~!)
  .+^ :: ColourNeedle -> Diff ColourNeedle -> ColourNeedle
(.+^) = ColourNeedle -> Diff ColourNeedle -> ColourNeedle
forall x. Semimanifold x => x -> Needle x -> x
(.+~^)

fromLtdRGB :: LtdCol -> Colour ℝ
fromLtdRGB :: LtdCol -> Colour ℝ
fromLtdRGB = (CD¹ (ZeroDim ℝ) -> ℝ) -> LtdCol -> RGB ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (\(CD¹ Scalar (Needle (ZeroDim ℝ))
h ZeroDim ℝ
Origin) -> Scalar (Needle (ZeroDim ℝ))
h) (LtdCol -> RGB ℝ) -> (RGB ℝ -> Colour ℝ) -> LtdCol -> Colour ℝ
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \(RGB ℝ
r ℝ
g ℝ
b) -> ℝ -> ℝ -> ℝ -> Colour ℝ
forall a. Fractional a => a -> a -> a -> Colour a
rgb ℝ
r ℝ
g ℝ
b

toLtdRGB :: Colour ℝ -> LtdCol
toLtdRGB :: Colour ℝ -> LtdCol
toLtdRGB = Colour ℝ -> RGB ℝ
forall a. Fractional a => Colour a -> RGB a
toRGB (Colour ℝ -> RGB ℝ) -> (RGB ℝ -> LtdCol) -> Colour ℝ -> LtdCol
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (ℝ -> CD¹ (ZeroDim ℝ)) -> RGB ℝ -> LtdCol
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((Scalar (Needle (ZeroDim ℝ)) -> ZeroDim ℝ -> CD¹ (ZeroDim ℝ)
forall x. Scalar (Needle x) -> x -> CD¹ x
`CD¹`ZeroDim ℝ
forall s. ZeroDim s
Origin) (ℝ -> CD¹ (ZeroDim ℝ)) -> (ℝ -> ℝ) -> ℝ -> CD¹ (ZeroDim ℝ)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ℝ -> ℝ -> ℝ
forall a. Ord a => a -> a -> a
min ℝ
1 (ℝ -> ℝ) -> (ℝ -> ℝ) -> ℝ -> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ℝ -> ℝ -> ℝ
forall a. Ord a => a -> a -> a
max ℝ
0)

type LtdCol = RGB (CD¹ ℝ⁰)

bijectToLtd :: ℝ -> CD¹ ℝ⁰
bijectToLtd :: ℝ -> CD¹ (ZeroDim ℝ)
bijectToLtd ℝ
0 = Scalar (Needle (ZeroDim ℝ)) -> ZeroDim ℝ -> CD¹ (ZeroDim ℝ)
forall x. Scalar (Needle x) -> x -> CD¹ x
CD¹ Scalar (Needle (ZeroDim ℝ))
0.5 ZeroDim ℝ
forall s. ZeroDim s
Origin
bijectToLtd ℝ
y
  | ℝ
ψ ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
0.5    = Scalar (Needle (ZeroDim ℝ)) -> ZeroDim ℝ -> CD¹ (ZeroDim ℝ)
forall x. Scalar (Needle x) -> x -> CD¹ x
CD¹ Scalar (Needle (ZeroDim ℝ))
1 ZeroDim ℝ
forall s. ZeroDim s
Origin
  | ℝ
ψ ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> -ℝ
0.5   = Scalar (Needle (ZeroDim ℝ)) -> ZeroDim ℝ -> CD¹ (ZeroDim ℝ)
forall x. Scalar (Needle x) -> x -> CD¹ x
CD¹ ( ℝ
0.5 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
ψ ) ZeroDim ℝ
forall s. ZeroDim s
Origin
  | Bool
otherwise  = Scalar (Needle (ZeroDim ℝ)) -> ZeroDim ℝ -> CD¹ (ZeroDim ℝ)
forall x. Scalar (Needle x) -> x -> CD¹ x
CD¹ Scalar (Needle (ZeroDim ℝ))
0 ZeroDim ℝ
forall s. ZeroDim s
Origin
 where ψ :: ℝ
ψ = (ℝ
1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ -> ℝ
forall a. Floating a => a -> a
sqrt(ℝ
1ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
yℝ -> Integer -> ℝ
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2)) ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ (ℝ
2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
y)
-- y = (x - 1/2) / (x*(1 - x))
-- y * x * (1 - x) = x - 1/2
-- y * x² - (1 - y) * x - 1/2 = 0
-- y * x² + (y - 1) * x - 1/2 = 0
-- x = (1 - y ± sqrt( (1-y)² + 2*y ) ) / (-2*y)
--   = (y - 1 +! sqrt( 1 + y² ) ) / (2*y)  -- unstable for y ≈ 0
--   = 1/2 - (1 - sqrt( 1 + y² ) ) / (2*y)

bijectFromLtd :: CD¹ ℝ⁰ -> Either S⁰ ℝ
bijectFromLtd :: CD¹ (ZeroDim ℝ) -> Either S⁰ ℝ
bijectFromLtd (CD¹ Scalar (Needle (ZeroDim ℝ))
x ZeroDim ℝ
Origin)
    | ℝ
Scalar (Needle (ZeroDim ℝ))
xℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
<=ℝ
1e-9     = S⁰ -> Either S⁰ ℝ
forall a b. a -> Either a b
Left S⁰
forall r. S⁰_ r
NegativeHalfSphere
    | ℝ
Scalar (Needle (ZeroDim ℝ))
xℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
>=ℝ
1ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
1e-9   = S⁰ -> Either S⁰ ℝ
forall a b. a -> Either a b
Left S⁰
forall r. S⁰_ r
PositiveHalfSphere
    | Bool
otherwise   = ℝ -> Either S⁰ ℝ
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (ℝ -> Either S⁰ ℝ) -> ℝ -> Either S⁰ ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ
Scalar (Needle (ZeroDim ℝ))
x ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
0.5) ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ (ℝ
Scalar (Needle (ZeroDim ℝ))
xℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*(ℝ
1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
Scalar (Needle (ZeroDim ℝ))
x))



#if MIN_VERSION_manifolds(0,6,0)
instance AdditiveMonoid ColourHalfNeedle
instance HalfSpace ColourHalfNeedle
#endif

#if MIN_VERSION_manifolds(0,6,0)
instance QC.Arbitrary ColourBoundary where
  arbitrary :: Gen ColourBoundary
arbitrary = S² -> ColourBoundary
ColourBoundarySphere (S² -> ColourBoundary) -> Gen S² -> Gen ColourBoundary
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Gen S²
forall a. Arbitrary a => Gen a
QC.arbitrary

instance SemimanifoldWithBoundary ColourBoundary where
  type Boundary ColourBoundary = EmptyMfd ℝ⁰
  type Interior ColourBoundary = ColourBoundary
  type HalfNeedle ColourBoundary = ℝay
  smfdWBoundWitness :: SmfdWBoundWitness ColourBoundary
smfdWBoundWitness = SmfdWBoundWitness ColourBoundary
forall m. OpenManifold m => SmfdWBoundWitness m
OpenManifoldWitness
  needleIsOpenMfd :: (OpenManifold (Needle (Interior ColourBoundary)) => r) -> r
needleIsOpenMfd OpenManifold (Needle (Interior ColourBoundary)) => r
q = r
OpenManifold (Needle (Interior ColourBoundary)) => r
q
  Boundary ColourBoundary
b|+^ :: Boundary ColourBoundary
-> HalfNeedle ColourBoundary -> ColourBoundary
|+^HalfNeedle ColourBoundary
_ = case Boundary ColourBoundary
b of {}
  ColourBoundary
_.+^| :: ColourBoundary
-> Needle (Interior ColourBoundary)
-> Either
     (Boundary ColourBoundary,
      Scalar (Needle (Interior ColourBoundary)))
     (Interior ColourBoundary)
.+^|Needle (Interior ColourBoundary)
b = case Needle (Interior ColourBoundary)
b of {}
  fromInterior :: Interior ColourBoundary -> ColourBoundary
fromInterior = Interior ColourBoundary -> ColourBoundary
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  fromBoundary :: Boundary ColourBoundary -> ColourBoundary
fromBoundary Boundary ColourBoundary
b = case Boundary ColourBoundary
b of {}
#endif

instance Hask.Foldable RGB where
  foldMap :: (a -> m) -> RGB a -> m
foldMap a -> m
f (RGB a
r a
g a
b) = a -> m
f a
r m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
g m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
b

projectRGBToColourBoundary :: RGB ℝ -> ColourBoundary
projectRGBToColourBoundary :: RGB ℝ -> ColourBoundary
projectRGBToColourBoundary RGB ℝ
c = S² -> ColourBoundary
ColourBoundarySphere (S² -> ColourBoundary) -> S² -> ColourBoundary
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> S²
forall r. r -> r -> S²_ r
S²Polar ℝ
ϑ ℝ
φ
 where (ℝ
h,ℝ
_,ℝ
l) = RGB ℝ -> (ℝ, ℝ, ℝ)
forall a. (Fractional a, Ord a) => RGB a -> (a, a, a)
hslView RGB ℝ
c
       φ :: ℝ
φ = ℝ
hℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
forall a. Floating a => a
piℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
360 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
forall a. Floating a => a
pi
       ϑ :: ℝ
ϑ = ℝ
l ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* ℝ
forall a. Floating a => a
pi

#if MIN_VERSION_manifolds(0,6,0)
instance SemimanifoldWithBoundary (Colour ℝ) where
  type Boundary (Colour ℝ) = ColourBoundary
  type HalfNeedle (Colour ℝ) = ColourHalfNeedle
  smfdWBoundWitness :: SmfdWBoundWitness (Colour ℝ)
smfdWBoundWitness = SmfdWBoundWitness (Colour ℝ)
forall a. HasCallStack => a
undefined -- SmfdWBoundWitness
  needleIsOpenMfd :: (OpenManifold (Needle (Interior (Colour ℝ))) => r) -> r
needleIsOpenMfd OpenManifold (Needle (Interior (Colour ℝ))) => r
q = r
OpenManifold (Needle (Interior (Colour ℝ))) => r
q
  fromBoundary :: Boundary (Colour ℝ) -> Colour ℝ
fromBoundary (ColourBoundarySphere (S²Polar ϑ φ))
        = RGB ℝ -> Colour ℝ
forall a. Fractional a => RGB a -> Colour a
fromRGB (RGB ℝ -> Colour ℝ) -> RGB ℝ -> Colour ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. (RealFrac a, Ord a) => a -> a -> a -> RGB a
hsl ((ℝ
φℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
forall a. Floating a => a
pi)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
360ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/(ℝ
2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
forall a. Floating a => a
pi)) ℝ
1 (ℝ
ϑℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
forall a. Floating a => a
pi)
  Boundary (Colour ℝ)
b |+^ :: Boundary (Colour ℝ) -> HalfNeedle (Colour ℝ) -> Colour ℝ
|+^ ColourHalfNeedle (Cℝay d Origin) δb
        = RGB ℝ -> Colour ℝ
forall a. Fractional a => RGB a -> Colour a
fromRGB (RGB ℝ -> Colour ℝ) -> RGB ℝ -> Colour ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. (RealFrac a, Ord a) => a -> a -> a -> RGB a
hsl ((ℝ
φℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
forall a. Floating a => a
pi)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
360ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/(ℝ
2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
forall a. Floating a => a
pi)) (ℝ
1ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/(ℝ
Scalar (Needle (ZeroDim ℝ))
dℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
1)) (ℝ
0.5 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ (ℝ
ϑℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
forall a. Floating a => a
piℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
0.5)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/(ℝ
Scalar (Needle (ZeroDim ℝ))
dℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
1))
   where ColourBoundarySphere (S²Polar ℝ
ϑ ℝ
φ) = Boundary (Colour ℝ)
ColourBoundary
bColourBoundary -> Needle ColourBoundary -> ColourBoundary
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle ColourBoundary
δb
  Colour ℝ
c .+^| :: Colour ℝ
-> Needle (Interior (Colour ℝ))
-> Either
     (Boundary (Colour ℝ), Scalar (Needle (Interior (Colour ℝ))))
     (Interior (Colour ℝ))
.+^| ColourNeedle dc
    | ℝ
ηℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
>ℝ
1        = (ColourBoundary, ℝ) -> Either (ColourBoundary, ℝ) ColourNeedle
forall a b. a -> Either a b
Left (RGB ℝ -> ColourBoundary
projectRGBToColourBoundary (RGB ℝ -> ColourBoundary) -> RGB ℝ -> ColourBoundary
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
(+)(ℝ -> ℝ -> ℝ) -> (ℝ -> ℝ) -> ℝ -> ℝ -> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.(ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
η) (ℝ -> ℝ -> ℝ) -> RGB ℝ -> RGB (ℝ -> ℝ)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> RGB ℝ
dc RGB (ℝ -> ℝ) -> RGB ℝ -> RGB ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
 ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
 ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
 Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*> RGB ℝ
rgb, ℝ
η ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
1)
    | Bool
otherwise  = case Colour ℝ -> Either ColourBoundary ColourNeedle
forall m.
SemimanifoldWithBoundary m =>
m -> Either (Boundary m) (Interior m)
separateInterior (Colour ℝ -> Either ColourBoundary ColourNeedle)
-> (RGB ℝ -> Colour ℝ)
-> RGB ℝ
-> Either ColourBoundary ColourNeedle
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. RGB ℝ -> Colour ℝ
forall a. Fractional a => RGB a -> Colour a
fromRGB (RGB ℝ -> Either ColourBoundary ColourNeedle)
-> RGB ℝ -> Either ColourBoundary ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
(+)(ℝ -> ℝ -> ℝ) -> RGB ℝ -> RGB (ℝ -> ℝ)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>RGB ℝ
dcRGB (ℝ -> ℝ) -> RGB ℝ -> RGB ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
 ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
 ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
 Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*>RGB ℝ
rgb of
                     Right ColourNeedle
c' -> ColourNeedle -> Either (ColourBoundary, ℝ) ColourNeedle
forall a b. b -> Either a b
Right ColourNeedle
c'
                     Left ColourBoundary
c'b -> [Char] -> Either (ColourBoundary, ℝ) ColourNeedle
forall a. HasCallStack => [Char] -> a
error ([Char] -> Either (ColourBoundary, ℝ) ColourNeedle)
-> [Char] -> Either (ColourBoundary, ℝ) ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ, RGB ℝ) -> [Char]
forall a. Show a => a -> [Char]
show (ℝ
η, ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
(+)(ℝ -> ℝ -> ℝ) -> RGB ℝ -> RGB (ℝ -> ℝ)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>RGB ℝ
dcRGB (ℝ -> ℝ) -> RGB ℝ -> RGB ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
 ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
 ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
 Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*>RGB ℝ
rgb)
   where rgb :: RGB ℝ
rgb = Colour ℝ -> RGB ℝ
forall a. Fractional a => Colour a -> RGB a
toRGB Colour ℝ
c
         η :: ℝ
η = RGB ℝ -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (RGB ℝ -> ℝ) -> RGB ℝ -> ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (\ℝ
m ℝ
d -> if ℝ
dℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
>ℝ
0 then if ℝ
mℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
<ℝ
1 then ℝ
dℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/(ℝ
1ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
m) else ℝ
huge
                                 else if ℝ
dℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
<ℝ
0 then -ℝ
dℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
m
                                 else ℝ
0)
                      (ℝ -> ℝ -> ℝ) -> RGB ℝ -> RGB (ℝ -> ℝ)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> RGB ℝ
rgb RGB (ℝ -> ℝ) -> RGB ℝ -> RGB ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
 ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
 ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
 Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*> RGB ℝ
dc
         huge :: ℝ
huge = ℝ
1e12
  separateInterior :: Colour ℝ -> Either (Boundary (Colour ℝ)) (Interior (Colour ℝ))
separateInterior Colour ℝ
c = case LtdCol -> Either S⁰ (RGB ℝ)
toin (LtdCol -> Either S⁰ (RGB ℝ)) -> LtdCol -> Either S⁰ (RGB ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Colour ℝ -> LtdCol
toLtdRGB Colour ℝ
c of
           Left S⁰
_ -> ColourBoundary -> Either ColourBoundary ColourNeedle
forall a b. a -> Either a b
Left (ColourBoundary -> Either ColourBoundary ColourNeedle)
-> (RGB ℝ -> ColourBoundary)
-> RGB ℝ
-> Either ColourBoundary ColourNeedle
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. RGB ℝ -> ColourBoundary
projectRGBToColourBoundary (RGB ℝ -> Either ColourBoundary ColourNeedle)
-> RGB ℝ -> Either ColourBoundary ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Colour ℝ -> RGB ℝ
forall a. Fractional a => Colour a -> RGB a
toRGB Colour ℝ
c
           Right RGB ℝ
ci -> ColourNeedle -> Either ColourBoundary ColourNeedle
forall a b. b -> Either a b
Right (ColourNeedle -> Either ColourBoundary ColourNeedle)
-> ColourNeedle -> Either ColourBoundary ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ RGB ℝ -> ColourNeedle
ColourNeedle RGB ℝ
ci
   where rgb :: RGB ℝ
rgb = Colour ℝ -> RGB ℝ
forall a. Fractional a => Colour a -> RGB a
toRGB Colour ℝ
c
         toin :: LtdCol -> Either S⁰ (RGB ℝ)
toin (RGB CD¹ (ZeroDim ℝ)
r CD¹ (ZeroDim ℝ)
g CD¹ (ZeroDim ℝ)
b) = (ℝ -> ℝ -> ℝ -> RGB ℝ)
-> Either S⁰ ℝ -> Either S⁰ ℝ -> Either S⁰ ℝ -> Either S⁰ (RGB ℝ)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) c d b a.
(Applicative f r t, Object r c, Object r d, ObjectMorphism r c d,
 ObjectMorphism r b (r c d), Object r (r c d), ObjectPair r a b,
 ObjectPair r (r c d) c, Object t (f c), Object t (f d),
 Object t (f a, f b), ObjectMorphism t (f c) (f d),
 ObjectMorphism t (f b) (t (f c) (f d)), Object t (t (f c) (f d)),
 ObjectPair t (f a) (f b), ObjectPair t (t (f c) (f d)) (f c),
 ObjectPair t (f (r c d)) (f c)) =>
r a (r b (r c d)) -> t (f a) (t (f b) (t (f c) (f d)))
liftA3 ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB (CD¹ (ZeroDim ℝ) -> Either S⁰ ℝ
bijectFromLtd CD¹ (ZeroDim ℝ)
r) (CD¹ (ZeroDim ℝ) -> Either S⁰ ℝ
bijectFromLtd CD¹ (ZeroDim ℝ)
g) (CD¹ (ZeroDim ℝ) -> Either S⁰ ℝ
bijectFromLtd CD¹ (ZeroDim ℝ)
b)
#else
instance Semimanifold (Colour ℝ) where
  type Needle (Colour ℝ) = ColourNeedle
#endif
  type Interior (Colour ℝ) = ColourNeedle
  fromInterior :: Interior (Colour ℝ) -> Colour ℝ
fromInterior (ColourNeedle q) = LtdCol -> Colour ℝ
fromLtdRGB (LtdCol -> Colour ℝ) -> LtdCol -> Colour ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ -> CD¹ (ZeroDim ℝ)) -> RGB ℝ -> LtdCol
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ℝ -> CD¹ (ZeroDim ℝ)
bijectToLtd RGB ℝ
q
  toInterior :: Colour ℝ -> Maybe (Interior (Colour ℝ))
toInterior = (RGB ℝ -> ColourNeedle) -> Maybe (RGB ℝ) -> Maybe ColourNeedle
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap RGB ℝ -> ColourNeedle
ColourNeedle (Maybe (RGB ℝ) -> Maybe ColourNeedle)
-> (Colour ℝ -> Maybe (RGB ℝ)) -> Colour ℝ -> Maybe ColourNeedle
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Either S⁰ (RGB ℝ) -> Maybe (RGB ℝ)
forall a b. Either a b -> Maybe b
eitherToMaybe (Either S⁰ (RGB ℝ) -> Maybe (RGB ℝ))
-> (Colour ℝ -> Either S⁰ (RGB ℝ)) -> Colour ℝ -> Maybe (RGB ℝ)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. LtdCol -> Either S⁰ (RGB ℝ)
toin (LtdCol -> Either S⁰ (RGB ℝ))
-> (Colour ℝ -> LtdCol) -> Colour ℝ -> Either S⁰ (RGB ℝ)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Colour ℝ -> LtdCol
toLtdRGB
   where toin :: LtdCol -> Either S⁰ (RGB ℝ)
toin (RGB CD¹ (ZeroDim ℝ)
r CD¹ (ZeroDim ℝ)
g CD¹ (ZeroDim ℝ)
b) = (ℝ -> ℝ -> ℝ -> RGB ℝ)
-> Either S⁰ ℝ -> Either S⁰ ℝ -> Either S⁰ ℝ -> Either S⁰ (RGB ℝ)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) c d b a.
(Applicative f r t, Object r c, Object r d, ObjectMorphism r c d,
 ObjectMorphism r b (r c d), Object r (r c d), ObjectPair r a b,
 ObjectPair r (r c d) c, Object t (f c), Object t (f d),
 Object t (f a, f b), ObjectMorphism t (f c) (f d),
 ObjectMorphism t (f b) (t (f c) (f d)), Object t (t (f c) (f d)),
 ObjectPair t (f a) (f b), ObjectPair t (t (f c) (f d)) (f c),
 ObjectPair t (f (r c d)) (f c)) =>
r a (r b (r c d)) -> t (f a) (t (f b) (t (f c) (f d)))
liftA3 ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB (CD¹ (ZeroDim ℝ) -> Either S⁰ ℝ
bijectFromLtd CD¹ (ZeroDim ℝ)
r) (CD¹ (ZeroDim ℝ) -> Either S⁰ ℝ
bijectFromLtd CD¹ (ZeroDim ℝ)
g) (CD¹ (ZeroDim ℝ) -> Either S⁰ ℝ
bijectFromLtd CD¹ (ZeroDim ℝ)
b)
#if !MIN_VERSION_manifolds(0,6,0)
  translateP = pure (^+^)
#endif

#if MIN_VERSION_manifolds(0,6,0)
instance PseudoAffineWithBoundary (Colour ℝ) where
  Colour ℝ
c .--! :: Colour ℝ -> Colour ℝ -> Needle (Interior (Colour ℝ))
.--! Colour ℝ
d = RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (-) (ℝ -> ℝ -> ℝ) -> RGB ℝ -> RGB (ℝ -> ℝ)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Colour ℝ -> RGB ℝ
forall a. Fractional a => Colour a -> RGB a
toRGB Colour ℝ
c RGB (ℝ -> ℝ) -> RGB ℝ -> RGB ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
 ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
 ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
 Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*> Colour ℝ -> RGB ℝ
forall a. Fractional a => Colour a -> RGB a
toRGB Colour ℝ
d
#else
instance PseudoAffine (Colour ℝ) where
  c .-~. ζ = liftA2 (^-^) (toInterior c) (toInterior ζ)
#endif

eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe (Left a
_) = Maybe b
forall a. Maybe a
Nothing
eitherToMaybe (Right b
x) = b -> Maybe b
forall a. a -> Maybe a
Just b
x

instance Geodesic (Colour ℝ) where
  geodesicBetween :: Colour ℝ -> Colour ℝ -> Maybe (D¹ -> Colour ℝ)
geodesicBetween Colour ℝ
a Colour ℝ
b = (D¹ -> Colour ℝ) -> Maybe (D¹ -> Colour ℝ)
forall (m :: * -> *) a. Monad m (->) => a -> m a
return ((D¹ -> Colour ℝ) -> Maybe (D¹ -> Colour ℝ))
-> (D¹ -> Colour ℝ) -> Maybe (D¹ -> Colour ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(D¹ ℝ
q) -> ℝ -> Colour ℝ -> Colour ℝ -> Colour ℝ
forall a (f :: * -> *).
(Num a, AffineSpace f) =>
a -> f a -> f a -> f a
blend ((ℝ
qℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
1)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2) Colour ℝ
b Colour ℝ
a

instance Geodesic ColourNeedle where
  geodesicBetween :: ColourNeedle -> ColourNeedle -> Maybe (D¹ -> ColourNeedle)
geodesicBetween (ColourNeedle (RGB ℝ
r ℝ
g ℝ
b)) (ColourNeedle (RGB ℝ
r' ℝ
g' ℝ
b'))
                 = (D¹ -> ColourNeedle) -> Maybe (D¹ -> ColourNeedle)
forall (m :: * -> *) a. Monad m (->) => a -> m a
return ((D¹ -> ColourNeedle) -> Maybe (D¹ -> ColourNeedle))
-> (D¹ -> ColourNeedle) -> Maybe (D¹ -> ColourNeedle)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(D¹ ℝ
q) -> let η' :: ℝ
η' = (ℝ
qℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
1)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2 in RGB ℝ -> ColourNeedle
ColourNeedle
                                        (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB (ℝ -> ℝ -> Scalar ℝ -> ℝ
forall v. VectorSpace v => v -> v -> Scalar v -> v
lerp ℝ
r ℝ
r' ℝ
Scalar ℝ
η')
                                              (ℝ -> ℝ -> Scalar ℝ -> ℝ
forall v. VectorSpace v => v -> v -> Scalar v -> v
lerp ℝ
g ℝ
g' ℝ
Scalar ℝ
η')
                                              (ℝ -> ℝ -> Scalar ℝ -> ℝ
forall v. VectorSpace v => v -> v -> Scalar v -> v
lerp ℝ
b ℝ
b' ℝ
Scalar ℝ
η')

instance Atlas (Colour ℝ) where
  type ChartIndex (Colour ℝ) = ()
  chartReferencePoint :: ChartIndex (Colour ℝ) -> Colour ℝ
chartReferencePoint () = Colour ℝ
forall a. (Ord a, Floating a) => Colour a
grey
#if !MIN_VERSION_manifolds(0,6,0)
  interiorChartReferencePoint = \_ () -> intGrey
   where Just intGrey = toInterior (grey :: Colour ℝ)
#endif
  lookupAtlas :: Colour ℝ -> ChartIndex (Colour ℝ)
lookupAtlas Colour ℝ
_ = ()

class QuantisedColour c where
  quantiseColour :: Colour ℝ -> c

instance QuantisedColour PixelRGBF where
  quantiseColour :: Colour ℝ -> PixelRGBF
quantiseColour Colour ℝ
c = PixelF -> PixelF -> PixelF -> PixelRGBF
PixelRGBF PixelF
r PixelF
g PixelF
b
   where RGB PixelF
r PixelF
g PixelF
b = (ℝ -> PixelF) -> RGB ℝ -> RGB PixelF
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ℝ -> PixelF
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RGB ℝ -> RGB PixelF) -> RGB ℝ -> RGB PixelF
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Colour ℝ -> RGB ℝ
forall b. (Ord b, Floating b) => Colour b -> RGB b
toSRGB Colour ℝ
c
  
instance QuantisedColour PixelRGB8 where
  quantiseColour :: Colour ℝ -> PixelRGB8
quantiseColour Colour ℝ
c = Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 Pixel8
r Pixel8
g Pixel8
b
   where RGB Pixel8
r Pixel8
g Pixel8
b = Colour ℝ -> RGB Pixel8
forall b. (RealFrac b, Floating b) => Colour b -> RGB Pixel8
toSRGB24 Colour ℝ
c


-- | A two-dimensional, smoothly varying colour palette.
data ColourMap x = ColourMap {
       ColourMap x -> ColourPlane
_cmPlane :: ColourPlane
     , ColourMap x -> ℝ
_cmSpectSwing :: ℝ
     }

planarColourMap :: ColourPlane -> ColourMap x
planarColourMap :: ColourPlane -> ColourMap x
planarColourMap = (ColourPlane -> ℝ -> ColourMap x
forall x. ColourPlane -> ℝ -> ColourMap x
`ColourMap`ℝ
0)

colourCurve :: ColourPlane -> ℝ -> ColourMap ℝ
colourCurve :: ColourPlane -> ℝ -> ColourMap ℝ
colourCurve = ColourPlane -> ℝ -> ColourMap ℝ
forall x. ColourPlane -> ℝ -> ColourMap x
ColourMap

spectralSwing :: (Needle x ~ ℝ) => Traversal' (ColourMap x) ℝ
spectralSwing :: Traversal' (ColourMap x) ℝ
spectralSwing = (ColourMap x -> ℝ)
-> (ColourMap x -> ℝ -> ColourMap x)
-> Lens (ColourMap x) (ColourMap x) ℝ ℝ
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourMap x -> ℝ
forall x. ColourMap x -> ℝ
_cmSpectSwing (\ColourMap x
cm ℝ
sw' -> ColourMap x
cm{_cmSpectSwing :: ℝ
_cmSpectSwing = ℝ
sw'})

colourMapPlane :: Traversal' (ColourMap x) ColourPlane
colourMapPlane :: (ColourPlane -> f ColourPlane) -> ColourMap x -> f (ColourMap x)
colourMapPlane = (ColourMap x -> ColourPlane)
-> (ColourMap x -> ColourPlane -> ColourMap x)
-> Lens (ColourMap x) (ColourMap x) ColourPlane ColourPlane
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourMap x -> ColourPlane
forall x. ColourMap x -> ColourPlane
_cmPlane (\ColourMap x
cm ColourPlane
pl' -> ColourMap x
cm{_cmPlane :: ColourPlane
_cmPlane = ColourPlane
pl'})

fromRGB :: Fractional a => RGB a -> Colour a
fromRGB :: RGB a -> Colour a
fromRGB (RGB a
r a
g a
b) = a -> a -> a -> Colour a
forall a. Fractional a => a -> a -> a -> Colour a
rgb a
r a
g a
b

data ColourPlane = ColourPlane {
        ColourPlane -> Colour ℝ
_cpCold :: Colour ℝ
      , ColourPlane -> Interior (Colour ℝ)
_cpNeutral :: Interior (Colour ℝ)
      , ColourPlane -> Colour ℝ
_cpHot :: Colour ℝ
      }
makeLenses ''ColourPlane

spanColourPlane :: Interior (Colour ℝ)   -- ^ Neutral colour
                -> (Colour ℝ, Colour ℝ)  -- ^ Extreme “cold” / “hot” colours
                -> ColourPlane
spanColourPlane :: Interior (Colour ℝ) -> (Colour ℝ, Colour ℝ) -> ColourPlane
spanColourPlane Interior (Colour ℝ)
neutral (Colour ℝ
cold,Colour ℝ
hot) = Colour ℝ -> Interior (Colour ℝ) -> Colour ℝ -> ColourPlane
ColourPlane Colour ℝ
cold Interior (Colour ℝ)
neutral Colour ℝ
hot

class Geodesic x => ColourMappable x where
  type ColourMapped x :: *
  type MappingVertex x :: *
  mapToColourWith :: HasCallStack
                  => ColourMap (MappingVertex x)
                  -> Interior (MappingVertex x)
                  -> (MappingVertex x, MappingVertex x)
                  -> x
                  -> ColourMapped x

instance ColourMappable ℝ where
  type ColourMapped ℝ = Colour ℝ
  type MappingVertex ℝ = ℝ
  mapToColourWith :: ColourMap (MappingVertex ℝ)
-> Interior (MappingVertex ℝ)
-> (MappingVertex ℝ, MappingVertex ℝ)
-> ℝ
-> ColourMapped ℝ
mapToColourWith (ColourMap (ColourPlane Colour ℝ
coldC Interior (Colour ℝ)
neutralC Colour ℝ
hotC) ℝ
swing)
              Interior (MappingVertex ℝ)
neutralP (MappingVertex ℝ
coldP, MappingVertex ℝ
hotP)
        = (\(Shade ColourNeedle
c Metric' ColourNeedle
_) -> Interior (Colour ℝ) -> Colour ℝ
forall m. SemimanifoldWithBoundary m => Interior m -> m
fromInterior Interior (Colour ℝ)
ColourNeedle
c)
           (Shade ColourNeedle -> Colour ℝ)
-> (ℝ -> Shade ColourNeedle) -> ℝ -> Colour ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Shade (ℝ, ℝ) -> Shade ColourNeedle
shFn
           (Shade (ℝ, ℝ) -> Shade ColourNeedle)
-> (ℝ -> Shade (ℝ, ℝ)) -> ℝ -> Shade ColourNeedle
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. \ℝ
x -> let φ :: ℝ
φ = ℝ
2ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*(ℝ
xℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
Interior (MappingVertex ℝ)
neutralP)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/(ℝ
MappingVertex ℝ
hotPℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
MappingVertex ℝ
coldP)
                   in (ℝ, ℝ) -> Metric' (ℝ, ℝ) -> Shade (ℝ, ℝ)
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade ( (ℝ
1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
φ)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ (ℝ
φℝ -> Integer -> ℝ
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
1)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ -> ℝ
forall a. Floating a => a -> a
exp ℝ
swingℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2
                            , (ℝ
φ ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
1)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ (ℝ
φℝ -> Integer -> ℝ
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
1)ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ -> ℝ
forall a. Floating a => a -> a
exp ℝ
swingℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2 )
                            ([DualVector (ℝ, ℝ)] -> Seminorm (ℝ, ℝ)
forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [(ℝ
256,ℝ
0), (ℝ
0,ℝ
256)])
                                     :: Shade (ℝ,ℝ)
   where Just Shade (ℝ, ℝ) -> Shade ColourNeedle
shFn = (Interior (ℝ, ℝ), Interior (Colour ℝ))
-> [((ℝ, ℝ), Colour ℝ)]
-> Maybe (Shade (Interior (ℝ, ℝ)) -> Shade (Interior (Colour ℝ)))
forall i m (t :: * -> *) s.
(Geodesic i, Geodesic m, WithField s AffineManifold (Interior i),
 WithField s AffineManifold (Interior m),
 SimpleSpace (Needle (Interior i)),
 SimpleSpace (Needle (Interior m)),
 SimpleSpace (Needle' (Interior i)),
 SimpleSpace (Needle' (Interior m)), RealFrac' s, Traversable t) =>
(Interior i, Interior m)
-> t (i, m) -> Maybe (Shade (Interior i) -> Shade (Interior m))
rangeWithinVertices ((ℝ
0,ℝ
0), Interior (Colour ℝ)
neutralC)
                                        [((ℝ
1,ℝ
0) :: (ℝ,ℝ), Colour ℝ
coldC), ((ℝ
0,ℝ
1), Colour ℝ
hotC)]

instance ColourMappable (ℝ,ℝ) where
  type ColourMapped (ℝ,ℝ) = Colour ℝ
  type MappingVertex (ℝ,ℝ) = (ℝ,ℝ)
  mapToColourWith :: ColourMap (MappingVertex (ℝ, ℝ))
-> Interior (MappingVertex (ℝ, ℝ))
-> (MappingVertex (ℝ, ℝ), MappingVertex (ℝ, ℝ))
-> (ℝ, ℝ)
-> ColourMapped (ℝ, ℝ)
mapToColourWith (ColourMap ColourPlane
cp ℝ
swing)
              (xN,yN) ((xCold,yCold), (xHot,yHot))
      = ColourMap (MappingVertex (V2 ℝ))
-> Interior (MappingVertex (V2 ℝ))
-> (MappingVertex (V2 ℝ), MappingVertex (V2 ℝ))
-> V2 ℝ
-> ColourMapped (V2 ℝ)
forall x.
(ColourMappable x, HasCallStack) =>
ColourMap (MappingVertex x)
-> Interior (MappingVertex x)
-> (MappingVertex x, MappingVertex x)
-> x
-> ColourMapped x
mapToColourWith (ColourPlane -> ℝ -> ColourMap (V2 ℝ)
forall x. ColourPlane -> ℝ -> ColourMap x
ColourMap ColourPlane
cp ℝ
swing) (ℝ -> ℝ -> V2 ℝ
forall a. a -> a -> V2 a
V2 ℝ
xN ℝ
yN) (ℝ -> ℝ -> V2 ℝ
forall a. a -> a -> V2 a
V2 ℝ
xCold ℝ
yCold, ℝ -> ℝ -> V2 ℝ
forall a. a -> a -> V2 a
V2 ℝ
xHot ℝ
yHot)
          (V2 ℝ -> Colour ℝ) -> ((ℝ, ℝ) -> V2 ℝ) -> (ℝ, ℝ) -> Colour ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. \(ℝ
x,ℝ
y) -> (ℝ -> ℝ -> V2 ℝ
forall a. a -> a -> V2 a
V2 ℝ
x ℝ
y)

instance ColourMappable ℝ² where
  type ColourMapped ℝ² = Colour ℝ
  type MappingVertex ℝ² = ℝ²
  mapToColourWith :: ColourMap (MappingVertex (V2 ℝ))
-> Interior (MappingVertex (V2 ℝ))
-> (MappingVertex (V2 ℝ), MappingVertex (V2 ℝ))
-> V2 ℝ
-> ColourMapped (V2 ℝ)
mapToColourWith (ColourMap (ColourPlane Colour ℝ
coldC Interior (Colour ℝ)
neutralC Colour ℝ
hotC) ℝ
swing)
              Interior (MappingVertex (V2 ℝ))
neutralP (MappingVertex (V2 ℝ)
coldP, MappingVertex (V2 ℝ)
hotP)
        = (\(Shade ColourNeedle
c Metric' ColourNeedle
_) -> Interior (Colour ℝ) -> Colour ℝ
forall m. SemimanifoldWithBoundary m => Interior m -> m
fromInterior Interior (Colour ℝ)
ColourNeedle
c)
           (Shade ColourNeedle -> Colour ℝ)
-> (V2 ℝ -> Shade ColourNeedle) -> V2 ℝ -> Colour ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Shade (V2 ℝ) -> Shade ColourNeedle
shFn
           (Shade (V2 ℝ) -> Shade ColourNeedle)
-> (V2 ℝ -> Shade (V2 ℝ)) -> V2 ℝ -> Shade ColourNeedle
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. \V2 ℝ
xy -> V2 ℝ -> Metric' (V2 ℝ) -> Shade (V2 ℝ)
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade V2 ℝ
xy Norm (V2 ℝ)
Metric' (V2 ℝ)
quantisationNorm
   where Just Shade (V2 ℝ) -> Shade ColourNeedle
shFn = (Interior (V2 ℝ), Interior (Colour ℝ))
-> [(V2 ℝ, Colour ℝ)]
-> Maybe (Shade (Interior (V2 ℝ)) -> Shade (Interior (Colour ℝ)))
forall i m (t :: * -> *) s.
(Geodesic i, Geodesic m, WithField s AffineManifold (Interior i),
 WithField s AffineManifold (Interior m),
 SimpleSpace (Needle (Interior i)),
 SimpleSpace (Needle (Interior m)),
 SimpleSpace (Needle' (Interior i)),
 SimpleSpace (Needle' (Interior m)), RealFrac' s, Traversable t) =>
(Interior i, Interior m)
-> t (i, m) -> Maybe (Shade (Interior i) -> Shade (Interior m))
rangeWithinVertices (Interior (V2 ℝ)
Interior (MappingVertex (V2 ℝ))
neutralP, Interior (Colour ℝ)
neutralC)
                                        [(V2 ℝ
MappingVertex (V2 ℝ)
coldP, Colour ℝ
coldC), (V2 ℝ
MappingVertex (V2 ℝ)
hotP, Colour ℝ
hotC)]
         quantisationNorm :: Norm (V2 ℝ)
quantisationNorm = Scalar (V2 ℝ) -> Norm (V2 ℝ) -> Norm (V2 ℝ)
forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm Scalar (V2 ℝ)
256 (Norm (V2 ℝ) -> Norm (V2 ℝ))
-> (Norm (V2 ℝ) -> Norm (V2 ℝ)) -> Norm (V2 ℝ) -> Norm (V2 ℝ)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Norm (V2 ℝ) -> Norm (V2 ℝ)
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm
                              (Norm (V2 ℝ) -> Norm (V2 ℝ)) -> Norm (V2 ℝ) -> Norm (V2 ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [V2 ℝ] -> Variance (V2 ℝ)
forall v. LSpace v => [v] -> Variance v
spanVariance [V2 ℝ
MappingVertex (V2 ℝ)
coldPV2 ℝ -> V2 ℝ -> V2 ℝ
forall v. AdditiveGroup v => v -> v -> v
^-^V2 ℝ
Interior (MappingVertex (V2 ℝ))
neutralP, V2 ℝ
MappingVertex (V2 ℝ)
hotPV2 ℝ -> V2 ℝ -> V2 ℝ
forall v. AdditiveGroup v => v -> v -> v
^-^V2 ℝ
Interior (MappingVertex (V2 ℝ))
neutralP]


class ColourMappable x => HasSimpleColourMaps x where
  simpleColourMap :: ColourPlane -> ℝ -> ColourMap x
  simpleColourMap = ColourMap x -> ℝ -> ColourMap x
forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const (ColourMap x -> ℝ -> ColourMap x)
-> (ColourPlane -> ColourMap x) -> ColourPlane -> ℝ -> ColourMap x
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ColourPlane -> ColourMap x
forall x. ColourPlane -> ColourMap x
planarColourMap

instance HasSimpleColourMaps ℝ where
  simpleColourMap :: ColourPlane -> ℝ -> ColourMap ℝ
simpleColourMap = ColourPlane -> ℝ -> ColourMap ℝ
colourCurve

instance HasSimpleColourMaps (ℝ,ℝ)
instance HasSimpleColourMaps ℝ²

type SimpleColourMap = ∀ x . HasSimpleColourMaps x => ColourMap x

blackBlueYellowRed :: SimpleColourMap
blackBlueYellowRed :: ColourMap x
blackBlueYellowRed
   = ColourPlane -> ℝ -> ColourMap x
forall x. HasSimpleColourMaps x => ColourPlane -> ℝ -> ColourMap x
simpleColourMap (Interior (Colour ℝ) -> (Colour ℝ, Colour ℝ) -> ColourPlane
spanColourPlane Interior (Colour ℝ)
ColourNeedle
neutralc (Colour ℝ
forall a. (Ord a, Floating a) => Colour a
darkblue,Colour ℝ
forall a. (Ord a, Floating a) => Colour a
goldenrod)) ℝ
1
 where Just ColourNeedle
neutralc = Colour ℝ -> Maybe (Interior (Colour ℝ))
forall m. SemimanifoldWithBoundary m => m -> Maybe (Interior m)
toInterior (Colour ℝ
forall a. (Ord a, Floating a) => Colour a
dimgrey :: Colour ℝ)

redVsBlue :: SimpleColourMap
redVsBlue :: ColourMap x
redVsBlue
   = ColourPlane -> ℝ -> ColourMap x
forall x. HasSimpleColourMaps x => ColourPlane -> ℝ -> ColourMap x
simpleColourMap (Interior (Colour ℝ) -> (Colour ℝ, Colour ℝ) -> ColourPlane
spanColourPlane Interior (Colour ℝ)
ColourNeedle
neutralc (ℝ -> ℝ -> ℝ -> Colour ℝ
forall a. Fractional a => a -> a -> a -> Colour a
rgb ℝ
0.9 ℝ
0 ℝ
0.2, ℝ -> ℝ -> ℝ -> Colour ℝ
forall a. Fractional a => a -> a -> a -> Colour a
rgb ℝ
0.1 ℝ
0.3 ℝ
1)) (-ℝ
1ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2)
 where neutralc :: ColourNeedle
neutralc = RGB ℝ -> ColourNeedle
ColourNeedle (RGB ℝ -> ColourNeedle) -> RGB ℝ -> ColourNeedle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> RGB ℝ
forall a. a -> a -> a -> RGB a
RGB (-ℝ
1.2) (-ℝ
0.5) (-ℝ
1.5)

brightVsRed :: SimpleColourMap
brightVsRed :: ColourMap x
brightVsRed
   = ColourPlane -> ℝ -> ColourMap x
forall x. HasSimpleColourMaps x => ColourPlane -> ℝ -> ColourMap x
simpleColourMap (Interior (Colour ℝ) -> (Colour ℝ, Colour ℝ) -> ColourPlane
spanColourPlane Interior (Colour ℝ)
ColourNeedle
neutralc (Colour ℝ
forall a. (Ord a, Floating a) => Colour a
white, Colour ℝ
forall a. (Ord a, Floating a) => Colour a
orangered)) ℝ
1
 where Just ColourNeedle
neutralc = Colour ℝ -> Maybe (Interior (Colour ℝ))
forall m. SemimanifoldWithBoundary m => m -> Maybe (Interior m)
toInterior (Colour ℝ
forall a. (Ord a, Floating a) => Colour a
darkgrey :: Colour ℝ)