ad 0.30.0 → 0.31.0

raw patch · 9 files changed

+214/−25 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Numeric/AD/Internal/Composition.hs +68/−6
• Numeric/AD/Internal/Identity.hs +4/−2
• Numeric/AD/Internal/Iterated.hs +46/−4
• Numeric/AD/Internal/Reverse.hs +7/−3
• Numeric/AD/Internal/Stream.hs +33/−2
• Numeric/AD/Internal/Tensors.hs +15/−3
• Numeric/AD/Internal/Tower.hs +7/−2
• Numeric/AD/Internal/Types.hs +31/−1
• ad.cabal +3/−2

@@ -9,7 +9,6 @@ -- Stability   :  experimental -- Portability :  GHC only ----- Defines the composition of two AD modes as an AD mode in its own right -----------------------------------------------------------------------------  module Numeric.AD.Internal.Composition@@ -19,13 +18,14 @@     , decomposeMode     ) where -import Data.Traversable import Control.Applicative-import Data.Foldable+import Data.Data (Data(..), mkDataType, DataType, mkConstr, Constr, constrIndex, Fixity(..))+import Data.Typeable (Typeable1(..), Typeable(..), TyCon, mkTyCon, mkTyConApp, typeOfDefault, gcast1)+import Data.Foldable (Foldable(foldMap))+import Data.Traversable (Traversable(traverse)) import Numeric.AD.Internal --- * Functor composition-+-- | Functor composition, used to nest the use of jacobian and grad newtype ComposeFunctor f g a = ComposeFunctor { decomposeFunctor :: f (g a) }  instance (Functor f, Functor g) => Functor (ComposeFunctor f g) where@@ -37,6 +37,38 @@ instance (Traversable f, Traversable g) => Traversable (ComposeFunctor f g) where     traverse f (ComposeFunctor a) = ComposeFunctor <$> traverse (traverse f) a +instance (Typeable1 f, Typeable1 g) => Typeable1 (ComposeFunctor f g) where+    typeOf1 tfga = mkTyConApp composeFunctorTyCon [typeOf1 (fa tfga), typeOf1 (ga tfga)]+        where fa :: t f (g :: * -> *) a -> f a+              fa = undefined+              ga :: t (f :: * -> *) g a -> g a+              ga = undefined++instance (Typeable1 f, Typeable1 g, Typeable a) => Typeable (ComposeFunctor f g a) where+    typeOf = typeOfDefault+    +composeFunctorTyCon :: TyCon+composeFunctorTyCon = mkTyCon "Numeric.AD.Internal.Composition.ComposeFunctor"+{-# NOINLINE composeFunctorTyCon #-}++composeFunctorConstr :: Constr+composeFunctorConstr = mkConstr composeFunctorDataType "ComposeFunctor" [] Prefix+{-# NOINLINE composeFunctorConstr #-}++composeFunctorDataType :: DataType+composeFunctorDataType = mkDataType "Numeric.AD.Internal.Composition.ComposeFunctor" [composeFunctorConstr]+{-# NOINLINE composeFunctorDataType #-}++instance (Typeable1 f, Typeable1 g, Data (f (g a)), Data a) => Data (ComposeFunctor f g a) where+    gfoldl f z (ComposeFunctor a) = z ComposeFunctor `f` a+    toConstr _ = composeFunctorConstr+    gunfold k z c = case constrIndex c of+        1 -> k (z ComposeFunctor)+        _ -> error "gunfold"+    dataTypeOf _ = composeFunctorDataType+    dataCast1 f = gcast1 f++-- | The composition of two AD modes is an AD mode in its own right newtype ComposeMode f g a = ComposeMode { runComposeMode :: f (AD g a) }  composeMode :: AD f (AD g a) -> AD (ComposeMode f g) a@@ -119,4 +151,34 @@     minBound1 = ComposeMode minBound1     maxBound1 = ComposeMode maxBound1 --- deriveNumeric (conT `appT` varT (mkName "f") `appT` varT (mkName "g"))+instance (Typeable1 f, Typeable1 g) => Typeable1 (ComposeMode f g) where+    typeOf1 tfga = mkTyConApp composeModeTyCon [typeOf1 (fa tfga), typeOf1 (ga tfga)]+        where fa :: t f (g :: * -> *) a -> f a+              fa = undefined+              ga :: t (f :: * -> *) g a -> g a+              ga = undefined++instance (Typeable1 f, Typeable1 g, Typeable a) => Typeable (ComposeMode f g a) where+    typeOf = typeOfDefault+    +composeModeTyCon :: TyCon+composeModeTyCon = mkTyCon "Numeric.AD.Internal.Composition.ComposeMode"+{-# NOINLINE composeModeTyCon #-}++composeModeConstr :: Constr+composeModeConstr = mkConstr composeModeDataType "ComposeMode" [] Prefix+{-# NOINLINE composeModeConstr #-}++composeModeDataType :: DataType+composeModeDataType = mkDataType "Numeric.AD.Internal.Composition.ComposeMode" [composeModeConstr]+{-# NOINLINE composeModeDataType #-}++instance (Typeable1 f, Typeable1 g, Data (f (AD g a)), Data a) => Data (ComposeMode f g a) where+    gfoldl f z (ComposeMode a) = z ComposeMode `f` a+    toConstr _ = composeModeConstr+    gunfold k z c = case constrIndex c of+        1 -> k (z ComposeMode)+        _ -> error "gunfold"+    dataTypeOf _ = composeModeDataType+    dataCast1 f = gcast1 f+

@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module      :  Numeric.AD.Internal.Identity@@ -21,11 +21,13 @@ import Numeric.AD.Internal.Classes import Numeric.AD.Internal.Types import Data.Monoid+import Data.Data (Data)+import Data.Typeable (Typeable) import Data.Traversable (Traversable, traverse) import Data.Foldable (Foldable, foldMap)  newtype Id a = Id a deriving-    (Iso a, Eq, Ord, Show, Enum, Bounded, Num, Real, Fractional, Floating, RealFrac, RealFloat, Monoid)+    (Iso a, Eq, Ord, Show, Enum, Bounded, Num, Real, Fractional, Floating, RealFrac, RealFloat, Monoid, Data, Typeable)  probe :: a -> AD Id a probe a = AD (Id a)

@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE BangPatterns, TemplateHaskell, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts, UndecidableInstances #-} -- {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- |@@ -15,24 +15,36 @@     ( Iterated(..)     , tailI     , unfoldI+    , bundle+    , bind     ) where  import Control.Applicative import Data.Monoid import Data.Foldable import Data.Traversable--- import Data.Data--- import Data.Typeable+import Data.Data (Data(..), mkDataType, DataType, mkConstr, Constr, constrIndex, Fixity(Infix))+import Data.Typeable (Typeable1(..), Typeable(..), TyCon, mkTyCon, mkTyConApp, typeOfDefault, gcast1) import Numeric.AD.Internal import Numeric.AD.Internal.Comonad import Numeric.AD.Internal.Combinators (on)+-- import qualified Numeric.AD.Internal.Forward+import Numeric.AD.Internal.Forward (Forward(..)) import Language.Haskell.TH  infixl 3 :|  data Iterated f a = a :| f (Iterated f a)---    deriving (Data, Typeable) +bundle :: Num a => a -> a -> AD (Iterated Forward) a+bundle a b = AD (a :| Forward (lift a) (lift b))++bind :: (Traversable f, Num a) => (f (AD (Iterated Forward) a) -> b) -> f a -> f b+bind f as = snd $ mapAccumL outer (0 :: Int) as+    where+        outer !i _ = (i + 1, f $ snd $ mapAccumL (inner i) 0 as)+        inner !i !j a = (j + 1, bundle a $ if i == j then 1 else 0)+ instance Functor f => Functor (Iterated f) where     fmap f (a :| as) = f a :| fmap f <$> as @@ -140,3 +152,33 @@ deriveNumeric     (classP (mkName "Mode") [varT $ mkName "f"]:)     (conT (mkName "Iterated") `appT` varT (mkName "f"))++instance Typeable1 f => Typeable1 (Iterated f) where+    typeOf1 tfa = mkTyConApp iteratedTyCon [typeOf1 (undefined `asArgsType` tfa)]+        where asArgsType :: f a -> t f a -> f a+              asArgsType = const++instance (Typeable1 f, Typeable a) => Typeable (Iterated f a) where+    typeOf = typeOfDefault+    +iteratedTyCon :: TyCon+iteratedTyCon = mkTyCon "Numeric.AD.Internal.Iterated.Iterated"+{-# NOINLINE iteratedTyCon #-}++consConstr :: Constr+consConstr = mkConstr iteratedDataType "(:|)" [] Infix+{-# NOINLINE consConstr #-}++iteratedDataType :: DataType+iteratedDataType = mkDataType "Numeric.AD.Internal.Iterated.Iterated" [consConstr]+{-# NOINLINE iteratedDataType #-}++instance (Typeable1 f, Data (f (Iterated f a)), Data a) => Data (Iterated f a) where+    gfoldl f z (a :| as) = z (:|) `f` a `f` as+    toConstr _ = consConstr+    gunfold k z c = case constrIndex c of+        1 -> k (k (z (:|)))+        _ -> error "gunfold"+    dataTypeOf _ = iteratedDataType+    dataCast1 f = gcast1 f+

@@ -1,4 +1,4 @@-{-# LANGUAGE Rank2Types, TypeFamilies, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, TemplateHaskell, UndecidableInstances #-}+{-# LANGUAGE Rank2Types, TypeFamilies, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, TemplateHaskell, UndecidableInstances, DeriveDataTypeable #-} -- {-# OPTIONS_HADDOCK hide, prune #-} ----------------------------------------------------------------------------- -- |@@ -48,6 +48,8 @@ import Data.Traversable (Traversable, mapM) import System.IO.Unsafe (unsafePerformIO) import Language.Haskell.TH+import Data.Data (Data)+import Data.Typeable (Typeable) import Numeric.AD.Internal import Numeric.AD.Internal.Identity @@ -57,10 +59,12 @@     | Var a {-# UNPACK #-} !Int     | Binary a a a t t     | Unary a a t-    deriving (Show)+    deriving (Show, Data, Typeable)  -- | @Reverse@ is a 'Mode' using reverse-mode automatic differentiation that provides fast 'diffFU', 'diff2FU', 'grad', 'grad2' and a fast 'jacobian' when you have a significantly smaller number of outputs than inputs.-newtype Reverse a = Reverse (Tape a (Reverse a)) deriving (Show)+newtype Reverse a = Reverse (Tape a (Reverse a)) deriving (Show, Typeable)++-- deriving instance (Data (Tape a (Reverse a)) => Data (Reverse a)  instance MuRef (Reverse a) where     type DeRef (Reverse a) = Tape a

@@ -22,8 +22,8 @@ import Data.Monoid import Data.Foldable import Data.Traversable--- import Data.Data--- import Data.Typeable+import Data.Data (Data(..), mkDataType, DataType, mkConstr, Constr, constrIndex, Fixity(Infix))+import Data.Typeable (Typeable1(..), Typeable(..), TyCon, mkTyCon, mkTyConApp, typeOfDefault, gcast1) import Numeric.AD.Internal.Comonad  infixl 3 :<@@ -52,13 +52,44 @@  headS :: Stream f a -> a headS (a :< _) = a+{-# INLINE headS #-}  -- tails of the f-branching stream comonad/cofree comonad tailS :: Stream f a -> f (Stream f a) tailS (_ :< as) = as+{-# INLINE tailS #-}  unfoldS :: Functor f => (a -> (b, f a)) -> a -> Stream f b unfoldS f a = h :< unfoldS f <$> t      where         (h, t) = f a++instance Typeable1 f => Typeable1 (Stream f) where+    typeOf1 tfa = mkTyConApp streamTyCon [typeOf1 (undefined `asArgsType` tfa)]+        where asArgsType :: f a -> t f a -> f a+              asArgsType = const++instance (Typeable1 f, Typeable a) => Typeable (Stream f a) where+    typeOf = typeOfDefault+    +streamTyCon :: TyCon+streamTyCon = mkTyCon "Numeric.AD.Internal.Stream.Stream"+{-# NOINLINE streamTyCon #-}++consConstr :: Constr+consConstr = mkConstr streamDataType "(:<)" [] Infix+{-# NOINLINE consConstr #-}++streamDataType :: DataType+streamDataType = mkDataType "Numeric.AD.Internal.Stream.Stream" [consConstr]+{-# NOINLINE streamDataType #-}++instance (Typeable1 f, Data (f (Stream f a)), Data a) => Data (Stream f a) where+    gfoldl f z (a :< as) = z (:<) `f` a `f` as+    toConstr _ = consConstr+    gunfold k z c = case constrIndex c of+        1 -> k (k (z (:<)))+        _ -> error "gunfold"+    dataTypeOf _ = streamDataType+    dataCast1 f = gcast1 f 

@@ -22,15 +22,14 @@ import Data.Foldable import Data.Traversable import Data.Monoid---import Data.Data---import Data.Typeable+import Data.Typeable (Typeable1(..), Typeable(..), TyCon, mkTyCon, mkTyConApp, typeOfDefault, gcast1) import Numeric.AD.Internal.Comonad import Numeric.AD.Internal.Stream  infixl 3 :-  data Tensors f a = a :- Tensors f (f a)--- TODO: deriving (Data, Typeable)+-- Polymorphic recursion precludes Data in its current form, as no Data1 class exists  instance Functor f => Functor (Tensors f) where     fmap f (a :- as) = f a :- fmap (fmap f) as@@ -60,3 +59,16 @@     where         distribute :: Functor f => f (Tensors f a) -> Tensors f (f a)         distribute x = (headT <$> x) :- distribute (tailT <$> x)+++instance Typeable1 f => Typeable1 (Tensors f) where+    typeOf1 tfa = mkTyConApp tensorsTyCon [typeOf1 (undefined `asArgsType` tfa)]+        where asArgsType :: f a -> t f a -> f a+              asArgsType = const++instance (Typeable1 f, Typeable a) => Typeable (Tensors f a) where+    typeOf = typeOfDefault+    +tensorsTyCon :: TyCon+tensorsTyCon = mkTyCon "Numeric.AD.Internal.Tensors.Tensors"+{-# NOINLINE tensorsTyCon #-}

@@ -1,4 +1,4 @@-{-# LANGUAGE Rank2Types, TypeFamilies, FlexibleContexts, UndecidableInstances, TemplateHaskell #-}+{-# LANGUAGE Rank2Types, TypeFamilies, FlexibleContexts, UndecidableInstances, TemplateHaskell, DeriveDataTypeable #-} -- {-# OPTIONS_HADDOCK hide, prune #-} ----------------------------------------------------------------------------- -- |@@ -29,11 +29,16 @@ import Prelude hiding (all) import Control.Applicative import Data.Foldable+import Data.Data (Data)+import Data.Typeable (Typeable) import Language.Haskell.TH import Numeric.AD.Internal  -- | @Tower@ is an AD 'Mode' that calculates a tangent tower by forward AD, and provides fast 'diffsUU', 'diffsUF'-newtype Tower a = Tower { getTower :: [a] } deriving (Show)+newtype Tower a = Tower { getTower :: [a] } deriving (Data, Typeable)++instance Show a => Show (Tower a) where+    showsPrec n (Tower as) = showParen (n > 10) $ showString "Tower " . showList as  -- Local combinators 

@@ -1,4 +1,4 @@-{-# LANGUAGE Rank2Types, GeneralizedNewtypeDeriving, TemplateHaskell, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}+{-# LANGUAGE Rank2Types, GeneralizedNewtypeDeriving, TemplateHaskell, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} -- {-# OPTIONS_HADDOCK hide, prune #-} ----------------------------------------------------------------------------- -- |@@ -15,6 +15,8 @@     , UU, UF, FU, FF     ) where +import Data.Data (Data(..), mkDataType, DataType, mkConstr, Constr, constrIndex, Fixity(..))+import Data.Typeable (Typeable1(..), Typeable(..), TyCon, mkTyCon, mkTyConApp, typeOfDefault, gcast1) import Language.Haskell.TH import Numeric.AD.Internal.Classes @@ -40,3 +42,31 @@ -- | A non-scalar-to-non-scalar automatically-differentiable function. type FF f g a = forall s. Mode s => f (AD s a) -> g (AD s a) +instance Typeable1 f => Typeable1 (AD f) where+    typeOf1 tfa = mkTyConApp adTyCon [typeOf1 (undefined `asArgsType` tfa)]+        where asArgsType :: f a -> t f a -> f a+              asArgsType = const++instance (Typeable1 f, Typeable a) => Typeable (AD f a) where+    typeOf = typeOfDefault+    +adTyCon :: TyCon+adTyCon = mkTyCon "Numeric.AD.Internal.Types.AD"+{-# NOINLINE adTyCon #-}++adConstr :: Constr+adConstr = mkConstr adDataType "AD" [] Prefix+{-# NOINLINE adConstr #-}++adDataType :: DataType+adDataType = mkDataType "Numeric.AD.Internal.Types.AD" [adConstr]+{-# NOINLINE adDataType #-}++instance (Typeable1 f, Typeable a, Data (f a), Data a) => Data (AD f a) where+    gfoldl f z (AD a) = z AD `f` a+    toConstr _ = adConstr+    gunfold k z c = case constrIndex c of+        1 -> k (z AD)+        _ -> error "gunfold"+    dataTypeOf _ = adDataType+    dataCast1 f = gcast1 f

@@ -1,5 +1,5 @@ Name:         ad-Version:      0.30.0+Version:      0.31.0 License:      BSD3 License-File: LICENSE Copyright:    (c) Edward Kmett 2010,@@ -53,4 +53,5 @@     Numeric.AD.Internal.Iterated  Extra-Source-Files: TODO-GHC-Options: -Wall -fspec-constr -O2+GHC-Options: -Wall -fspec-constr +--           -O2