HLearn-algebra 0.0.1 → 0.1.0
raw patch · 9 files changed
+384/−110 lines, 9 filesdep +containersdep −binarydep −ghc-primdep −hashablePVP ok
version bump matches the API change (PVP)
Dependencies added: containers
Dependencies removed: binary, ghc-prim, hashable, vector
API changes (from Hackage documentation)
- HLearn.Algebra.Models: class (Hashable label, Binary label, Ord label, Eq label, Show label, Read label) => Label label
- HLearn.Algebra.Models: instance (Hashable label, Binary label, Ord label, Eq label, Show label, Read label) => Label label
- HLearn.Algebra.Models: type Labeled var label = (label, var)
- HLearn.Algebra.Models: type Weighted var = (var, Double)
- HLearn.Algebra.Structures: SGJust :: sg -> RegSG2Group sg
- HLearn.Algebra.Structures: SGNothing :: RegSG2Group sg
- HLearn.Algebra.Structures: class (RegularSemigroup g, Monoid g) => Group g
- HLearn.Algebra.Structures: class Semigroup g => RegularSemigroup g
- HLearn.Algebra.Structures: data RegularSemigroup sg => RegSG2Group sg
- HLearn.Algebra.Structures: instance (Eq sg, RegularSemigroup sg) => Eq (RegSG2Group sg)
- HLearn.Algebra.Structures: instance (Ord sg, RegularSemigroup sg) => Ord (RegSG2Group sg)
- HLearn.Algebra.Structures: instance (Read sg, RegularSemigroup sg) => Read (RegSG2Group sg)
- HLearn.Algebra.Structures: instance (Show sg, RegularSemigroup sg) => Show (RegSG2Group sg)
- HLearn.Algebra.Structures: instance RegularSemigroup sg => Group (RegSG2Group sg)
- HLearn.Algebra.Structures: instance RegularSemigroup sg => Monoid (RegSG2Group sg)
- HLearn.Algebra.Structures: instance RegularSemigroup sg => RegularSemigroup (RegSG2Group sg)
- HLearn.Algebra.Structures: instance RegularSemigroup sg => Semigroup (RegSG2Group sg)
- HLearn.Algebra.Structures: inverse :: RegularSemigroup g => g -> g
+ HLearn.Algebra.Models: instance (HomTrainer modelparams datapoint model, LeftOperator r model) => HomTrainer modelparams (r, datapoint) model
+ HLearn.Algebra.Morphism: ($>) :: Morphism domain params codomain => domain -> params -> codomain
+ HLearn.Algebra.Morphism: (:.) :: params2 -> params1 -> MorphismComposition domain params1 interdomain params2 codomain
+ HLearn.Algebra.Morphism: (<.>) :: Morphism domain params codomain => params -> domain -> codomain
+ HLearn.Algebra.Morphism: class Morphism domain params codomain => DefaultMorphism domain params codomain | domain codomain -> params where morph domain = (morph' :: domain -> params -> codomain) domain (defMorphParams (undefined :: domain) (undefined :: codomain))
+ HLearn.Algebra.Morphism: class Morphism domain params codomain | params -> codomain where morph' = ($>) $> = morph' <.> = flip morph'
+ HLearn.Algebra.Morphism: data (Morphism domain params1 interdomain, Morphism interdomain params2 codomain) => MorphismComposition domain params1 interdomain params2 codomain
+ HLearn.Algebra.Morphism: defMorphParams :: DefaultMorphism domain params codomain => domain -> codomain -> params
+ HLearn.Algebra.Morphism: instance (FunctorConstraint container model, FunctorConstraint container datapoint, FoldableConstraint container model, Foldable container, Functor container, Model (MorphismComposition (container datapoint) params1 interdomain params2 codomain) codomain, HomTrainer params1 datapoint interdomain, Morphism (container datapoint) params1 interdomain, Morphism interdomain params2 codomain, Monoid codomain, Semigroup codomain, Model (MorphismComposition domain params1 interdomain params2 codomain) codomain) => HomTrainer (MorphismComposition (container datapoint) params1 interdomain params2 codomain) datapoint codomain
+ HLearn.Algebra.Morphism: instance (Homomorphism domain params1 interdomain, Homomorphism interdomain params2 codomain) => Homomorphism domain (MorphismComposition domain params1 interdomain params2 codomain) codomain
+ HLearn.Algebra.Morphism: instance (Injective domain params1 interdomain, Injective interdomain params2 codomain) => Injective domain (MorphismComposition domain params1 interdomain params2 codomain) codomain
+ HLearn.Algebra.Morphism: instance (Morphism domain params1 interdomain, Morphism interdomain params2 codomain) => Morphism domain (MorphismComposition domain params1 interdomain params2 codomain) codomain
+ HLearn.Algebra.Morphism: instance (Surjective domain params1 interdomain, Surjective interdomain params2 codomain) => Surjective domain (MorphismComposition domain params1 interdomain params2 codomain) codomain
+ HLearn.Algebra.Morphism: morph :: DefaultMorphism domain params codomain => domain -> codomain
+ HLearn.Algebra.Morphism: morph' :: Morphism domain params codomain => domain -> params -> codomain
+ HLearn.Algebra.Structures.Free.RegSG2Group: SGJust :: sg -> RegSG2Group sg
+ HLearn.Algebra.Structures.Free.RegSG2Group: SGNothing :: RegSG2Group sg
+ HLearn.Algebra.Structures.Free.RegSG2Group: data RegularSemigroup sg => RegSG2Group sg
+ HLearn.Algebra.Structures.Free.RegSG2Group: instance (Eq sg, RegularSemigroup sg) => Eq (RegSG2Group sg)
+ HLearn.Algebra.Structures.Free.RegSG2Group: instance (LeftOperator r sg, RegularSemigroup sg) => LeftOperator r (RegSG2Group sg)
+ HLearn.Algebra.Structures.Free.RegSG2Group: instance (Ord sg, RegularSemigroup sg) => Ord (RegSG2Group sg)
+ HLearn.Algebra.Structures.Free.RegSG2Group: instance (Read sg, RegularSemigroup sg) => Read (RegSG2Group sg)
+ HLearn.Algebra.Structures.Free.RegSG2Group: instance (RegularSemigroup sg, NFData sg) => NFData (RegSG2Group sg)
+ HLearn.Algebra.Structures.Free.RegSG2Group: instance (RightOperator r sg, RegularSemigroup sg) => RightOperator r (RegSG2Group sg)
+ HLearn.Algebra.Structures.Free.RegSG2Group: instance (Show sg, RegularSemigroup sg) => Show (RegSG2Group sg)
+ HLearn.Algebra.Structures.Free.RegSG2Group: instance RegularSemigroup sg => Group (RegSG2Group sg)
+ HLearn.Algebra.Structures.Free.RegSG2Group: instance RegularSemigroup sg => Monoid (RegSG2Group sg)
+ HLearn.Algebra.Structures.Free.RegSG2Group: instance RegularSemigroup sg => RegularSemigroup (RegSG2Group sg)
+ HLearn.Algebra.Structures.Free.RegSG2Group: instance RegularSemigroup sg => Semigroup (RegSG2Group sg)
+ HLearn.Algebra.Structures.Groups: class Semigroup sg => Abelian sg
+ HLearn.Algebra.Structures.Groups: class (RegularSemigroup g, Monoid g) => Group g
+ HLearn.Algebra.Structures.Groups: class Semigroup g => RegularSemigroup g
+ HLearn.Algebra.Structures.Groups: instance (RegularSemigroup g, Monoid g) => Group g
+ HLearn.Algebra.Structures.Groups: inverse :: RegularSemigroup g => g -> g
+ HLearn.Algebra.Structures.Modules: (*.) :: RightOperator r m => m -> r -> m
+ HLearn.Algebra.Structures.Modules: (.*) :: LeftOperator r m => r -> m -> m
+ HLearn.Algebra.Structures.Modules: FreeMod :: (Map a r) -> FreeMod r a
+ HLearn.Algebra.Structures.Modules: FreeModParams :: FreeModParams
+ HLearn.Algebra.Structures.Modules: class (LeftOperator r g, Num r, Group g, Abelian g) => LeftModule r g
+ HLearn.Algebra.Structures.Modules: class LeftOperator r m | m -> r
+ HLearn.Algebra.Structures.Modules: class (LeftModule r g, RightModule r g) => Module r g
+ HLearn.Algebra.Structures.Modules: class (LeftOperator r m, RightOperator r m) => Operator r m
+ HLearn.Algebra.Structures.Modules: class (RightOperator r g, Num r, Group g, Abelian g) => RightModule r g
+ HLearn.Algebra.Structures.Modules: class RightOperator r m | m -> r
+ HLearn.Algebra.Structures.Modules: data FreeModParams
+ HLearn.Algebra.Structures.Modules: instance (Eq r, Eq a) => Eq (FreeMod r a)
+ HLearn.Algebra.Structures.Modules: instance (LeftModule r g, RightModule r g) => Module r g
+ HLearn.Algebra.Structures.Modules: instance (LeftOperator r g, Num r, Group g, Abelian g) => LeftModule r g
+ HLearn.Algebra.Structures.Modules: instance (LeftOperator r m, RightOperator r m) => Operator r m
+ HLearn.Algebra.Structures.Modules: instance (Num r, Ord a) => Abelian (FreeMod r a)
+ HLearn.Algebra.Structures.Modules: instance (Num r, Ord a) => LeftModule r (FreeMod r a)
+ HLearn.Algebra.Structures.Modules: instance (Num r, Ord a) => LeftOperator r (FreeMod r a)
+ HLearn.Algebra.Structures.Modules: instance (Num r, Ord a) => Monoid (FreeMod r a)
+ HLearn.Algebra.Structures.Modules: instance (Num r, Ord a) => RegularSemigroup (FreeMod r a)
+ HLearn.Algebra.Structures.Modules: instance (Num r, Ord a) => RightModule r (FreeMod r a)
+ HLearn.Algebra.Structures.Modules: instance (Num r, Ord a) => RightOperator r (FreeMod r a)
+ HLearn.Algebra.Structures.Modules: instance (Num r, Ord a) => Semigroup (FreeMod r a)
+ HLearn.Algebra.Structures.Modules: instance (Num r, Ord a, Read r, Read a) => Read (FreeMod r a)
+ HLearn.Algebra.Structures.Modules: instance (Num r, Ord a, Show r, Show a) => Show (FreeMod r a)
+ HLearn.Algebra.Structures.Modules: instance (RightOperator r g, Num r, Group g, Abelian g) => RightModule r g
+ HLearn.Algebra.Structures.Modules: instance Foldable (FreeMod r)
+ HLearn.Algebra.Structures.Modules: instance Functor (FreeMod r)
+ HLearn.Algebra.Structures.Modules: instance LeftOperator Double Double
+ HLearn.Algebra.Structures.Modules: instance LeftOperator Float Float
+ HLearn.Algebra.Structures.Modules: instance LeftOperator Int Int
+ HLearn.Algebra.Structures.Modules: instance LeftOperator Integer Integer
+ HLearn.Algebra.Structures.Modules: instance LeftOperator a b => LeftOperator a [b]
+ HLearn.Algebra.Structures.Modules: instance RightOperator Double Double
+ HLearn.Algebra.Structures.Modules: instance RightOperator Float Float
+ HLearn.Algebra.Structures.Modules: instance RightOperator Int Int
+ HLearn.Algebra.Structures.Modules: instance RightOperator Integer Integer
+ HLearn.Algebra.Structures.Modules: instance RightOperator a b => RightOperator a [b]
+ HLearn.Algebra.Structures.Modules: list2module :: (Num r, Ord r, Ord a) => [a] -> FreeMod r a
+ HLearn.Algebra.Structures.Modules: newtype (Num r, Ord a) => FreeMod r a
- HLearn.Algebra.Models: class (DefaultModel modelparams model, HomTrainer modelparams datapoint model) => DefaultHomTrainer modelparams datapoint model where train1dp = train1dp' (defparams :: modelparams) train = train' (defparams :: modelparams)
+ HLearn.Algebra.Models: class (DefaultModel modelparams model, HomTrainer modelparams datapoint model) => DefaultHomTrainer modelparams datapoint model | model -> modelparams where train1dp = train1dp' (defparams :: modelparams) train = train' (defparams :: modelparams)
- HLearn.Algebra.Models: class Model modelparams model => DefaultModel modelparams model
+ HLearn.Algebra.Models: class Model modelparams model => DefaultModel modelparams model | model -> modelparams
- HLearn.Algebra.Models: class Model modelparams model | modelparams -> model, model -> modelparams
+ HLearn.Algebra.Models: class Model modelparams model | modelparams -> model
Files
- HLearn-algebra.cabal +8/−8
- src/HLearn/Algebra.hs +11/−5
- src/HLearn/Algebra/Functions.hs +1/−1
- src/HLearn/Algebra/Models.hs +20/−25
- src/HLearn/Algebra/Morphism.hs +120/−0
- src/HLearn/Algebra/Structures.hs +0/−71
- src/HLearn/Algebra/Structures/Free/RegSG2Group.hs +46/−0
- src/HLearn/Algebra/Structures/Groups.hs +43/−0
- src/HLearn/Algebra/Structures/Modules.hs +135/−0
HLearn-algebra.cabal view
@@ -1,6 +1,6 @@ Name: HLearn-algebra-Version: 0.0.1-Synopsis: Algebraic foundation for the homomorphic learning+Version: 0.1.0+Synopsis: Algebraic foundation for homomorphic learning Description: This module contains the algebraic basis for the HLearn library. It is separated out in it's own library because it contains routines that may be useful to others. In particular, it contains methods for automatically converting algorithms into online/parallel versions, and its structure is slightly more modular (although much less complete) than other algebra packages. Category: Data Mining, Machine Learning License: GPL@@ -13,19 +13,19 @@ Library Build-Depends: base >= 3 && < 5,- ghc-prim, ConstraintKinds >= 0.0.1, semigroups >= 0.8, parallel >= 3.2, deepseq >= 1.3,- binary >= 0.5,- hashable >= 1.1.2,- vector >= 0.9+ containers >= 0.5 hs-source-dirs: src ghc-options: -rtsopts -auto-all -caf-all -O2 Exposed-modules: HLearn.Algebra- HLearn.Algebra.Models- HLearn.Algebra.Structures HLearn.Algebra.Functions+ HLearn.Algebra.Models+ HLearn.Algebra.Morphism+ HLearn.Algebra.Structures.Groups+ HLearn.Algebra.Structures.Modules+ HLearn.Algebra.Structures.Free.RegSG2Group
src/HLearn/Algebra.hs view
@@ -1,12 +1,18 @@ -- | This is the base module for the HLearn library. It exports all the functions / data structures needed. module HLearn.Algebra- ( module HLearn.Algebra.Models- , module HLearn.Algebra.Structures- , module HLearn.Algebra.Functions+ ( module HLearn.Algebra.Functions+ , module HLearn.Algebra.Models+ , module HLearn.Algebra.Morphism+ , module HLearn.Algebra.Structures.Groups+ , module HLearn.Algebra.Structures.Modules+ , module HLearn.Algebra.Structures.Free.RegSG2Group ) where -import HLearn.Algebra.Models-import HLearn.Algebra.Structures import HLearn.Algebra.Functions+import HLearn.Algebra.Models+import HLearn.Algebra.Morphism+import HLearn.Algebra.Structures.Groups+import HLearn.Algebra.Structures.Modules+import HLearn.Algebra.Structures.Free.RegSG2Group
src/HLearn/Algebra/Functions.hs view
@@ -30,7 +30,7 @@ import Prelude hiding (filter) import System.IO.Unsafe -import HLearn.Algebra.Structures+import HLearn.Algebra.Structures.Groups ------------------------------------------------------------------------------- -- higher order functions
src/HLearn/Algebra/Models.hs view
@@ -21,44 +21,31 @@ , DefaultHomTrainer (..) -- * Type synonyms- , Labeled- , Weighted- , Label (..)-- , module Control.DeepSeq- , module Data.Hashable- , module Data.Binary+-- , Labeled+-- , Weighted+-- , Label (..) ) where import qualified Control.ConstraintKinds as CK -import HLearn.Algebra.Structures import HLearn.Algebra.Functions--import Control.DeepSeq-import Data.Hashable-import Data.Binary------------------------------------------------------------------------------------ Idioms--type Labeled var label = (label,var)-type Weighted var = (var,Double)+import HLearn.Algebra.Structures.Groups+import HLearn.Algebra.Structures.Modules --- | I only ever expect labels of type Bool, Int, and String, but it may be convenient to use other types as well for something. This class and instance exist so that we have some reasonable assumptions about what properties labels should have for our other classes to work with. It also keeps us from writing so many constraints.-class (Hashable label, Binary label, Ord label, Eq label, Show label, Read label) => Label label-instance (Hashable label, Binary label, Ord label, Eq label, Show label, Read label) => Label label+-- import Control.DeepSeq+-- import Data.Hashable+-- import Data.Binary ------------------------------------------------------------------------------- -- Model -- | Every model has at least one data type that that fully describes its parameters. Many models do not actually *need* any parameters, in which case they will simply use an empty data type for modelparams.-class Model modelparams model | modelparams -> model, model -> modelparams where+class Model modelparams model | modelparams -> model{-, model -> modelparams-} where getparams :: model -> modelparams -- | For those algorithms that do not require parameters (or that have reasonable default parameters), this class lets us use a more convenient calling notation.-class (Model modelparams model) => DefaultModel modelparams model where+class (Model modelparams model) => DefaultModel modelparams model | model -> modelparams where defparams :: modelparams -- | A minimal complete definition of the class is the singleton trainer 'train1dp\''@@ -101,12 +88,18 @@ ) => model -> container datapoint -> model addBatch model = online (train' (getparams model :: modelparams)) model - +instance + ( HomTrainer modelparams datapoint model+ , LeftOperator r model+ ) => HomTrainer modelparams (r,datapoint) model where+ train1dp' modelparams (r,dp) = r .* (train1dp' modelparams dp)++ -- | Provides parameterless functions for those training algorithms that do not require parameters class ( DefaultModel modelparams model , HomTrainer modelparams datapoint model- ) => DefaultHomTrainer modelparams datapoint model+ ) => DefaultHomTrainer modelparams datapoint model | model -> modelparams where -- | A singleton trainer that doesn't require parameters (uses 'defparams')@@ -129,3 +122,5 @@ ( DefaultModel modelparams model , HomTrainer modelparams datapoint model ) => DefaultHomTrainer modelparams datapoint model+ +
+ src/HLearn/Algebra/Morphism.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE DatatypeContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}++module HLearn.Algebra.Morphism+ ( Morphism (..)+ , MorphismComposition (..)+ , DefaultMorphism (..)+ )+ where++import qualified Control.ConstraintKinds as CK+import HLearn.Algebra.Models+import HLearn.Algebra.Structures.Groups++class Morphism domain params codomain | params -> codomain where+ morph' :: domain -> params -> codomain+ morph' = ($>)++ ($>) :: domain -> params -> codomain+ ($>) = morph'+ + (<.>) :: params -> domain -> codomain+ (<.>) = flip morph'++data + ( Morphism domain params1 interdomain+ , Morphism interdomain params2 codomain+ ) => MorphismComposition domain params1 interdomain params2 codomain = (:.) params2 params1++instance + ( Morphism domain params1 interdomain+ , Morphism interdomain params2 codomain+ ) => Morphism domain (MorphismComposition domain params1 interdomain params2 codomain) codomain+ where+ morph' x (params2 :. params1) = morph' (morph' x params1) params2++class (Morphism domain params codomain) => DefaultMorphism domain params codomain | domain codomain -> params where+ defMorphParams :: domain -> codomain -> params+ + morph :: domain -> codomain+ morph domain = (morph' :: domain -> params -> codomain) domain (defMorphParams (undefined :: domain) (undefined :: codomain))++-------------------------------------------------------------------------------++-- data HLearn params domain codomain = HLearn params+-- instance Category (MorphismComposition' params1 interdomain params2) where+-- id a = a+-- (.) = ++-------------------------------------------------------------------------------+-- Properties++class (Morphism domain params codomain) => Surjective domain params codomain+instance + ( Surjective domain params1 interdomain+ , Surjective interdomain params2 codomain+ ) => Surjective domain (MorphismComposition domain params1 interdomain params2 codomain) codomain+ +class (Morphism domain params codomain) => Injective domain params codomain+instance + ( Injective domain params1 interdomain+ , Injective interdomain params2 codomain+ ) => Injective domain (MorphismComposition domain params1 interdomain params2 codomain) codomain+ +class (Morphism domain params codomain) => Homomorphism domain params codomain+instance + ( Homomorphism domain params1 interdomain+ , Homomorphism interdomain params2 codomain+ ) => Homomorphism domain (MorphismComposition domain params1 interdomain params2 codomain) codomain++-------------------------------------------------------------------------------+-- Training++-- instance +-- ( HomTrainer modelparams datapoint model+-- , CK.Foldable container+-- , CK.FoldableConstraint container model+-- , CK.Functor container+-- , CK.FunctorConstraint container datapoint+-- , CK.FunctorConstraint container model+-- ) => Morphism (container datapoint) modelparams model+-- where+-- morph' input params = train' params input+-- +-- instance +-- ( Model params1 interdomain+-- , Model params2 codomain+-- ) => Model (MorphismComposition domain params1 interdomain params2 codomain) codomain+-- where+-- getparams model = undefined++-- instance +-- ( DefaultModel params1 interdomain+-- , DefaultModel params2 codomain+-- ) => DefaultModel (MorphismComposition domain params1 interdomain params2 codomain) codomain+-- where+-- defparams = undefined++instance + ( CK.FunctorConstraint container model+ , CK.FunctorConstraint container datapoint+ , CK.FoldableConstraint container model+ , CK.Foldable container+ , CK.Functor container+ , Model (MorphismComposition (container datapoint) params1 interdomain params2 codomain) codomain+ , HomTrainer params1 datapoint interdomain+ , Morphism (container datapoint) params1 interdomain+ , Morphism interdomain params2 codomain+ , Monoid codomain+ , Semigroup codomain+ , Model (MorphismComposition domain params1 interdomain params2 codomain) codomain+ ) => HomTrainer (MorphismComposition (container datapoint) params1 interdomain params2 codomain) datapoint codomain+ where+ train1dp' (params2 :. params1) dp = params2 <.> (train1dp' params1 dp)
− src/HLearn/Algebra/Structures.hs
@@ -1,71 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}---- | These algebraic structures have sacrificed generality in favor of being easily used with the standard Haskell Prelude. The fact that monoids are not guaranteed to be semigroups makes this difficult.--module HLearn.Algebra.Structures- ( - -- * Type classes- RegularSemigroup (..)- , Group(..)- - -- * Free Structures- , RegSG2Group (..)-- , module Data.Semigroup- )- where--import Data.Semigroup------------------------------------------------------------------------------------ Inverses---- | Semigroups that also have an inverse. See <https://en.wikipedia.org/wiki/Regular_semigroup>-class (Semigroup g) => RegularSemigroup g where- inverse :: g -> g---- -- | Semigroups where a unique inverse exists for each element. See <https://en.wikipedia.org/wiki/Inverse_semigroup>--- class (RegularSemigroup g) => InverseSemigroup g---- | Regular semigroups that also have an identity; alternatively, monoids where every element has a unique inverse. See <https://en.wikipedia.org/wiki/Group_(mathematics)>-class (RegularSemigroup g, Monoid g) => Group g------------------------------------------------------------------------------------ RegSG2Group----- | Convert any regular semigroup into a group (and thus also a monoid) by adding a unique identity element-data (RegularSemigroup sg) => RegSG2Group sg = SGNothing | SGJust sg- deriving (Show,Read,Ord,Eq)--instance (RegularSemigroup sg) => Semigroup (RegSG2Group sg) where- SGNothing <> m = m- m <> SGNothing = m- (SGJust sg1) <> (SGJust sg2) = SGJust $ sg1<>sg2--instance (RegularSemigroup sg) => RegularSemigroup (RegSG2Group sg) where- inverse SGNothing = SGNothing- inverse (SGJust x) = SGJust $ inverse x--instance (RegularSemigroup sg) => Monoid (RegSG2Group sg) where- mempty = SGNothing- mappend = (<>)- -instance (RegularSemigroup sg) => Group (RegSG2Group sg)---- ---------------------------------------------------------------------------------- -- SG2Monoid--- --- data (Semigroup sg) => SG2Monoid sg = SGNothing | SGJust sg--- deriving (Show,Read)--- --- instance (Semigroup sg) => Monoid (SG2Monoid sg) where--- mempty = SGNothing--- mappend SGNothing m = m--- mappend m SGNothing = m--- mappend (SGJust sg1) (SGJust sg2) = SGJust $ sg1<>sg2--- --- instance (Semigroup sg) => Semigroup (SG2Monoid sg) where--- (<>) = mappend
+ src/HLearn/Algebra/Structures/Free/RegSG2Group.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DatatypeContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- | These algebraic structures have sacrificed generality in favor of being easily used with the standard Haskell Prelude. The fact that monoids are not guaranteed to be semigroups makes this difficult.++module HLearn.Algebra.Structures.Free.RegSG2Group+ where++import HLearn.Algebra.Structures.Groups+import HLearn.Algebra.Structures.Modules+import Control.DeepSeq++-- | Convert any regular semigroup into a group (and thus also a monoid) by adding a unique identity element+data (RegularSemigroup sg) => RegSG2Group sg = SGNothing | SGJust sg+ deriving (Show,Read,Ord,Eq)++instance (RegularSemigroup sg) => Semigroup (RegSG2Group sg) where+ SGNothing <> m = m+ m <> SGNothing = m+ (SGJust sg1) <> (SGJust sg2) = SGJust $ sg1<>sg2++instance (RegularSemigroup sg) => RegularSemigroup (RegSG2Group sg) where+ inverse SGNothing = SGNothing+ inverse (SGJust x) = SGJust $ inverse x++instance (RegularSemigroup sg) => Monoid (RegSG2Group sg) where+ mempty = SGNothing+ mappend = (<>)+ +instance (RegularSemigroup sg) => Group (RegSG2Group sg)++instance (RegularSemigroup sg, NFData sg) => NFData (RegSG2Group sg) where+ rnf SGNothing = ()+ rnf (SGJust sg) = rnf sg+ +instance (LeftOperator r sg, RegularSemigroup sg) => LeftOperator r (RegSG2Group sg) where+ r .* (SGNothing) = SGNothing+ r .* (SGJust sg) = SGJust $ r .* sg+ +instance (RightOperator r sg, RegularSemigroup sg) => RightOperator r (RegSG2Group sg) where+ (SGNothing) *. r = SGNothing+ (SGJust sg) *. r = SGJust $ sg *. r
+ src/HLearn/Algebra/Structures/Groups.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DatatypeContexts #-}++-- | These algebraic structures have sacrificed generality in favor of being easily used with the standard Haskell Prelude. The fact that monoids are not guaranteed to be semigroups makes this difficult.++module HLearn.Algebra.Structures.Groups+ ( + -- * Type classes+ RegularSemigroup (..)+ , Group(..)+ , Abelian (..)++ , module Data.Semigroup+ )+ where++import Control.DeepSeq+import Data.Semigroup+import GHC.Exts (Constraint)++-------------------------------------------------------------------------------++-- class (c a) => Abelian (a :: *) (c :: * -> Constraint) where+-- op :: a -> a -> a++class (Semigroup sg) => Abelian sg++-------------------------------------------------------------------------------+-- Inverses++-- | Semigroups that also have an inverse. See <https://en.wikipedia.org/wiki/Regular_semigroup>+class (Semigroup g) => RegularSemigroup g where+ inverse :: g -> g++-- -- | Semigroups where a unique inverse exists for each element. See <https://en.wikipedia.org/wiki/Inverse_semigroup>+-- class (RegularSemigroup g) => InverseSemigroup g++-- | Regular semigroups that also have an identity; alternatively, monoids where every element has a unique inverse. See <https://en.wikipedia.org/wiki/Group_(mathematics)>+class (RegularSemigroup g, Monoid g) => Group g+instance (RegularSemigroup g, Monoid g) => Group g
+ src/HLearn/Algebra/Structures/Modules.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DatatypeContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Modules are a generalization of vector spaces++module HLearn.Algebra.Structures.Modules+ where++import qualified Control.ConstraintKinds as CK+import Data.List+import qualified Data.Map as Map+import HLearn.Algebra.Structures.Groups++-------------------------------------------------------------------------------+-- Operators++class (LeftOperator r m, RightOperator r m) => Operator r m+instance (LeftOperator r m, RightOperator r m) => Operator r m++class LeftOperator r m | m -> r where+ infixl 7 .*+ (.*) :: r -> m -> m++class RightOperator r m | m -> r where+ infixl 7 *.+ (*.) :: m -> r -> m++instance RightOperator Integer Integer where (*.) = (*)+instance LeftOperator Integer Integer where (.*) = (*)++instance RightOperator Int Int where (*.) = (*)+instance LeftOperator Int Int where (.*) = (*)++instance RightOperator Float Float where (*.) = (*)+instance LeftOperator Float Float where (.*) = (*)++instance RightOperator Double Double where (*.) = (*)+instance LeftOperator Double Double where (.*) = (*)++instance (RightOperator a b) => RightOperator a [b] where bs *. a = fmap (*.a) bs+instance (LeftOperator a b) => LeftOperator a [b] where a .* bs = fmap (a.*) bs++-------------------------------------------------------------------------------+-- FreeOp++-- | Bug: Technically, the free operator should just require that r be a semigroup and use (<>) to chain the r's together. But this would make things awkward because the number types aren't instances of semigroup. Constraining r to be of type Num reduces our generality but makes FreeOp easier to work with in most practical use cases.++-- newtype (Num r) => FreeOp r a = FreeOp [(r,a)]+-- deriving (Read,Show)+-- +-- instance (Num r) => Functor (FreeOp r) where+-- fmap f (FreeOp xs) = FreeOp $ map (\(r,a) -> (r,f a)) xs+-- +-- instance (Num r) => LeftOperator r (FreeOp r m) where+-- r <| (FreeOp xs) = FreeOp $ map (\(r2,m) -> (r*r2,m)) xs+-- +-- instance (Num r) => RightOperator r (FreeOp r m) where+-- m |> r = r <| m+-- +-- list2freeop :: (Num r) => [a] -> FreeOp r a+-- list2freeop = FreeOp . map (\x -> (1,x))++++-------------------------------------------------------------------------------+-- Modules++-- | Bug: The module classes have the constraint that r be of type Num. Technically, this should be a Ring. But creating a Ring class would be awkward because it would conflict with the Num class and require importing a different Prelude.++class (LeftModule r g, RightModule r g) => Module r g+instance (LeftModule r g, RightModule r g) => Module r g++class (LeftOperator r g, Num r, Group g, Abelian g) => LeftModule r g+instance (LeftOperator r g, Num r, Group g, Abelian g) => LeftModule r g++class (RightOperator r g, Num r, Group g, Abelian g) => RightModule r g+instance (RightOperator r g, Num r, Group g, Abelian g) => RightModule r g++-------------------------------------------------------------------------------+-- FreeModule++data FreeModParams = FreeModParams++newtype (Num r, Ord a) => FreeMod r a = FreeMod (Map.Map a r)+ deriving (Read,Show,Eq)++instance CK.Functor (FreeMod r) where+ type FunctorConstraint (FreeMod r) a = (Num r, Ord a)+ fmap f (FreeMod m) = FreeMod $ Map.mapKeysWith (+) f m++instance CK.Foldable (FreeMod r) where+ type FoldableConstraint (FreeMod r) a = (Num r, Ord a, Operator r a)+-- foldr f b (FreeMod m) = Map.foldrWithKey (\a r b -> f (r .* a) b) b m+ foldr f b (FreeMod m) = foldr (\(a,r) b -> f (r .* a) b) b $ Map.toList m+ foldl f b (FreeMod m) = foldl (\b (a,r) -> f b (r .* a)) b $ Map.toList m+ foldl' f b (FreeMod m) = foldl' (\b (a,r) -> f b (r .* a)) b $ Map.toList m+ + foldr1 f (FreeMod m) = foldr1 f $ map (\(a,r) -> r.*a) $ Map.toList m+ foldl1 f (FreeMod m) = foldl1 f $ map (\(a,r) -> r.*a) $ Map.toList m++instance (Num r, Ord a) => Abelian (FreeMod r a)+instance (Num r, Ord a) => Semigroup (FreeMod r a) where+ (FreeMod m1) <> (FreeMod m2) = FreeMod $ Map.unionWith (+) m1 m2++instance (Num r, Ord a) => Monoid (FreeMod r a) where+ mempty = FreeMod mempty+ mappend = (<>)+ +instance (Num r, Ord a) => RegularSemigroup (FreeMod r a) where+ inverse (FreeMod m) = FreeMod $ Map.map negate m++instance (Num r, Ord a) => LeftModule r (FreeMod r a)+instance (Num r, Ord a) => LeftOperator r (FreeMod r a) where+ r .* (FreeMod m) = FreeMod $ Map.map (r*) m+ +instance (Num r, Ord a) => RightModule r (FreeMod r a)+instance (Num r, Ord a) => RightOperator r (FreeMod r a) where+ a *. r = r .* a++list2module :: (Num r, Ord r, Ord a) => [a] -> FreeMod r a+list2module xs = FreeMod $ Map.fromList $ go 0 (head sorted) [] sorted+ where+ sorted = sort xs+ + go n x retL [] = (x,n):retL+ go n x retL xs = if (head xs) == x+ then go (n+1) x retL (tail xs)+ else go 1 (head xs) ((x,n):retL) (tail xs)+