| Copyright | (c) NoviSci Inc 2020 |
|---|---|
| License | BSD3 |
| Maintainer | bsaul@novisci.com |
| Safe Haskell | None |
| Language | Haskell2010 |
Hasklepias
Description
Synopsis
- module EventData
- data FeatureData d
- data MissingReason
- data KnownSymbol name => Feature name d
- type F n a = Feature n a
- data FeatureN d
- featureDataL :: MissingReason -> FeatureData d
- featureDataR :: d -> FeatureData d
- missingBecause :: MissingReason -> FeatureData d
- makeFeature :: KnownSymbol name => FeatureData d -> Feature name d
- getFeatureData :: FeatureData d -> Either MissingReason d
- getFData :: Feature name d -> FeatureData d
- getData :: Feature n d -> Either MissingReason d
- getDataN :: FeatureN d -> FeatureData d
- getNameN :: FeatureN d -> Text
- nameFeature :: forall name d. KnownSymbol name => Feature name d -> FeatureN d
- data Definition d where
- Pure :: a -> Definition (F n0 a)
- D1 :: (b -> a) -> Definition (F n1 b -> F n0 a)
- D1A :: (b -> F n0 a) -> Definition (F n1 b -> F n0 a)
- D1C :: (a2 -> a1 -> a) -> Definition (F n1 b -> F n02 a2) -> Definition (F n1 b -> F n01 a1) -> Definition (F n1 b -> F n0 a)
- D2 :: (c -> b -> a) -> Definition (F n2 c -> F n1 b -> F n0 a)
- D2A :: (c -> b -> F n0 a) -> Definition (F n2 c -> F n1 b -> F n0 a)
- D2C :: (a2 -> a1 -> a) -> Definition (F n2 c -> F n1 b -> F n02 a2) -> Definition (F n2 c -> F n1 b -> F n01 a1) -> Definition (F n2 c -> F n1 b -> F n0 a)
- D3 :: (d -> c -> b -> a) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n0 a)
- D3A :: (d -> c -> b -> F n0 a) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n0 a)
- D3C :: (a2 -> a1 -> a) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n02 a2) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n01 a1) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n0 a)
- D4 :: (e -> d -> c -> b -> a) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a)
- D4A :: (e -> d -> c -> b -> F n0 a) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a)
- D4C :: (a2 -> a1 -> a) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n02 a2) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n01 a1) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a)
- class Define inputs def | def -> inputs where
- define :: inputs -> Definition def
- class DefineA inputs def | def -> inputs where
- defineA :: inputs -> Definition def
- type Def d = Definition d
- eval :: Definition d -> d
- data Attributes = MkAttributes {}
- data Role
- data Purpose = MkPurpose {}
- class KnownSymbol name => HasAttributes name d where
- getAttributes :: f name d -> Attributes
- emptyAttributes :: Attributes
- basicAttributes :: Text -> Text -> [Role] -> [Text] -> Attributes
- emptyPurpose :: Purpose
- data Featureable = forall d.(Show d, ToJSON d, ShapeOutput d) => MkFeatureable d Attributes
- packFeature :: (KnownSymbol n, Show d, ToJSON d, Typeable d, HasAttributes n d) => Feature n d -> Featureable
- getFeatureableAttrs :: Featureable -> Attributes
- data Featureset
- newtype FeaturesetList = MkFeaturesetList (NonEmpty Featureset)
- featureset :: NonEmpty Featureable -> Featureset
- getFeatureset :: Featureset -> NonEmpty Featureable
- getFeaturesetAttrs :: Featureset -> NonEmpty Attributes
- getFeaturesetList :: FeaturesetList -> NonEmpty Featureset
- tpose :: FeaturesetList -> FeaturesetList
- class ToJSON a => ShapeOutput a where
- dataOnly :: a -> OutputShape b
- nameOnly :: a -> OutputShape b
- attrOnly :: a -> OutputShape b
- nameData :: a -> OutputShape b
- nameAttr :: a -> OutputShape b
- data OutputShape d
- buildIsEnrolled :: (Intervallic i0 a, Monoid (container (Interval a)), Applicative container, Witherable container) => Predicate (Event a) -> Definition (Feature indexName (Index i0 a) -> Feature eventsName (container (Event a)) -> Feature varName Status)
- buildContinuousEnrollment :: (Monoid (container (Interval a)), Monoid (container (Maybe (Interval a))), Applicative container, Witherable container, IntervalSizeable a b) => (Index i0 a -> AssessmentInterval a) -> Predicate (Event a) -> b -> Definition (Feature indexName (Index i0 a) -> Feature eventsName (container (Event a)) -> Feature prevName Status -> Feature varName Status)
- buildNofX :: (Intervallic i a, Witherable container) => (Bool -> outputType) -> Natural -> (Index i a -> AssessmentInterval a) -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -> Predicate (Event a) -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName outputType)
- buildNofXBool :: (Intervallic i a, Witherable container) => Natural -> (Index i a -> AssessmentInterval a) -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -> Predicate (Event a) -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Bool)
- buildNofXBinary :: (Intervallic i a, Witherable container) => Natural -> (Index i a -> AssessmentInterval a) -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -> Predicate (Event a) -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Binary)
- buildNofXBinaryConcurBaseline :: (Intervallic i0 a, Witherable t, IntervalSizeable a b, Baseline i0 a) => Natural -> b -> Predicate (Event a) -> Definition (Feature indexName (Index i0 a) -> Feature eventsName (t (Event a)) -> Feature varName Binary)
- buildNofConceptsBinaryConcurBaseline :: (Intervallic i0 a, Witherable t, IntervalSizeable a b, Baseline i0 a) => Natural -> b -> [Text] -> Definition (Feature indexName (Index i0 a) -> Feature eventsName (t (Event a)) -> Feature varName Binary)
- buildNofXWithGap :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) => (Bool -> outputType) -> Natural -> b -> (Index i a -> AssessmentInterval a) -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -> Predicate (Event a) -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName outputType)
- buildNofXWithGapBool :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) => Natural -> b -> (Index i a -> AssessmentInterval a) -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -> Predicate (Event a) -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Bool)
- buildNofXWithGapBinary :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) => Natural -> b -> (Index i a -> AssessmentInterval a) -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -> Predicate (Event a) -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Binary)
- buildNofXOrNofYWithGap :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) => (outputType -> outputType -> outputType) -> (Bool -> outputType) -> Natural -> Predicate (Event a) -> Natural -> b -> (Index i a -> AssessmentInterval a) -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -> Predicate (Event a) -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName outputType)
- buildNofXOrNofYWithGapBool :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) => Natural -> Predicate (Event a) -> Natural -> b -> (Index i a -> AssessmentInterval a) -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -> Predicate (Event a) -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Bool)
- buildNofXOrNofYWithGapBinary :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) => Natural -> Predicate (Event a) -> Natural -> b -> (Index i a -> AssessmentInterval a) -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -> Predicate (Event a) -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Binary)
- buildNofUniqueBegins :: (Intervallic i a, IntervalSizeable a b, Witherable container) => (Index i a -> AssessmentInterval a) -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -> Predicate (Event a) -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName [(EventTime b, Count)])
- isNotEmpty :: [a] -> Bool
- atleastNofX :: Int -> [Text] -> Events a -> Bool
- anyGapsWithinAtLeastDuration :: (IntervalSizeable a b, Intervallic i0 a, IntervalCombinable i1 a, Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))), Applicative t, Witherable t) => b -> i0 a -> t (i1 a) -> Bool
- allGapsWithinLessThanDuration :: (IntervalSizeable a b, Intervallic i0 a, IntervalCombinable i1 a, Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))), Applicative t, Witherable t) => b -> i0 a -> t (i1 a) -> Bool
- nthConceptOccurrence :: Filterable f => (f (Event a) -> Maybe (Event a)) -> [Text] -> f (Event a) -> Maybe (Event a)
- firstConceptOccurrence :: Witherable f => [Text] -> f (Event a) -> Maybe (Event a)
- allPairs :: Applicative f => f a -> f b -> f (a, b)
- pairs :: [a] -> [(a, a)]
- splitByConcepts :: Filterable f => [Text] -> [Text] -> f (Event a) -> (f (Event a), f (Event a))
- makeConceptsFilter :: Filterable f => [Text] -> f (Event a) -> f (Event a)
- makePairedFilter :: Ord a => ComparativePredicateOf2 (i0 a) (PairedInterval b a) -> i0 a -> (b -> Bool) -> [PairedInterval b a] -> [PairedInterval b a]
- yearFromDay :: Day -> Year
- monthFromDay :: Day -> MonthOfYear
- dayOfMonthFromDay :: Day -> DayOfMonth
- lookback :: (Intervallic i a, IntervalSizeable a b) => b -> i a -> Interval a
- lookahead :: (Intervallic i a, IntervalSizeable a b) => b -> i a -> Interval a
- computeAgeAt :: Day -> Day -> Integer
- pairGaps :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a) => [i a] -> [Maybe b]
- newtype Occurrence what when = MkOccurrence (what, EventTime when)
- makeOccurrence :: OccurrenceReason what => what -> EventTime b -> Occurrence what b
- getOccurrenceReason :: Occurrence what b -> what
- getOccurrenceTime :: Occurrence what b -> EventTime b
- data CensoringReason cr or
- = AdminCensor
- | C cr
- | O or
- class (Ord a, Show a) => OccurrenceReason a
- data CensoredOccurrence censors outcomes b = MkCensoredOccurrence {
- reason :: CensoringReason censors outcomes
- time :: MaybeCensored (EventTime b)
- adminCensor :: EventTime b -> CensoredOccurrence c o b
- newtype Subject d = MkSubject (ID, d)
- type ID = Text
- newtype Population d = MkPopulation [Subject d]
- data ObsUnit d = MkObsUnit {}
- newtype CohortData d = MkCohortData {
- getObsData :: [ObsUnit d]
- newtype Cohort d = MkCohort (AttritionInfo, CohortData d)
- data CohortSpec d1 d0
- data CohortSetSpec i d
- newtype CohortSet d = MkCohortSet (Map Text (Cohort d))
- data AttritionInfo = MkAttritionInfo {}
- data AttritionLevel = MkAttritionLevel {}
- specifyCohort :: (d1 -> Criteria) -> (d1 -> d0) -> CohortSpec d1 d0
- makeObsUnitFeatures :: (d1 -> d0) -> Subject d1 -> ObsUnit d0
- evalCohort :: CohortSpec d1 d0 -> Population d1 -> Cohort d0
- getCohortIDs :: Cohort d -> [ID]
- getCohortDataIDs :: CohortData d -> [ID]
- getCohortData :: Cohort d -> [d]
- getCohortDataData :: CohortData d -> [d]
- getAttritionInfo :: Cohort d -> AttritionInfo
- makeCohortSpecs :: [(Text, d1 -> Criteria, d1 -> d0)] -> CohortSetSpec d1 d0
- evalCohortSet :: CohortSetSpec d1 d0 -> Population d1 -> CohortSet d0
- getCohortSet :: CohortSet d -> Map Text (Cohort d)
- data Index i a
- makeIndex :: Intervallic i a => i a -> Index i a
- data BaselineInterval a
- class Intervallic i a => Baseline i a where
- baseline :: IntervalSizeable a b => b -> Index i a -> BaselineInterval a
- baselineBefore :: IntervalSizeable a b => b -> b -> Index i a -> BaselineInterval a
- data FollowupInterval a
- class Intervallic i a => Followup i a where
- followup :: (IntervalSizeable a b, Intervallic i a) => b -> Index i a -> FollowupInterval a
- followupMetBy :: (IntervalSizeable a b, Intervallic i a) => b -> Index i a -> FollowupInterval a
- followupAfter :: (IntervalSizeable a b, Intervallic i a) => b -> b -> Index i a -> FollowupInterval a
- data AssessmentInterval a
- makeBaselineFromIndex :: (Baseline i a, IntervalSizeable a b) => b -> Index i a -> AssessmentInterval a
- makeBaselineBeforeIndex :: (Baseline i a, IntervalSizeable a b) => b -> b -> Index i a -> AssessmentInterval a
- makeFollowupFromIndex :: (Followup i a, IntervalSizeable a b) => b -> Index i a -> AssessmentInterval a
- makeFollowupMeetingIndex :: (Followup i a, IntervalSizeable a b) => b -> Index i a -> AssessmentInterval a
- makeFollowupAfterIndex :: (Followup i a, IntervalSizeable a b) => b -> b -> Index i a -> AssessmentInterval a
- data Criterion
- newtype Criteria = MkCriteria {
- getCriteria :: NonEmpty (Natural, Criterion)
- data Status
- data CohortStatus
- = Included
- | ExcludedBy (Natural, Text)
- criterion :: KnownSymbol n => Feature n Status -> Criterion
- criteria :: NonEmpty Criterion -> Criteria
- excludeIf :: Bool -> Status
- includeIf :: Bool -> Status
- initStatusInfo :: Criteria -> NonEmpty CohortStatus
- checkCohortStatus :: Criteria -> CohortStatus
- parsePopulationLines :: (FromJSON a, Show a, IntervalSizeable a b) => ByteString -> ([ParseError], Population (Events a))
- parsePopulationIntLines :: ByteString -> ([ParseError], Population (Events Int))
- parsePopulationDayLines :: ByteString -> ([ParseError], Population (Events Day))
- newtype ParseError = MkParseError (Natural, Text)
- data CohortJSON
- newtype CohortSetJSON = MkCohortSetJSON (Map Text CohortJSON)
- data CohortDataShape d
- data CohortDataShapeJSON
- data ColumnWiseJSON = MkColumnWiseJSON {
- attributes :: [Value]
- ids :: [Value]
- cohortData :: [[Value]]
- data RowWiseJSON = MkRowWiseJSON {
- attributes :: [Value]
- cohortData :: [Value]
- class ShapeCohort d where
- colWise :: Cohort d -> CohortJSON
- rowWise :: Cohort d -> CohortJSON
- toJSONCohortDataShape :: CohortDataShape shape -> Value
- makeCohortApp :: (FromJSON a, Show a, IntervalSizeable a b, ToJSON d0, ShapeCohort d0) => String -> String -> (Cohort d0 -> CohortJSON) -> CohortSetSpec (Events a) d0 -> IO ()
- module Stype
- module Hasklepias.Reexports
- newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
- encode :: ToJSON a => a -> ByteString
- class ToJSON a where
- toJSON :: a -> Value
- toEncoding :: a -> Encoding
- toJSONList :: [a] -> Value
- toEncodingList :: [a] -> Encoding
- type HasCallStack = ?callStack :: CallStack
- withResource :: IO a -> (a -> IO ()) -> (IO a -> TestTree) -> TestTree
- askOption :: IsOption v => (v -> TestTree) -> TestTree
- localOption :: IsOption v => v -> TestTree -> TestTree
- adjustOption :: IsOption v => (v -> v) -> TestTree -> TestTree
- defaultMain :: TestTree -> IO ()
- defaultIngredients :: [Ingredient]
- defaultMainWithIngredients :: [Ingredient] -> TestTree -> IO ()
- includingOptions :: [OptionDescription] -> Ingredient
- after_ :: DependencyType -> Expr -> TestTree -> TestTree
- testGroup :: TestName -> [TestTree] -> TestTree
- type TestName = String
- data DependencyType
- data TestTree
- mkTimeout :: Integer -> Timeout
- data Timeout
- testCaseInfo :: TestName -> IO String -> TestTree
- testCase :: TestName -> Assertion -> TestTree
- testCaseSteps :: TestName -> ((String -> IO ()) -> Assertion) -> TestTree
- assertString :: HasCallStack => String -> Assertion
- (@?) :: (AssertionPredicable t, HasCallStack) => t -> String -> Assertion
- (@?=) :: (Eq a, Show a, HasCallStack) => a -> a -> Assertion
- (@=?) :: (Eq a, Show a, HasCallStack) => a -> a -> Assertion
- assertEqual :: (Eq a, Show a, HasCallStack) => String -> a -> a -> Assertion
- assertBool :: HasCallStack => String -> Bool -> Assertion
- assertFailure :: HasCallStack => String -> IO a
- type Assertion = IO ()
- class AssertionPredicable t where
- assertionPredicate :: t -> IO Bool
- data HUnitFailure = HUnitFailure (Maybe SrcLoc) String
- class Assertable t where
- type AssertionPredicate = IO Bool
Documentation
Hasklepias is an embedded domain specific language (eDSL) written in Haskell.
To get started, then, you'll need to install the Haskell toolchain, especially
the Glasgow Haskell Compiler (GHC) and the building
and packaging system cabal, for which you can
use the ghcup utility.
You can use any development environment you choose, but for maximum coding pleasure,
you should install the Haskell language server
(hsl). This can be installed using ghcup. Some integrated development
environments, such as [Visual Studio Code](https:/code.visualstudio.com, have
[excellent hsl integration](https:/marketplace.visualstudio.comitems?itemName=haskell.haskell).
In summary,
- Install
ghcup.
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
- Inspect your toolchain installation using
ghcup list. You will needghc(>= 8.10.4) ,hls(>= 1.2), andcabal(>= 3.4) installed. - Upgrade toolchain components as necesarry. For example:
ghcup install ghc {ghcVersion}
ghcup set ghc {ghcVersion}
ghcup install cabal {cabalVersion}
ghcup set cabal {cabalVersion}
- Setup your IDE. (e.g. in Visual Studio, you'll want to install the Haskell extension.
Getting started in Haskell
Since Hasklepias is written in Haskell, you'll need
to understand the syntax of Haskell function and a few concepts. The Haskell
language is over 30 years old and has many, many features. Here are a few resources:
- Learn You a Haskell for Great Good!: good intro text
- Programming in Haskell: excellent intro text
- What I wish I knew when learning Haskell: excellent resource
- Haskeller competency matrix
- Hoogle: search engine for Haskell functions
- 5 years of Haskell in production: video on using Haskell in production environment
- Things software engineers trip up on when learning Haskell: a software engineer's list of tips on using Haskell
Interacting with the examples (using GHCi)
To run the examples interactively, open a ghci session with:
cabal repl hasklepias:examples
In ghci you have access to all exposed functions in hasklepias, interval-algebra,
and those in the examples folder.
Event Data
Events depend heavily on the interval-algebra library. See that pacakge's documentation for information about the types and functions for working with intervals.
module EventData
Working with Features
A Feature is a type parametrized by two types: name and d. The type d here
stands for "data", which then parametrizes the FeatureData type which is the
singular value which a Feature contains. The d here can be almost anything
and need not be a scalar, for example, all the following are valid types for d:
The name type a bit special: it does not appear on the right-hand side of the `=`.
In type-theory parlance, name is a phantom type.
We'll see in a bit how this can be useful. For now, think of the name as the
name of a variable as you would in most programming languages. To summarize,
a Feature 's type constructor takes two arguments (name and d), but its
*value* constructor (MkFeature) takes a single value of type FeatureData d.
Values of the FeatureData type contain the data we're ultimately interested
in analyzing or passing along to downstream applications. However, a FeatureData
value does not simply contain data of type d. The type allows for the possibility
of missingness, failures, or errors by using the Either type. A value
of a FeatureData, then, is either a or a
Left MissingReason.Right d
The use of Either has important implications when defining Features, as we will see.
Now that we know the internals of a Feature, how do we create Feature s? There
are two ways to create features: (1) purely lifting data into a Feature or
(2) writing a Definition: a function that defines a Feature based on other
Features.
The first method is a way to get data directly into a Feature. Fhe following
function takes a list of Events and makes a Feature of them:
allEvents :: [Event Day] -> Feature "allEvents" [Event Day] allEvents = pure
The pure lifting is generally used to lift a subject's input data into a Feature,
so that other features can be defined from a subject's data. Feature s are
derived from other Features by the Definition type. Specifically,
Definition is a type which contains a function which maps Feature inputs
to a Feature output, for example:
myDef :: Definition (Feature "a" Int -> Feature "b" Bool) myDef = define (x -> if x > 0 then True else False)
A Definition is created by the define (or defineA) function. One may ask
why define is necessary, and we don't directly define the function
(Feature "a" Int -> Feature "b" Bool) directly. What may not be obvious in
the above, is that x is type Int not Feature "a" Int and the return type
is Bool not Feature "b" Bool. The define function and Definition type
do the magic of lifting these types to the Feature level. To see this,
in the following, myDef2 is equivalent to myDef:
intToBool :: Int -> Bool intToBool x = if x > 0 then True else False) myDef2 :: Definition (Feature "a" Int -> Feature "b" Bool) myDef2 = define intToBoo
The define function, then, let's us focus on the *logic* of our Features
without needing to worry handling the error cases. If we were to write a function
with signature Feature "a" Int -> Feature "b" Bool directly, it would look
something like:
myFeat :: Feature "a" Int -> Feature "b" Bool myFeat (MkFeature (MkFeatureData (Left r))) = MkFeature (MkFeatureData (Left r)) myFeat (MkFeature (MkFeatureData (Right x))) = MkFeature (MkFeatureData (Right $ intToBool x))
One would need to pattern match all the possible types of inputs, which gets
more complicated as the number of inputs increases. As an aside, since Features are
[Functors]( https://hackage.haskell.org/package/base-4.15.0.0/docs/Data-Functor.html),
one could instead write:
myFeat :: Feature "a" Int -> Feature "b" Bool myFeat = fmap intToBool
This would require understanding how Functors and similar structures are used.
The define and defineA functions provide a common interface to these structures
without needing to understand the details.
Evaluating Definitions
To evaluate a Definition, we use the eval function. Consider the following example.
The input data is a list of Ints if the list is empty (null), this is considered
an error in feat1. If the list has more than 3 elements, then in feat2,
the sum is computed; otherwise 0 is returned.
featInts :: [Int] -> Feature "someInts" [Int]
featInts = pure
feat1 :: Definition (Feature "someInts" [Int] -> Feature "hasMoreThan3" Bool)
feat1 = defineA
(ints -> if null ints then makeFeature (missingBecause $ Other "no data")
else makeFeature $ featureDataR (length ints > 3))
feat2 :: Definition (
Feature "hasMoreThan3" Bool
-> Feature "someInts" [Int]
-> Feature "sum" Int)
feat2 = define (b ints -> if b then sum ints else 0)
ex0 = featInts []
ex0a = eval feat1 ex0 -- MkFeature (MkFeatureData (Left (Other "no data")))
ex0b = eval feat2 (ex0a, ex0) -- MkFeature (MkFeatureData (Left (Other "no data")))
ex1 = featInts [3, 8]
ex1a = eval feat1 ex1 -- MkFeature (MkFeatureData (Right False))
ex1b = eval feat2 (ex1a, ex1) -- MkFeature (MkFeatureData (Right 0))
ex2 = featInts [1..4]
ex2a = eval feat1 ex2 -- MkFeature (MkFeatureData (Right True))
ex2b = eval feat2 (ex2a, ex2) -- MkFeature (MkFeatureData (Right 10))
Note the value of ex0b. It is a Left because the value of ex0a is a Left;
in other words, errors propogate along Features. If a given Feature's dependency
is a Left then that Feature will also be Left. A Feature's internal
Either structure has important implications for designing Features and
performance. Capturing an error in a Left is a way to prevent downstream
dependencies from needing to be computed.
Type Safety of Features
In describing the Feature type, the utility of having the name as a type may
not have been clear. To clarify, consider the following example:
x :: Feature "someInt" Natural x = pure 39 y :: Feature "age" Natural y = pure 43 f :: Definition (Feature "age" Natural -> Feature "isOld" Bool) f = define (>= 39) fail = eval f x pass = eval f y
In the example, fail does not compile because "someInt" is not "age",
even though both the data type are Natural.
Creating Features
Features and FeatureData
data FeatureData d Source #
The FeatureData type is a container for an (almost) arbitrary type d that can
have a "failed" or "missing" state. The failure is represented by the of
an Left, while the data Eitherd is contained in the 's Either.Right
To construct a successful value, use . A missing value can be
constructed with featureDataR or its synonym featureDataL.missingBecause
Instances
| Monad FeatureData Source # | |
Defined in Features.Compose Methods (>>=) :: FeatureData a -> (a -> FeatureData b) -> FeatureData b # (>>) :: FeatureData a -> FeatureData b -> FeatureData b # return :: a -> FeatureData a # | |
| Functor FeatureData Source # | Transform (
Note that
|
Defined in Features.Compose Methods fmap :: (a -> b) -> FeatureData a -> FeatureData b # (<$) :: a -> FeatureData b -> FeatureData a # | |
| Applicative FeatureData Source # | |
Defined in Features.Compose Methods pure :: a -> FeatureData a # (<*>) :: FeatureData (a -> b) -> FeatureData a -> FeatureData b # liftA2 :: (a -> b -> c) -> FeatureData a -> FeatureData b -> FeatureData c # (*>) :: FeatureData a -> FeatureData b -> FeatureData b # (<*) :: FeatureData a -> FeatureData b -> FeatureData a # | |
| Foldable FeatureData Source # | |
Defined in Features.Compose Methods fold :: Monoid m => FeatureData m -> m # foldMap :: Monoid m => (a -> m) -> FeatureData a -> m # foldMap' :: Monoid m => (a -> m) -> FeatureData a -> m # foldr :: (a -> b -> b) -> b -> FeatureData a -> b # foldr' :: (a -> b -> b) -> b -> FeatureData a -> b # foldl :: (b -> a -> b) -> b -> FeatureData a -> b # foldl' :: (b -> a -> b) -> b -> FeatureData a -> b # foldr1 :: (a -> a -> a) -> FeatureData a -> a # foldl1 :: (a -> a -> a) -> FeatureData a -> a # toList :: FeatureData a -> [a] # null :: FeatureData a -> Bool # length :: FeatureData a -> Int # elem :: Eq a => a -> FeatureData a -> Bool # maximum :: Ord a => FeatureData a -> a # minimum :: Ord a => FeatureData a -> a # sum :: Num a => FeatureData a -> a # product :: Num a => FeatureData a -> a # | |
| Traversable FeatureData Source # | |
Defined in Features.Compose Methods traverse :: Applicative f => (a -> f b) -> FeatureData a -> f (FeatureData b) # sequenceA :: Applicative f => FeatureData (f a) -> f (FeatureData a) # mapM :: Monad m => (a -> m b) -> FeatureData a -> m (FeatureData b) # sequence :: Monad m => FeatureData (m a) -> m (FeatureData a) # | |
| Eq d => Eq (FeatureData d) Source # | |
Defined in Features.Compose Methods (==) :: FeatureData d -> FeatureData d -> Bool # (/=) :: FeatureData d -> FeatureData d -> Bool # | |
| Show d => Show (FeatureData d) Source # | |
Defined in Features.Compose Methods showsPrec :: Int -> FeatureData d -> ShowS # show :: FeatureData d -> String # showList :: [FeatureData d] -> ShowS # | |
| Generic (FeatureData d) Source # | |
Defined in Features.Compose Associated Types type Rep (FeatureData d) :: Type -> Type # Methods from :: FeatureData d -> Rep (FeatureData d) x # to :: Rep (FeatureData d) x -> FeatureData d # | |
| ToJSON d => ToJSON (FeatureData d) Source # | |
Defined in Features.Output Methods toJSON :: FeatureData d -> Value # toEncoding :: FeatureData d -> Encoding # toJSONList :: [FeatureData d] -> Value # toEncodingList :: [FeatureData d] -> Encoding # | |
| type Rep (FeatureData d) Source # | |
Defined in Features.Compose type Rep (FeatureData d) = D1 ('MetaData "FeatureData" "Features.Compose" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkFeatureData" 'PrefixI 'True) (S1 ('MetaSel ('Just "getFeatureData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Either MissingReason d)))) | |
data MissingReason Source #
Defines the reasons that a value may be missing. Can be used to
indicate the reason that a FeatureData's data was unable to be derived or does
not need to be derived. Feature
Constructors
| InsufficientData | Insufficient information available to derive data. |
| Other Text | User provided reason for missingness |
Instances
data KnownSymbol name => Feature name d Source #
The is an abstraction for Featurenamed data, where the name is a
*type*. Essentially, it is a container for that assigns a FeatureDataname
to the data.
Except when using to lift data into a pureFeature, Features can only be
derived from other Feature via a .Definition
Instances
| Define a (Feature n0 a) Source # | |
Defined in Features.Compose Methods define :: a -> Definition (Feature n0 a) Source # | |
| Monad (Feature name) Source # | |
| Functor (Feature name) Source # | |
| Applicative (Feature name) Source # | |
Defined in Features.Compose | |
| Foldable (Feature name) Source # | |
Defined in Features.Compose Methods fold :: Monoid m => Feature name m -> m # foldMap :: Monoid m => (a -> m) -> Feature name a -> m # foldMap' :: Monoid m => (a -> m) -> Feature name a -> m # foldr :: (a -> b -> b) -> b -> Feature name a -> b # foldr' :: (a -> b -> b) -> b -> Feature name a -> b # foldl :: (b -> a -> b) -> b -> Feature name a -> b # foldl' :: (b -> a -> b) -> b -> Feature name a -> b # foldr1 :: (a -> a -> a) -> Feature name a -> a # foldl1 :: (a -> a -> a) -> Feature name a -> a # toList :: Feature name a -> [a] # null :: Feature name a -> Bool # length :: Feature name a -> Int # elem :: Eq a => a -> Feature name a -> Bool # maximum :: Ord a => Feature name a -> a # minimum :: Ord a => Feature name a -> a # | |
| Traversable (Feature name) Source # | |
Defined in Features.Compose | |
| Eq d => Eq (Feature name d) Source # | |
| (KnownSymbol name, Show a) => Show (Feature name a) Source # | |
| (Typeable d, KnownSymbol n, ToJSON d, HasAttributes n d) => ToJSON (Feature n d) Source # | |
Defined in Features.Output | |
| (KnownSymbol n, Show d, ToJSON d, Typeable d, HasAttributes n d) => ShapeOutput (Feature n d) Source # | |
Defined in Features.Output Methods dataOnly :: Feature n d -> OutputShape b Source # nameOnly :: Feature n d -> OutputShape b Source # attrOnly :: Feature n d -> OutputShape b Source # nameData :: Feature n d -> OutputShape b Source # nameAttr :: Feature n d -> OutputShape b Source # | |
| DefineA (e -> d -> c -> b -> Feature n0 a) (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # | |
| DefineA (d -> c -> b -> Feature n0 a) (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
| DefineA (c -> b -> Feature n0 a) (Feature n2 c -> Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
| DefineA (b -> Feature n0 a) (Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
| Define (e -> d -> c -> b -> a) (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
| Define (d -> c -> b -> a) (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
| Define (c -> b -> a) (Feature n2 c -> Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
| Define (b -> a) (Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
The type is similar to FeatureN where the Featurename is included
as a Text field. This type is mainly for internal purposes in order to collect
Features of the same type d into a homogeneous container like a .List
featureDataL :: MissingReason -> FeatureData d Source #
Creates a missing FeatureData.
>>>featureDataL (Other "no good reason") :: FeatureData P.IntMkFeatureData (Left (Other "no good reason"))
>>>featureDataL (Other "no good reason") :: FeatureData TextMkFeatureData (Left (Other "no good reason"))
featureDataR :: d -> FeatureData d Source #
Creates a non-missing FeatureData. Since is an instance of
FeatureData, Applicative is also a synonym of for pure.featureDataR
>>>featureDataR "aString"MkFeatureData (Right "aString")>>>featureDataR (1 :: P.Int)MkFeatureData (Right 1)
>>>featureDataR ("aString", (1 :: P.Int))MkFeatureData (Right ("aString",1))
missingBecause :: MissingReason -> FeatureData d Source #
A synonym for featureDataL.
makeFeature :: KnownSymbol name => FeatureData d -> Feature name d Source #
A utility for constructing a from Feature.
Since FeatureDataname is a type, you may need to annotate the type when using this
function.
>>>makeFeature (pure "test") :: Feature "dummy" Text"dummy": MkFeatureData {getFeatureData = Right "test"}
getFeatureData :: FeatureData d -> Either MissingReason d Source #
Unwrap FeatureData.
getFData :: Feature name d -> FeatureData d Source #
Gets the FeatureData from a Feature.
getData :: Feature n d -> Either MissingReason d Source #
A utility for getting the (inner) content of a FeatureData.Feature
getDataN :: FeatureN d -> FeatureData d Source #
Get the data of a FeatureN
nameFeature :: forall name d. KnownSymbol name => Feature name d -> FeatureN d Source #
Feature Definitions
data Definition d where Source #
A Definition can be thought of as a lifted function. Specifically, the
function takes an arbitrary function (currently up to three arguments)
and returns a defineDefintion where the arguments have been lifted to a new domain.
For example, here we take f and lift to to a function of Features.
f :: Int -> String -> Bool f i s | 1 "yes" = True | otherwise = FALSE myFeature :: Definition (Feature A Int -> Feature B String -> Feature C Bool ) myFeature = define f
See for evaluating evalDefintions.
Constructors
| Pure :: a -> Definition (F n0 a) | |
| D1 :: (b -> a) -> Definition (F n1 b -> F n0 a) | |
| D1A :: (b -> F n0 a) -> Definition (F n1 b -> F n0 a) | |
| D1C :: (a2 -> a1 -> a) -> Definition (F n1 b -> F n02 a2) -> Definition (F n1 b -> F n01 a1) -> Definition (F n1 b -> F n0 a) | |
| D2 :: (c -> b -> a) -> Definition (F n2 c -> F n1 b -> F n0 a) | |
| D2A :: (c -> b -> F n0 a) -> Definition (F n2 c -> F n1 b -> F n0 a) | |
| D2C :: (a2 -> a1 -> a) -> Definition (F n2 c -> F n1 b -> F n02 a2) -> Definition (F n2 c -> F n1 b -> F n01 a1) -> Definition (F n2 c -> F n1 b -> F n0 a) | |
| D3 :: (d -> c -> b -> a) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n0 a) | |
| D3A :: (d -> c -> b -> F n0 a) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n0 a) | |
| D3C :: (a2 -> a1 -> a) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n02 a2) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n01 a1) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n0 a) | |
| D4 :: (e -> d -> c -> b -> a) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a) | |
| D4A :: (e -> d -> c -> b -> F n0 a) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a) | |
| D4C :: (a2 -> a1 -> a) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n02 a2) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n01 a1) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a) |
class Define inputs def | def -> inputs where Source #
Define (and 'DefineA) provide a means to create new s via
Definition (define). The defineA function takes a single function input
and returns a lifted function. For example,define
f :: Int -> String -> Bool f i s | 1 "yes" = True | otherwise = FALSE myFeature :: Definition (Feature A Int -> Feature B String -> Feature C Bool ) myFeature = define f
The function is similar, except that the return type of the input
function is already lifted. In the example below, an input of defineANothing is
considered a missing state:
f :: Int -> Maybe String -> Feature C Bool f i s | 1 (Just "yes") = pure True | _ (Just _ ) = pure False -- False for any Int and any (Just String) | otherwise = pure $ missingBecause InsufficientData -- missing if no string myFeature :: Definition (Feature A Int -> Feature B String -> Feature C Bool ) myFeature = defineA f
Methods
define :: inputs -> Definition def Source #
Instances
| Define a (Feature n0 a) Source # | |
Defined in Features.Compose Methods define :: a -> Definition (Feature n0 a) Source # | |
| Define (e -> d -> c -> b -> a) (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
| Define (d -> c -> b -> a) (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
| Define (c -> b -> a) (Feature n2 c -> Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
| Define (b -> a) (Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
class DefineA inputs def | def -> inputs where Source #
See .Define
Methods
defineA :: inputs -> Definition def Source #
Instances
| DefineA (e -> d -> c -> b -> Feature n0 a) (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # | |
| DefineA (d -> c -> b -> Feature n0 a) (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
| DefineA (c -> b -> Feature n0 a) (Feature n2 c -> Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
| DefineA (b -> Feature n0 a) (Feature n1 b -> Feature n0 a) Source # | |
Defined in Features.Compose | |
type Def d = Definition d Source #
Type synonym for Definition.
eval :: Definition d -> d Source #
Evaluate a Definition. Note that (currently), the second argument of eval
is a *tuple* of inputs. For example,
f :: Int -> String -> Bool f i s | 1 "yes" = True | otherwise = FALSE myFeature :: Definition (Feature A Int -> Feature B String -> Feature C Bool ) myFeature = define f a :: Feature A Int a = pure 1 b :: Feature B String b = pure "yes" c = eval myFeature a b
Adding Attributes to Features
data Attributes Source #
A data type for holding attritbutes of Features. This type and the
are likely to change in future versions.HasAttributes
Constructors
| MkAttributes | |
Fields
| |
Instances
A type to identify a feature's role in a research study.
Constructors
| Outcome | |
| Covariate | |
| Exposure | |
| Competing | |
| Weight | |
| Intermediate | |
| Unspecified |
Instances
| Eq Role Source # | |
| Ord Role Source # | |
| Show Role Source # | |
| Generic Role Source # | |
| ToJSON Role Source # | |
Defined in Features.Output | |
| type Rep Role Source # | |
Defined in Features.Attributes type Rep Role = D1 ('MetaData "Role" "Features.Attributes" "hasklepias-0.21.0-inplace" 'False) ((C1 ('MetaCons "Outcome" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Covariate" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Exposure" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Competing" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Weight" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Intermediate" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Unspecified" 'PrefixI 'False) (U1 :: Type -> Type)))) | |
A type to identify a feature's purpose
Instances
| Eq Purpose Source # | |
| Show Purpose Source # | |
| Generic Purpose Source # | |
| ToJSON Purpose Source # | |
Defined in Features.Output | |
| type Rep Purpose Source # | |
Defined in Features.Attributes type Rep Purpose = D1 ('MetaData "Purpose" "Features.Attributes" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "MkPurpose" 'PrefixI 'True) (S1 ('MetaSel ('Just "getRole") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set Role)) :*: S1 ('MetaSel ('Just "getTags") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set Text)))) | |
class KnownSymbol name => HasAttributes name d where Source #
A typeclass providing a single method for defining Attributes for a
Feature.
Minimal complete definition
Nothing
Methods
getAttributes :: f name d -> Attributes Source #
emptyAttributes :: Attributes Source #
An empty attributes value.
Arguments
| :: Text | short label |
| -> Text | long label |
| -> [Role] | purpose roles |
| -> [Text] | purpose tags |
| -> Attributes |
Create attributes with just short label, long label, roles, and tags.
emptyPurpose :: Purpose Source #
An empty purpose value.
Exporting Features
data Featureable Source #
Existential type to hold features, which allows for Features to be put into a homogeneous list.
Constructors
| forall d.(Show d, ToJSON d, ShapeOutput d) => MkFeatureable d Attributes |
Instances
| Show Featureable Source # | |
Defined in Features.Featureable Methods showsPrec :: Int -> Featureable -> ShowS # show :: Featureable -> String # showList :: [Featureable] -> ShowS # | |
| ToJSON Featureable Source # | |
Defined in Features.Featureable Methods toJSON :: Featureable -> Value # toEncoding :: Featureable -> Encoding # toJSONList :: [Featureable] -> Value # toEncodingList :: [Featureable] -> Encoding # | |
| ShapeOutput Featureable Source # | |
Defined in Features.Featureable Methods dataOnly :: Featureable -> OutputShape b Source # nameOnly :: Featureable -> OutputShape b Source # attrOnly :: Featureable -> OutputShape b Source # nameData :: Featureable -> OutputShape b Source # nameAttr :: Featureable -> OutputShape b Source # | |
packFeature :: (KnownSymbol n, Show d, ToJSON d, Typeable d, HasAttributes n d) => Feature n d -> Featureable Source #
Pack a feature into a Featurable.
getFeatureableAttrs :: Featureable -> Attributes Source #
Get the Attributes from a Featureable.
data Featureset Source #
A Featureset is a (non-empty) list of Featureable.
Instances
| Show Featureset Source # | |
Defined in Features.Featureset Methods showsPrec :: Int -> Featureset -> ShowS # show :: Featureset -> String # showList :: [Featureset] -> ShowS # | |
| ToJSON Featureset Source # | |
Defined in Features.Featureset Methods toJSON :: Featureset -> Value # toEncoding :: Featureset -> Encoding # toJSONList :: [Featureset] -> Value # toEncodingList :: [Featureset] -> Encoding # | |
| ShapeCohort Featureset Source # | |
Defined in Cohort.Output Methods colWise :: Cohort Featureset -> CohortJSON Source # rowWise :: Cohort Featureset -> CohortJSON Source # | |
newtype FeaturesetList Source #
A newtype wrapper for a NonEmpty Featureset.
Constructors
| MkFeaturesetList (NonEmpty Featureset) |
Instances
| Show FeaturesetList Source # | |
Defined in Features.Featureset Methods showsPrec :: Int -> FeaturesetList -> ShowS # show :: FeaturesetList -> String # showList :: [FeaturesetList] -> ShowS # | |
featureset :: NonEmpty Featureable -> Featureset Source #
Constructor of a Featureset.
getFeatureset :: Featureset -> NonEmpty Featureable Source #
Constructor of a Featureset.
getFeaturesetAttrs :: Featureset -> NonEmpty Attributes Source #
Gets a list of Attributes from a Featureset, one Attributes per Featureable.
getFeaturesetList :: FeaturesetList -> NonEmpty Featureset Source #
Constructor of a Featureset.
tpose :: FeaturesetList -> FeaturesetList Source #
Transpose a FeaturesetList
class ToJSON a => ShapeOutput a where Source #
A class that provides methods for transforming some type to an OutputShape.
Methods
dataOnly :: a -> OutputShape b Source #
nameOnly :: a -> OutputShape b Source #
attrOnly :: a -> OutputShape b Source #
nameData :: a -> OutputShape b Source #
nameAttr :: a -> OutputShape b Source #
Instances
| ShapeOutput Featureable Source # | |
Defined in Features.Featureable Methods dataOnly :: Featureable -> OutputShape b Source # nameOnly :: Featureable -> OutputShape b Source # attrOnly :: Featureable -> OutputShape b Source # nameData :: Featureable -> OutputShape b Source # nameAttr :: Featureable -> OutputShape b Source # | |
| (KnownSymbol n, Show d, ToJSON d, Typeable d, HasAttributes n d) => ShapeOutput (Feature n d) Source # | |
Defined in Features.Output Methods dataOnly :: Feature n d -> OutputShape b Source # nameOnly :: Feature n d -> OutputShape b Source # attrOnly :: Feature n d -> OutputShape b Source # nameData :: Feature n d -> OutputShape b Source # nameAttr :: Feature n d -> OutputShape b Source # | |
data OutputShape d Source #
A type used to determine the output shape of a Feature.
Instances
| Show (OutputShape a) Source # | |
Defined in Features.Output Methods showsPrec :: Int -> OutputShape a -> ShowS # show :: OutputShape a -> String # showList :: [OutputShape a] -> ShowS # | |
| ToJSON (OutputShape a) Source # | |
Defined in Features.Output Methods toJSON :: OutputShape a -> Value # toEncoding :: OutputShape a -> Encoding # toJSONList :: [OutputShape a] -> Value # toEncodingList :: [OutputShape a] -> Encoding # | |
Feature definition builders
A collection of pre-defined functions which build common feature definitions used in epidemiologic cohorts.
Arguments
| :: (Intervallic i0 a, Monoid (container (Interval a)), Applicative container, Witherable container) | |
| => Predicate (Event a) | The predicate to filter to Enrollment events (e.g. |
| -> Definition (Feature indexName (Index i0 a) -> Feature eventsName (container (Event a)) -> Feature varName Status) |
Is Enrolled
TODO: describe this
buildContinuousEnrollment Source #
Arguments
| :: (Monoid (container (Interval a)), Monoid (container (Maybe (Interval a))), Applicative container, Witherable container, IntervalSizeable a b) | |
| => (Index i0 a -> AssessmentInterval a) | function which maps index interval to interval in which to assess enrollment |
| -> Predicate (Event a) | The predicate to filter to Enrollment events (e.g. |
| -> b | duration of allowable gap between enrollment intervals |
| -> Definition (Feature indexName (Index i0 a) -> Feature eventsName (container (Event a)) -> Feature prevName Status -> Feature varName Status) |
Continuous Enrollment
TODO: describe this
Arguments
| :: (Intervallic i a, Witherable container) | |
| => (Bool -> outputType) | casting function |
| -> Natural | minimum number of cases |
| -> (Index i a -> AssessmentInterval a) | function to transform a |
| -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) | interval predicate |
| -> Predicate (Event a) | a predicate on events |
| -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName outputType) |
Do N events relating to the AssessmentInterval in some way the satisfy
the given predicate?
Arguments
| :: (Intervallic i a, Witherable container) | |
| => Natural | minimum number of cases |
| -> (Index i a -> AssessmentInterval a) | function to transform a |
| -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) | interval predicate |
| -> Predicate (Event a) | a predicate on events |
| -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Bool) |
buildNofXBinary :: (Intervallic i a, Witherable container) => Natural -> (Index i a -> AssessmentInterval a) -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -> Predicate (Event a) -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Binary) Source #
buildNofXBinaryConcurBaseline Source #
Arguments
| :: (Intervallic i0 a, Witherable t, IntervalSizeable a b, Baseline i0 a) | |
| => Natural | minimum number of events. |
| -> b | duration of baseline (passed to |
| -> Predicate (Event a) | |
| -> Definition (Feature indexName (Index i0 a) -> Feature eventsName (t (Event a)) -> Feature varName Binary) |
buildNofXBinary specialized to filter to events that concur
with an AssessmentInterval created by makeBaselineFromIndex of
a specified duration and a provided Predicate.
buildNofConceptsBinaryConcurBaseline Source #
Arguments
| :: (Intervallic i0 a, Witherable t, IntervalSizeable a b, Baseline i0 a) | |
| => Natural | minimum number of events. |
| -> b | duration of baseline (passed to |
| -> [Text] | list of |
| -> Definition (Feature indexName (Index i0 a) -> Feature eventsName (t (Event a)) -> Feature varName Binary) |
buildNofXBinary specialized to filter to events that concur
with an AssessmentInterval created by makeBaselineFromIndex of
a specified duration and that have a given set of Concepts.
Arguments
| :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) | |
| => (Bool -> outputType) | |
| -> Natural | the minimum number of gaps |
| -> b | the minimum duration of a gap |
| -> (Index i a -> AssessmentInterval a) | |
| -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) | |
| -> Predicate (Event a) | |
| -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName outputType) |
Are there N gaps of at least the given duration between any pair of events
that relate to the AssessmentInterval by the given relation and the
satisfy the given predicate?
Arguments
| :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) | |
| => Natural | the minimum number of gaps |
| -> b | the minimum duration of a gap |
| -> (Index i a -> AssessmentInterval a) | |
| -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) | |
| -> Predicate (Event a) | |
| -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Bool) |
buildNofXWithGap specialized to return Bool.
buildNofXWithGapBinary Source #
Arguments
| :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) | |
| => Natural | the minimum number of gaps |
| -> b | the minimum duration of a gap |
| -> (Index i a -> AssessmentInterval a) | |
| -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) | |
| -> Predicate (Event a) | |
| -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Binary) |
buildNofXWithGap specialized to return Binary.
buildNofXOrNofYWithGap Source #
Arguments
| :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) | |
| => (outputType -> outputType -> outputType) | |
| -> (Bool -> outputType) | |
| -> Natural | count passed to |
| -> Predicate (Event a) | |
| -> Natural | the minimum number of gaps passed to |
| -> b | the minimum duration of a gap passed to |
| -> (Index i a -> AssessmentInterval a) | |
| -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) | |
| -> Predicate (Event a) | |
| -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName outputType) |
Is either buildNofX or buildNofXWithGap satisfied
buildNofXOrNofYWithGapBool Source #
Arguments
| :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) | |
| => Natural | count passed to |
| -> Predicate (Event a) | |
| -> Natural | the minimum number of gaps passed to |
| -> b | the minimum duration of a gap passed to |
| -> (Index i a -> AssessmentInterval a) | |
| -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) | |
| -> Predicate (Event a) | |
| -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Bool) |
buildNofXOrNofYWithGap specialized to return Bool.
buildNofXOrNofYWithGapBinary Source #
Arguments
| :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) | |
| => Natural | count passed to |
| -> Predicate (Event a) | |
| -> Natural | the minimum number of gaps passed to |
| -> b | the minimum duration of a gap passed to |
| -> (Index i a -> AssessmentInterval a) | |
| -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) | |
| -> Predicate (Event a) | |
| -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Binary) |
buildNofXOrNofYWithGap specialized to return Binary.
Arguments
| :: (Intervallic i a, IntervalSizeable a b, Witherable container) | |
| => (Index i a -> AssessmentInterval a) | function to transform a |
| -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) | interval predicate |
| -> Predicate (Event a) | a predicate on events |
| -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName [(EventTime b, Count)]) |
Do N events relating to the AssessmentInterval in some way the satisfy
the given predicate?
Utilities for defining Features from Events
Much of logic needed to define features from events depends on the interval-algebra library. Its main functions and types are re-exported in Hasklepias, but the documentation can be found on hackage.
Container predicates
isNotEmpty :: [a] -> Bool Source #
Is the input list empty?
Does Events have at least n events with any of the Concept in x.
anyGapsWithinAtLeastDuration Source #
Arguments
| :: (IntervalSizeable a b, Intervallic i0 a, IntervalCombinable i1 a, Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))), Applicative t, Witherable t) | |
| => b | duration of gap |
| -> i0 a | within this interval |
| -> t (i1 a) | |
| -> Bool |
Within a provided spanning interval, are there any gaps of at least the specified duration among the input intervals?
allGapsWithinLessThanDuration Source #
Arguments
| :: (IntervalSizeable a b, Intervallic i0 a, IntervalCombinable i1 a, Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))), Applicative t, Witherable t) | |
| => b | duration of gap |
| -> i0 a | within this interval |
| -> t (i1 a) | |
| -> Bool |
Within a provided spanning interval, are all gaps less than the specified duration among the input intervals?
>>>allGapsWithinLessThanDuration 30 (beginerval 100 (0::Int)) [beginerval 5 (-1), beginerval 99 10]True
Finding occurrences of concepts
Arguments
| :: Filterable f | |
| => (f (Event a) -> Maybe (Event a)) | function used to select a single event |
| -> [Text] | |
| -> f (Event a) | |
| -> Maybe (Event a) |
Filter Events to a single , based on a provided function,
with the provided concepts. For example, see Maybe EventfirstConceptOccurrence and
lastConceptOccurrence.
firstConceptOccurrence :: Witherable f => [Text] -> f (Event a) -> Maybe (Event a) Source #
Finds the *first* occurrence of an Event with at least one of the concepts.
Assumes the input Events list is appropriately sorted.
Reshaping containers
allPairs :: Applicative f => f a -> f b -> f (a, b) Source #
Generate all pair-wise combinations from two lists.
splitByConcepts :: Filterable f => [Text] -> [Text] -> f (Event a) -> (f (Event a), f (Event a)) Source #
Split an Events a into a pair of Events a. The first element contains
events have any of the concepts in the first argument, similarly for the
second element.
Create filters
Arguments
| :: Filterable f | |
| => [Text] | the list of concepts by which to filter |
| -> f (Event a) | |
| -> f (Event a) |
Filter Events to those that have any of the provided concepts.
makePairedFilter :: Ord a => ComparativePredicateOf2 (i0 a) (PairedInterval b a) -> i0 a -> (b -> Bool) -> [PairedInterval b a] -> [PairedInterval b a] Source #
Manipulating Dates
monthFromDay :: Day -> MonthOfYear Source #
Gets the MonthOfDay from a Day.
dayOfMonthFromDay :: Day -> DayOfMonth Source #
Gets the DayOfMonth from a Day.
Functions for manipulating intervals
Arguments
| :: (Intervallic i a, IntervalSizeable a b) | |
| => b | lookback duration |
| -> i a | |
| -> Interval a |
Creates a new Interval of a provided lookback duration ending at the
begin of the input interval.
>>>lookback 4 (beginerval 10 (1 :: Int))(-3, 1)
Arguments
| :: (Intervallic i a, IntervalSizeable a b) | |
| => b | lookahead duration |
| -> i a | |
| -> Interval a |
Creates a new Interval of a provided lookahead duration beginning at the
end of the input interval.
>>>lookahead 4 (beginerval 1 (1 :: Int))(2, 6)
Misc functions
computeAgeAt :: Day -> Day -> Integer Source #
Compute the "age" in years between two calendar days. The difference between the days is rounded down.
pairGaps :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a) => [i a] -> [Maybe b] Source #
Gets the durations of gaps (via 'IntervalAlgebra.(><)') between all pairs of the input.
newtype Occurrence what when Source #
A type containing the time and when something occurred
Constructors
| MkOccurrence (what, EventTime when) |
Instances
makeOccurrence :: OccurrenceReason what => what -> EventTime b -> Occurrence what b Source #
Create an Occurrence
getOccurrenceReason :: Occurrence what b -> what Source #
Get the reason for an Occurrence.
getOccurrenceTime :: Occurrence what b -> EventTime b Source #
Get the time of an Occurrence.
data CensoringReason cr or Source #
Sum type for possible censoring and outcome reasons, including administrative censoring.
Constructors
| AdminCensor | |
| C cr | |
| O or |
Instances
class (Ord a, Show a) => OccurrenceReason a Source #
A simple typeclass for making a type a "reason" for an event.
data CensoredOccurrence censors outcomes b Source #
A type to represent censored Occurrence.
Constructors
| MkCensoredOccurrence | |
Fields
| |
Instances
adminCensor :: EventTime b -> CensoredOccurrence c o b Source #
Creates an administratively censored occurrence.
Specifying and building cohorts
Defining Cohorts
A subject is just a pair of ID and data.
newtype Population d Source #
A population is a list of sSubject
Constructors
| MkPopulation [Subject d] |
Instances
| Functor Population Source # | |
Defined in Cohort.Core Methods fmap :: (a -> b) -> Population a -> Population b # (<$) :: a -> Population b -> Population a # | |
| Eq d => Eq (Population d) Source # | |
Defined in Cohort.Core | |
| Show d => Show (Population d) Source # | |
Defined in Cohort.Core Methods showsPrec :: Int -> Population d -> ShowS # show :: Population d -> String # showList :: [Population d] -> ShowS # | |
| Generic (Population d) Source # | |
Defined in Cohort.Core Associated Types type Rep (Population d) :: Type -> Type # | |
| FromJSON d => FromJSON (Population d) Source # | |
Defined in Cohort.Core Methods parseJSON :: Value -> Parser (Population d) # parseJSONList :: Value -> Parser [Population d] # | |
| type Rep (Population d) Source # | |
Defined in Cohort.Core type Rep (Population d) = D1 ('MetaData "Population" "Cohort.Core" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkPopulation" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Subject d]))) | |
An observational unit is what a subject may be transformed into.
Instances
| Eq d => Eq (ObsUnit d) Source # | |
| Show d => Show (ObsUnit d) Source # | |
| Generic (ObsUnit d) Source # | |
| ToJSON d => ToJSON (ObsUnit d) Source # | |
Defined in Cohort.Output | |
| type Rep (ObsUnit d) Source # | |
Defined in Cohort.Core type Rep (ObsUnit d) = D1 ('MetaData "ObsUnit" "Cohort.Core" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "MkObsUnit" 'PrefixI 'True) (S1 ('MetaSel ('Just "obsID") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ID) :*: S1 ('MetaSel ('Just "obsData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 d))) | |
newtype CohortData d Source #
A container for CohortData
Constructors
| MkCohortData | |
Fields
| |
Instances
| Eq d => Eq (CohortData d) Source # | |
Defined in Cohort.Core | |
| Show d => Show (CohortData d) Source # | |
Defined in Cohort.Core Methods showsPrec :: Int -> CohortData d -> ShowS # show :: CohortData d -> String # showList :: [CohortData d] -> ShowS # | |
| Generic (CohortData d) Source # | |
Defined in Cohort.Core Associated Types type Rep (CohortData d) :: Type -> Type # | |
| ToJSON d => ToJSON (CohortData d) Source # | |
Defined in Cohort.Output Methods toJSON :: CohortData d -> Value # toEncoding :: CohortData d -> Encoding # toJSONList :: [CohortData d] -> Value # toEncodingList :: [CohortData d] -> Encoding # | |
| type Rep (CohortData d) Source # | |
Defined in Cohort.Core type Rep (CohortData d) = D1 ('MetaData "CohortData" "Cohort.Core" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkCohortData" 'PrefixI 'True) (S1 ('MetaSel ('Just "getObsData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [ObsUnit d]))) | |
A cohort is a list of observational units along with
regarding the number of subjects excluded by the AttritionInfo. Criteria
Constructors
| MkCohort (AttritionInfo, CohortData d) |
Instances
| Eq d => Eq (Cohort d) Source # | |
| Show d => Show (Cohort d) Source # | |
| Generic (Cohort d) Source # | |
| ToJSON d => ToJSON (Cohort d) Source # | |
Defined in Cohort.Output | |
| type Rep (Cohort d) Source # | |
Defined in Cohort.Core type Rep (Cohort d) = D1 ('MetaData "Cohort" "Cohort.Core" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkCohort" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (AttritionInfo, CohortData d)))) | |
data CohortSpec d1 d0 Source #
A cohort specification consist of two functions: one that transforms a subject's
input data into a and another that transforms a subject's input data
into the desired return type.Criteria
data CohortSetSpec i d Source #
Key/value pairs of CohortSpecs. The keys are the names of the cohorts.
A container hold multiple cohorts of the same type. The key is the name of the cohort; value is a cohort.
Constructors
| MkCohortSet (Map Text (Cohort d)) |
data AttritionInfo Source #
A type which collects the counts of subjects included or excluded.
Constructors
| MkAttritionInfo | |
Fields | |
Instances
data AttritionLevel Source #
A type which collects counts of a CohortStatus
Constructors
| MkAttritionLevel | |
Fields | |
Instances
specifyCohort :: (d1 -> Criteria) -> (d1 -> d0) -> CohortSpec d1 d0 Source #
Creates a .CohortSpec
makeObsUnitFeatures :: (d1 -> d0) -> Subject d1 -> ObsUnit d0 Source #
evalCohort :: CohortSpec d1 d0 -> Population d1 -> Cohort d0 Source #
Evaluates a on a CohortSpec.Population
getCohortIDs :: Cohort d -> [ID] Source #
Get IDs from a cohort.
getCohortDataIDs :: CohortData d -> [ID] Source #
Get IDs from CohortData.
getCohortData :: Cohort d -> [d] Source #
Get data from a cohort.
getCohortDataData :: CohortData d -> [d] Source #
Get data from a cohort.
getAttritionInfo :: Cohort d -> AttritionInfo Source #
Gets the attrition info from a cohort
makeCohortSpecs :: [(Text, d1 -> Criteria, d1 -> d0)] -> CohortSetSpec d1 d0 Source #
Make a set of CohortSpecs from list input.
evalCohortSet :: CohortSetSpec d1 d0 -> Population d1 -> CohortSet d0 Source #
Evaluates a on a CohortSetSpec.Population
Index
An Index is an interval of time from which the assessment intervals for an
observational unit may be derived. Assessment intervals (encoded in the type
AssessmentInterval) are intervals of time during which features are evaluated.
An Index is a wrapper for an Intervallic used to indicate that a particular
interval is considered an index interval to which other intervals will be compared.
Instances
| Functor i => Functor (Index i) Source # | |
| Intervallic i a => Intervallic (Index i) a Source # | |
Defined in Cohort.Index Methods getInterval :: Index i a -> Interval a # setInterval :: Index i a -> Interval a -> Index i a # | |
| Eq (i a) => Eq (Index i a) Source # | |
| Show (i a) => Show (Index i a) Source # | |
| Generic (Index i a) Source # | |
| (Intervallic i a, ToJSON (i a)) => ToJSON (Index i a) Source # | |
Defined in Cohort.Index | |
| type Rep (Index i a) Source # | |
Defined in Cohort.Index | |
Assessment Intervals
The assessment intervals provided are:
Baseline: an interval which eithermeetsorprecedesindex. Covariates are typically assessed during baseline intervals. A cohort's specification may include multiple baseline intervals, as different features may require different baseline intervals. For example, one feature may use a baseline interval of 365 days prior to index, while another uses a baseline interval of 90 days before index up to 30 days before index.Followup: an interval which isstartedBy,metBy, orafteranIndex. Outcomes are typically assessed during followup intervals. Similar toBaseline, a cohort's specification may include multiple followup intervals, as different features may require different followup intervals.
In future versions, one subject may have multiple values for an Index
corresponding to unique ObsUnit. That is, there is a 1-to-1 map between
index values and observational units, but there may be a 1-to-many map from
subjects to indices.
While users are protected from forming invalid assessment intervals, they still need to carefully consider how to filter events based on the assessment interval. Consider the following data:
_ <- Index (15, 16)
---------- <- Baseline (5, 15)
--- <- A (1, 4)
--- <- B (2, 5)
--- <- C (4, 7)
--- <- D (5, 8)
--- <- E (8, 11)
--- <- F (12, 15)
--- <- G (14, 17)
___ <- H (17, 20)
|----|----|----|----|
0 10 20
We have index, baseline, and 8 events (A-H). If Baseline is our assessment interval,
then the events concuring (i.e. not disjoint) with Baseline are C-G. While C-F
probably make sense to use in deriving some covariate, what about G? The event G
begins during baseline but ends after index. If you want, for example, to know
how many events started during baseline, then you’d want to include G in your
filter (using concur). But if you wanted to know the durations
of events enclosed by baseline, then you wouldn’t want to filter using concur
and instead perhaps use enclosedBy.
data BaselineInterval a Source #
A type to contain baseline intervals. See the Baseline typeclass for methods
to create values of this type.
Instances
class Intervallic i a => Baseline i a where Source #
Provides functions for creating a BaselineInterval from an Index. The
baseline function should satify:
- Meets
relate(baselined i) i =Meets
The baselineBefore function should satisfy:
- Before
relate(baselineBefores d i) i =Before
>>>import Cohort.Index>>>import IntervalAlgebra>>>x = makeIndex (beginerval 1 10)>>>b =baseline 10 x>>>b>>>relate b xMkBaselineInterval (0, 10) Meets
>>>import Cohort.Index>>>import IntervalAlgebra>>>x = makeIndex (beginerval 1 10)>>>b = baselineBefore 2 4 x>>>b>>>relate b xMkBaselineInterval (4, 8) Before
Minimal complete definition
Nothing
Methods
Arguments
| :: IntervalSizeable a b | |
| => b | duration of baseline |
| -> Index i a | the |
| -> BaselineInterval a |
Creates a BaselineInterval of the given duration that Meets
the Index interval.
Arguments
| :: IntervalSizeable a b | |
| => b | duration to shift back |
| -> b | duration of baseline |
| -> Index i a | the |
| -> BaselineInterval a |
Creates a BaselineInterval of the given duration that precedes
the Index interval.
Instances
| Ord a => Baseline Interval a Source # | |
Defined in Cohort.AssessmentIntervals Methods baseline :: IntervalSizeable a b => b -> Index Interval a -> BaselineInterval a Source # baselineBefore :: IntervalSizeable a b => b -> b -> Index Interval a -> BaselineInterval a Source # | |
data FollowupInterval a Source #
A type to contain followup intervals. See the Followup typeclass for methods
to create values of this type.
Instances
class Intervallic i a => Followup i a where Source #
Provides functions for creating a FollowupInterval from an Index. The
followup function should satify:
- StartedBy
relate(followupd i) i =StartedBy
The followupMetBy function should satisfy:
- MetBy
relate(followupMetByd i) i =MetBy
The followupAfter function should satisfy:
- After
relate(followupAfters d i) i =After
>>>import Cohort.Index>>>import IntervalAlgebra>>>x = makeIndex (beginerval 1 10)>>>f = followup 10 x>>>f>>>relate f xMkFollowupInterval (10, 20) StartedBy
Note the consequence of providing a duration less than or equal to the duration
of the index: a moment is added to the duration, so that the
end of the FollowupInterval is greater than the end of the Index.
>>>import Cohort.Index>>>import IntervalAlgebra>>>x = makeIndex (beginerval 1 10)>>>f = followup 1 x>>>f>>>relate f xMkFollowupInterval (10, 12) StartedBy
>>>import Cohort.Index>>>import IntervalAlgebra>>>x = makeIndex (beginerval 1 10)>>>f = followupMetBy 9 x>>>f>>>relate f xMkFollowupInterval (11, 20) MetBy
>>>import Cohort.Index>>>import IntervalAlgebra>>>x = makeIndex (beginerval 1 10)>>>f = followupAfter 1 9 x>>>f>>>relate f xMkFollowupInterval (12, 21) After
Minimal complete definition
Nothing
Methods
Arguments
| :: (IntervalSizeable a b, Intervallic i a) | |
| => b | duration of followup |
| -> Index i a | the |
| -> FollowupInterval a |
Arguments
| :: (IntervalSizeable a b, Intervallic i a) | |
| => b | duration of followup |
| -> Index i a | the |
| -> FollowupInterval a |
Arguments
| :: (IntervalSizeable a b, Intervallic i a) | |
| => b | duration add between the end of index and begin of followup |
| -> b | duration of followup |
| -> Index i a | the |
| -> FollowupInterval a |
Instances
| Ord a => Followup Interval a Source # | |
Defined in Cohort.AssessmentIntervals Methods followup :: (IntervalSizeable a b, Intervallic Interval a) => b -> Index Interval a -> FollowupInterval a Source # followupMetBy :: (IntervalSizeable a b, Intervallic Interval a) => b -> Index Interval a -> FollowupInterval a Source # followupAfter :: (IntervalSizeable a b, Intervallic Interval a) => b -> b -> Index Interval a -> FollowupInterval a Source # | |
data AssessmentInterval a Source #
A data type that contains variants of intervals during which assessment may occur.
Instances
makeBaselineFromIndex :: (Baseline i a, IntervalSizeable a b) => b -> Index i a -> AssessmentInterval a Source #
Creates an AssessmentInterval using the baseline function.
>>>import Cohort.Index>>>x = makeIndex $ beginerval 1 10>>>makeBaselineFromIndex 10 xBl (MkBaselineInterval (0, 10))
makeBaselineBeforeIndex :: (Baseline i a, IntervalSizeable a b) => b -> b -> Index i a -> AssessmentInterval a Source #
Creates an AssessmentInterval using the baselineBefore function.
>>>import Cohort.Index>>>x = makeIndex $ beginerval 1 10>>>makeBaselineBeforeIndex 2 10 xBl (MkBaselineInterval (-2, 8))
makeFollowupFromIndex :: (Followup i a, IntervalSizeable a b) => b -> Index i a -> AssessmentInterval a Source #
Creates an AssessmentInterval using the followup function.
>>>import Cohort.Index>>>x = makeIndex $ beginerval 1 10>>>makeFollowupFromIndex 10 xFl (MkFollowupInterval (10, 20))
makeFollowupMeetingIndex :: (Followup i a, IntervalSizeable a b) => b -> Index i a -> AssessmentInterval a Source #
Creates an AssessmentInterval using the followupMetBy function.
>>>import Cohort.Index>>>x = makeIndex $ beginerval 1 10>>>makeFollowupMeetingIndex 10 xFl (MkFollowupInterval (11, 21))
makeFollowupAfterIndex :: (Followup i a, IntervalSizeable a b) => b -> b -> Index i a -> AssessmentInterval a Source #
Creates an AssessmentInterval using the followupAfter function.
>>>import Cohort.Index>>>x = makeIndex $ beginerval 1 10>>>makeFollowupAfterIndex 10 10 xFl (MkFollowupInterval (21, 31))
Criteria
A type that is simply a 'FeatureN Status', that is, a feature that
identifies whether to or Include a subject.Exclude
Instances
A nonempty collection of paired with a CriterionNatural number.
Constructors
| MkCriteria | |
Fields
| |
Defines the return type for indicating whether to include or
exclude a subject.Criterion
data CohortStatus Source #
Defines subject's diposition in a cohort either included or which criterion
they were excluded by. See for evaluating a checkCohortStatus
to determine CohortStatus.Criteria
Constructors
| Included | |
| ExcludedBy (Natural, Text) |
Instances
excludeIf :: Bool -> Status Source #
Helper to convert a Bool to a Status
>>>excludeIf True>>>excludeIf FalseExclude Include
includeIf :: Bool -> Status Source #
Helper to convert a Bool to a Status
>>>includeIf True>>>includeIf FalseInclude Exclude
initStatusInfo :: Criteria -> NonEmpty CohortStatus Source #
Initializes a container of from a CohortStatus. This can be used
to collect generate all the possible Exclusion/Inclusion reasons. Criteria
checkCohortStatus :: Criteria -> CohortStatus Source #
Converts a subject's to a Criteria. The status is set
to CohortStatus if none of the Included have a status of Criterion.Exclude
Cohort I/O
Input
parsePopulationLines :: (FromJSON a, Show a, IntervalSizeable a b) => ByteString -> ([ParseError], Population (Events a)) Source #
Parse Event Int from json lines.
parsePopulationIntLines :: ByteString -> ([ParseError], Population (Events Int)) Source #
Parse Event Int from json lines.
parsePopulationDayLines :: ByteString -> ([ParseError], Population (Events Day)) Source #
Parse Event Day from json lines.
newtype ParseError Source #
Contains the line number and error message.
Constructors
| MkParseError (Natural, Text) |
Instances
| Eq ParseError Source # | |
Defined in Cohort.Input | |
| Show ParseError Source # | |
Defined in Cohort.Input Methods showsPrec :: Int -> ParseError -> ShowS # show :: ParseError -> String # showList :: [ParseError] -> ShowS # | |
Output
data CohortJSON Source #
A type containing all the information of a Cohort but where the CohortData
has been reshaped to a CohortDataShapeJSON.
Instances
newtype CohortSetJSON Source #
Similar to CohortSet, but where the Cohorts have been mapped to a CohortJSON.
Constructors
| MkCohortSetJSON (Map Text CohortJSON) |
Instances
data CohortDataShape d Source #
A type used to determine the output shape of a Cohort.
Instances
| Show d => Show (CohortDataShape d) Source # | |
Defined in Cohort.Output Methods showsPrec :: Int -> CohortDataShape d -> ShowS # show :: CohortDataShape d -> String # showList :: [CohortDataShape d] -> ShowS # | |
data CohortDataShapeJSON Source #
A type used to represent JSON formats for each shape
Constructors
| CW ColumnWiseJSON | |
| RW RowWiseJSON |
Instances
data ColumnWiseJSON Source #
A type to hold Cohort information in a column-wise manner.
Constructors
| MkColumnWiseJSON | |
Fields
| |
Instances
data RowWiseJSON Source #
A type to hold Cohort information in a row-wise manner.
Constructors
| MkRowWiseJSON | |
Fields
| |
Instances
class ShapeCohort d where Source #
Provides methods for reshaping a Cohort to a CohortDataShapeJSON.
Instances
| ShapeCohort Featureset Source # | |
Defined in Cohort.Output Methods colWise :: Cohort Featureset -> CohortJSON Source # rowWise :: Cohort Featureset -> CohortJSON Source # | |
toJSONCohortDataShape :: CohortDataShape shape -> Value Source #
Maps CohortDataShape into an Aeson Value.
Creating an executable cohort application
Arguments
| :: (FromJSON a, Show a, IntervalSizeable a b, ToJSON d0, ShapeCohort d0) | |
| => String | cohort name |
| -> String | app version |
| -> (Cohort d0 -> CohortJSON) | a function which specifies the output shape |
| -> CohortSetSpec (Events a) d0 | a list of cohort specifications |
| -> IO () |
Make a command line cohort building application.
Statistical Types
module Stype
Rexported Functions and modules
module Hasklepias.Reexports
A value of type is a computation which, when performed,
does some I/O before returning a value of type IO aa.
There is really only one way to "perform" an I/O action: bind it to
Main.main in your program. When your program is run, the I/O will
be performed. It isn't possible to perform I/O from an arbitrary
function, unless that function is itself in the IO monad and called
at some point, directly or indirectly, from Main.main.
IO is a monad, so IO actions can be combined using either the do-notation
or the >> and >>= operations from the Monad
class.
Instances
encode :: ToJSON a => a -> ByteString #
Efficiently serialize a JSON value as a lazy ByteString.
This is implemented in terms of the ToJSON class's toEncoding method.
A type that can be converted to JSON.
Instances in general must specify toJSON and should (but don't need
to) specify toEncoding.
An example type and instance:
-- Allow ourselves to writeTextliterals. {-# LANGUAGE OverloadedStrings #-} data Coord = Coord { x :: Double, y :: Double } instanceToJSONCoord wheretoJSON(Coord x y) =object["x".=x, "y".=y]toEncoding(Coord x y) =pairs("x".=x<>"y".=y)
Instead of manually writing your ToJSON instance, there are two options
to do it automatically:
- Data.Aeson.TH provides Template Haskell functions which will derive an instance at compile time. The generated instance is optimized for your type so it will probably be more efficient than the following option.
- The compiler can provide a default generic implementation for
toJSON.
To use the second, simply add a deriving clause to your
datatype and declare a GenericToJSON instance. If you require nothing other than
defaultOptions, it is sufficient to write (and this is the only
alternative where the default toJSON implementation is sufficient):
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
data Coord = Coord { x :: Double, y :: Double } deriving Generic
instance ToJSON Coord where
toEncoding = genericToEncoding defaultOptions
If on the other hand you wish to customize the generic decoding, you have to implement both methods:
customOptions =defaultOptions{fieldLabelModifier=maptoUpper} instanceToJSONCoord wheretoJSON=genericToJSONcustomOptionstoEncoding=genericToEncodingcustomOptions
Previous versions of this library only had the toJSON method. Adding
toEncoding had two reasons:
- toEncoding is more efficient for the common case that the output of
toJSONis directly serialized to aByteString. Further, expressing either method in terms of the other would be non-optimal. - The choice of defaults allows a smooth transition for existing users:
Existing instances that do not define
toEncodingstill compile and have the correct semantics. This is ensured by making the default implementation oftoEncodingusetoJSON. This produces correct results, but since it performs an intermediate conversion to aValue, it will be less efficient than directly emitting anEncoding. (this also means that specifying nothing more thaninstance ToJSON Coordwould be sufficient as a generically decoding instance, but there probably exists no good reason to not specifytoEncodingin new instances.)
Minimal complete definition
Nothing
Methods
Convert a Haskell value to a JSON-friendly intermediate type.
toEncoding :: a -> Encoding #
Encode a Haskell value as JSON.
The default implementation of this method creates an
intermediate Value using toJSON. This provides
source-level compatibility for people upgrading from older
versions of this library, but obviously offers no performance
advantage.
To benefit from direct encoding, you must provide an
implementation for this method. The easiest way to do so is by
having your types implement Generic using the DeriveGeneric
extension, and then have GHC generate a method body as follows.
instanceToJSONCoord wheretoEncoding=genericToEncodingdefaultOptions
toJSONList :: [a] -> Value #
toEncodingList :: [a] -> Encoding #
Instances
type HasCallStack = ?callStack :: CallStack #
Request a CallStack.
NOTE: The implicit parameter ?callStack :: CallStack is an
implementation detail and should not be considered part of the
CallStack API, we may decide to change the implementation in the
future.
Since: base-4.9.0.0
Arguments
| :: IO a | initialize the resource |
| -> (a -> IO ()) | free the resource |
| -> (IO a -> TestTree) |
|
| -> TestTree |
Acquire the resource to run this test (sub)tree and release it afterwards
askOption :: IsOption v => (v -> TestTree) -> TestTree #
Customize the test tree based on the run-time options
localOption :: IsOption v => v -> TestTree -> TestTree #
Locally set the option value for the given test subtree
adjustOption :: IsOption v => (v -> v) -> TestTree -> TestTree #
Locally adjust the option value for the given test subtree
defaultMain :: TestTree -> IO () #
Parse the command line arguments and run the tests.
When the tests finish, this function calls exitWith with the exit code
that indicates whether any tests have failed. Most external systems
(stack, cabal, travis-ci, jenkins etc.) rely on the exit code to detect
whether the tests pass. If you want to do something else after
defaultMain returns, you need to catch the exception and then re-throw
it. Example:
import Test.Tasty
import Test.Tasty.HUnit
import System.Exit
import Control.Exception
test = testCase "Test 1" (2 @?= 3)
main = defaultMain test
`catch` (\e -> do
if e == ExitSuccess
then putStrLn "Yea"
else putStrLn "Nay"
throwIO e)defaultIngredients :: [Ingredient] #
List of the default ingredients. This is what defaultMain uses.
At the moment it consists of listingTests and consoleTestReporter.
defaultMainWithIngredients :: [Ingredient] -> TestTree -> IO () #
Parse the command line arguments and run the tests using the provided ingredient list.
When the tests finish, this function calls exitWith with the exit code
that indicates whether any tests have failed. See defaultMain for
details.
includingOptions :: [OptionDescription] -> Ingredient #
This ingredient doesn't do anything apart from registering additional options.
The option values can be accessed using askOption.
Arguments
| :: DependencyType | whether to run the tests even if some of the dependencies fail |
| -> Expr | the pattern |
| -> TestTree | the subtree that depends on other tests |
| -> TestTree | the subtree annotated with dependency information |
Like after, but accepts the pattern as a syntax tree instead
of a string. Useful for generating a test tree programmatically.
Examples
Only match on the test's own name, ignoring the group names:
after_AllFinish(EQ(FieldNF) (StringLit"Bar")) $testCase"A test that depends on Foo.Bar" $ ...
Since: tasty-1.2
data DependencyType #
These are the two ways in which one test may depend on the others.
This is the same distinction as the hard vs soft dependencies in TestNG.
Since: tasty-1.2
Constructors
| AllSucceed | The current test tree will be executed after its dependencies finish, and only if all of the dependencies succeed. |
| AllFinish | The current test tree will be executed after its dependencies finish, regardless of whether they succeed or not. |
Instances
| Eq DependencyType | |
Defined in Test.Tasty.Core Methods (==) :: DependencyType -> DependencyType -> Bool # (/=) :: DependencyType -> DependencyType -> Bool # | |
| Show DependencyType | |
Defined in Test.Tasty.Core Methods showsPrec :: Int -> DependencyType -> ShowS # show :: DependencyType -> String # showList :: [DependencyType] -> ShowS # | |
The main data structure defining a test suite.
It consists of individual test cases and properties, organized in named groups which form a tree-like hierarchy.
There is no generic way to create a test case. Instead, every test
provider (tasty-hunit, tasty-smallcheck etc.) provides a function to
turn a test case into a TestTree.
Groups can be created using testGroup.
Timeout to be applied to individual tests
Constructors
| Timeout Integer String |
|
| NoTimeout |
Instances
| Show Timeout | |
| IsOption Timeout | |
Defined in Test.Tasty.Options.Core Methods defaultValue :: Timeout # parseValue :: String -> Maybe Timeout # optionName :: Tagged Timeout String # optionHelp :: Tagged Timeout String # showDefaultValue :: Timeout -> Maybe String # | |
testCaseInfo :: TestName -> IO String -> TestTree #
Like testCase, except in case the test succeeds, the returned string
will be shown as the description. If the empty string is returned, it
will be ignored.
testCaseSteps :: TestName -> ((String -> IO ()) -> Assertion) -> TestTree #
Create a multi-step unit test.
Example:
main = defaultMain $ testCaseSteps "Multi-step test" $ \step -> do step "Preparing..." -- do something step "Running part 1" -- do something step "Running part 2" -- do something assertFailure "BAM!" step "Running part 3" -- do something
The step calls are mere annotations. They let you see which steps were
performed successfully, and which step failed.
You can think of step
as putStrLn, except putStrLn would mess up the output with the
console reporter and get lost with the others.
For the example above, the output will be
Multi-step test: FAIL
Preparing...
Running part 1
Running part 2
BAM!
1 out of 1 tests failed (0.00s)Note that:
- Tasty still treats this as a single test, even though it consists of multiple steps.
- The execution stops after the first failure. When we are looking at a failed test, we know that all displayed steps but the last one were successful, and the last one failed. The steps after the failed one are not displayed, since they didn't run.
Arguments
| :: HasCallStack | |
| => String | The message that is displayed with the assertion failure |
| -> Assertion |
Signals an assertion failure if a non-empty message (i.e., a message
other than "") is passed.
Arguments
| :: (AssertionPredicable t, HasCallStack) | |
| => t | A value of which the asserted condition is predicated |
| -> String | A message that is displayed if the assertion fails |
| -> Assertion |
An infix and flipped version of assertBool. E.g. instead of
assertBool "Non-empty list" (null [1])
you can write
null [1] @? "Non-empty list"
@? is also overloaded to accept predicates, so instead
ofIO Bool
do e <- doesFileExist "test" e @? "File does not exist"
you can write
doesFileExist "test" @? "File does not exist"
Arguments
| :: (Eq a, Show a, HasCallStack) | |
| => a | The actual value |
| -> a | The expected value |
| -> Assertion |
Asserts that the specified actual value is equal to the expected value (with the actual value on the left-hand side).
Arguments
| :: (Eq a, Show a, HasCallStack) | |
| => a | The expected value |
| -> a | The actual value |
| -> Assertion |
Asserts that the specified actual value is equal to the expected value (with the expected value on the left-hand side).
Arguments
| :: (Eq a, Show a, HasCallStack) | |
| => String | The message prefix |
| -> a | The expected value |
| -> a | The actual value |
| -> Assertion |
Asserts that the specified actual value is equal to the expected value. The output message will contain the prefix, the expected value, and the actual value.
If the prefix is the empty string (i.e., ""), then the prefix is omitted
and only the expected and actual values are output.
Arguments
| :: HasCallStack | |
| => String | The message that is displayed if the assertion fails |
| -> Bool | The condition |
| -> Assertion |
Asserts that the specified condition holds.
Arguments
| :: HasCallStack | |
| => String | A message that is displayed with the assertion failure |
| -> IO a |
Unconditionally signals that a failure has occured. All other assertions can be expressed with the form:
if conditionIsMet
then return ()
else assertFailure msg
An assertion is simply an IO action. Assertion failure is indicated
by throwing an exception, typically HUnitFailure.
Instead of throwing the exception directly, you should use
functions like assertFailure and assertBool.
Test cases are composed of a sequence of one or more assertions.
class AssertionPredicable t where #
An ad-hoc class used to overload the @? operator.
The only intended instances of this class are and Bool.IO Bool
You shouldn't need to interact with this class directly.
Methods
assertionPredicate :: t -> IO Bool #
Instances
| AssertionPredicable Bool | |
Defined in Test.Tasty.HUnit.Orig Methods assertionPredicate :: Bool -> IO Bool # | |
| AssertionPredicable t => AssertionPredicable (IO t) | |
Defined in Test.Tasty.HUnit.Orig Methods assertionPredicate :: IO t -> IO Bool # | |
data HUnitFailure #
Exception thrown by assertFailure etc.
Constructors
| HUnitFailure (Maybe SrcLoc) String |
Instances
| Eq HUnitFailure | |
Defined in Test.Tasty.HUnit.Orig | |
| Show HUnitFailure | |
Defined in Test.Tasty.HUnit.Orig Methods showsPrec :: Int -> HUnitFailure -> ShowS # show :: HUnitFailure -> String # showList :: [HUnitFailure] -> ShowS # | |
| Exception HUnitFailure | |
Defined in Test.Tasty.HUnit.Orig Methods toException :: HUnitFailure -> SomeException # fromException :: SomeException -> Maybe HUnitFailure # displayException :: HUnitFailure -> String # | |
class Assertable t where #
Allows the extension of the assertion mechanism.
Since an Assertion can be a sequence of Assertions and IO actions,
there is a fair amount of flexibility of what can be achieved. As a rule,
the resulting Assertion should be the body of a TestCase or part of
a TestCase; it should not be used to assert multiple, independent
conditions.
If more complex arrangements of assertions are needed, Tests and
Testable should be used.
Instances
| Assertable Bool | |
Defined in Test.Tasty.HUnit.Orig | |
| Assertable () | |
Defined in Test.Tasty.HUnit.Orig | |
| Assertable String | |
Defined in Test.Tasty.HUnit.Orig | |
| Assertable t => Assertable (IO t) | |
Defined in Test.Tasty.HUnit.Orig | |
type AssertionPredicate = IO Bool #
The result of an assertion that hasn't been evaluated yet.
Most test cases follow the following steps:
- Do some processing or an action.
- Assert certain conditions.
However, this flow is not always suitable. AssertionPredicate allows for
additional steps to be inserted without the initial action to be affected
by side effects. Additionally, clean-up can be done before the test case
has a chance to end. A potential work flow is:
- Write data to a file.
- Read data from a file, evaluate conditions.
- Clean up the file.
- Assert that the side effects of the read operation meet certain conditions.
- Assert that the conditions evaluated in step 2 are met.