backprop 0.1.4.0 → 0.1.5.0

raw patch · 4 files changed

+329/−19 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−0
• backprop.cabal +2/−2
• src/Numeric/Backprop/Internal.hs +18/−0
• src/Numeric/Backprop/Tuple.hs +294/−17

@@ -1,6 +1,21 @@ Changelog ========= +Version 0.1.5.0+---------------++*Mar 30, 2018*++<https://github.com/mstksg/backprop/releases/tag/v0.1.5.0>++*   `T` added to *Numeric.Backprop.Tuple*: basically an `HList` with a `Num`+    instance.+*   `Eq` and `Ord` instances for `BVar`.  Is this sound?++*Internal*++*   Refactored `Monoid` instances in *Numeric.Backprop.Tuple*+ Version 0.1.4.0 --------------- 

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 29db4e10ba34d97fcc6fd087831de6d57d581d92e0cb33d6088380834faccda4+-- hash: f63250aadbaab3be65345eb28df24e2b368dc8f857f029577525ef698e71540c  name:           backprop-version:        0.1.4.0+version:        0.1.5.0 synopsis:       Heterogeneous automatic differentation (backpropagation) description:    Write your functions to compute your result, and the library will                 automatically generate functions to compute your gradient.

@@ -42,6 +42,7 @@ import           Control.Monad.Trans.State import           Data.Bifunctor import           Data.Foldable+import           Data.Function import           Data.IORef import           Data.Kind import           Data.Maybe@@ -665,6 +666,23 @@     {-# INLINE acosh #-}     atanh   = liftOp1 atanhOp     {-# INLINE atanh #-}++-- | Compares the values inside the 'BVar'.+--+-- @since 0.1.5.0+instance Eq a => Eq (BVar s a) where+    (==) = (==) `on` _bvVal+    (/=) = (/=) `on` _bvVal++-- | Compares the values inside the 'BVar'.+--+-- @since 0.1.5.0+instance Ord a => Ord (BVar s a) where+    compare = compare `on` _bvVal+    (<)     = (<)     `on` _bvVal+    (<=)    = (<=)    `on` _bvVal+    (>)     = (>)     `on` _bvVal+    (>=)    = (>=)    `on` _bvVal  -- Some utility functions to get around a lens dependency itraverse

@@ -1,8 +1,22 @@+{-# LANGUAGE AllowAmbiguousTypes   #-}+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE ConstraintKinds       #-} {-# LANGUAGE DeriveDataTypeable    #-} {-# LANGUAGE DeriveFunctor         #-} {-# LANGUAGE DeriveGeneric         #-} {-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE LambdaCase            #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeInType            #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE ViewPatterns          #-}  -- | -- Module      : Numeric.Backprop.Tuple@@ -75,16 +89,36 @@   , t3_1, t3_2, t3_3   -- ** Consumption   , uncurryT3, curryT3+  -- * N-Tuples+  , T(..)+  , indexT+  -- ** Conversions+  -- $tiso+  , tOnly, onlyT, tSplit, tAppend, tProd, prodT+  -- ** Lenses+  , tIx, tHead, tTail, tTake, tDrop+  -- ** Internal Utility+  , constT, mapT, zipT   ) where  import           Control.DeepSeq import           Data.Bifunctor import           Data.Data-import           Data.Semigroup-import           GHC.Generics        (Generic)+import           Data.Kind+import           Data.Type.Combinator+import           Data.Type.Index+import           Data.Type.Length+import           Data.Type.Product+import           GHC.Generics               (Generic) import           Lens.Micro-import           Lens.Micro.Internal+import           Lens.Micro.Internal hiding (Index)+import           Type.Class.Known+import           Type.Family.List +#if !MIN_VERSION_base(4,11,0)+import           Data.Semigroup+#endif+ -- | Unit ('()') with 'Num', 'Fractional', and 'Floating' instances. -- -- Be aware that the methods in its numerical instances are all non-strict:@@ -113,8 +147,30 @@ data T3 a b c = T3 !a !b !c   deriving (Show, Read, Eq, Ord, Generic, Functor, Data) +-- | Strict inductive N-tuple with a 'Num', 'Fractional', and 'Floating'+-- instances.+--+-- It is basically "yet another HList", like the one found in+-- "Data.Type.Product" and many other locations on the haskell ecosystem.+-- Because it's inductively defined, it has O(n) random indexing, but is+-- efficient for zipping and mapping and other sequential consumption+-- patterns.+--+-- It is provided because of its 'Num' instance, making it useful for+-- /backproup/.  Will be obsolete when 'Data.Type.Product.Product' gets+-- numerical instances.+--+-- @since 0.1.5.0+data T :: [Type] -> Type where+    TNil :: T '[]+    (:&) :: !a -> !(T as) -> T (a ': as)+ instance (NFData a, NFData b) => NFData (T2 a b) instance (NFData a, NFData b, NFData c) => NFData (T3 a b c)+instance ListC (NFData <$> as) => NFData (T as) where+    rnf = \case+      TNil       -> ()+      (!_) :& xs -> rnf xs  instance Bifunctor T2 where     bimap f g (T2 x y) = T2 (f x) (g y)@@ -146,6 +202,22 @@ tupT3 :: (a, b, c) -> T3 a b c tupT3 (x, y, z) = T3 x y z +-- | A singleton 'T'+--+-- Forms an isomorphism with 'tOnly'+--+-- @since 0.1.5.0+onlyT :: a -> T '[a]+onlyT = (:& TNil)++-- | Extract a singleton 'T'+--+-- Forms an isomorphism with 'onlyT'+--+-- @since 0.1.5.0+tOnly :: T '[a] -> a+tOnly (x :& _) = x+ -- | Uncurry a function to take in a 'T2' of its arguments -- -- @since 0.1.2.0@@ -171,45 +243,134 @@ curryT3 f x y z = f (T3 x y z)  instance Field1 (T2 a b) (T2 a' b) a a' where-    _1 f (T2 x y) = (`T2` y) <$> f x+    _1 = t2_1  instance Field2 (T2 a b) (T2 a b') b b' where-    _2 f (T2 x y) = T2 x <$> f y+    _2 = t2_2  instance Field1 (T3 a b c) (T3 a' b c) a a' where-    _1 f (T3 x y z) = (\x' -> T3 x' y z) <$> f x+    _1 = t3_1  instance Field2 (T3 a b c) (T3 a b' c) b b' where-    _2 f (T3 x y z) = (\y' -> T3 x y' z) <$> f y+    _2 = t3_2  instance Field3 (T3 a b c) (T3 a b c') c c' where-    _3 f (T3 x y z) = T3 x y <$> f z+    _3 = t3_3 +instance Field1 (T (a ': as)) (T (a ': as)) a a where+    _1 = tIx IZ++instance Field2 (T (a ': b ': as)) (T (a ': b ': as)) b b where+    _2 = tIx (IS IZ)++instance Field3 (T (a ': b ': c ': as)) (T (a ': b ': c ': as)) c c where+    _3 = tIx (IS (IS IZ))+ -- | Lens into the first field of a 'T2'.  Also exported as '_1' from -- "Lens.Micro". t2_1 :: Lens (T2 a b) (T2 a' b) a a'-t2_1 = _1+t2_1 f (T2 x y) = (`T2` y) <$> f x  -- | Lens into the second field of a 'T2'.  Also exported as '_2' from -- "Lens.Micro". t2_2 :: Lens (T2 a b) (T2 a b') b b'-t2_2 = _2+t2_2 f (T2 x y) = T2 x <$> f y  -- | Lens into the first field of a 'T3'.  Also exported as '_1' from -- "Lens.Micro". t3_1 :: Lens (T3 a b c) (T3 a' b c) a a'-t3_1 = _1+t3_1 f (T3 x y z) = (\x' -> T3 x' y z) <$> f x  -- | Lens into the second field of a 'T3'.  Also exported as '_2' from -- "Lens.Micro". t3_2 :: Lens (T3 a b c) (T3 a b' c) b b'-t3_2 = _2+t3_2 f (T3 x y z) = (\y' -> T3 x y' z) <$> f y  -- | Lens into the third field of a 'T3'.  Also exported as '_3' from -- "Lens.Micro". t3_3 :: Lens (T3 a b c) (T3 a b c') c c'-t3_3 = _3+t3_3 f (T3 x y z) = T3 x y <$> f z +-- | Index into a 'T'.+--+-- /O(i)/+--+-- @since 0.1.5.0+indexT :: Index as a -> T as -> a+indexT = flip (^.) . tIx++-- | Lens into a given index of a 'T'.+--+-- @since 0.1.5.0+tIx :: Index as a -> Lens' (T as) a+tIx IZ     f (x :& xs) = (:& xs) <$> f x+tIx (IS i) f (x :& xs) = (x :&)  <$> tIx i f xs++-- | Lens into the head of a 'T'+--+-- @since 0.1.5.0+tHead :: Lens (T (a ': as)) (T (b ': as)) a b+tHead f (x :& xs) = (:& xs) <$> f x++-- | Lens into the tail of a 'T'+--+-- @since 0.1.5.0+tTail :: Lens (T (a ': as)) (T (a ': bs)) (T as) (T bs)+tTail f (x :& xs) = (x :&) <$> f xs++-- | Append two 'T's.+--+-- Forms an isomorphism with 'tSplit'.+--+-- @since 0.1.5.0+tAppend :: T as -> T bs -> T (as ++ bs)+tAppend TNil      ys = ys+tAppend (x :& xs) ys = x :& tAppend xs ys+infixr 5 `tAppend`++-- | Split a 'T'.  For splits known at compile-time, you can use 'known' to+-- derive the 'Length' automatically.+--+-- Forms an isomorphism with 'tAppend'.+--+-- @since 0.1.5.0+tSplit :: Length as -> T (as ++ bs) -> (T as, T bs)+tSplit LZ     xs        = (TNil, xs)+tSplit (LS l) (x :& xs) = first (x :&) . tSplit l $ xs++-- | Lens into the initial portion of a 'T'.  For splits known at+-- compile-time, you can use 'known' to derive the 'Length' automatically.+--+-- @since 0.1.5.0+tTake :: forall as bs cs. Length as -> Lens (T (as ++ bs)) (T (cs ++ bs)) (T as) (T cs)+tTake l f (tSplit l->(xs,ys)) = flip (tAppend @cs @bs) ys <$> f xs++-- | Lens into the ending portion of a 'T'.  For splits known at+-- compile-time, you can use 'known' to derive the 'Length' automatically.+--+-- @since 0.1.5.0+tDrop :: forall as bs cs. Length as -> Lens (T (as ++ bs)) (T (as ++ cs)) (T bs) (T cs)+tDrop l f (tSplit l->(xs,ys)) = tAppend xs <$> f ys++-- | Convert a 'T' to a 'Tuple'.+--+-- Forms an isomorphism with 'prodT'.+--+-- @since 0.1.5.0+tProd :: T as -> Tuple as+tProd TNil      = Ø+tProd (x :& xs) = x ::< tProd xs++-- | Convert a 'Tuple' to a 'T'.+--+-- Forms an isomorphism with 'tProd'.+--+-- @since 0.1.5.0+prodT :: Tuple as -> T as+prodT Ø           = TNil+prodT (I x :< xs) = x :& prodT xs++ instance Num T0 where     _ + _         = T0     _ - _         = T0@@ -242,6 +403,13 @@     acosh _     = T0     atanh _     = T0 +instance Semigroup T0 where+    _ <> _ = T0++instance Monoid T0 where+    mempty = T0+    mappend = (<>)+ instance (Num a, Num b) => Num (T2 a b) where     T2 x1 y1 + T2 x2 y2 = T2 (x1 + x2) (y1 + y2)     T2 x1 y1 - T2 x2 y2 = T2 (x1 - x2) (y1 - y2)@@ -277,9 +445,13 @@ instance (Semigroup a, Semigroup b) => Semigroup (T2 a b) where     T2 x1 y1 <> T2 x2 y2 = T2 (x1 <> x2) (y1 <> y2) +#if MIN_VERSION_base(4,11,0) instance (Monoid a, Monoid b) => Monoid (T2 a b) where-    mappend (T2 x1 y1) (T2 x2 y2) = T2 (mappend x1 x2) (mappend y1 y2)-    mempty                        = T2 mempty mempty+#else+instance (Semigroup a, Semigroup b, Monoid a, Monoid b) => Monoid (T2 a b) where+#endif+    mappend = (<>)+    mempty  = T2 mempty mempty  instance (Num a, Num b, Num c) => Num (T3 a b c) where     T3 x1 y1 z1 + T3 x2 y2 z2 = T3 (x1 + x2) (y1 + y2) (z1 + z2)@@ -316,10 +488,106 @@ instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (T3 a b c) where     T3 x1 y1 z1 <> T3 x2 y2 z2 = T3 (x1 <> x2) (y1 <> y2) (z1 <> z2) +#if MIN_VERSION_base(4,11,0) instance (Monoid a, Monoid b, Monoid c) => Monoid (T3 a b c) where-    mappend (T3 x1 y1 z1) (T3 x2 y2 z2) = T3 (mappend x1 x2) (mappend y1 y2) (mappend z1 z2)-    mempty                              = T3 mempty mempty mempty+#else+instance (Semigroup a, Semigroup b, Semigroup c, Monoid a, Monoid b, Monoid c) => Monoid (T3 a b c) where+#endif+    mappend = (<>)+    mempty  = T3 mempty mempty mempty +-- | Initialize a 'T' with a Rank-N value.  Mostly used internally, but+-- provided in case useful.+--+-- Must be used with /TypeApplications/ to provide the Rank-N constraint.+--+-- @since 0.1.5.0+constT+    :: forall c as. ListC (c <$> as)+    => (forall a. c a => a)+    -> Length as+    -> T as+constT x = go+  where+    go :: forall bs. ListC (c <$> bs) => Length bs -> T bs+    go LZ     = TNil+    go (LS l) = x :& go l++-- | Map over a 'T' with a Rank-N function.  Mostly used internally, but+-- provided in case useful.+--+-- Must be used with /TypeApplications/ to provide the Rank-N constraint.+--+-- @since 0.1.5.0+mapT+    :: forall c as. ListC (c <$> as)+    => (forall a. c a => a -> a)+    -> T as+    -> T as+mapT f = go+  where+    go :: forall bs. ListC (c <$> bs) => T bs -> T bs+    go TNil      = TNil+    go (x :& xs) = f x :& go xs++-- | Map over a 'T' with a Rank-N function.  Mostly used internally, but+-- provided in case useful.+--+-- Must be used with /TypeApplications/ to provide the Rank-N constraint.+--+-- @since 0.1.5.0+zipT+    :: forall c as. ListC (c <$> as)+    => (forall a. c a => a -> a -> a)+    -> T as+    -> T as+    -> T as+zipT f = go+  where+    go :: forall bs. ListC (c <$> bs) => T bs -> T bs -> T bs+    go TNil      TNil      = TNil+    go (x :& xs) (y :& ys) = f x y :& go xs ys++instance (Known Length as, ListC (Num <$> as)) => Num (T as) where+    (+)           = zipT @Num (+)+    (-)           = zipT @Num (-)+    (*)           = zipT @Num (*)+    negate        = mapT @Num negate+    abs           = mapT @Num abs+    signum        = mapT @Num signum+    fromInteger x = constT @Num (fromInteger x) known++instance (Known Length as, ListC (Num <$> as), ListC (Fractional <$> as)) => Fractional (T as) where+    (/)            = zipT @Fractional (/)+    recip          = mapT @Fractional recip+    fromRational x = constT @Fractional (fromRational x) known++instance (Known Length as, ListC (Num <$> as), ListC (Fractional <$> as), ListC (Floating <$> as))+        => Floating (T as) where+    pi      = constT @Floating pi known+    (**)    = zipT @Floating (**)+    logBase = zipT @Floating logBase+    exp     = mapT @Floating exp+    log     = mapT @Floating log+    sqrt    = mapT @Floating sqrt+    sin     = mapT @Floating sin+    cos     = mapT @Floating cos+    asin    = mapT @Floating asin+    acos    = mapT @Floating acos+    atan    = mapT @Floating atan+    sinh    = mapT @Floating sinh+    cosh    = mapT @Floating cosh+    asinh   = mapT @Floating asinh+    acosh   = mapT @Floating acosh+    atanh   = mapT @Floating atanh++instance ListC (Semigroup <$> as) => Semigroup (T as) where+    (<>) = zipT @Semigroup (<>)++instance (Known Length as, ListC (Semigroup <$> as), ListC (Monoid <$> as)) => Monoid (T as) where+    mempty  = constT @Monoid mempty known+    mappend = (<>)+ -- $t2iso -- -- If using /lens/, the two conversion functions can be chained with prisms@@ -336,4 +604,13 @@ -- -- @ -- 'iso' 'tupT3' 't2Tup' :: 'Iso'' (a, b, c) ('T3' a b c)+-- @++-- $tiso+--+-- If using /lens/, the two conversion functions can be chained with prisms+-- and traversals and other optics using:+--+-- @+-- 'iso' 'onlyT' 'tOnly' :: 'Iso'' a (T '[a]) -- @