{-|
Module      : Hasklepias Cohorts
Description : Defines the Cohort type and associated methods
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
-- {-# LANGUAGE Safe #-}

module Cohort.Core(
      Subject(..)
    , ID
    , Population(..)
    , ObsUnit(..)
    , CohortData(..)
    , Cohort(..)
    , CohortSpec
    , AttritionInfo(..)
    , specifyCohort
    , makeObsUnitFeatures
    , evalCohort
    , getCohortIDs
    , getCohortData
    , getAttritionInfo
) where

import GHC.Num                              ( Num((+)), Natural )
import Data.Aeson                           ( FromJSON, ToJSON, ToJSONKey )
import Data.Bool                            ( Bool )
import Data.Eq                              ( Eq )
import Data.Foldable                        ( Foldable(length) )
import Data.Function                        ( ($) )
import Data.Functor                         ( Functor(fmap) )
import Data.Maybe                           ( Maybe(..), catMaybes )
import Data.List                            ( zipWith, replicate )
import Data.List.NonEmpty                   ( NonEmpty(..), zip, fromList, nonEmpty )
import Data.Map.Strict as Map               ( toList, fromListWith )
import Data.Text                            ( Text )
import GHC.Generics                         ( Generic )
import GHC.Show                             ( Show(..) )
import Cohort.Index                         ( makeIndex, Index(..) )
import Cohort.Criteria

-- | A subject identifier. Currently, simply @Text@.
type ID = Text

-- | A subject is just a pair of @ID@ and data.
newtype Subject d = MkSubject (ID, d)
    deriving (Subject d -> Subject d -> Bool
(Subject d -> Subject d -> Bool)
-> (Subject d -> Subject d -> Bool) -> Eq (Subject d)
forall d. Eq d => Subject d -> Subject d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subject d -> Subject d -> Bool
$c/= :: forall d. Eq d => Subject d -> Subject d -> Bool
== :: Subject d -> Subject d -> Bool
$c== :: forall d. Eq d => Subject d -> Subject d -> Bool
Eq, Int -> Subject d -> ShowS
[Subject d] -> ShowS
Subject d -> String
(Int -> Subject d -> ShowS)
-> (Subject d -> String)
-> ([Subject d] -> ShowS)
-> Show (Subject d)
forall d. Show d => Int -> Subject d -> ShowS
forall d. Show d => [Subject d] -> ShowS
forall d. Show d => Subject d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subject d] -> ShowS
$cshowList :: forall d. Show d => [Subject d] -> ShowS
show :: Subject d -> String
$cshow :: forall d. Show d => Subject d -> String
showsPrec :: Int -> Subject d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> Subject d -> ShowS
Show, (forall x. Subject d -> Rep (Subject d) x)
-> (forall x. Rep (Subject d) x -> Subject d)
-> Generic (Subject d)
forall x. Rep (Subject d) x -> Subject d
forall x. Subject d -> Rep (Subject d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (Subject d) x -> Subject d
forall d x. Subject d -> Rep (Subject d) x
$cto :: forall d x. Rep (Subject d) x -> Subject d
$cfrom :: forall d x. Subject d -> Rep (Subject d) x
Generic)

instance Functor Subject where
    fmap :: (a -> b) -> Subject a -> Subject b
fmap a -> b
f (MkSubject (ID
id, a
x)) = (ID, b) -> Subject b
forall d. (ID, d) -> Subject d
MkSubject (ID
id, a -> b
f a
x)

instance (FromJSON d) => FromJSON (Subject d) where

-- | A population is a list of @'Subject'@s
newtype Population d = MkPopulation  [Subject d] 
    deriving (Population d -> Population d -> Bool
(Population d -> Population d -> Bool)
-> (Population d -> Population d -> Bool) -> Eq (Population d)
forall d. Eq d => Population d -> Population d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Population d -> Population d -> Bool
$c/= :: forall d. Eq d => Population d -> Population d -> Bool
== :: Population d -> Population d -> Bool
$c== :: forall d. Eq d => Population d -> Population d -> Bool
Eq, Int -> Population d -> ShowS
[Population d] -> ShowS
Population d -> String
(Int -> Population d -> ShowS)
-> (Population d -> String)
-> ([Population d] -> ShowS)
-> Show (Population d)
forall d. Show d => Int -> Population d -> ShowS
forall d. Show d => [Population d] -> ShowS
forall d. Show d => Population d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Population d] -> ShowS
$cshowList :: forall d. Show d => [Population d] -> ShowS
show :: Population d -> String
$cshow :: forall d. Show d => Population d -> String
showsPrec :: Int -> Population d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> Population d -> ShowS
Show, (forall x. Population d -> Rep (Population d) x)
-> (forall x. Rep (Population d) x -> Population d)
-> Generic (Population d)
forall x. Rep (Population d) x -> Population d
forall x. Population d -> Rep (Population d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (Population d) x -> Population d
forall d x. Population d -> Rep (Population d) x
$cto :: forall d x. Rep (Population d) x -> Population d
$cfrom :: forall d x. Population d -> Rep (Population d) x
Generic)

instance Functor Population where
    fmap :: (a -> b) -> Population a -> Population b
fmap a -> b
f (MkPopulation [Subject a]
x) = [Subject b] -> Population b
forall d. [Subject d] -> Population d
MkPopulation ((Subject a -> Subject b) -> [Subject a] -> [Subject b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Subject a -> Subject b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Subject a]
x)

instance (FromJSON d) => FromJSON (Population d) where

-- | An observational unit is what a subject may be transformed into.
data ObsUnit d = MkObsUnit {
        ObsUnit d -> ID
obsID :: ID
      , ObsUnit d -> d
obsData :: d }
    deriving (ObsUnit d -> ObsUnit d -> Bool
(ObsUnit d -> ObsUnit d -> Bool)
-> (ObsUnit d -> ObsUnit d -> Bool) -> Eq (ObsUnit d)
forall d. Eq d => ObsUnit d -> ObsUnit d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObsUnit d -> ObsUnit d -> Bool
$c/= :: forall d. Eq d => ObsUnit d -> ObsUnit d -> Bool
== :: ObsUnit d -> ObsUnit d -> Bool
$c== :: forall d. Eq d => ObsUnit d -> ObsUnit d -> Bool
Eq, Int -> ObsUnit d -> ShowS
[ObsUnit d] -> ShowS
ObsUnit d -> String
(Int -> ObsUnit d -> ShowS)
-> (ObsUnit d -> String)
-> ([ObsUnit d] -> ShowS)
-> Show (ObsUnit d)
forall d. Show d => Int -> ObsUnit d -> ShowS
forall d. Show d => [ObsUnit d] -> ShowS
forall d. Show d => ObsUnit d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObsUnit d] -> ShowS
$cshowList :: forall d. Show d => [ObsUnit d] -> ShowS
show :: ObsUnit d -> String
$cshow :: forall d. Show d => ObsUnit d -> String
showsPrec :: Int -> ObsUnit d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> ObsUnit d -> ShowS
Show, (forall x. ObsUnit d -> Rep (ObsUnit d) x)
-> (forall x. Rep (ObsUnit d) x -> ObsUnit d)
-> Generic (ObsUnit d)
forall x. Rep (ObsUnit d) x -> ObsUnit d
forall x. ObsUnit d -> Rep (ObsUnit d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (ObsUnit d) x -> ObsUnit d
forall d x. ObsUnit d -> Rep (ObsUnit d) x
$cto :: forall d x. Rep (ObsUnit d) x -> ObsUnit d
$cfrom :: forall d x. ObsUnit d -> Rep (ObsUnit d) x
Generic)

-- | A container for CohortData
newtype CohortData d = MkCohortData { CohortData d -> [ObsUnit d]
getObsData :: [ObsUnit d] }
    deriving (CohortData d -> CohortData d -> Bool
(CohortData d -> CohortData d -> Bool)
-> (CohortData d -> CohortData d -> Bool) -> Eq (CohortData d)
forall d. Eq d => CohortData d -> CohortData d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CohortData d -> CohortData d -> Bool
$c/= :: forall d. Eq d => CohortData d -> CohortData d -> Bool
== :: CohortData d -> CohortData d -> Bool
$c== :: forall d. Eq d => CohortData d -> CohortData d -> Bool
Eq, Int -> CohortData d -> ShowS
[CohortData d] -> ShowS
CohortData d -> String
(Int -> CohortData d -> ShowS)
-> (CohortData d -> String)
-> ([CohortData d] -> ShowS)
-> Show (CohortData d)
forall d. Show d => Int -> CohortData d -> ShowS
forall d. Show d => [CohortData d] -> ShowS
forall d. Show d => CohortData d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CohortData d] -> ShowS
$cshowList :: forall d. Show d => [CohortData d] -> ShowS
show :: CohortData d -> String
$cshow :: forall d. Show d => CohortData d -> String
showsPrec :: Int -> CohortData d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> CohortData d -> ShowS
Show, (forall x. CohortData d -> Rep (CohortData d) x)
-> (forall x. Rep (CohortData d) x -> CohortData d)
-> Generic (CohortData d)
forall x. Rep (CohortData d) x -> CohortData d
forall x. CohortData d -> Rep (CohortData d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (CohortData d) x -> CohortData d
forall d x. CohortData d -> Rep (CohortData d) x
$cto :: forall d x. Rep (CohortData d) x -> CohortData d
$cfrom :: forall d x. CohortData d -> Rep (CohortData d) x
Generic)

-- | A cohort is a list of observational units along with @'AttritionInfo'@ 
-- regarding the number of subjects excluded by the @'Criteria'@. 
newtype Cohort d = MkCohort (Maybe AttritionInfo, CohortData d)
    deriving (Cohort d -> Cohort d -> Bool
(Cohort d -> Cohort d -> Bool)
-> (Cohort d -> Cohort d -> Bool) -> Eq (Cohort d)
forall d. Eq d => Cohort d -> Cohort d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cohort d -> Cohort d -> Bool
$c/= :: forall d. Eq d => Cohort d -> Cohort d -> Bool
== :: Cohort d -> Cohort d -> Bool
$c== :: forall d. Eq d => Cohort d -> Cohort d -> Bool
Eq, Int -> Cohort d -> ShowS
[Cohort d] -> ShowS
Cohort d -> String
(Int -> Cohort d -> ShowS)
-> (Cohort d -> String) -> ([Cohort d] -> ShowS) -> Show (Cohort d)
forall d. Show d => Int -> Cohort d -> ShowS
forall d. Show d => [Cohort d] -> ShowS
forall d. Show d => Cohort d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cohort d] -> ShowS
$cshowList :: forall d. Show d => [Cohort d] -> ShowS
show :: Cohort d -> String
$cshow :: forall d. Show d => Cohort d -> String
showsPrec :: Int -> Cohort d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> Cohort d -> ShowS
Show, (forall x. Cohort d -> Rep (Cohort d) x)
-> (forall x. Rep (Cohort d) x -> Cohort d) -> Generic (Cohort d)
forall x. Rep (Cohort d) x -> Cohort d
forall x. Cohort d -> Rep (Cohort d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (Cohort d) x -> Cohort d
forall d x. Cohort d -> Rep (Cohort d) x
$cto :: forall d x. Rep (Cohort d) x -> Cohort d
$cfrom :: forall d x. Cohort d -> Rep (Cohort d) x
Generic)

-- | Gets the attrition info from a cohort
getAttritionInfo :: Cohort d -> Maybe AttritionInfo
getAttritionInfo :: Cohort d -> Maybe AttritionInfo
getAttritionInfo (MkCohort (Maybe AttritionInfo
x, CohortData d
_)) = Maybe AttritionInfo
x

-- | Unpacks a @'Population'@ to a list of subjects.
getPopulation :: Population d -> [Subject d]
getPopulation :: Population d -> [Subject d]
getPopulation (MkPopulation [Subject d]
x) = [Subject d]
x

-- | Gets the data out of  a @'Subject'@.
getSubjectData :: Subject d -> d
getSubjectData :: Subject d -> d
getSubjectData (MkSubject (ID
_, d
x)) = d
x

-- | Tranforms a @'Subject'@ into a @'ObsUnit'@.
makeObsUnitFeatures :: (d1 -> d0) -> Subject d1 -> ObsUnit d0
makeObsUnitFeatures :: (d1 -> d0) -> Subject d1 -> ObsUnit d0
makeObsUnitFeatures d1 -> d0
f (MkSubject (ID
id, d1
dat)) = ID -> d0 -> ObsUnit d0
forall d. ID -> d -> ObsUnit d
MkObsUnit ID
id (d1 -> d0
f d1
dat)

-- | A cohort specification consist of two functions: one that transforms a subject's
-- input data into a @'Criteria'@ and another that transforms a subject's input data
-- into the desired return type.
data CohortSpec d1 d0 = MkCohortSpec
        { CohortSpec d1 d0 -> d1 -> Criteria
runCriteria:: d1 -> Criteria
        -- (Feature (Index i a))
        , CohortSpec d1 d0 -> d1 -> d0
runFeatures:: d1 -> d0 }

-- | Creates a @'CohortSpec'@.
specifyCohort :: (d1 -> Criteria) -> (d1 -> d0) ->  CohortSpec d1 d0
specifyCohort :: (d1 -> Criteria) -> (d1 -> d0) -> CohortSpec d1 d0
specifyCohort = (d1 -> Criteria) -> (d1 -> d0) -> CohortSpec d1 d0
forall d1 d0. (d1 -> Criteria) -> (d1 -> d0) -> CohortSpec d1 d0
MkCohortSpec

-- | Evaluates the @'runCriteria'@ of a @'CohortSpec'@ on a @'Population'@ to 
-- return a list of @Subject Criteria@ (one per subject in the population). 
evalCriteria :: CohortSpec d1 d0 -> Population d1 -> [Subject Criteria]
evalCriteria :: CohortSpec d1 d0 -> Population d1 -> [Subject Criteria]
evalCriteria (MkCohortSpec d1 -> Criteria
runCrit d1 -> d0
_) (MkPopulation [Subject d1]
pop) = (Subject d1 -> Subject Criteria)
-> [Subject d1] -> [Subject Criteria]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((d1 -> Criteria) -> Subject d1 -> Subject Criteria
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap d1 -> Criteria
runCrit) [Subject d1]
pop

-- | Convert a list of @Subject Criteria@ into a list of @Subject CohortStatus@
evalCohortStatus :: [Subject Criteria] -> [Subject CohortStatus]
evalCohortStatus :: [Subject Criteria] -> [Subject CohortStatus]
evalCohortStatus = (Subject Criteria -> Subject CohortStatus)
-> [Subject Criteria] -> [Subject CohortStatus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Criteria -> CohortStatus)
-> Subject Criteria -> Subject CohortStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Criteria -> CohortStatus
checkCohortStatus)

-- | Runs the input function which transforms a subject into an observational unit. 
-- If the subeject is excluded, the result is @Nothing@; otherwise it is @Just@ 
-- an observational unit.
evalSubjectCohort :: (d1 -> d0) -> Subject CohortStatus -> Subject d1 -> Maybe (ObsUnit d0)
evalSubjectCohort :: (d1 -> d0)
-> Subject CohortStatus -> Subject d1 -> Maybe (ObsUnit d0)
evalSubjectCohort d1 -> d0
f (MkSubject (ID
id, CohortStatus
status)) Subject d1
subjData =
    case CohortStatus
status of
        CohortStatus
Included     -> ObsUnit d0 -> Maybe (ObsUnit d0)
forall a. a -> Maybe a
Just (ObsUnit d0 -> Maybe (ObsUnit d0))
-> ObsUnit d0 -> Maybe (ObsUnit d0)
forall a b. (a -> b) -> a -> b
$ (d1 -> d0) -> Subject d1 -> ObsUnit d0
forall d1 d0. (d1 -> d0) -> Subject d1 -> ObsUnit d0
makeObsUnitFeatures d1 -> d0
f Subject d1
subjData
        ExcludedBy (Natural, ID)
_ -> Maybe (ObsUnit d0)
forall a. Maybe a
Nothing

-- | A type which collects the counts of subjects included or excluded.
newtype AttritionInfo = MkAttritionInfo (NonEmpty (CohortStatus, Natural))
    deriving (AttritionInfo -> AttritionInfo -> Bool
(AttritionInfo -> AttritionInfo -> Bool)
-> (AttritionInfo -> AttritionInfo -> Bool) -> Eq AttritionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttritionInfo -> AttritionInfo -> Bool
$c/= :: AttritionInfo -> AttritionInfo -> Bool
== :: AttritionInfo -> AttritionInfo -> Bool
$c== :: AttritionInfo -> AttritionInfo -> Bool
Eq, Int -> AttritionInfo -> ShowS
[AttritionInfo] -> ShowS
AttritionInfo -> String
(Int -> AttritionInfo -> ShowS)
-> (AttritionInfo -> String)
-> ([AttritionInfo] -> ShowS)
-> Show AttritionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttritionInfo] -> ShowS
$cshowList :: [AttritionInfo] -> ShowS
show :: AttritionInfo -> String
$cshow :: AttritionInfo -> String
showsPrec :: Int -> AttritionInfo -> ShowS
$cshowsPrec :: Int -> AttritionInfo -> ShowS
Show, (forall x. AttritionInfo -> Rep AttritionInfo x)
-> (forall x. Rep AttritionInfo x -> AttritionInfo)
-> Generic AttritionInfo
forall x. Rep AttritionInfo x -> AttritionInfo
forall x. AttritionInfo -> Rep AttritionInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttritionInfo x -> AttritionInfo
$cfrom :: forall x. AttritionInfo -> Rep AttritionInfo x
Generic)

-- | Initializes @AttritionInfo@ from a @'Criteria'@.
initAttritionInfo :: Criteria -> AttritionInfo
initAttritionInfo :: Criteria -> AttritionInfo
initAttritionInfo Criteria
x =
    NonEmpty (CohortStatus, Natural) -> AttritionInfo
MkAttritionInfo (NonEmpty (CohortStatus, Natural) -> AttritionInfo)
-> NonEmpty (CohortStatus, Natural) -> AttritionInfo
forall a b. (a -> b) -> a -> b
$ NonEmpty CohortStatus
-> NonEmpty Natural -> NonEmpty (CohortStatus, Natural)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
zip (Criteria -> NonEmpty CohortStatus
initStatusInfo Criteria
x) 
        (Natural
0 Natural -> [Natural] -> NonEmpty Natural
forall a. a -> [a] -> NonEmpty a
:| Int -> Natural -> [Natural]
forall a. Int -> a -> [a]
replicate (NonEmpty (Natural, Criterion) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Criteria -> NonEmpty (Natural, Criterion)
getCriteria Criteria
x)) Natural
0)

-- | Creates an @'AttritionInfo'@ from a list of @Subject CohortStatus@. The result
-- is @Nothing@ if the input list is empty.
measureAttrition :: [Subject CohortStatus] -> Maybe AttritionInfo
measureAttrition :: [Subject CohortStatus] -> Maybe AttritionInfo
measureAttrition [Subject CohortStatus]
l = (NonEmpty (CohortStatus, Natural) -> AttritionInfo)
-> Maybe (NonEmpty (CohortStatus, Natural)) -> Maybe AttritionInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (CohortStatus, Natural) -> AttritionInfo
MkAttritionInfo (Maybe (NonEmpty (CohortStatus, Natural)) -> Maybe AttritionInfo)
-> Maybe (NonEmpty (CohortStatus, Natural)) -> Maybe AttritionInfo
forall a b. (a -> b) -> a -> b
$ [(CohortStatus, Natural)]
-> Maybe (NonEmpty (CohortStatus, Natural))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([(CohortStatus, Natural)]
 -> Maybe (NonEmpty (CohortStatus, Natural)))
-> [(CohortStatus, Natural)]
-> Maybe (NonEmpty (CohortStatus, Natural))
forall a b. (a -> b) -> a -> b
$ Map CohortStatus Natural -> [(CohortStatus, Natural)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map CohortStatus Natural -> [(CohortStatus, Natural)])
-> Map CohortStatus Natural -> [(CohortStatus, Natural)]
forall a b. (a -> b) -> a -> b
$
     (Natural -> Natural -> Natural)
-> [(CohortStatus, Natural)] -> Map CohortStatus Natural
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(+) ([(CohortStatus, Natural)] -> Map CohortStatus Natural)
-> [(CohortStatus, Natural)] -> Map CohortStatus Natural
forall a b. (a -> b) -> a -> b
$ (Subject CohortStatus -> (CohortStatus, Natural))
-> [Subject CohortStatus] -> [(CohortStatus, Natural)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Subject CohortStatus
x -> (Subject CohortStatus -> CohortStatus
forall d. Subject d -> d
getSubjectData Subject CohortStatus
x, Natural
1)) [Subject CohortStatus]
l

-- | The internal function to evaluate a @'CohortSpec'@ on a @'Population'@. 
evalUnits :: CohortSpec d1 d0 -> Population d1 -> (Maybe AttritionInfo, CohortData d0)
evalUnits :: CohortSpec d1 d0
-> Population d1 -> (Maybe AttritionInfo, CohortData d0)
evalUnits CohortSpec d1 d0
spec Population d1
pop =
    ( [Subject CohortStatus] -> Maybe AttritionInfo
measureAttrition [Subject CohortStatus]
statuses
    , [ObsUnit d0] -> CohortData d0
forall d. [ObsUnit d] -> CohortData d
MkCohortData ([ObsUnit d0] -> CohortData d0) -> [ObsUnit d0] -> CohortData d0
forall a b. (a -> b) -> a -> b
$ [Maybe (ObsUnit d0)] -> [ObsUnit d0]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (ObsUnit d0)] -> [ObsUnit d0])
-> [Maybe (ObsUnit d0)] -> [ObsUnit d0]
forall a b. (a -> b) -> a -> b
$ (Subject CohortStatus -> Subject d1 -> Maybe (ObsUnit d0))
-> [Subject CohortStatus] -> [Subject d1] -> [Maybe (ObsUnit d0)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((d1 -> d0)
-> Subject CohortStatus -> Subject d1 -> Maybe (ObsUnit d0)
forall d1 d0.
(d1 -> d0)
-> Subject CohortStatus -> Subject d1 -> Maybe (ObsUnit d0)
evalSubjectCohort (CohortSpec d1 d0 -> d1 -> d0
forall d1 d0. CohortSpec d1 d0 -> d1 -> d0
runFeatures CohortSpec d1 d0
spec))
                                [Subject CohortStatus]
statuses
                                (Population d1 -> [Subject d1]
forall d. Population d -> [Subject d]
getPopulation Population d1
pop))
    where crits :: [Subject Criteria]
crits = CohortSpec d1 d0 -> Population d1 -> [Subject Criteria]
forall d1 d0.
CohortSpec d1 d0 -> Population d1 -> [Subject Criteria]
evalCriteria CohortSpec d1 d0
spec Population d1
pop
          statuses :: [Subject CohortStatus]
statuses = [Subject Criteria] -> [Subject CohortStatus]
evalCohortStatus [Subject Criteria]
crits

-- | Evaluates a @'CohortSpec'@ on a @'Population'@.
evalCohort :: CohortSpec d1 d0 -> Population d1 -> Cohort d0
evalCohort :: CohortSpec d1 d0 -> Population d1 -> Cohort d0
evalCohort CohortSpec d1 d0
s Population d1
p = (Maybe AttritionInfo, CohortData d0) -> Cohort d0
forall d. (Maybe AttritionInfo, CohortData d) -> Cohort d
MkCohort ((Maybe AttritionInfo, CohortData d0) -> Cohort d0)
-> (Maybe AttritionInfo, CohortData d0) -> Cohort d0
forall a b. (a -> b) -> a -> b
$ CohortSpec d1 d0
-> Population d1 -> (Maybe AttritionInfo, CohortData d0)
forall d1 d0.
CohortSpec d1 d0
-> Population d1 -> (Maybe AttritionInfo, CohortData d0)
evalUnits CohortSpec d1 d0
s Population d1
p

-- | Get IDs from a cohort.
getCohortIDs :: Cohort d -> [ID]
getCohortIDs :: Cohort d -> [ID]
getCohortIDs (MkCohort (Maybe AttritionInfo
_, CohortData d
dat)) = (ObsUnit d -> ID) -> [ObsUnit d] -> [ID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ObsUnit d -> ID
forall d. ObsUnit d -> ID
obsID ( CohortData d -> [ObsUnit d]
forall d. CohortData d -> [ObsUnit d]
getObsData CohortData d
dat )

-- | Get data from a cohort.
getCohortData :: Cohort d -> [d]
getCohortData :: Cohort d -> [d]
getCohortData (MkCohort (Maybe AttritionInfo
_, CohortData d
dat)) = (ObsUnit d -> d) -> [ObsUnit d] -> [d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ObsUnit d -> d
forall d. ObsUnit d -> d
obsData ( CohortData d -> [ObsUnit d]
forall d. CohortData d -> [ObsUnit d]
getObsData CohortData d
dat )