{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Cohort.Core
( Subject(..)
, ID
, Population(..)
, ObsUnit(..)
, CohortData(..)
, Cohort(..)
, CohortSpec
, CohortSetSpec
, CohortSet(..)
, AttritionInfo(..)
, AttritionLevel(..)
, specifyCohort
, makeObsUnitFeatures
, evalCohort
, getCohortIDs
, getCohortDataIDs
, getCohortData
, getCohortDataData
, getAttritionInfo
, makeCohortSpecs
, evalCohortSet
, getCohortSet
) where
import Cohort.Criteria ( CohortStatus(..)
, Criteria(getCriteria)
, checkCohortStatus
, initStatusInfo
)
import Cohort.Index ( Index(..)
, makeIndex
)
import Data.Aeson ( FromJSON
, ToJSON(..)
)
import Data.Bool ( Bool )
import Data.Eq ( Eq )
import Data.Foldable ( Foldable(length) )
import Data.Function ( ($) )
import Data.Functor ( (<$>)
, Functor(fmap)
)
import Data.List ( replicate
, zip
, zipWith
)
import qualified Data.List.NonEmpty as NEL
( NonEmpty(..)
)
import Data.Map.Strict as Map
( Map
, fromListWith
, unionsWith
)
import Data.Maybe ( Maybe(..)
, maybe
, catMaybes
)
import Data.Monoid ( mempty )
import Data.Ord ( Ord(..) )
import Data.Semigroup ( Semigroup((<>)) )
import qualified Data.Set as Set
( Set
)
import Data.Text ( Text )
import Data.Tuple ( uncurry )
import GHC.Exts ( IsList(..) )
import GHC.Generics ( Generic )
import GHC.Int ( Int )
import GHC.Num ( Natural
, Num((+))
)
import GHC.Show ( Show(..) )
import Safe ( headMay )
type ID = Text
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
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
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)
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)
newtype Cohort d = MkCohort (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)
getAttritionInfo :: Cohort d -> AttritionInfo
getAttritionInfo :: Cohort d -> AttritionInfo
getAttritionInfo (MkCohort (AttritionInfo
x, CohortData d
_)) = AttritionInfo
x
getPopulation :: Population d -> [Subject d]
getPopulation :: Population d -> [Subject d]
getPopulation (MkPopulation [Subject d]
x) = [Subject d]
x
getSubjectData :: Subject d -> d
getSubjectData :: Subject d -> d
getSubjectData (MkSubject (ID
_, d
x)) = d
x
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)
data CohortSpec d1 d0 = MkCohortSpec
{ CohortSpec d1 d0 -> d1 -> Criteria
runCriteria :: d1 -> Criteria
, CohortSpec d1 d0 -> d1 -> d0
runFeatures :: d1 -> d0
}
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
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
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)
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
data AttritionLevel = MkAttritionLevel
{ AttritionLevel -> CohortStatus
attritionLevel :: CohortStatus
, AttritionLevel -> Natural
attritionCount :: Natural
}
deriving (AttritionLevel -> AttritionLevel -> Bool
(AttritionLevel -> AttritionLevel -> Bool)
-> (AttritionLevel -> AttritionLevel -> Bool) -> Eq AttritionLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttritionLevel -> AttritionLevel -> Bool
$c/= :: AttritionLevel -> AttritionLevel -> Bool
== :: AttritionLevel -> AttritionLevel -> Bool
$c== :: AttritionLevel -> AttritionLevel -> Bool
Eq, Int -> AttritionLevel -> ShowS
[AttritionLevel] -> ShowS
AttritionLevel -> String
(Int -> AttritionLevel -> ShowS)
-> (AttritionLevel -> String)
-> ([AttritionLevel] -> ShowS)
-> Show AttritionLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttritionLevel] -> ShowS
$cshowList :: [AttritionLevel] -> ShowS
show :: AttritionLevel -> String
$cshow :: AttritionLevel -> String
showsPrec :: Int -> AttritionLevel -> ShowS
$cshowsPrec :: Int -> AttritionLevel -> ShowS
Show, (forall x. AttritionLevel -> Rep AttritionLevel x)
-> (forall x. Rep AttritionLevel x -> AttritionLevel)
-> Generic AttritionLevel
forall x. Rep AttritionLevel x -> AttritionLevel
forall x. AttritionLevel -> Rep AttritionLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttritionLevel x -> AttritionLevel
$cfrom :: forall x. AttritionLevel -> Rep AttritionLevel x
Generic)
instance Ord AttritionLevel where
compare :: AttritionLevel -> AttritionLevel -> Ordering
compare (MkAttritionLevel CohortStatus
l1 Natural
_) (MkAttritionLevel CohortStatus
l2 Natural
_) = CohortStatus -> CohortStatus -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CohortStatus
l1 CohortStatus
l2
instance Semigroup AttritionLevel where
<> :: AttritionLevel -> AttritionLevel -> AttritionLevel
(<>) (MkAttritionLevel CohortStatus
l1 Natural
c1) (MkAttritionLevel CohortStatus
_ Natural
c2) =
CohortStatus -> Natural -> AttritionLevel
MkAttritionLevel CohortStatus
l1 (Natural
c1 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
c2)
data AttritionInfo = MkAttritionInfo
{ AttritionInfo -> Int
totalProcessed :: Int
, AttritionInfo -> Set AttritionLevel
attritionInfo :: Set.Set AttritionLevel
}
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)
setAttrLevlToMap :: Set.Set AttritionLevel -> Map.Map CohortStatus Natural
setAttrLevlToMap :: Set AttritionLevel -> Map CohortStatus Natural
setAttrLevlToMap Set AttritionLevel
x =
[Item (Map CohortStatus Natural)] -> Map CohortStatus Natural
forall l. IsList l => [Item l] -> l
fromList ([Item (Map CohortStatus Natural)] -> Map CohortStatus Natural)
-> [Item (Map CohortStatus Natural)] -> Map CohortStatus Natural
forall a b. (a -> b) -> a -> b
$ (\(MkAttritionLevel CohortStatus
l Natural
c) -> (CohortStatus
l, Natural
c)) (AttritionLevel -> (CohortStatus, Natural))
-> [AttritionLevel] -> [(CohortStatus, Natural)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set AttritionLevel -> [Item (Set AttritionLevel)]
forall l. IsList l => l -> [Item l]
toList Set AttritionLevel
x
mapToSetAttrLevel :: Map.Map CohortStatus Natural -> Set.Set AttritionLevel
mapToSetAttrLevel :: Map CohortStatus Natural -> Set AttritionLevel
mapToSetAttrLevel Map CohortStatus Natural
x = [Item (Set AttritionLevel)] -> Set AttritionLevel
forall l. IsList l => [Item l] -> l
fromList ([Item (Set AttritionLevel)] -> Set AttritionLevel)
-> [Item (Set AttritionLevel)] -> Set AttritionLevel
forall a b. (a -> b) -> a -> b
$ (CohortStatus -> Natural -> AttritionLevel)
-> (CohortStatus, Natural) -> AttritionLevel
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CohortStatus -> Natural -> AttritionLevel
MkAttritionLevel ((CohortStatus, Natural) -> AttritionLevel)
-> [(CohortStatus, Natural)] -> [AttritionLevel]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map CohortStatus Natural -> [Item (Map CohortStatus Natural)]
forall l. IsList l => l -> [Item l]
toList Map CohortStatus Natural
x
instance Semigroup AttritionInfo where
<> :: AttritionInfo -> AttritionInfo -> AttritionInfo
(<>) (MkAttritionInfo Int
t1 Set AttritionLevel
i1) (MkAttritionInfo Int
t2 Set AttritionLevel
i2) = Int -> Set AttritionLevel -> AttritionInfo
MkAttritionInfo
(Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
t2)
( Map CohortStatus Natural -> Set AttritionLevel
mapToSetAttrLevel
(Map CohortStatus Natural -> Set AttritionLevel)
-> Map CohortStatus Natural -> Set AttritionLevel
forall a b. (a -> b) -> a -> b
$ (Natural -> Natural -> Natural)
-> [Map CohortStatus Natural] -> Map CohortStatus Natural
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
unionsWith Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(+) [Set AttritionLevel -> Map CohortStatus Natural
setAttrLevlToMap Set AttritionLevel
i1, Set AttritionLevel -> Map CohortStatus Natural
setAttrLevlToMap Set AttritionLevel
i2]
)
initAttritionInfo :: Criteria -> Map.Map CohortStatus Natural
initAttritionInfo :: Criteria -> Map CohortStatus Natural
initAttritionInfo Criteria
x = [Item (Map CohortStatus Natural)] -> Map CohortStatus Natural
forall l. IsList l => [Item l] -> l
fromList
([Item (Map CohortStatus Natural)] -> Map CohortStatus Natural)
-> [Item (Map CohortStatus Natural)] -> Map CohortStatus Natural
forall a b. (a -> b) -> a -> b
$ [CohortStatus] -> [Natural] -> [(CohortStatus, Natural)]
forall a b. [a] -> [b] -> [(a, b)]
zip (NonEmpty CohortStatus -> [Item (NonEmpty CohortStatus)]
forall l. IsList l => l -> [Item l]
toList (Criteria -> NonEmpty CohortStatus
initStatusInfo Criteria
x)) (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)
measureAttrition
:: Maybe Criteria -> [Subject CohortStatus] -> AttritionInfo
measureAttrition :: Maybe Criteria -> [Subject CohortStatus] -> AttritionInfo
measureAttrition Maybe Criteria
c [Subject CohortStatus]
l =
Int -> Set AttritionLevel -> AttritionInfo
MkAttritionInfo ([Subject CohortStatus] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Subject CohortStatus]
l) (Set AttritionLevel -> AttritionInfo)
-> Set AttritionLevel -> AttritionInfo
forall a b. (a -> b) -> a -> b
$ Map CohortStatus Natural -> Set AttritionLevel
mapToSetAttrLevel (Map CohortStatus Natural -> Set AttritionLevel)
-> Map CohortStatus Natural -> Set AttritionLevel
forall a b. (a -> b) -> a -> b
$ (Natural -> Natural -> Natural)
-> [Map CohortStatus Natural] -> Map CohortStatus Natural
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
unionsWith
Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(+)
[ Map CohortStatus Natural
-> (Criteria -> Map CohortStatus Natural)
-> Maybe Criteria
-> Map CohortStatus Natural
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map CohortStatus Natural
forall a. Monoid a => a
mempty Criteria -> Map CohortStatus Natural
initAttritionInfo Maybe Criteria
c
, (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
, [Item (Map CohortStatus Natural)] -> Map CohortStatus Natural
forall l. IsList l => [Item l] -> l
fromList [(CohortStatus
Included, Natural
0)]
]
evalUnits
:: CohortSpec d1 d0 -> Population d1 -> (AttritionInfo, CohortData d0)
evalUnits :: CohortSpec d1 d0 -> Population d1 -> (AttritionInfo, CohortData d0)
evalUnits CohortSpec d1 d0
spec Population d1
pop =
( Maybe Criteria -> [Subject CohortStatus] -> AttritionInfo
measureAttrition Maybe Criteria
fcrit [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
fcrit :: Maybe Criteria
fcrit = (Subject Criteria -> Criteria)
-> Maybe (Subject Criteria) -> Maybe Criteria
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Subject Criteria -> Criteria
forall d. Subject d -> d
getSubjectData ([Subject Criteria] -> Maybe (Subject Criteria)
forall a. [a] -> Maybe a
headMay [Subject Criteria]
crits)
statuses :: [Subject CohortStatus]
statuses = [Subject Criteria] -> [Subject CohortStatus]
evalCohortStatus [Subject Criteria]
crits
evalCohort :: CohortSpec d1 d0 -> Population d1 -> Cohort d0
evalCohort :: CohortSpec d1 d0 -> Population d1 -> Cohort d0
evalCohort CohortSpec d1 d0
s Population d1
p = (AttritionInfo, CohortData d0) -> Cohort d0
forall d. (AttritionInfo, CohortData d) -> Cohort d
MkCohort ((AttritionInfo, CohortData d0) -> Cohort d0)
-> (AttritionInfo, CohortData d0) -> Cohort d0
forall a b. (a -> b) -> a -> b
$ CohortSpec d1 d0 -> Population d1 -> (AttritionInfo, CohortData d0)
forall d1 d0.
CohortSpec d1 d0 -> Population d1 -> (AttritionInfo, CohortData d0)
evalUnits CohortSpec d1 d0
s Population d1
p
getCohortDataIDs :: CohortData d -> [ID]
getCohortDataIDs :: CohortData d -> [ID]
getCohortDataIDs (MkCohortData [ObsUnit d]
x) = (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 [ObsUnit d]
x
getCohortIDs :: Cohort d -> [ID]
getCohortIDs :: Cohort d -> [ID]
getCohortIDs (MkCohort (AttritionInfo
_, CohortData d
dat)) = CohortData d -> [ID]
forall d. CohortData d -> [ID]
getCohortDataIDs CohortData d
dat
getCohortDataData :: CohortData d -> [d]
getCohortDataData :: CohortData d -> [d]
getCohortDataData (MkCohortData [ObsUnit d]
x) = (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 [ObsUnit d]
x
getCohortData :: Cohort d -> [d]
getCohortData :: Cohort d -> [d]
getCohortData (MkCohort (AttritionInfo
_, CohortData d
dat)) = CohortData d -> [d]
forall d. CohortData d -> [d]
getCohortDataData CohortData d
dat
newtype CohortSet d = MkCohortSet (Map Text (Cohort d))
deriving (CohortSet d -> CohortSet d -> Bool
(CohortSet d -> CohortSet d -> Bool)
-> (CohortSet d -> CohortSet d -> Bool) -> Eq (CohortSet d)
forall d. Eq d => CohortSet d -> CohortSet d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CohortSet d -> CohortSet d -> Bool
$c/= :: forall d. Eq d => CohortSet d -> CohortSet d -> Bool
== :: CohortSet d -> CohortSet d -> Bool
$c== :: forall d. Eq d => CohortSet d -> CohortSet d -> Bool
Eq, Int -> CohortSet d -> ShowS
[CohortSet d] -> ShowS
CohortSet d -> String
(Int -> CohortSet d -> ShowS)
-> (CohortSet d -> String)
-> ([CohortSet d] -> ShowS)
-> Show (CohortSet d)
forall d. Show d => Int -> CohortSet d -> ShowS
forall d. Show d => [CohortSet d] -> ShowS
forall d. Show d => CohortSet d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CohortSet d] -> ShowS
$cshowList :: forall d. Show d => [CohortSet d] -> ShowS
show :: CohortSet d -> String
$cshow :: forall d. Show d => CohortSet d -> String
showsPrec :: Int -> CohortSet d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> CohortSet d -> ShowS
Show, (forall x. CohortSet d -> Rep (CohortSet d) x)
-> (forall x. Rep (CohortSet d) x -> CohortSet d)
-> Generic (CohortSet d)
forall x. Rep (CohortSet d) x -> CohortSet d
forall x. CohortSet d -> Rep (CohortSet d) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (CohortSet d) x -> CohortSet d
forall d x. CohortSet d -> Rep (CohortSet d) x
$cto :: forall d x. Rep (CohortSet d) x -> CohortSet d
$cfrom :: forall d x. CohortSet d -> Rep (CohortSet d) x
Generic)
getCohortSet :: CohortSet d -> Map Text (Cohort d)
getCohortSet :: CohortSet d -> Map ID (Cohort d)
getCohortSet (MkCohortSet Map ID (Cohort d)
x) = Map ID (Cohort d)
x
newtype CohortSetSpec i d = MkCohortSetSpec (Map Text (CohortSpec i d))
makeCohortSpecs :: [(Text, d1 -> Criteria, d1 -> d0)] -> CohortSetSpec d1 d0
makeCohortSpecs :: [(ID, d1 -> Criteria, d1 -> d0)] -> CohortSetSpec d1 d0
makeCohortSpecs [(ID, d1 -> Criteria, d1 -> d0)]
l =
Map ID (CohortSpec d1 d0) -> CohortSetSpec d1 d0
forall i d. Map ID (CohortSpec i d) -> CohortSetSpec i d
MkCohortSetSpec (Map ID (CohortSpec d1 d0) -> CohortSetSpec d1 d0)
-> Map ID (CohortSpec d1 d0) -> CohortSetSpec d1 d0
forall a b. (a -> b) -> a -> b
$ [Item (Map ID (CohortSpec d1 d0))] -> Map ID (CohortSpec d1 d0)
forall l. IsList l => [Item l] -> l
fromList (((ID, d1 -> Criteria, d1 -> d0) -> (ID, CohortSpec d1 d0))
-> [(ID, d1 -> Criteria, d1 -> d0)] -> [(ID, CohortSpec d1 d0)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ID
n, d1 -> Criteria
c, d1 -> d0
f) -> (ID
n, (d1 -> Criteria) -> (d1 -> d0) -> CohortSpec d1 d0
forall d1 d0. (d1 -> Criteria) -> (d1 -> d0) -> CohortSpec d1 d0
specifyCohort d1 -> Criteria
c d1 -> d0
f)) [(ID, d1 -> Criteria, d1 -> d0)]
l)
evalCohortSet :: CohortSetSpec d1 d0 -> Population d1 -> CohortSet d0
evalCohortSet :: CohortSetSpec d1 d0 -> Population d1 -> CohortSet d0
evalCohortSet (MkCohortSetSpec Map ID (CohortSpec d1 d0)
s) Population d1
p = Map ID (Cohort d0) -> CohortSet d0
forall d. Map ID (Cohort d) -> CohortSet d
MkCohortSet (Map ID (Cohort d0) -> CohortSet d0)
-> Map ID (Cohort d0) -> CohortSet d0
forall a b. (a -> b) -> a -> b
$ (CohortSpec d1 d0 -> Cohort d0)
-> Map ID (CohortSpec d1 d0) -> Map ID (Cohort d0)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CohortSpec d1 d0 -> Population d1 -> Cohort d0
forall d1 d0. CohortSpec d1 d0 -> Population d1 -> Cohort d0
`evalCohort` Population d1
p) Map ID (CohortSpec d1 d0)
s