hakaru-0.3.0: A probabilistic programming language

CopyrightCopyright (c) 2016 the Hakaru team
LicenseBSD3
Maintainerwren@community.haskell.org
Stabilityexperimental
PortabilityGHC-only
Safe HaskellNone
LanguageHaskell2010

Language.Hakaru.Types.HClasses

Contents

Description

A collection of type classes for encoding Hakaru's numeric hierarchy.

Synopsis

Equality

data HEq :: Hakaru -> * where Source #

Concrete dictionaries for Hakaru types with decidable equality.

Constructors

HEq_Nat :: HEq HNat 
HEq_Int :: HEq HInt 
HEq_Prob :: HEq HProb 
HEq_Real :: HEq HReal 
HEq_Array :: !(HEq a) -> HEq (HArray a) 
HEq_Bool :: HEq HBool 
HEq_Unit :: HEq HUnit 
HEq_Pair :: !(HEq a) -> !(HEq b) -> HEq (HPair a b) 
HEq_Either :: !(HEq a) -> !(HEq b) -> HEq (HEither a b) 

Instances

Eq (HEq a) Source # 

Methods

(==) :: HEq a -> HEq a -> Bool #

(/=) :: HEq a -> HEq a -> Bool #

Show (HEq a) Source # 

Methods

showsPrec :: Int -> HEq a -> ShowS #

show :: HEq a -> String #

showList :: [HEq a] -> ShowS #

class HEq_ a where Source #

Haskell type class for automatic HEq inference.

Minimal complete definition

hEq

Methods

hEq :: HEq a Source #

Instances

HEq_ HUnit Source # 

Methods

hEq :: HEq HUnit Source #

HEq_ HBool Source # 

Methods

hEq :: HEq HBool Source #

HEq_ HNat Source # 

Methods

hEq :: HEq HNat Source #

HEq_ HInt Source # 

Methods

hEq :: HEq HInt Source #

HEq_ HProb Source # 

Methods

hEq :: HEq HProb Source #

HEq_ HReal Source # 

Methods

hEq :: HEq HReal Source #

HEq_ a => HEq_ (HArray a) Source # 

Methods

hEq :: HEq (HArray a) Source #

(HEq_ a, HEq_ b) => HEq_ (HEither a b) Source # 

Methods

hEq :: HEq (HEither a b) Source #

(HEq_ a, HEq_ b) => HEq_ (HPair a b) Source # 

Methods

hEq :: HEq (HPair a b) Source #

Ordering

data HOrd :: Hakaru -> * where Source #

Concrete dictionaries for Hakaru types with decidable total ordering.

Constructors

HOrd_Nat :: HOrd HNat 
HOrd_Int :: HOrd HInt 
HOrd_Prob :: HOrd HProb 
HOrd_Real :: HOrd HReal 
HOrd_Array :: !(HOrd a) -> HOrd (HArray a) 
HOrd_Bool :: HOrd HBool 
HOrd_Unit :: HOrd HUnit 
HOrd_Pair :: !(HOrd a) -> !(HOrd b) -> HOrd (HPair a b) 
HOrd_Either :: !(HOrd a) -> !(HOrd b) -> HOrd (HEither a b) 

Instances

Eq (HOrd a) Source # 

Methods

(==) :: HOrd a -> HOrd a -> Bool #

(/=) :: HOrd a -> HOrd a -> Bool #

Show (HOrd a) Source # 

Methods

showsPrec :: Int -> HOrd a -> ShowS #

show :: HOrd a -> String #

showList :: [HOrd a] -> ShowS #

hEq_HOrd :: HOrd a -> HEq a Source #

Every HOrd type is HEq.

class HEq_ a => HOrd_ a where Source #

Haskell type class for automatic HOrd inference.

Minimal complete definition

hOrd

Methods

hOrd :: HOrd a Source #

Instances

HOrd_ HUnit Source # 

Methods

hOrd :: HOrd HUnit Source #

HOrd_ HBool Source # 

Methods

hOrd :: HOrd HBool Source #

HOrd_ HNat Source # 

Methods

hOrd :: HOrd HNat Source #

HOrd_ HInt Source # 

Methods

hOrd :: HOrd HInt Source #

HOrd_ HProb Source # 

Methods

hOrd :: HOrd HProb Source #

HOrd_ HReal Source # 

Methods

hOrd :: HOrd HReal Source #

HOrd_ a => HOrd_ (HArray a) Source # 

Methods

hOrd :: HOrd (HArray a) Source #

(HOrd_ a, HOrd_ b) => HOrd_ (HEither a b) Source # 

Methods

hOrd :: HOrd (HEither a b) Source #

(HOrd_ a, HOrd_ b) => HOrd_ (HPair a b) Source # 

Methods

hOrd :: HOrd (HPair a b) Source #

HIntegrable

data HIntegrable :: Hakaru -> * where Source #

Concrete dictionaries for types where Infinity can have

Instances

Semirings

data HSemiring :: Hakaru -> * where Source #

Concrete dictionaries for Hakaru types which are semirings. N.B., even though these particular semirings are commutative, we don't necessarily assume that.

Instances

JmEq1 Hakaru HSemiring Source # 

Methods

jmEq1 :: a i -> a j -> Maybe (TypeEq HSemiring i j) Source #

Eq1 Hakaru HSemiring Source # 

Methods

eq1 :: a i -> a i -> Bool Source #

Eq (HSemiring a) Source # 

Methods

(==) :: HSemiring a -> HSemiring a -> Bool #

(/=) :: HSemiring a -> HSemiring a -> Bool #

Show (HSemiring a) Source # 

class HSemiring_ a where Source #

Haskell type class for automatic HSemiring inference.

Minimal complete definition

hSemiring

Rings

data HRing :: Hakaru -> * where Source #

Concrete dictionaries for Hakaru types which are rings. N.B., even though these particular rings are commutative, we don't necessarily assume that.

Constructors

HRing_Int :: HRing HInt 
HRing_Real :: HRing HReal 

Instances

JmEq1 Hakaru HRing Source # 

Methods

jmEq1 :: a i -> a j -> Maybe (TypeEq HRing i j) Source #

Eq1 Hakaru HRing Source # 

Methods

eq1 :: a i -> a i -> Bool Source #

Eq (HRing a) Source # 

Methods

(==) :: HRing a -> HRing a -> Bool #

(/=) :: HRing a -> HRing a -> Bool #

Show (HRing a) Source # 

Methods

showsPrec :: Int -> HRing a -> ShowS #

show :: HRing a -> String #

showList :: [HRing a] -> ShowS #

hSemiring_NonNegativeHRing :: HRing a -> HSemiring (NonNegative a) Source #

The non-negative type of every HRing is a HSemiring.

class (HSemiring_ (NonNegative a), HSemiring_ a) => HRing_ a where Source #

Haskell type class for automatic HRing inference.

Every HRing has an associated type for the semiring of its non-negative elements. This type family captures two notions. First, if we take the semiring and close it under negation/subtraction then we will generate this ring. Second, when we take the absolute value of something in the ring we will get back something in the non-negative semiring. For HInt and HReal these two notions coincide; however for Complex and Vector types, the notions diverge.

TODO: Can we somehow specify that the HSemiring (NonNegative a) semantics coincides with the HSemiring a semantics? Or should we just assume that?

Minimal complete definition

hRing

Associated Types

type NonNegative (a :: Hakaru) :: Hakaru Source #

Methods

hRing :: HRing a Source #

Instances

HRing_ HInt Source # 

Associated Types

type NonNegative (HInt :: Hakaru) :: Hakaru Source #

Methods

hRing :: HRing HInt Source #

HRing_ HReal Source # 

Associated Types

type NonNegative (HReal :: Hakaru) :: Hakaru Source #

Fractional types

data HFractional :: Hakaru -> * where Source #

Concrete dictionaries for Hakaru types which are division-semirings; i.e., division-rings without negation. This is called a "semifield" in ring theory, but should not be confused with the "semifields" of geometry.

Instances

class HSemiring_ a => HFractional_ a where Source #

Haskell type class for automatic HFractional inference.

Minimal complete definition

hFractional

Radical types

data HRadical :: Hakaru -> * where Source #

Concrete dictionaries for semirings which are closed under all HNat-roots. This means it's closed under all positive rational powers as well. (If the type happens to be HFractional, then it's closed under all rational powers.)

N.B., HReal is not HRadical because we do not have real-valued roots for negative reals.

N.B., we assume not only that the type is surd-complete, but also that it's still complete under the semiring operations. Thus we have values like sqrt 2 + sqrt 3 which cannot be expressed as a single root. Thus, in order to solve for zeros/roots, we'll need solutions to more general polynomials than just the x^n - a polynomials. However, the Galois groups of these are all solvable, so this shouldn't be too bad.

Constructors

HRadical_Prob :: HRadical HProb 

Instances

JmEq1 Hakaru HRadical Source # 

Methods

jmEq1 :: a i -> a j -> Maybe (TypeEq HRadical i j) Source #

Eq1 Hakaru HRadical Source # 

Methods

eq1 :: a i -> a i -> Bool Source #

Eq (HRadical a) Source # 

Methods

(==) :: HRadical a -> HRadical a -> Bool #

(/=) :: HRadical a -> HRadical a -> Bool #

Show (HRadical a) Source # 

Methods

showsPrec :: Int -> HRadical a -> ShowS #

show :: HRadical a -> String #

showList :: [HRadical a] -> ShowS #

class HSemiring_ a => HRadical_ a where Source #

Haskell type class for automatic HRadical inference.

Minimal complete definition

hRadical

Discrete types

data HDiscrete :: Hakaru -> * where Source #

Concrete dictionaries for Hakaru types which are "discrete".

Instances

JmEq1 Hakaru HDiscrete Source # 

Methods

jmEq1 :: a i -> a j -> Maybe (TypeEq HDiscrete i j) Source #

Eq1 Hakaru HDiscrete Source # 

Methods

eq1 :: a i -> a i -> Bool Source #

Eq (HDiscrete a) Source # 

Methods

(==) :: HDiscrete a -> HDiscrete a -> Bool #

(/=) :: HDiscrete a -> HDiscrete a -> Bool #

Show (HDiscrete a) Source # 

class HSemiring_ a => HDiscrete_ a where Source #

Haskell type class for automatic HDiscrete inference.

Minimal complete definition

hDiscrete

Continuous types

data HContinuous :: Hakaru -> * where Source #

Concrete dictionaries for Hakaru types which are "continuous". This is an ad-hoc class for (a) lifting 'HNat'\/'HInt' into 'HProb'\/'HReal', and (b) handling the polymorphism of monotonic functions like etf.

Instances

class (HSemiring_ (HIntegral a), HFractional_ a) => HContinuous_ a where Source #

Haskell type class for automatic HContinuous inference.

Every HContinuous has an associated type for the semiring of its integral elements.

TODO: Can we somehow specify that the HSemiring (HIntegral a) semantics coincides with the HSemiring a semantics? Or should we just assume that?

Minimal complete definition

hContinuous

Associated Types

type HIntegral (a :: Hakaru) :: Hakaru Source #