backprop-0.1.1.0: Heterogeneous automatic differentation (backpropagation)

Copyright(c) Justin Le 2018
LicenseBSD3
Maintainerjustin@jle.im
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell2010

Numeric.Backprop.Tuple

Contents

Description

Canonical strict tuples with Num instances for usage with backprop. This is here to solve the problem of orphan instances in libraries and potential mismatched tuple types.

If you are writing a library that needs to export BVars of tuples, consider using the tuples in this module so that your library can have easy interoperability with other libraries using backprop.

Because of API decisions, backprop and gradBP only work with things with Num instances. However, this disallows default Prelude tuples (without orphan instances from packages like NumInstances).

Until tuples have Num instances in base, this module is intended to be a workaround for situations where:

This comes up often in cases where:

  1. A function wants to return more than one value (BVar s (T2 a b)
  2. You want to uncurry a BVar function to use with backprop and gradBP.
  3. You want to use the useful Prisms automatically generated by the lens library, which use tuples for multiple-constructor fields.

Only 2-tuples and 3-tuples are provided. Any more and you should probably be using your own custom product types, with instances automatically generated from something like one-liner-instances.

Lenses into the fields are provided, but they also work with _1, _2, and _3 from Lens.Micro. However, note that these are incompatible with _1, _2, and _3 from Control.Lens.

Since: 0.1.1.0

Synopsis

Two-tuples

data T2 a b Source #

Strict 2-tuple with a Num instance.

Since: 0.1.1.0

Constructors

T2 !a !b 

Instances

Bifunctor T2 Source # 

Methods

bimap :: (a -> b) -> (c -> d) -> T2 a c -> T2 b d #

first :: (a -> b) -> T2 a c -> T2 b c #

second :: (b -> c) -> T2 a b -> T2 a c #

Functor (T2 a) Source # 

Methods

fmap :: (a -> b) -> T2 a a -> T2 a b #

(<$) :: a -> T2 a b -> T2 a a #

(Eq b, Eq a) => Eq (T2 a b) Source # 

Methods

(==) :: T2 a b -> T2 a b -> Bool #

(/=) :: T2 a b -> T2 a b -> Bool #

(Floating a, Floating b) => Floating (T2 a b) Source # 

Methods

pi :: T2 a b #

exp :: T2 a b -> T2 a b #

log :: T2 a b -> T2 a b #

sqrt :: T2 a b -> T2 a b #

(**) :: T2 a b -> T2 a b -> T2 a b #

logBase :: T2 a b -> T2 a b -> T2 a b #

sin :: T2 a b -> T2 a b #

cos :: T2 a b -> T2 a b #

tan :: T2 a b -> T2 a b #

asin :: T2 a b -> T2 a b #

acos :: T2 a b -> T2 a b #

atan :: T2 a b -> T2 a b #

sinh :: T2 a b -> T2 a b #

cosh :: T2 a b -> T2 a b #

tanh :: T2 a b -> T2 a b #

asinh :: T2 a b -> T2 a b #

acosh :: T2 a b -> T2 a b #

atanh :: T2 a b -> T2 a b #

log1p :: T2 a b -> T2 a b #

expm1 :: T2 a b -> T2 a b #

log1pexp :: T2 a b -> T2 a b #

log1mexp :: T2 a b -> T2 a b #

(Fractional a, Fractional b) => Fractional (T2 a b) Source # 

Methods

(/) :: T2 a b -> T2 a b -> T2 a b #

recip :: T2 a b -> T2 a b #

fromRational :: Rational -> T2 a b #

(Data b, Data a) => Data (T2 a b) Source # 

Methods

gfoldl :: (forall d c. Data d => c (d -> c) -> d -> c c) -> (forall g. g -> c g) -> T2 a b -> c (T2 a b) #

gunfold :: (forall c r. Data c => c (c -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (T2 a b) #

toConstr :: T2 a b -> Constr #

dataTypeOf :: T2 a b -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (T2 a b)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (T2 a b)) #

gmapT :: (forall c. Data c => c -> c) -> T2 a b -> T2 a b #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> T2 a b -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> T2 a b -> r #

gmapQ :: (forall d. Data d => d -> u) -> T2 a b -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> T2 a b -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> T2 a b -> m (T2 a b) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> T2 a b -> m (T2 a b) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> T2 a b -> m (T2 a b) #

(Num a, Num b) => Num (T2 a b) Source # 

Methods

(+) :: T2 a b -> T2 a b -> T2 a b #

(-) :: T2 a b -> T2 a b -> T2 a b #

(*) :: T2 a b -> T2 a b -> T2 a b #

negate :: T2 a b -> T2 a b #

abs :: T2 a b -> T2 a b #

signum :: T2 a b -> T2 a b #

fromInteger :: Integer -> T2 a b #

(Ord b, Ord a) => Ord (T2 a b) Source # 

Methods

compare :: T2 a b -> T2 a b -> Ordering #

(<) :: T2 a b -> T2 a b -> Bool #

(<=) :: T2 a b -> T2 a b -> Bool #

(>) :: T2 a b -> T2 a b -> Bool #

(>=) :: T2 a b -> T2 a b -> Bool #

max :: T2 a b -> T2 a b -> T2 a b #

min :: T2 a b -> T2 a b -> T2 a b #

(Read b, Read a) => Read (T2 a b) Source # 

Methods

readsPrec :: Int -> ReadS (T2 a b) #

readList :: ReadS [T2 a b] #

readPrec :: ReadPrec (T2 a b) #

readListPrec :: ReadPrec [T2 a b] #

(Show b, Show a) => Show (T2 a b) Source # 

Methods

showsPrec :: Int -> T2 a b -> ShowS #

show :: T2 a b -> String #

showList :: [T2 a b] -> ShowS #

Generic (T2 a b) Source # 

Associated Types

type Rep (T2 a b) :: * -> * #

Methods

from :: T2 a b -> Rep (T2 a b) x #

to :: Rep (T2 a b) x -> T2 a b #

(Semigroup a, Semigroup b) => Semigroup (T2 a b) Source # 

Methods

(<>) :: T2 a b -> T2 a b -> T2 a b #

sconcat :: NonEmpty (T2 a b) -> T2 a b #

stimes :: Integral b => b -> T2 a b -> T2 a b #

(Monoid a, Monoid b) => Monoid (T2 a b) Source # 

Methods

mempty :: T2 a b #

mappend :: T2 a b -> T2 a b -> T2 a b #

mconcat :: [T2 a b] -> T2 a b #

(NFData a, NFData b) => NFData (T2 a b) Source # 

Methods

rnf :: T2 a b -> () #

Field1 (T2 a b) (T2 a' b) a a' Source # 

Methods

_1 :: Lens (T2 a b) (T2 a' b) a a' #

Field2 (T2 a b) (T2 a b') b b' Source # 

Methods

_2 :: Lens (T2 a b) (T2 a b') b b' #

type Rep (T2 a b) Source # 
type Rep (T2 a b) = D1 * (MetaData "T2" "Numeric.Backprop.Tuple" "backprop-0.1.1.0-5I06pn05MPzKPQVsp4TxpS" False) (C1 * (MetaCons "T2" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * a)) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * b))))

Conversions

If using lens, the two conversion functions can be chained with prisms and traversals and other optics using:

iso tupT2 t2Tup :: Iso' (a, b) (T2 a b)

t2Tup :: T2 a b -> (a, b) Source #

Convert to a Haskell tuple.

Forms an isomorphism with tupT2. @since 0.1.1.0

tupT2 :: (a, b) -> T2 a b Source #

Convert from Haskell tuple.

Forms an isomorphism with t2Tup.

Since: 0.1.1.0

Lenses

t2_1 :: Lens (T2 a b) (T2 a' b) a a' Source #

Lens into the first field of a T2. Also exported as _1 from Lens.Micro.

t2_2 :: Lens (T2 a b) (T2 a b') b b' Source #

Lens into the second field of a T2. Also exported as _2 from Lens.Micro.

Three-tuples

data T3 a b c Source #

Strict 3-tuple with a Num instance.

Since: 0.1.1.0

Constructors

T3 !a !b !c 

Instances

Bifunctor (T3 a) Source # 

Methods

bimap :: (a -> b) -> (c -> d) -> T3 a a c -> T3 a b d #

first :: (a -> b) -> T3 a a c -> T3 a b c #

second :: (b -> c) -> T3 a a b -> T3 a a c #

Functor (T3 a b) Source # 

Methods

fmap :: (a -> b) -> T3 a b a -> T3 a b b #

(<$) :: a -> T3 a b b -> T3 a b a #

(Eq c, Eq b, Eq a) => Eq (T3 a b c) Source # 

Methods

(==) :: T3 a b c -> T3 a b c -> Bool #

(/=) :: T3 a b c -> T3 a b c -> Bool #

(Floating a, Floating b, Floating c) => Floating (T3 a b c) Source # 

Methods

pi :: T3 a b c #

exp :: T3 a b c -> T3 a b c #

log :: T3 a b c -> T3 a b c #

sqrt :: T3 a b c -> T3 a b c #

(**) :: T3 a b c -> T3 a b c -> T3 a b c #

logBase :: T3 a b c -> T3 a b c -> T3 a b c #

sin :: T3 a b c -> T3 a b c #

cos :: T3 a b c -> T3 a b c #

tan :: T3 a b c -> T3 a b c #

asin :: T3 a b c -> T3 a b c #

acos :: T3 a b c -> T3 a b c #

atan :: T3 a b c -> T3 a b c #

sinh :: T3 a b c -> T3 a b c #

cosh :: T3 a b c -> T3 a b c #

tanh :: T3 a b c -> T3 a b c #

asinh :: T3 a b c -> T3 a b c #

acosh :: T3 a b c -> T3 a b c #

atanh :: T3 a b c -> T3 a b c #

log1p :: T3 a b c -> T3 a b c #

expm1 :: T3 a b c -> T3 a b c #

log1pexp :: T3 a b c -> T3 a b c #

log1mexp :: T3 a b c -> T3 a b c #

(Fractional a, Fractional b, Fractional c) => Fractional (T3 a b c) Source # 

Methods

(/) :: T3 a b c -> T3 a b c -> T3 a b c #

recip :: T3 a b c -> T3 a b c #

fromRational :: Rational -> T3 a b c #

(Data c, Data b, Data a) => Data (T3 a b c) Source # 

Methods

gfoldl :: (forall d e. Data d => c (d -> e) -> d -> c e) -> (forall g. g -> c g) -> T3 a b c -> c (T3 a b c) #

gunfold :: (forall d r. Data d => c (d -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (T3 a b c) #

toConstr :: T3 a b c -> Constr #

dataTypeOf :: T3 a b c -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (T3 a b c)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (T3 a b c)) #

gmapT :: (forall d. Data d => d -> d) -> T3 a b c -> T3 a b c #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> T3 a b c -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> T3 a b c -> r #

gmapQ :: (forall d. Data d => d -> u) -> T3 a b c -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> T3 a b c -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> T3 a b c -> m (T3 a b c) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> T3 a b c -> m (T3 a b c) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> T3 a b c -> m (T3 a b c) #

(Num a, Num b, Num c) => Num (T3 a b c) Source # 

Methods

(+) :: T3 a b c -> T3 a b c -> T3 a b c #

(-) :: T3 a b c -> T3 a b c -> T3 a b c #

(*) :: T3 a b c -> T3 a b c -> T3 a b c #

negate :: T3 a b c -> T3 a b c #

abs :: T3 a b c -> T3 a b c #

signum :: T3 a b c -> T3 a b c #

fromInteger :: Integer -> T3 a b c #

(Ord c, Ord b, Ord a) => Ord (T3 a b c) Source # 

Methods

compare :: T3 a b c -> T3 a b c -> Ordering #

(<) :: T3 a b c -> T3 a b c -> Bool #

(<=) :: T3 a b c -> T3 a b c -> Bool #

(>) :: T3 a b c -> T3 a b c -> Bool #

(>=) :: T3 a b c -> T3 a b c -> Bool #

max :: T3 a b c -> T3 a b c -> T3 a b c #

min :: T3 a b c -> T3 a b c -> T3 a b c #

(Read c, Read b, Read a) => Read (T3 a b c) Source # 

Methods

readsPrec :: Int -> ReadS (T3 a b c) #

readList :: ReadS [T3 a b c] #

readPrec :: ReadPrec (T3 a b c) #

readListPrec :: ReadPrec [T3 a b c] #

(Show c, Show b, Show a) => Show (T3 a b c) Source # 

Methods

showsPrec :: Int -> T3 a b c -> ShowS #

show :: T3 a b c -> String #

showList :: [T3 a b c] -> ShowS #

Generic (T3 a b c) Source # 

Associated Types

type Rep (T3 a b c) :: * -> * #

Methods

from :: T3 a b c -> Rep (T3 a b c) x #

to :: Rep (T3 a b c) x -> T3 a b c #

(Semigroup a, Semigroup b, Semigroup c) => Semigroup (T3 a b c) Source # 

Methods

(<>) :: T3 a b c -> T3 a b c -> T3 a b c #

sconcat :: NonEmpty (T3 a b c) -> T3 a b c #

stimes :: Integral b => b -> T3 a b c -> T3 a b c #

(Monoid a, Monoid b, Monoid c) => Monoid (T3 a b c) Source # 

Methods

mempty :: T3 a b c #

mappend :: T3 a b c -> T3 a b c -> T3 a b c #

mconcat :: [T3 a b c] -> T3 a b c #

(NFData a, NFData b, NFData c) => NFData (T3 a b c) Source # 

Methods

rnf :: T3 a b c -> () #

Field1 (T3 a b c) (T3 a' b c) a a' Source # 

Methods

_1 :: Lens (T3 a b c) (T3 a' b c) a a' #

Field2 (T3 a b c) (T3 a b' c) b b' Source # 

Methods

_2 :: Lens (T3 a b c) (T3 a b' c) b b' #

Field3 (T3 a b c) (T3 a b c') c c' Source # 

Methods

_3 :: Lens (T3 a b c) (T3 a b c') c c' #

type Rep (T3 a b c) Source # 

Conversions

If using lens, the two conversion functions can be chained with prisms and traversals and other optics using:

iso tupT3 t2Tup :: Iso' (a, b, c) (T3 a b c)

t3Tup :: T3 a b c -> (a, b, c) Source #

Convert to a Haskell tuple.

Forms an isomorphism with tupT3.

tupT3 :: (a, b, c) -> T3 a b c Source #

Convert from Haskell tuple.

Forms an isomorphism with t3Tup.

Lenses

t3_1 :: Lens (T3 a b c) (T3 a' b c) a a' Source #

Lens into the first field of a T3. Also exported as _1 from Lens.Micro.

t3_2 :: Lens (T3 a b c) (T3 a b' c) b b' Source #

Lens into the second field of a T3. Also exported as _2 from Lens.Micro.

t3_3 :: Lens (T3 a b c) (T3 a b c') c c' Source #

Lens into the third field of a T3. Also exported as _3 from Lens.Micro.