Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- type ModelFunc p s a b = forall z. Reifies z W => PMaybe (BVar z) p -> BVar z a -> PMaybe (BVar z) s -> (BVar z b, PMaybe (BVar z) s)
- type ModelFuncStoch p s a b = forall m z. (PrimMonad m, Reifies z W) => Gen (PrimState m) -> PMaybe (BVar z) p -> BVar z a -> PMaybe (BVar z) s -> m (BVar z b, PMaybe (BVar z) s)
- data Model :: Maybe Type -> Maybe Type -> Type -> Type -> Type where
- modelD :: ModelFunc p s a b -> Model p s a b
- type ModelFuncStateless p a b = forall z. Reifies z W => PMaybe (BVar z) p -> BVar z a -> BVar z b
- type ModelFuncStochStateless p a b = forall m z. (PrimMonad m, Reifies z W) => Gen (PrimState m) -> PMaybe (BVar z) p -> BVar z a -> m (BVar z b)
- type ModelStateless p = Model p Nothing
- pattern ModelStateless :: ModelFuncStateless p a b -> ModelFuncStochStateless p a b -> ModelStateless p a b
- runLearnStateless :: ModelStateless p a b -> forall z. Reifies z W => PMaybe (BVar z) p -> BVar z a -> BVar z b
- runLearnStochStateless :: ModelStateless p a b -> forall (m :: Type -> Type) z. (PrimMonad m, Reifies z W) => Gen (PrimState m) -> PMaybe (BVar z) p -> BVar z a -> m (BVar z b)
- modelStatelessD :: ModelFuncStateless p a b -> ModelStateless p a b
- type BFunc a b = forall z. Reifies z W => BVar z a -> BVar z b
- type BFuncStoch a b = forall m z. (PrimMonad m, Reifies z W) => Gen (PrimState m) -> BVar z a -> m (BVar z b)
- type Func = Model Nothing Nothing
- pattern Func :: BFunc a b -> BFuncStoch a b -> Func a b
- runFunc :: Func a b -> forall z. Reifies z W => BVar z a -> BVar z b
- runFuncStoch :: Func a b -> forall (m :: Type -> Type) z. (PrimMonad m, Reifies z W) => Gen (PrimState m) -> BVar z a -> m (BVar z b)
- funcD :: BFunc a b -> Func a b
- type ModelFuncM m p s a b = forall z. Reifies z W => PMaybe (BVar z) p -> BVar z a -> PMaybe (BVar z) s -> m (BVar z b, PMaybe (BVar z) s)
- withModelFunc0 :: (forall m. Monad m => ModelFuncM m p s a b) -> Model p s a b
- withModelFunc :: (forall m. Monad m => ModelFuncM m p s a b -> ModelFuncM m q t c d) -> Model p s a b -> Model q t c d
- withModelFunc2 :: (forall m. Monad m => ModelFuncM m p s a b -> ModelFuncM m q t c d -> ModelFuncM m r u e f) -> Model p s a b -> Model q t c d -> Model r u e f
- data PMaybe (a :: k -> Type) (b :: Maybe k) :: forall k. (k -> Type) -> Maybe k -> Type where
- type TMaybe = PMaybe TF
- fromPJust :: PMaybe f (Just a) -> f a
- type Learnables as = (RecApplicative as, ReifyConstraint Backprop TF as, RMap as, RApply as)
- class (Initialize a, Regularize a, Binary a, NFData a, LinearInPlace m Double a) => Learnable m a
- class Backprop p => Regularize p where
- class Initialize p where
- initialize :: (ContGen d, PrimMonad m) => d -> Gen (PrimState m) -> m p
Model type
type ModelFunc p s a b = forall z. Reifies z W => PMaybe (BVar z) p -> BVar z a -> PMaybe (BVar z) s -> (BVar z b, PMaybe (BVar z) s) Source #
type ModelFuncStoch p s a b = forall m z. (PrimMonad m, Reifies z W) => Gen (PrimState m) -> PMaybe (BVar z) p -> BVar z a -> PMaybe (BVar z) s -> m (BVar z b, PMaybe (BVar z) s) Source #
data Model :: Maybe Type -> Maybe Type -> Type -> Type -> Type where Source #
General parameterized model with potential state
Model | |
|
modelD :: ModelFunc p s a b -> Model p s a b Source #
Construct a deterministic model, with no stochastic component.
Specialized Models
Stateless
type ModelFuncStateless p a b = forall z. Reifies z W => PMaybe (BVar z) p -> BVar z a -> BVar z b Source #
type ModelFuncStochStateless p a b = forall m z. (PrimMonad m, Reifies z W) => Gen (PrimState m) -> PMaybe (BVar z) p -> BVar z a -> m (BVar z b) Source #
type ModelStateless p = Model p Nothing Source #
Parameterized model with no state
pattern ModelStateless :: ModelFuncStateless p a b -> ModelFuncStochStateless p a b -> ModelStateless p a b Source #
Construct a ModelStateless
.
runLearnStateless :: ModelStateless p a b -> forall z. Reifies z W => PMaybe (BVar z) p -> BVar z a -> BVar z b Source #
runLearnStochStateless :: ModelStateless p a b -> forall (m :: Type -> Type) z. (PrimMonad m, Reifies z W) => Gen (PrimState m) -> PMaybe (BVar z) p -> BVar z a -> m (BVar z b) Source #
modelStatelessD :: ModelFuncStateless p a b -> ModelStateless p a b Source #
Construct a deterministic stateless model, with no stochastic component.
Stateless and Parameterless
type BFuncStoch a b = forall m z. (PrimMonad m, Reifies z W) => Gen (PrimState m) -> BVar z a -> m (BVar z b) Source #
runFuncStoch :: Func a b -> forall (m :: Type -> Type) z. (PrimMonad m, Reifies z W) => Gen (PrimState m) -> BVar z a -> m (BVar z b) Source #
funcD :: BFunc a b -> Func a b Source #
Construct an deterministic unparameterized stateless model, with no stochastic component.
Manipulating models as functions
type ModelFuncM m p s a b = forall z. Reifies z W => PMaybe (BVar z) p -> BVar z a -> PMaybe (BVar z) s -> m (BVar z b, PMaybe (BVar z) s) Source #
withModelFunc0 :: (forall m. Monad m => ModelFuncM m p s a b) -> Model p s a b Source #
withModelFunc :: (forall m. Monad m => ModelFuncM m p s a b -> ModelFuncM m q t c d) -> Model p s a b -> Model q t c d Source #
withModelFunc2 :: (forall m. Monad m => ModelFuncM m p s a b -> ModelFuncM m q t c d -> ModelFuncM m r u e f) -> Model p s a b -> Model q t c d -> Model r u e f Source #
Utility
data PMaybe (a :: k -> Type) (b :: Maybe k) :: forall k. (k -> Type) -> Maybe k -> Type where #
A
contains nothing, and a PMaybe
f 'Nothing
contains an PMaybe
f ('Just a)f a
.
In practice this can be useful to write polymorphic functions/abstractions that contain an argument that can be "turned off" for different instances.
PNothing :: forall k (a :: k -> Type) (b :: Maybe k). PMaybe a (Nothing :: Maybe k) | |
PJust :: forall k (a :: k -> Type) (b :: Maybe k) (a1 :: k). a a1 -> PMaybe a (Just a1) |
Instances
PureProdC Maybe Backprop as => Backprop (TMaybe as) Source # | |
Decidable (TyPred (PMaybe (Sing :: k -> Type)) :: Predicate (Maybe k)) | Since: decidable-2.0.0 |
Provable (TyPred (PMaybe (Sing :: k -> Type)) :: Predicate (Maybe k)) | Since: decidable-2.0.0 |
SingI as => Auto (TyPred (PMaybe (Sing :: k -> Type)) :: Predicate (Maybe k)) (as :: Maybe k) | Since: decidable-2.0.0 |
ReifyConstraintProd Maybe Eq f as => Eq (PMaybe f as) | |
(ReifyConstraintProd Maybe Eq f as, ReifyConstraintProd Maybe Ord f as) => Ord (PMaybe f as) | |
Defined in Data.Type.Functor.Product | |
ReifyConstraintProd Maybe Show f as => Show (PMaybe f as) | |
(PureProdC Maybe Backprop as, PureProdC Maybe Regularize as) => Regularize (PMaybe TF as) Source # | |
type Learnables as = (RecApplicative as, ReifyConstraint Backprop TF as, RMap as, RApply as) Source #
Combination of common constraints for type-level lists.
class (Initialize a, Regularize a, Binary a, NFData a, LinearInPlace m Double a) => Learnable m a Source #
Helpful utility class for ensuring that a parameter or state type is Learnable
Instances
class Backprop p => Regularize p where Source #
A class for data types that support regularization during training.
This class is somewhat similar to
, in that it
supports summing the components and summing squared components.
However, the main difference is that when summing components, we only
consider components that we want to regularize.Metric
Double
Often, this doesn't include bias terms (terms that "add" to inputs), and only includes terms that "scale" inputs, like components in a weight matrix of a feed-forward neural network layer.
However, if all of your components are to be regularized, you can use
norm_1
, norm_2
, lassoLinear
, and ridgeLinear
as sensible
implementations, or use DerivingVia with RegularizeMetric
:
data MyType = ... deriving Regularize via (RegularizeMetric MyType)
You can also derive an instance where no are regularized, using
NoRegularize
:
data MyType = ... deriving Regularize via (NoRegularize MyType)
The default implementations are based on Generics
, and work for types
that are records of items that are all instances of Regularize
.
Nothing
rnorm_1 :: p -> Double Source #
Like norm_1
: sums all of the weights in p
, but only the
ones you want to regularize:
\[ \sum_w \lvert w \rvert \]
Note that typically bias terms (terms that add to inputs) are not regularized. Only "weight" terms that scale inputs are typically regularized.
If p
is an instance of Metric
, then you can set
. However, this would count all terms in rnorm_1
= norm_1
p
, even
potential bias terms.
rnorm_1 :: (ADT p, Constraints p Regularize) => p -> Double Source #
Like norm_1
: sums all of the weights in p
, but only the
ones you want to regularize:
\[ \sum_w \lvert w \rvert \]
Note that typically bias terms (terms that add to inputs) are not regularized. Only "weight" terms that scale inputs are typically regularized.
If p
is an instance of Metric
, then you can set
. However, this would count all terms in rnorm_1
= norm_1
p
, even
potential bias terms.
rnorm_2 :: p -> Double Source #
Like norm_2
: sums all of the squares of the weights
n p
, but only the ones you want to regularize:
\[ \sum_w w^2 \]
Note that typically bias terms (terms that add to inputs) are not regularized. Only "weight" terms that scale inputs are typically regularized.
If p
is an instance of Metric
, then you can set
. However, this would count all terms in rnorm_2
= norm_2
p
, even
potential bias terms.
rnorm_2 :: (ADT p, Constraints p Regularize) => p -> Double Source #
Like norm_2
: sums all of the squares of the weights
n p
, but only the ones you want to regularize:
\[ \sum_w w^2 \]
Note that typically bias terms (terms that add to inputs) are not regularized. Only "weight" terms that scale inputs are typically regularized.
If p
is an instance of Metric
, then you can set
. However, this would count all terms in rnorm_2
= norm_2
p
, even
potential bias terms.
lasso :: Double -> p -> p Source #
sets all regularized components (that is, components
summed by lasso
r prnorm_1
) in p
to be either r
if that component was
positive, or -r
if that component was negative. Behavior is not
defined if the component is exactly zero, but either r
or -r
are
sensible possibilities.
It must set all non-regularized components (like bias terms, or
whatever items that rnorm_1
ignores) to zero.
If p
is an instance of
and Linear
Double
Num
, then you can set
. However, this is only valid if lasso
= lassoLinear
rnorm_1
counts all terms in p
, including potential bias terms.
lasso :: (ADT p, Constraints p Regularize) => Double -> p -> p Source #
sets all regularized components (that is, components
summed by lasso
r prnorm_1
) in p
to be either r
if that component was
positive, or -r
if that component was negative. Behavior is not
defined if the component is exactly zero, but either r
or -r
are
sensible possibilities.
It must set all non-regularized components (like bias terms, or
whatever items that rnorm_1
ignores) to zero.
If p
is an instance of
and Linear
Double
Num
, then you can set
. However, this is only valid if lasso
= lassoLinear
rnorm_1
counts all terms in p
, including potential bias terms.
ridge :: Double -> p -> p Source #
scales all regularized components (that is,
components summed by ridge
r prnorm_2
) in p
by r
.
It must set all non-regularized components (like bias terms, or
whatever items that rnorm_2
ignores) to zero.
If p
is an instance of
and Linear
Double
Num
, then you can set
. However, this is only valid if ridge
= ridgeLinear
rnorm_2
counts all terms in p
, including potential bias terms.
ridge :: (ADT p, Constraints p Regularize) => Double -> p -> p Source #
scales all regularized components (that is,
components summed by ridge
r prnorm_2
) in p
by r
.
It must set all non-regularized components (like bias terms, or
whatever items that rnorm_2
ignores) to zero.
If p
is an instance of
and Linear
Double
Num
, then you can set
. However, this is only valid if ridge
= ridgeLinear
rnorm_2
counts all terms in p
, including potential bias terms.
Instances
class Initialize p where Source #
Class for types that are basically a bunch of Double
s, which can be
initialized with a given identical and independent distribution.
Nothing
initialize :: (ContGen d, PrimMonad m) => d -> Gen (PrimState m) -> m p Source #
initialize :: (ADTRecord p, Constraints p Initialize, ContGen d, PrimMonad m) => d -> Gen (PrimState m) -> m p Source #