{-|
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 OverloadedStrings #-}
-- {-# LANGUAGE Safe #-}

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 )
-- | 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 (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 -> AttritionInfo
getAttritionInfo :: Cohort d -> AttritionInfo
getAttritionInfo (MkCohort (AttritionInfo
x, CohortData d
_)) = 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 counts of a 'CohortStatus'
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)

-- | Ordering of @AttritionLevel@ is based on the value of its 'attritionLevel'. 
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

-- | NOTE: the @Semigroup@ instance prefers the 'attritionLevel' from the left,
--   so be sure that you're combining 
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)

-- | A type which collects the counts of subjects included or excluded.
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

-- | Two @AttritionInfo@ values can be combined, but this meant for combining
--   attrition info from the same set of @Criteria@.
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]
    )

-- Initializes @AttritionInfo@ from a @'Criteria'@.
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)

-- An internal function used to measure attrition for a cohort.
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)]
        -- including Included in the case that none of the evaluated criteria
        -- have status Include
    ]

-- | The internal function to evaluate a @'CohortSpec'@ on a @'Population'@. 
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

-- | 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 = (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

-- | Get IDs from 'CohortData'.
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

-- | Get IDs from a cohort.
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

-- | Get data from a cohort.
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

-- | Get data from a cohort.
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

{-| A container hold multiple cohorts of the same type. The key is the name of 
    the cohort; value is a cohort.
-}
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)

-- | Unwraps a 'CohortSet'.
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

{-| Key/value pairs of 'CohortSpec's. The keys are the names of the cohorts.
-}
newtype CohortSetSpec i d = MkCohortSetSpec (Map Text (CohortSpec i d))

-- | Make a set of 'CohortSpec's from list input.
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)

-- | Evaluates a @'CohortSetSpec'@ on a @'Population'@.
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