Safe Haskell | None |
---|---|
Language | Haskell2010 |
See NumericPrelude.AffineSpace for design discussion.
- class C a => C a v where
- scale :: C a v => (a, v) -> v
- scaleAccumulate :: C a v => (a, v) -> v -> v
- (+.*) :: C a v => v -> (a, v) -> v
- combine2 :: C a v => a -> (v, v) -> v
- combineMany :: C a v => (a, T a) -> (v, T v) -> v
- scaleAndAccumulateRing :: C a => (a, a) -> (a, a -> a)
- scaleAndAccumulateModule :: C a v => (a, v) -> (v, v -> v)
- scaleAndAccumulateApplicative :: (C a v, Applicative f) => (a, f v) -> (f v, f v -> f v)
- scaleAndAccumulateRingApplicative :: (C a, Applicative f) => (a, f a) -> (f a, f a -> f a)
- scaleAndAccumulateModuleApplicative :: (C a v, Applicative f) => (a, f v) -> (f v, f v -> f v)
- newtype MAC a v x = MAC {
- runMac :: (a, v) -> (x, v -> x)
- element :: C a x => (v -> x) -> MAC a v x
- makeMac :: C a x => (x -> v) -> (v -> x) -> (a, v) -> (v, v -> v)
- makeMac2 :: (C a x, C a y) => (x -> y -> v) -> (v -> x) -> (v -> y) -> (a, v) -> (v, v -> v)
- makeMac3 :: (C a x, C a y, C a z) => (x -> y -> z -> v) -> (v -> x) -> (v -> y) -> (v -> z) -> (a, v) -> (v, v -> v)
Documentation
class C a => C a v where Source #
Given that scale zero v == Additive.zero
this type class is equivalent to Module in the following way:
scaleAndAccumulate (a,x) = let ax = a *> x in (ax, (ax+))
(see implementation of scaleAndAccumulateModule
)
and
x+y = scaleAccumulate one y $ scale one x zero = scale zero x s*>x = scale s x
But this redundancy is only because of a lack of the type system or lack of my imagination how to solve it better. Use this type class for all kinds of interpolation, that is where addition and scaling alone make no sense.
I intended to name this class AffineSpace, because all interpolations should be affine combinations. This property is equivalent to interpolations that preserve constant functions. However, I cannot easily assert this property and I'm not entirely sure that all reasonable interpolations are actually affine.
Early versions had a zero
method,
but this is against the idea of interpolation.
For implementing zero
we needed a Maybe
wrapper
for interpolation of StorableVector
s.
Btw. having zero
instead of scale
is also inefficient,
since every sum must include a zero summand,
which works well only when the optimizer
simplifies addition with a constant.
We use only one class method
that contains actually two methods:
scale
and scaleAccumulate
.
We expect that instances are always defined on record types
lifting interpolations from scalars to records.
This should be done using makeMac
and friends
or the MAC
type and the Applicative
interface
for records with many elements.
scaleAndAccumulate :: (a, v) -> (v, v -> v) Source #
C Double Double Source # | |
C Float Float Source # | |
C a v => C a (T v) Source # | |
C a v => C a (T v) Source # | |
C a v => C a (Parameter v) Source # | |
C a v => C a (Parameter v) Source # | |
(C a v, Storable v) => C a (Parameter v) Source # | |
C a v => C a (Parameter v) Source # | |
C a v => C a (Parameter v) Source # | |
C a v => C a (Parameter v) Source # | |
C a v => C a (Parameter v) Source # | |
(C a v, C a w) => C a (v, w) Source # | |
(C a v, C a w, C a u) => C a (v, w, u) Source # | |
C a => C (T a) (T a) Source # | |
scaleAccumulate :: C a v => (a, v) -> v -> v Source #
(+.*) :: C a v => v -> (a, v) -> v infixl 6 Source #
Infix variant of scaleAccumulate
.
convenience functions for defining scaleAndAccumulate
scaleAndAccumulateRing :: C a => (a, a) -> (a, a -> a) Source #
scaleAndAccumulateModule :: C a v => (a, v) -> (v, v -> v) Source #
scaleAndAccumulateApplicative :: (C a v, Applicative f) => (a, f v) -> (f v, f v -> f v) Source #
scaleAndAccumulateRingApplicative :: (C a, Applicative f) => (a, f a) -> (f a, f a -> f a) Source #
scaleAndAccumulateModuleApplicative :: (C a v, Applicative f) => (a, f v) -> (f v, f v -> f v) Source #
A special reader monad.