packages feed

hasklepias 0.14.0 → 0.15.0

raw patch · 33 files changed

+1839/−1109 lines, 33 filesdep ~interval-algebra

Dependency ranges changed: interval-algebra

Files

ChangeLog.md view
@@ -1,5 +1,14 @@ # Changelog for hasklepias +## 0.15.0++* Adds `Occurrence` type which is a simply a pair a reason and an `EventTime`. That is, an `Occurrence` captures what and when something occurred. Adds the `CensoredOccurrence` type which is similar to an `Occurrence`, except that the reason is of type `CensoringReason cr or`, where `data CensoringReason cr or = AdminCensor | C cr | O or`. The time of a `CensoredOccurrence` is a `MaybeCensored (EventTime a)` (not simply can `EventTime`). See the examples in `examples/ExampleFeatures4` for usage.+* A number of the utility functions in the `Hasklepias.FeatureEvents` module are generalized to operate on data structures other than lists of `Event`s.+* Exports type synonyms `F n a` and `Def d` for `Feature n a` and `Definiton d` to save a bit of typing.+* Adds `Hasklepias.Misc` module as a location to collect miscellaneous types and functions for the time-being, until better locations are found or created.+* Adds `examples/ExampleFeatures4.hs` which is an extensive example of assessing exposure protocols and censored outcomes.+* Moves the `Cohort` module to the top-level. Moves the `FeatureEvents` module within the `Hasklepias` module.+ ## 0.14.0  * Adds the ability to modify the output shape of cohorts. The `makeCohortApp` now takes a "`shape`" function as an argument of type `Cohort d -> CohortShape shape`. Currently, two functions of this type are provided: `rowWise` and `colWise`. The `rowWise` functions presents the output feature data in a row-wise format where each subject's data is its own array; whereas `colWise` presents the feature data where all the data of a given feature are in a single array.
+ examples/ExampleFeatures4.hs view
@@ -0,0 +1,571 @@+{-|+Module      : ExampleFeatures4+Description : Demostrates how to define an outcome monitoring treatment regimes+              over time.+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeApplications #-}++module ExampleFeatures4(+    exampleFeatures4Spec+) where++import Hasklepias+import ExampleEvents ( exampleEvents4 )+import Test.Hspec ( shouldBe, it, Spec, xcontext, describe, pending )++{-+  Example Data and utilities to create such+-}++type EventData a b = (b, a, Text)++t1 :: (a, b, c) -> a+t1 (x , _ , _) = x+t2 :: (a, b, c) -> b+t2 (_ , x , _) = x+t3 :: (a, b, c) -> c+t3 (_ , _ , x) = x++toEvent :: (IntervalSizeable a b, Show a, Integral b) => +  EventData a b-> Event a+toEvent x = event (beginerval (t1 x) (t2 x))+    (context (UnimplementedDomain ()) (packConcepts [t3 x]))++toEvents :: (Show a, IntervalSizeable a b, Integral b) =>+  [EventData a b] -> Events a+toEvents = sort.map toEvent++sapExample1 :: Events Day+sapExample1 = toEvents [+    (1, fromGregorian 2017 1 1, "index")+  , (1, fromGregorian 2017 3 1, "pcsk")+ ]++sapExample2 :: Events Day+sapExample2 = toEvents [+    (1, fromGregorian 2017 1 1,   "index")+  , (1, fromGregorian 2017 3 1, "wellness")+ ]++p1Events :: Events Int+p1Events = toEvents [+    (1, 1,   "index")+  , (1, 7 + 15, "pcsk")+ ]++p2Events :: Events Int+p2Events = toEvents [+    (1, 1,   "index")+  , (1, 7 + 60, "pcsk")+ ]++p3Events :: Events Int+p3Events = toEvents [+    (1, 1,   "index")+  , (1, 7 + 120, "pcsk")+ ]++p4Events :: Events Int+p4Events = toEvents [+    (1, 1,   "index")+  , (1, 7 + 240, "pcsk")+ ]++p5Events :: Events Int+p5Events = toEvents [+    (1, 1,   "index")+ ]++{-+  Types used for features+-}++data CensorReason =+  -- The order matters here in that if two censoring events occur on the same+  -- day then the reason for censoring will be chosen based on the following +  -- ordering.+    Death+  | Disenrollment+  | Discontinuation+  | Noncompliance+  | EndOfData+  deriving (Eq, Show, Ord)++instance OccurrenceReason CensorReason++data OutcomeReason =+    Wellness+  | Accident+  -- etc+  deriving (Eq, Show, Ord)++instance OccurrenceReason OutcomeReason++data NegOutcomes b = MkNegOutcome {+    g1 :: CensoredOccurrence CensorReason OutcomeReason b+  , g2 :: CensoredOccurrence CensorReason OutcomeReason b+  , g3 :: CensoredOccurrence CensorReason OutcomeReason b+  , g4 :: CensoredOccurrence CensorReason OutcomeReason b+  , g5 :: CensoredOccurrence CensorReason OutcomeReason b+ } deriving (Eq)++instance (Show b) => Show ( NegOutcomes b ) where+  show (MkNegOutcome x1 x2 x3 x4 x5) =+    "\n g1: " ++ show x1 +++    "\n g2: " ++ show x2 +++    "\n g3: " ++ show x3 +++    "\n g4: " ++ show x4 +++    "\n g5: " ++ show x5 +++    "\n"++data ProtocolStatus a =+    Compliant+  | NonCompliant (EventTime a)+  deriving (Eq, Show)++data Protocols a = MkProtocols {+    noInit  :: ProtocolStatus a+  , init30  :: ProtocolStatus a+  , init90  :: ProtocolStatus a+  , init180 :: ProtocolStatus a+  , init365 :: ProtocolStatus a+ } deriving (Eq)++instance (Show a) => Show (Protocols a) where+  show (MkProtocols x1 x2 x3 x4 x5) =+    "\n " ++ show x1 +++    "\n " ++ show x2 +++    "\n " ++ show x3 +++    "\n " ++ show x4 +++    "\n " ++ show x5 +++    "\n"++{-+  Helper functions+-}++-- | Duration of follow up in days+followupDuration :: Integral b => b+followupDuration = 365++-- | Duration to not observe events after the begin of index.+washoutDuration :: Integral b => b+washoutDuration = 7++-- | Creates an interval *starting 7 days after the index* and +--   ending 'followupDuration' days later.+makeFollowupInterval :: ( Integral b+                        , Intervallic i a+                        , IntervalSizeable a b) => +    b -> Index i a -> Interval a+makeFollowupInterval dur index =  +  beginerval dur (add washoutDuration (begin $ getIndex index))++-- | Creates an interval *starting 7 days after the index* and +--   ending 'followupDuration' days later.+followupInterval :: (Integral b, IntervalSizeable a b) => +    Index Interval a -> Interval a+followupInterval = makeFollowupInterval 365++{-+  Functions for defining the study's exposure protocol(s)+-}++protocol :: ( Intervallic i0 a+            , Intervallic i1 a+            , Intervallic i2 a+            , IntervalSizeable a b+            , Filterable container) =>+       (Index i2 a -> i0 a)+    -- ^ Function that maps an index interval to interval during which protocol is evaluated+    -> (i0 a -> container (i1 a) -> ProtocolStatus b)+    -- ^ Function that maps data to a @ProtocolStatus@.+    -> Index i2 a+    -> container (i1 a)+    -> ProtocolStatus b+protocol g f i dat = f (g i) ( filterConcur (g i) dat )++compliantIfNone :: (  IntervalSizeable a b+                    , Intervallic i0 a+                    , Intervallic i1 a+                    , Witherable container ) =>+        i0 a+    -> container (i1 a)+    -> ProtocolStatus b+compliantIfNone i x+  | null x     = Compliant+  | otherwise  = NonCompliant (mkEventTime (fmap (`diff` begin i) (end <$> headMay (toList x))))++compliantIfSome :: ( IntervalSizeable a b+                    , Intervallic i0 a+                    , Intervallic i1 a+                    , Witherable container) =>+       i0 a+    -> container (i1 a)+    -> ProtocolStatus b+compliantIfSome i x+  | null x     = NonCompliant (mkEventTime (Just $ diff (end i) (begin i)))+  | otherwise  = Compliant++protocolNoInit :: ( Integral b+                  , IntervalSizeable a b+                  , Intervallic i0 a+                  , Intervallic i1 a+                  , Witherable container) =>+       Index i0 a+    -> container (i1 a)+    -> ProtocolStatus b+protocolNoInit = protocol (makeFollowupInterval 365) compliantIfNone++protocols :: (  Integral b+              , IntervalSizeable a b+              , Intervallic i0 a+              , Intervallic i1 a+              , Witherable container) =>+       Index i0 a+    -> container (i1 a)+    -> Protocols b+protocols i e = MkProtocols+  ( protocol (makeFollowupInterval 365) compliantIfNone i e)+  ( protocol (makeFollowupInterval 30 ) compliantIfSome i e)+  ( protocol (makeFollowupInterval 90 ) compliantIfSome i e)+  ( protocol (makeFollowupInterval 180) compliantIfSome i e)+  ( protocol (makeFollowupInterval 365) compliantIfSome i e)++-- adminCensor :: (Integral b) => EventTime b -> CensoredOccurrence c o b+-- adminCensor t = MkCensoredOccurrence AdminCensor ( RightCensored t )++compliantOutcome :: (Integral b) => +     EventTime b+  -> Occurrence OutcomeReason b+  -> Occurrence CensorReason b+  -> CensoredOccurrence CensorReason OutcomeReason b+compliantOutcome+      adminTime+      (MkOccurrence  (oreason, otime))+      (MkOccurrence  (creason, ctime))+  | all (adminTime <) [otime, ctime]   = adminCensor adminTime+  | all (otime <=)    [ctime]          = MkCensoredOccurrence (O oreason) (Uncensored otime)+  | otherwise                          = MkCensoredOccurrence (C creason) (RightCensored ctime)++nonCompliantOutcome :: (Integral b) => +     EventTime b+  -> EventTime b+  -> Occurrence OutcomeReason b+  -> Occurrence CensorReason b+  -> CensoredOccurrence CensorReason OutcomeReason b+nonCompliantOutcome+      etime+      adminTime+      (MkOccurrence  (oreason, otime))+      (MkOccurrence  (creason, ctime))+  | all (adminTime <) [otime, ctime, etime] = adminCensor adminTime+  | all (otime <=)    [ctime, etime]        = MkCensoredOccurrence (O oreason) (Uncensored otime)+  | etime <= ctime                          = MkCensoredOccurrence (C Noncompliance) (RightCensored etime)+  | otherwise                               = MkCensoredOccurrence (C creason) (RightCensored ctime)++decideOutcome :: (Integral b) =>+     EventTime b      -- ^ admin censoring time+  -> ProtocolStatus b -- ^ pcsk+  -> Occurrence OutcomeReason b    -- ^ time of outcome+  -> Occurrence CensorReason b    -- ^ time of censoring (other than noncompliance)+  -> CensoredOccurrence CensorReason OutcomeReason b+decideOutcome  adminTime exposure outcomeTime censorTime =+  case exposure of+    Compliant      -> compliantOutcome adminTime outcomeTime censorTime+    NonCompliant t -> nonCompliantOutcome t adminTime outcomeTime censorTime++{-+   Features needed to evaluate censoring and outcome events+-}+index :: (Ord a)=> +  Def (F "events" (Events a) -> F "index" (Index Interval a))+index = defineA (+       makeConceptsFilter ["index"]+    .> intervals+    .> headMay+    .> \case+          Nothing -> makeFeature $ featureDataL ( Other "no index" )+          Just x  -> pure $ makeIndex x+      )++flupEvents :: (Integral b, IntervalSizeable a b) => +    Def (+     F "index" (Index Interval a)+  -> F "events" (Events a)+  -> F "allFollowupEvents" (Events b))+flupEvents = define (\index es ->+      es+      |> filterConcur ( followupInterval index)+      |> fmap ( diffFromBegin ( followupInterval index ) )+    )++{-+   Censoring Events+-}++death :: Integral b => Def (+     F "allFollowupEvents" (Events b)+  -> F "death" (EventTime b))+death = define (mkEventTime . fmap begin . firstConceptOccurrence ["death"])++disenrollment :: (Integral b, IntervalSizeable a b) =>+  Def (+     F "index" (Index Interval a)+     -- using all events rather than just follow-up events because enrollment+     -- intervals need to be combined first+  -> F "events" (Events a)+  -> F "disenrollment" (EventTime b))+disenrollment = define (\i events ->+  events+  |> makeConceptsFilter ["enrollment"]+  -- combine any concurring enrollment intervals+  |> combineIntervals+  -- find gaps between any enrollment intervals (as well as bounds of followup )+  |> gapsWithin (followupInterval i)+  -- get the first gap longer than 30 days (if it exists)+  |> \x -> (headMay . filter (\x -> duration x > 30)) =<< x+  -- Shift endpoints of intervals so that end of follow up is reference point+  |> fmap (diffFromBegin (followupInterval i))+  -- take the end of this gap as the time of disenrollment+  |> fmap end+  |> mkEventTime )++-- | A collector feature for all censors (except noncompliance)+censorTime :: (Integral b) => Def (+     F "death" (EventTime b)+  -> F "disenrollment" (EventTime b)+  -- etc+  -> F "censortime" (Occurrence CensorReason b))+censorTime = define (+  \dth disrl  ->+      minimum [ makeOccurrence Death dth+              , makeOccurrence Disenrollment disrl+              -- etc+              ]+   )++{- +  Exposure Definitions+-}++pcskEvents :: Def (+     F "events" (Events a)+  -> F "pcskEvents" (Events a))+pcskEvents = define ( makeConceptsFilter ["pcsk"] )++pcskProtocols :: (Integral b, IntervalSizeable a b) => +  Def (+     F "index" (Index Interval a)+  -> F "pcskEvents" (Events a)+  -> F "pcskProtocols" (Protocols b) )+pcskProtocols = define protocols++{-+  Outcome definitions+-}++makeg :: (Integral b, IntervalSizeable a b) => +      b+    -> Index Interval a+    -> ProtocolStatus b+    -> Occurrence OutcomeReason b+    -> Occurrence CensorReason b+    -> CensoredOccurrence CensorReason OutcomeReason b+makeg dur i = decideOutcome +    (mkEventTime $ Just $ duration (makeFollowupInterval dur i))++makeNegOutcomes :: (Integral b, IntervalSizeable a b) => +      Index Interval a+   -> Protocols b+   -> Occurrence CensorReason b +   -> Occurrence OutcomeReason b+   -> NegOutcomes b+makeNegOutcomes i (MkProtocols p1 p2 p3 p4 p5) c o = MkNegOutcome+    (makeg 365 i p1 o c)+    (makeg 30  i p2 o c)+    (makeg 90  i p3 o c)+    (makeg 180 i p4 o c)+    (makeg 365 i p5 o c)++type OutcomeFeature name a b = +     F "index" (Index Interval a)+  -> F "allFollowupEvents" (Events b)+  -> F "pcskProtocols" (Protocols b)+  -> F "censortime" (Occurrence CensorReason b)+  -> F name (NegOutcomes b)++makeOutcomeDefinition :: +  ( KnownSymbol name+  , Integral b+  , IntervalSizeable  a b) =>+    [Text]+  -> OutcomeReason+  -> Def (   F "index" (Index Interval a)+          -> F "allFollowupEvents" (Events b)+          -> F "pcskProtocols" (Protocols b)+          -> F "censortime" ( Occurrence CensorReason b) +          -> F name ( NegOutcomes b))+makeOutcomeDefinition cpt oreason  = define (+    \index events protocols censor  ->+      events+      |> firstConceptOccurrence cpt+      |> \x -> makeOccurrence oreason (mkEventTime (fmap begin x))+      |> makeNegOutcomes index protocols censor+  )++o1 :: (Integral b, IntervalSizeable  a b ) => +  Def ( OutcomeFeature "wellness" a b)+o1 = makeOutcomeDefinition ["wellness"] Wellness++o2 :: (Integral b, IntervalSizeable  a b ) => +  Def ( OutcomeFeature "accident" a b)+o2 = makeOutcomeDefinition ["accident"] Accident ++{- +   Tests of protocols+-}++testProtocols :: (Integral b, IntervalSizeable a b ) => +  [Event a] -> Feature "pcskProtocols" (Protocols b)+testProtocols input = eval pcskProtocols (idx,  pcev)+  where evs   = pure input+        idx   = eval index evs+        pcev  = eval pcskEvents evs++p1Protocols :: Feature "pcskProtocols" (Protocols Int)+p1Protocols = pure $ MkProtocols+    ( NonCompliant (mkEventTime (Just 15)) )+      Compliant+      Compliant+      Compliant+      Compliant++p2Protocols :: Feature "pcskProtocols" (Protocols Int)+p2Protocols = pure $ MkProtocols+    ( NonCompliant (mkEventTime (Just 60)) )+    ( NonCompliant (mkEventTime (Just 30)) )+      Compliant+      Compliant+      Compliant++p3Protocols :: Feature "pcskProtocols" (Protocols Int)+p3Protocols = pure $ MkProtocols+    ( NonCompliant (mkEventTime (Just 120)) )+    ( NonCompliant (mkEventTime (Just 30)) )+    ( NonCompliant (mkEventTime (Just 90)) )+      Compliant+      Compliant++p4Protocols :: Feature "pcskProtocols" (Protocols Int)+p4Protocols = pure $ MkProtocols+    ( NonCompliant (mkEventTime (Just 240)) )+    ( NonCompliant (mkEventTime (Just 30)) )+    ( NonCompliant (mkEventTime (Just 90)) )+    ( NonCompliant (mkEventTime (Just 180)) )+      Compliant++p5Protocols :: Feature "pcskProtocols" (Protocols Int)+p5Protocols = pure $ MkProtocols+      Compliant+    ( NonCompliant (mkEventTime (Just 30)) )+    ( NonCompliant (mkEventTime (Just 90)) )+    ( NonCompliant (mkEventTime (Just 180)) )+    ( NonCompliant (mkEventTime (Just 365)) )++{- +   Tests of outcomes+-}++testOutcomes :: ( Integral b, IntervalSizeable  a b ) => +      [Event a]+   -> (Feature "wellness" ( NegOutcomes b ), Feature "accident" (NegOutcomes b) )+testOutcomes input = (+      eval o1 (idx, flevs, prot, ctime) +    , eval o2 (idx, flevs, prot, ctime) )+  where evs   = pure input+        idx   = eval index evs+        flevs = eval flupEvents (idx, evs)+        pcev  = eval pcskEvents evs+        dth   = eval death flevs+        disen = eval disenrollment (idx, evs)+        prot  = eval pcskProtocols (idx, pcev)+        ctime = eval censorTime (dth, disen)++p1Outcomes :: (Integral b) => +  ( Feature "wellness" ( NegOutcomes b)+  , Feature "accident" ( NegOutcomes b)) +p1Outcomes = (+    pure $ MkNegOutcome +      (MkCensoredOccurrence (C Noncompliance) (RightCensored (mkEventTime (Just 15))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 30))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 90))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 180))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 365))))+  , pure $ MkNegOutcome +      (MkCensoredOccurrence (C Noncompliance) (RightCensored (mkEventTime (Just 15))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 30))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 90))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 180))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 365)))) + )+++p1Outcomes' :: (Integral b) => +  ( Feature "wellness" (NegOutcomes b)+  , Feature "accident" (NegOutcomes b)) +p1Outcomes' = (+    pure $ MkNegOutcome +      (MkCensoredOccurrence (C Noncompliance) (RightCensored (mkEventTime (Just 15))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 30))))+      (MkCensoredOccurrence (O Wellness)      (Uncensored (mkEventTime (Just 51))))+      (MkCensoredOccurrence (O Wellness)      (Uncensored (mkEventTime (Just 51))))+      (MkCensoredOccurrence (O Wellness)      (Uncensored (mkEventTime (Just 51))))+  , pure $ MkNegOutcome +      (MkCensoredOccurrence (C Noncompliance) (RightCensored (mkEventTime (Just 15))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 30))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 90))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 180))))+      (MkCensoredOccurrence  AdminCensor      (RightCensored (mkEventTime (Just 365)))) + )++{-+  Test specs+-}++exampleFeatures4Spec :: Spec+exampleFeatures4Spec = do+    describe "tests of exposure protocols" $+      do+        it "p1" $+          testProtocols p1Events `shouldBe` p1Protocols+        it "p2" $+          testProtocols p2Events `shouldBe` p2Protocols+        it "p3" $+          testProtocols p3Events `shouldBe` p3Protocols+        it "p4" $+          testProtocols p4Events `shouldBe` p4Protocols+        it "p5" $+          testProtocols p5Events `shouldBe` p5Protocols++    describe "tests of outcomes" $+      do+        it "p1" $+          testOutcomes p1Events `shouldBe` p1Outcomes+        it "p1'" $+          testOutcomes (sort p1Events <> [toEvent (1, 59, "wellness")] ) +            `shouldBe` p1Outcomes'++    -- describe "SAP examples" $ +    --   do+    --     it "sap example 1" pending+        -- testOutcomes sapExample1 `shouldBe` ???
examples/Main.hs view
@@ -6,6 +6,7 @@ import ExampleFeatures1 ( exampleFeatures1Spec ) import ExampleFeatures2 ( exampleFeatures2Spec )  import ExampleFeatures3 ( exampleFeatures3Spec ) +import ExampleFeatures4 ( exampleFeatures4Spec )  import ExampleCohort1   ( exampleCohort1tests ) import Test.Tasty import Test.Tasty.Hspec ( testSpec )@@ -18,11 +19,13 @@ main = do   spec1 <- testSpec "spec1" exampleFeatures1Spec   spec2 <- testSpec "spec2" exampleFeatures2Spec-  spec3 <- testSpec "spec3" exampleFeatures3Spec +  spec3 <- testSpec "spec3" exampleFeatures3Spec+  spec4 <- testSpec "spec4" exampleFeatures4Spec    defaultMain     (testGroup "tests"       [ spec1       , spec2-      , spec3 +      , spec3+      , spec4       , testGroup "Tests" [exampleCohort1tests]       ])
hasklepias.cabal view
@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           hasklepias-version:        0.14.0+version:        0.15.0 description:    Please see the README on GitHub at <https://github.com/novisci/asclepias#readme> homepage:       https://github.com/novisci/asclepias/#readme bug-reports:    https://github.com/novisci/asclepias/issues@@ -36,17 +36,18 @@       Features.Featureable       Features.Output       Features.Featureset-      FeatureEvents+      Cohort+      Cohort.Core+      Cohort.Input+      Cohort.Output+      Cohort.Criteria+      Cohort.Index       Hasklepias+      Hasklepias.FeatureEvents       Hasklepias.MakeApp+      Hasklepias.Misc       Hasklepias.Reexports       Hasklepias.ReexportsUnsafe-      Hasklepias.Cohort-      Hasklepias.Cohort.Core-      Hasklepias.Cohort.Input-      Hasklepias.Cohort.Output-      Hasklepias.Cohort.Criteria-      Hasklepias.Cohort.Index       Stype       Stype.Aeson       Stype.Numeric@@ -71,7 +72,7 @@     , co-log == 0.4.0.1     , flow == 1.0.22     , ghc-prim == 0.6.1-    , interval-algebra == 0.9.0+    , interval-algebra == 0.10.0     , lens == 5.0.1     , lens-aeson == 1.1.1     , mtl == 2.2.2@@ -101,10 +102,10 @@       FeaturesSpec       Features.OutputSpec       Features.FeaturesetSpec-      Hasklepias.Cohort.InputSpec-      Hasklepias.Cohort.CoreSpec-      Hasklepias.Cohort.CriteriaSpec-      FeatureEventsSpec+      Cohort.InputSpec+      Cohort.CoreSpec+      Cohort.CriteriaSpec+      Hasklepias.FeatureEventsSpec       Stype.AesonSpec       Stype.Numeric.CensoredSpec       Paths_hasklepias@@ -121,7 +122,7 @@     , flow == 1.0.22     , hasklepias     , hspec-    , interval-algebra == 0.9.0+    , interval-algebra == 0.10.0     , lens == 5.0.1     , text >=1.2.3     , time >=1.11@@ -138,6 +139,7 @@       ExampleFeatures1       ExampleFeatures2       ExampleFeatures3+      ExampleFeatures4       ExampleCohort1   hs-source-dirs:       examples
+ src/Cohort.hs view
@@ -0,0 +1,35 @@+{-|+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 #-}++module Cohort(++   -- * Defining Cohorts+      module Cohort.Core++    -- ** Criteria+    , module Cohort.Criteria+    -- ** Index+    , module Cohort.Index++    -- * Cohort I/O+    -- ** Input+    , module Cohort.Input   +    -- ** Output+    , module Cohort.Output+++) where+++import Cohort.Core+import Cohort.Index+import Cohort.Criteria+import Cohort.Input+import Cohort.Output
+ src/Cohort/Core.hs view
@@ -0,0 +1,167 @@+{-|+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 (Eq, Show, Generic)++instance Functor Subject where+    fmap f (MkSubject (id, x)) = MkSubject (id, f x)++instance (FromJSON d) => FromJSON (Subject d) where++-- | A population is a list of @'Subject'@s+newtype Population d = MkPopulation  [Subject d] +    deriving (Eq, Show, Generic)++instance Functor Population where+    fmap f (MkPopulation x) = MkPopulation (fmap (fmap f) x)++instance (FromJSON d) => FromJSON (Population d) where++-- | An observational unit is what a subject may be transformed into.+data ObsUnit d = MkObsUnit {+        obsID :: ID+      , obsData :: d }+    deriving (Eq, Show, Generic)++-- | A container for CohortData+newtype CohortData d = MkCohortData { getObsData :: [ObsUnit d] }+    deriving (Eq, Show, 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 (Eq, Show, Generic)++-- | Gets the attrition info from a cohort+getAttritionInfo :: Cohort d -> Maybe AttritionInfo+getAttritionInfo (MkCohort (x, _)) = x++-- | Unpacks a @'Population'@ to a list of subjects.+getPopulation :: Population d -> [Subject d]+getPopulation (MkPopulation x) = x++-- | Gets the data out of  a @'Subject'@.+getSubjectData :: Subject d -> d+getSubjectData (MkSubject (_, x)) = x++-- | Tranforms a @'Subject'@ into a @'ObsUnit'@.+makeObsUnitFeatures :: (d1 -> d0) -> Subject d1 -> ObsUnit d0+makeObsUnitFeatures f (MkSubject (id, dat)) = MkObsUnit id (f 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+        { runCriteria:: d1 -> Criteria+        -- (Feature (Index i a))+        , runFeatures:: d1 -> d0 }++-- | Creates a @'CohortSpec'@.+specifyCohort :: (d1 -> Criteria) -> (d1 -> d0) ->  CohortSpec d1 d0+specifyCohort = 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 (MkCohortSpec runCrit _) (MkPopulation pop) = fmap (fmap runCrit) pop++-- | Convert a list of @Subject Criteria@ into a list of @Subject CohortStatus@+evalCohortStatus :: [Subject Criteria] -> [Subject CohortStatus]+evalCohortStatus = fmap (fmap 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 f (MkSubject (id, status)) subjData =+    case status of+        Included     -> Just $ makeObsUnitFeatures f subjData+        ExcludedBy _ -> Nothing++-- | A type which collects the counts of subjects included or excluded.+newtype AttritionInfo = MkAttritionInfo (NonEmpty (CohortStatus, Natural))+    deriving (Eq, Show, Generic)++-- | Initializes @AttritionInfo@ from a @'Criteria'@.+initAttritionInfo :: Criteria -> AttritionInfo+initAttritionInfo x =+    MkAttritionInfo $ zip (initStatusInfo x) +        (0 :| replicate (length (getCriteria x)) 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 l = fmap MkAttritionInfo $ nonEmpty $ Map.toList $+     Map.fromListWith (+) $ fmap (\x -> (getSubjectData x, 1)) l++-- | The internal function to evaluate a @'CohortSpec'@ on a @'Population'@. +evalUnits :: CohortSpec d1 d0 -> Population d1 -> (Maybe AttritionInfo, CohortData d0)+evalUnits spec pop =+    ( measureAttrition statuses+    , MkCohortData $ catMaybes $ zipWith (evalSubjectCohort (runFeatures spec))+                                statuses+                                (getPopulation pop))+    where crits = evalCriteria spec pop+          statuses = evalCohortStatus crits++-- | Evaluates a @'CohortSpec'@ on a @'Population'@.+evalCohort :: CohortSpec d1 d0 -> Population d1 -> Cohort d0+evalCohort s p = MkCohort $ evalUnits s p++-- | Get IDs from a cohort.+getCohortIDs :: Cohort d -> [ID]+getCohortIDs (MkCohort (_, dat)) = fmap obsID ( getObsData dat )++-- | Get data from a cohort.+getCohortData :: Cohort d -> [d]+getCohortData (MkCohort (_, dat)) = fmap obsData ( getObsData dat )
+ src/Cohort/Criteria.hs view
@@ -0,0 +1,144 @@+{-|+Module      : Cohort Criteria+Description : Defines the Criteria and related types and functions+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com+-}+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TupleSections #-}++module Cohort.Criteria(+      Criterion+    , Criteria(..)+    , Status(..)+    , CohortStatus(..)+    , criterion+    , criteria+    , excludeIf+    , includeIf+    , initStatusInfo+    , checkCohortStatus+) where++import safe GHC.Generics                ( Generic )+import safe GHC.Num                     ( Num((+)), Natural )+import safe GHC.Show                    ( Show(show) )+import safe GHC.TypeLits                ( KnownSymbol, symbolVal )+import safe Control.Applicative         ( Applicative(pure) )+import safe Control.Monad               ( Functor(..) )+import safe Data.Bifunctor              ( Bifunctor(second) )+import safe Data.Bool                   ( Bool(..), otherwise, not, (&&) )+import safe Data.Either                 ( either )+import safe Data.Eq                     ( Eq(..) )+import safe Data.Function               ( ($), (.), const, id )+import safe qualified Data.List.NonEmpty as NE+                                        ( NonEmpty, zip, fromList, toList, map )+import safe Data.List                   ( find, (++) )+import safe Data.Maybe                  ( Maybe(..), maybe )+import safe Data.Ord                    ( Ord(..), Ordering(..) )+import safe Data.Semigroup              ( Semigroup((<>)) )+import safe Data.Tuple                  ( fst, snd )+import safe Data.Text                   ( Text, pack )+import safe Features.Compose            ( getFeatureData+                                        , Feature+                                        , nameFeature+                                        , FeatureN(..) )++-- | Defines the return type for @'Criterion'@ indicating whether to include or +-- exclude a subject.+data Status = Include | Exclude deriving (Eq, Show)++-- | Defines subject's diposition in a cohort either included or which criterion+-- they were excluded by. See @'checkCohortStatus'@ for evaluating a @'Criteria'@+-- to determine CohortStatus.+data CohortStatus =+  Included | ExcludedBy (Natural, Text)+    deriving (Eq, Show, Generic)++-- Defines an ordering to put @Included@ last in a container of @'CohortStatus'@.+-- The @'ExcludedBy'@ are ordered by their number value.+instance Ord CohortStatus where+  compare Included Included = EQ+  compare Included (ExcludedBy _) = GT+  compare (ExcludedBy _) Included = LT+  compare (ExcludedBy (i, _)) (ExcludedBy (j, _)) = compare i j++-- | Helper to convert a @Bool@ to a @'Status'@+-- +-- >>> includeIf True+-- >>> includeIf False+-- Include+-- Exclude+includeIf :: Bool -> Status+includeIf True  = Include+includeIf False = Exclude++-- | Helper to convert a @Bool@ to a @'Status'@+-- +-- >>> excludeIf True+-- >>> excludeIf False+-- Exclude+-- Include+excludeIf :: Bool -> Status+excludeIf True  = Exclude+excludeIf False = Include++-- | A type that is simply a @'FeatureN Status'@, that is, a feature that +-- identifies whether to @'Include'@ or @'Exclude'@ a subject.+newtype Criterion = MkCriterion ( FeatureN Status ) deriving (Eq, Show)++-- | Converts a @'Feature'@ to a @'Criterion'@.+criterion :: (KnownSymbol n) => Feature n Status -> Criterion+criterion x = MkCriterion (nameFeature x)++-- | A nonempty collection of @'Criterion'@ paired with a @Natural@ number.+newtype Criteria = MkCriteria {+    getCriteria :: NE.NonEmpty (Natural, Criterion)+  } deriving (Eq, Show)++-- | Constructs a @'Criteria'@ from a @'NE.NonEmpty'@ collection of @'Criterion'@.+criteria :: NE.NonEmpty Criterion -> Criteria+criteria l = MkCriteria $ NE.zip (NE.fromList [1..]) l++-- | Unpacks a @'Criterion'@ into a (Text, Status) pair where the text is the+-- name of the criterion and its @Status@ is the value of the status in the +-- @'Criterion'@. In the case, that the value of the @'FeatureData'@ within the +-- @'Criterion'@ is @Left@, the status is set to @'Exclude'@. +getStatus :: Criterion -> (Text, Status)+getStatus (MkCriterion x) =+  either (const (nm, Exclude)) (nm,) ((getFeatureData . getDataN) x)+    where nm = getNameN x++-- | Converts a subject's @'Criteria'@ into a @'NE.NonEmpty'@ triple of +-- (order of criterion, name of criterion, status)+getStatuses ::+  Criteria -> NE.NonEmpty (Natural, Text, Status)+getStatuses (MkCriteria x) =+  fmap (\c -> (fst c, (fst.getStatus.snd) c, (snd.getStatus.snd) c)) x++-- | An internal function used to @'Data.List.find'@ excluded statuses. Used in+-- 'checkCohortStatus'.+findExclude ::+  Criteria -> Maybe (Natural, Text, Status)+findExclude x =  find (\(_, _, z) -> z == Exclude) (getStatuses x)++-- | Converts a subject's @'Criteria'@ to a @'CohortStatus'@. The status is set+-- to @'Included'@ if none of the @'Criterion'@ have a status of @'Exclude'@.+checkCohortStatus ::+  Criteria -> CohortStatus+checkCohortStatus x =+    maybe Included (\(i, n, _) -> ExcludedBy (i, n)) (findExclude x)++-- | Utility to get the name of a @'Criterion'@.+getCriterionName :: Criterion -> Text+getCriterionName (MkCriterion x) = getNameN x++-- | Initializes a container of @'CohortStatus'@ from a @'Criteria'@. This can be used+-- to collect generate all the possible Exclusion/Inclusion reasons. +initStatusInfo :: Criteria -> NE.NonEmpty CohortStatus+initStatusInfo (MkCriteria z) =+   NE.map (ExcludedBy . Data.Bifunctor.second getCriterionName) z <> pure Included
+ src/Cohort/Index.hs view
@@ -0,0 +1,39 @@+{-|+Module      : Cohort Index +Description : Defines the Index and related types and functions+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com+-}++{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DeriveGeneric #-}+-- {-# LANGUAGE Safe #-}++module Cohort.Index(+    Index+  , makeIndex+  , getIndex+) where++import GHC.Show                    ( Show )+import GHC.Generics+import Data.Eq                     ( Eq )+import IntervalAlgebra             ( Intervallic )+import Data.Aeson++{-|+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.+-}++newtype Index i a = MkIndex { +    getIndex :: i a -- ^ Unwrap an @Index@+  } deriving (Eq, Show, Generic)++-- | Creates a new @'Index'@.+makeIndex :: Intervallic i a => i a -> Index i a+makeIndex = MkIndex++instance (Intervallic i a, ToJSON (i a)) => ToJSON (Index i a)
+ src/Cohort/Input.hs view
@@ -0,0 +1,97 @@+{-|+Module      : Functions for Parsing Hasklepias populations +Description : Defines FromJSON instances for Hasklepias populations .+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com+-}+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TupleSections #-}++module Cohort.Input(+      parsePopulationLines+    , parsePopulationIntLines+    , parsePopulationDayLines+    , ParseError(..)+) where++import Control.Applicative                  ( Applicative((<*>)), (<$>) )+import Data.Aeson                           ( FromJSON(..)+                                            , ToJSON(..)+                                            , eitherDecode+                                            , Value(Array))+import qualified Data.ByteString.Lazy as B  ( fromStrict+                                            , toStrict+                                            , ByteString)+import qualified Data.ByteString.Char8 as C ( lines )+import Prelude                              (+                                             String)+import Data.Bifunctor                       ( Bifunctor(first) )+import Data.Either                          ( Either(..)+                                            , partitionEithers )+import Data.Eq                              ( Eq )+import Data.Function                        ( ($), id )                                        +import Data.Functor                         ( Functor(fmap) )+import Data.List                            ( sort, (++), zipWith )+import qualified Data.Map.Strict as M       ( toList, fromListWith)+import Data.Ord                             ( Ord )+import Data.Text                            (Text, pack)+import Data.Time.Calendar                   ( Day )+import Data.Vector                          ( (!) )+import EventData                            ( Events, event, Event )+import EventData.Aeson                      ()+import Cohort.Core                          ( Population(..)+                                            , ID+                                            , Subject(MkSubject) )+import GHC.Int                              ( Int )+import GHC.Num                              ( Natural )+import GHC.Show                             ( Show )+import IntervalAlgebra                      ( IntervalSizeable )+++newtype SubjectEvent a = MkSubjectEvent (ID, Event a)++subjectEvent :: ID -> Event a -> SubjectEvent a+subjectEvent x y = MkSubjectEvent (x, y)++instance (FromJSON a, Show a, IntervalSizeable a b) => FromJSON (SubjectEvent a) where+    parseJSON (Array v) = subjectEvent <$>+        parseJSON (v ! 0) <*> (event <$> parseJSON (v ! 5) <*> parseJSON (Array v))++mapIntoPop :: (Ord a) => [SubjectEvent a] -> Population (Events a)+mapIntoPop l = MkPopulation $+    fmap (\(id, es) -> MkSubject (id, sort es)) -- TODO: is there a way to avoid the sort?+        (M.toList $ M.fromListWith (++) +        (fmap (\(MkSubjectEvent (id, e)) -> (id, [e])) l ))++decodeIntoSubj :: (FromJSON a, Show a, IntervalSizeable a b) => +        B.ByteString  -> Either Text (SubjectEvent a)+decodeIntoSubj x = first pack $ eitherDecode x ++-- | Contains the line number and error message.+newtype ParseError = MkParseError (Natural, Text) deriving (Eq, Show)++-- |  Parse @Event Int@ from json lines.+parseSubjectLines ::+    (FromJSON a, Show a, IntervalSizeable a b) =>+        B.ByteString -> ( [ParseError], [SubjectEvent a] )+parseSubjectLines l =+    partitionEithers $ zipWith+      (\x i -> first (\t -> MkParseError (i,t)) (decodeIntoSubj $ B.fromStrict x) )+      (C.lines $ B.toStrict l)+      [1..]++-- |  Parse @Event Int@ from json lines.+parsePopulationLines :: (FromJSON a, Show a, IntervalSizeable a b) => +    B.ByteString -> ([ParseError], Population (Events a))+parsePopulationLines x = fmap mapIntoPop (parseSubjectLines x)++-- |  Parse @Event Int@ from json lines.+parsePopulationIntLines :: B.ByteString -> ([ParseError], Population (Events Int))+parsePopulationIntLines x = fmap mapIntoPop (parseSubjectLines x)++-- |  Parse @Event Day@ from json lines.+parsePopulationDayLines :: B.ByteString -> ([ParseError], Population (Events Day))+parsePopulationDayLines x = fmap mapIntoPop (parseSubjectLines x)
+ src/Cohort/Output.hs view
@@ -0,0 +1,120 @@+{-|+Module      : Hasklepias Cohorts+Description : Defines the options for outputting a cohort+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com+-}+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveAnyClass #-}++module Cohort.Output(+    CohortShape+  , ShapeCohort(..)+  , toJSONCohortShape+) where++import Data.Aeson                           ( ToJSON(..)+                                            , Value+                                            , object+                                            , (.=) )+import Data.Function                        ( (.) )+import Data.Functor                         ( Functor(fmap) )+import Data.List.NonEmpty as NE             ( NonEmpty(..)+                                            , head+                                            , fromList+                                            , zip )+import Data.Tuple                           ( uncurry )+import GHC.Generics                         ( Generic )+import GHC.Types                            ( Type )+import GHC.Show                             ( Show )+import Cohort.Core                          ( AttritionInfo,+                                              Cohort,+                                              ObsUnit,+                                              ID,+                                              CohortData,+                                              getCohortData,+                                              getCohortIDs )+import Cohort.Criteria                      ( CohortStatus )+import Features.Featureset                  ( FeaturesetList(MkFeaturesetList)+                                            , Featureset+                                            , getFeatureset+                                            , getFeaturesetList+                                            , tpose )+import Features.Output                      ( ShapeOutput(dataOnly, nameAttr)+                                            , OutputShape )++instance (ToJSON d) => ToJSON (ObsUnit d) where+instance (ToJSON d) => ToJSON (CohortData d) where+instance (ToJSON d) => ToJSON (Cohort d) where+instance ToJSON CohortStatus where+instance ToJSON AttritionInfo where++-- | A type used to determine the output shape of a Cohort.+data CohortShape d where+  ColumnWise :: (Show a, ToJSON a) => a -> CohortShape ColumnWise+  RowWise :: (Show a, ToJSON a) => a -> CohortShape RowWise++deriving instance Show d => Show (CohortShape d)++-- | Maps CohortShape into an Aeson Value. +-- TODO: implement Generic and ToJSON instance of CohortShape directly.+toJSONCohortShape :: CohortShape shape -> Value+toJSONCohortShape (ColumnWise x) = toJSON x+toJSONCohortShape (RowWise x)    = toJSON x++class ShapeCohort d where+  colWise :: Cohort d -> CohortShape ColumnWise+  rowWise :: Cohort d -> CohortShape RowWise++instance ShapeCohort Featureset where+  colWise x = ColumnWise (shapeColumnWise x)+  rowWise x = RowWise (shapeRowWise x)++data ColumnWise = MkColumnWise {+    colAttributes :: NonEmpty (OutputShape Type)+  , ids     :: [ID]+  , colData :: NonEmpty (NonEmpty (OutputShape Type))+  } deriving ( Show, Generic )++instance ToJSON ColumnWise where+  toJSON x = object [ "attributes" .= colAttributes x+                    , "ids"        .= ids x+                    , "data"       .= colData x ]++newtype IDRow = MkIDRow (ID, NonEmpty (OutputShape Type))+  deriving ( Show, Generic )++instance ToJSON IDRow where+  toJSON (MkIDRow x) = object [ uncurry (.=) x]++data RowWise = MkRowWise {+    attributes :: NonEmpty (OutputShape Type)+  , rowData :: NonEmpty IDRow+  } deriving ( Show, Generic )++instance ToJSON RowWise where+  toJSON x = object [ "attributes" .= attributes x+                    , "data"       .= rowData x ]++shapeColumnWise :: Cohort Featureset -> ColumnWise+shapeColumnWise x = MkColumnWise+        (fmap (nameAttr . NE.head . getFeatureset) z)+        (getCohortIDs x)+        (fmap (fmap dataOnly . getFeatureset)  z)+        -- TODO: don't use fromList; do something more principled+        where z = getFeaturesetList (tpose (MkFeaturesetList (NE.fromList (getCohortData x))))++shapeRowWise :: Cohort Featureset -> RowWise+shapeRowWise x = MkRowWise+        (fmap (nameAttr . NE.head . getFeatureset) z)+        (fmap MkIDRow (zip ids (fmap (fmap dataOnly . getFeatureset) z)))+        -- TODO: don't use fromList; do something more principled+        where z = NE.fromList (getCohortData x)+              ids = fromList (getCohortIDs x)
− src/FeatureEvents.hs 
@@ -1,249 +0,0 @@-{-|-Module      : Functions for composing features from events  -Description : Functions for composing features. -Copyright   : (c) NoviSci, Inc 2020-License     : BSD3-Maintainer  : bsaul@novisci.com--Provides functions used in defining @'Features.Feature'@ from -@'EventData.Event'@s.--}-{-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE NoImplicitPrelude #-}--module FeatureEvents(-    -- ** Container predicates-      isNotEmpty-    , atleastNofX-    , anyGapsWithinAtLeastDuration-    , allGapsWithinLessThanDuration--    -- **  Finding occurrences of concepts-    , nthConceptOccurrence-    , firstConceptOccurrence--    -- ** Reshaping containers-    , allPairs-    , splitByConcepts--    -- ** Create filters-    , makeConceptsFilter-    , makePairedFilter--    -- ** Functions for working with Event Domains-    , viewBirthYears-    , previewBirthYear--    -- ** Function for manipulating intervals-    , lookback-    , lookahead--    -- ** Misc functions-    , computeAgeAt-) where---import IntervalAlgebra                      ( Intervallic-                                            , IntervalSizeable(..)-                                            , ComparativePredicateOf1-                                            , ComparativePredicateOf2-                                            , Interval-                                            , IntervalCombinable-                                            , begin-                                            , end-                                            , beginerval-                                            , enderval )-import IntervalAlgebra.PairedInterval       ( PairedInterval, getPairData )-import IntervalAlgebra.IntervalUtilities    ( durations, gapsWithin )-import EventData                            ( Events-                                            , Event-                                            , ConceptEvent-                                            , ctxt )-import EventData.Context                    ( Concept-                                            , Concepts-                                            , Context-                                            , HasConcept( hasConcepts )-                                            , facts )-import EventData.Context.Domain             ( Domain-                                            , demo-                                            , info-                                            , _Demographics )-import Safe                                 ( headMay, lastMay )-import Control.Applicative                  ( Applicative(liftA2) )-import Control.Monad                        ( Functor(fmap), (=<<) )-import Control.Lens                         ( preview, (^.) )-import Data.Bool                            ( Bool(..), (&&), not, (||) )-import Data.Either                          ( either )-import Data.Eq                              ( Eq )-import Data.Foldable                        ( Foldable(length, null), all, any )-import Data.Function                        ( (.), ($), const )-import Data.Functor                         ( Functor(fmap) )-import Data.Int                             ( Int )-import Data.Maybe                           ( Maybe(..), maybe, mapMaybe )-import Data.Monoid                          ( Monoid )-import Data.Ord                             ( Ord(..) )-import Data.Time.Calendar                   ( Day, Year, diffDays )-import Data.Text                            ( Text )-import Data.Text.Read                       ( rational )-import Data.Tuple                           ( fst )-import Witherable                           ( filter, Filterable, Witherable )-import GHC.Num                              ( Integer, fromInteger )-import GHC.Real                             ( RealFrac(floor), (/) )---- | Is the input list empty? -isNotEmpty :: [a] -> Bool-isNotEmpty = not.null---- | Filter 'Events' to those that have any of the provided concepts.-makeConceptsFilter ::-       [Text]    -- ^ the list of concepts by which to filter -    -> Events a-    -> Events a-makeConceptsFilter cpts = filter (`hasConcepts` cpts)---- | Filter 'Events' to a single @'Maybe' 'Event'@, based on a provided function,---   with the provided concepts. For example, see 'firstConceptOccurrence' and---  'lastConceptOccurrence'.-nthConceptOccurrence ::-       (Events a -> Maybe (Event a)) -- ^ function used to select a single event-    -> [Text]-    -> Events a-    -> Maybe (Event a)-nthConceptOccurrence f c = f.makeConceptsFilter c---- | Finds the *first* occurrence of an 'Event' with at least one of the concepts.---   Assumes the input 'Events' list is appropriately sorted.-firstConceptOccurrence ::-      [Text]-    -> Events a-    -> Maybe (Event a)-firstConceptOccurrence = nthConceptOccurrence headMay---- | Finds the *last* occurrence of an 'Event' with at least one of the concepts.---   Assumes the input 'Events' list is appropriately sorted.-lastConceptOccurrence ::-      [Text]-    -> Events a-    -> Maybe (Event a)-lastConceptOccurrence = nthConceptOccurrence lastMay---- | Does 'Events' have at least @n@ events with any of the Concept in @x@.-atleastNofX ::-      Int -- ^ n-   -> [Text] -- ^ x-   -> Events a -> Bool-atleastNofX n x es = length (makeConceptsFilter x es) >= n---- | Takes a predicate of intervals and a predicate on the data part of a ---   paired interval to create a single predicate such that both input---   predicates should hold.-makePairPredicate ::  Ord a =>-       ComparativePredicateOf2 (i0 a) ((PairedInterval b) a)-    -> i0 a-    -> (b -> Bool)-    -> (PairedInterval b a -> Bool)-makePairPredicate pi i pd x =  pi i x && pd (getPairData x)---- | -makePairedFilter :: Ord a =>-       ComparativePredicateOf2 (i0 a) ((PairedInterval b) a)-    -> i0 a-    -> (b -> Bool)-    -> [PairedInterval b a]-    -> [PairedInterval b a]-makePairedFilter fi i fc = filter (makePairPredicate fi i fc)---- | Generate all pair-wise combinations from two lists.-allPairs :: [a] -> [b] -> [(a, b)]-allPairs = liftA2 (,)---- | 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.-splitByConcepts :: [Text]-        -> [Text]-        -> Events a-        -> (Events a, Events a)-splitByConcepts c1 c2 es = ( filter (`hasConcepts` c1) es-                           , filter (`hasConcepts` c2) es)----- | Create a predicate function that checks whether within a provided spanning---   interval, are there (e.g. any, all) gaps of (e.g. <, <=, >=, >) a specified---   duration among  the input intervals?-makeGapsWithinPredicate ::-       ( Monoid (t (Interval a))-       , Monoid (t (Maybe (Interval a)))-       , Applicative t-       , Witherable t-       , IntervalSizeable a b-       , IntervalCombinable i0 a-       , IntervalCombinable i1 a) =>-          ((b -> Bool) ->  t b -> Bool)-        -> (b -> b -> Bool)-        -> (b -> i0 a -> t (i1 a) -> Bool)-makeGapsWithinPredicate f op gapDuration interval l =-     maybe False (f (`op` gapDuration) . durations) (gapsWithin interval l)---- | Within a provided spanning interval, are there any gaps of at least the---   specified duration among the input intervals?-anyGapsWithinAtLeastDuration ::-      (IntervalSizeable a b, IntervalCombinable i0 a, IntervalCombinable i1 a) =>-        b       -- ^ duration of gap-        -> i0 a  -- ^ within this interval-        -> [i1 a]-        -> Bool-anyGapsWithinAtLeastDuration = makeGapsWithinPredicate any (>=)---- | 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-allGapsWithinLessThanDuration ::-      (IntervalSizeable a b, IntervalCombinable i0 a, IntervalCombinable i1 a) =>-        b       -- ^ duration of gap-        -> i0 a  -- ^ within this interval-        -> [i1 a]-        -> Bool-allGapsWithinLessThanDuration = makeGapsWithinPredicate all (<)---- | Utility for reading text into a maybe integer-intMayMap :: Text -> Maybe Integer -- TODO: this is ridiculous-intMayMap x = fmap floor (either (const Nothing) (Just . fst) (Data.Text.Read.rational x))---- | Preview birth year from a domain-previewBirthYear :: Domain -> Maybe Year-previewBirthYear dmn = intMayMap =<< ((^.demo.info) =<< preview _Demographics dmn)---- | Returns a (possibly emtpy) list of birth years from a set of events-viewBirthYears :: Events a -> [Year]-viewBirthYears = mapMaybe (\e -> previewBirthYear =<< Just (ctxt e^.facts ))---- | Compute the "age" in years between two calendar days. The difference between---   the days is rounded down.-computeAgeAt :: Day -> Day -> Integer-computeAgeAt bd at = floor (fromInteger (diffDays at bd) / 365.25)---- | 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)-lookback :: (Intervallic i a, IntervalSizeable a b) =>-    b   -- ^ lookback duration-    -> i a-    -> Interval a-lookback d x = enderval d (begin x)---- | 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)-lookahead :: (Intervallic i a, IntervalSizeable a b) =>-    b   -- ^ lookahead duration-    -> i a-    -> Interval a-lookahead d x = beginerval d (end x)-
src/Features/Compose.hs view
@@ -55,7 +55,7 @@ import safe Control.Applicative        ( Applicative(..)                                         , liftA3, (<$>) ) import safe Control.Monad              ( Functor(..), Monad(..)-                                       , (=<<), join, liftM, liftM2, liftM3)+                                       , (=<<), join, liftM, liftM2, liftM3, liftM4) import safe Data.Either                ( Either(..) ) import safe Data.Eq                    ( Eq(..) ) import safe Data.Foldable              ( Foldable(foldr), fold )@@ -258,6 +258,8 @@   D2A :: (c -> b -> f0 a) -> Definition (f2 c -> f1 b -> f0 a)   D3  :: (d -> c -> b -> a) -> Definition (f3 d -> f2 c -> f1 b -> f0 a)   D3A :: (d -> c -> b -> f0 a) -> Definition (f3 d -> f2 c -> f1 b -> f0 a)+  D4  :: (e -> d -> c -> b -> a) -> Definition (f4 e -> f3 d -> f2 c -> f1 b -> f0 a) +  D4A :: (e -> d -> c -> b -> f0 a) -> Definition (f4 e -> f3 d -> f2 c -> f1 b -> f0 a)   {- | Define (and @'DefineA@) provide a means to create new @'Definition'@s via  @'define'@ (@'defineA'@). The @'define'@ function takes a single function input @@ -299,19 +301,24 @@ instance Define (b -> a) (FeatureData b -> FeatureData a) where define = D1 instance Define (c -> b -> a) (FeatureData c -> FeatureData b -> FeatureData a) where define = D2 instance Define (d -> c -> b -> a) (FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a) where define = D3+instance Define (e -> d -> c -> b -> a) (FeatureData e -> FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a) where define = D4  instance DefineA (b -> FeatureData a) (FeatureData b -> FeatureData a) where defineA = D1A instance DefineA (c -> b -> FeatureData a) (FeatureData c -> FeatureData b -> FeatureData a) where defineA = D2A instance DefineA (d -> c -> b -> FeatureData a) (FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a) where defineA = D3A+instance DefineA (e -> d -> c -> b -> FeatureData a) (FeatureData e -> FeatureData d -> FeatureData c -> FeatureData b -> FeatureData a) where defineA = D4A  instance Define (b -> a) (Feature n1 b -> Feature n0 a) where define = D1 instance Define (c -> b -> a) (Feature n2 c -> Feature n1 b -> Feature n0 a) where define = D2 instance Define (d -> c -> b -> a) (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) where define = D3+instance Define (e -> d -> c -> b -> a) (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) where define = D4  instance DefineA (b -> Feature n0 a) (Feature n1 b -> Feature n0 a) where defineA = D1A instance DefineA (c -> b -> Feature n0 a) (Feature n2 c -> Feature n1 b -> Feature n0 a) where defineA = D2A instance DefineA (d -> c -> b -> Feature n0 a) (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) where defineA = D3A+instance DefineA (e -> d -> c -> b -> Feature n0 a) (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) where defineA = D4A + {- | Evaluate a @Definition@. Note that (currently), the second argument of 'eval' is a *tuple* of inputs. For example, @@ -379,6 +386,15 @@   eval (D3 f) (MkFeature x, MkFeature y, MkFeature z) = MkFeature $ liftA3 f x y z   eval (D3A f) (MkFeature x, MkFeature y, MkFeature z) =       case liftA3 f x y z of+          MkFeatureData (Left l)  -> MkFeature $ MkFeatureData (Left l)+          MkFeatureData (Right r) -> r++instance Eval (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a)+              (Feature n4 e,   Feature n3 d,   Feature n2 c,   Feature n1 b)  (Feature n0 a)+   where+  eval (D4 f)  (MkFeature v, MkFeature x, MkFeature y, MkFeature z) = MkFeature $ liftM4 f v x y z+  eval (D4A f) (MkFeature v, MkFeature x, MkFeature y, MkFeature z) =+      case liftM4 f v x y z of           MkFeatureData (Left l)  -> MkFeature $ MkFeatureData (Left l)           MkFeatureData (Right r) -> r
src/Hasklepias.hs view
@@ -23,10 +23,11 @@     can be found on [hackage](https://hackage.haskell.org/package/interval-algebra).      -}-    , module FeatureEvents+    , module Hasklepias.FeatureEvents+    , module Hasklepias.Misc          -- * Specifying and building cohorts-    , module Hasklepias.Cohort+    , module Cohort      -- ** Creating an executable cohort application     , module Hasklepias.MakeApp@@ -47,10 +48,12 @@  import Features -import FeatureEvents+import Cohort++import Hasklepias.FeatureEvents+import Hasklepias.Misc import Hasklepias.Reexports import Hasklepias.ReexportsUnsafe-import Hasklepias.Cohort import Hasklepias.MakeApp  import Stype
− src/Hasklepias/Cohort.hs 
@@ -1,35 +0,0 @@-{-|-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 #-}--module Hasklepias.Cohort(--   -- * Defining Cohorts-      module Hasklepias.Cohort.Core--    -- ** Criteria-    , module Hasklepias.Cohort.Criteria-    -- ** Index-    , module Hasklepias.Cohort.Index--    -- * Cohort I/O-    -- ** Input-    , module Hasklepias.Cohort.Input   -    -- ** Output-    , module Hasklepias.Cohort.Output---) where---import Hasklepias.Cohort.Core-import Hasklepias.Cohort.Index-import Hasklepias.Cohort.Criteria-import Hasklepias.Cohort.Input-import Hasklepias.Cohort.Output
− src/Hasklepias/Cohort/Core.hs 
@@ -1,167 +0,0 @@-{-|-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 Hasklepias.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 Hasklepias.Cohort.Index              ( makeIndex, Index(..) )-import Hasklepias.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 (Eq, Show, Generic)--instance Functor Subject where-    fmap f (MkSubject (id, x)) = MkSubject (id, f x)--instance (FromJSON d) => FromJSON (Subject d) where---- | A population is a list of @'Subject'@s-newtype Population d = MkPopulation  [Subject d] -    deriving (Eq, Show, Generic)--instance Functor Population where-    fmap f (MkPopulation x) = MkPopulation (fmap (fmap f) x)--instance (FromJSON d) => FromJSON (Population d) where---- | An observational unit is what a subject may be transformed into.-data ObsUnit d = MkObsUnit {-        obsID :: ID-      , obsData :: d }-    deriving (Eq, Show, Generic)---- | A container for CohortData-newtype CohortData d = MkCohortData { getObsData :: [ObsUnit d] }-    deriving (Eq, Show, 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 (Eq, Show, Generic)---- | Gets the attrition info from a cohort-getAttritionInfo :: Cohort d -> Maybe AttritionInfo-getAttritionInfo (MkCohort (x, _)) = x---- | Unpacks a @'Population'@ to a list of subjects.-getPopulation :: Population d -> [Subject d]-getPopulation (MkPopulation x) = x---- | Gets the data out of  a @'Subject'@.-getSubjectData :: Subject d -> d-getSubjectData (MkSubject (_, x)) = x---- | Tranforms a @'Subject'@ into a @'ObsUnit'@.-makeObsUnitFeatures :: (d1 -> d0) -> Subject d1 -> ObsUnit d0-makeObsUnitFeatures f (MkSubject (id, dat)) = MkObsUnit id (f 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-        { runCriteria:: d1 -> Criteria-        -- (Feature (Index i a))-        , runFeatures:: d1 -> d0 }---- | Creates a @'CohortSpec'@.-specifyCohort :: (d1 -> Criteria) -> (d1 -> d0) ->  CohortSpec d1 d0-specifyCohort = 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 (MkCohortSpec runCrit _) (MkPopulation pop) = fmap (fmap runCrit) pop---- | Convert a list of @Subject Criteria@ into a list of @Subject CohortStatus@-evalCohortStatus :: [Subject Criteria] -> [Subject CohortStatus]-evalCohortStatus = fmap (fmap 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 f (MkSubject (id, status)) subjData =-    case status of-        Included     -> Just $ makeObsUnitFeatures f subjData-        ExcludedBy _ -> Nothing---- | A type which collects the counts of subjects included or excluded.-newtype AttritionInfo = MkAttritionInfo (NonEmpty (CohortStatus, Natural))-    deriving (Eq, Show, Generic)---- | Initializes @AttritionInfo@ from a @'Criteria'@.-initAttritionInfo :: Criteria -> AttritionInfo-initAttritionInfo x =-    MkAttritionInfo $ zip (initStatusInfo x) -        (0 :| replicate (length (getCriteria x)) 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 l = fmap MkAttritionInfo $ nonEmpty $ Map.toList $-     Map.fromListWith (+) $ fmap (\x -> (getSubjectData x, 1)) l---- | The internal function to evaluate a @'CohortSpec'@ on a @'Population'@. -evalUnits :: CohortSpec d1 d0 -> Population d1 -> (Maybe AttritionInfo, CohortData d0)-evalUnits spec pop =-    ( measureAttrition statuses-    , MkCohortData $ catMaybes $ zipWith (evalSubjectCohort (runFeatures spec))-                                statuses-                                (getPopulation pop))-    where crits = evalCriteria spec pop-          statuses = evalCohortStatus crits---- | Evaluates a @'CohortSpec'@ on a @'Population'@.-evalCohort :: CohortSpec d1 d0 -> Population d1 -> Cohort d0-evalCohort s p = MkCohort $ evalUnits s p---- | Get IDs from a cohort.-getCohortIDs :: Cohort d -> [ID]-getCohortIDs (MkCohort (_, dat)) = fmap obsID ( getObsData dat )---- | Get data from a cohort.-getCohortData :: Cohort d -> [d]-getCohortData (MkCohort (_, dat)) = fmap obsData ( getObsData dat )
− src/Hasklepias/Cohort/Criteria.hs 
@@ -1,144 +0,0 @@-{-|-Module      : Cohort Criteria-Description : Defines the Criteria and related types and functions-Copyright   : (c) NoviSci, Inc 2020-License     : BSD3-Maintainer  : bsaul@novisci.com--}-{-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE Safe #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TupleSections #-}--module Hasklepias.Cohort.Criteria(-      Criterion-    , Criteria(..)-    , Status(..)-    , CohortStatus(..)-    , criterion-    , criteria-    , excludeIf-    , includeIf-    , initStatusInfo-    , checkCohortStatus-) where--import safe GHC.Generics                ( Generic )-import safe GHC.Num                     ( Num((+)), Natural )-import safe GHC.Show                    ( Show(show) )-import safe GHC.TypeLits                ( KnownSymbol, symbolVal )-import safe Control.Applicative         ( Applicative(pure) )-import safe Control.Monad               ( Functor(..) )-import safe Data.Bifunctor              ( Bifunctor(second) )-import safe Data.Bool                   ( Bool(..), otherwise, not, (&&) )-import safe Data.Either                 ( either )-import safe Data.Eq                     ( Eq(..) )-import safe Data.Function               ( ($), (.), const, id )-import safe qualified Data.List.NonEmpty as NE-                                        ( NonEmpty, zip, fromList, toList, map )-import safe Data.List                   ( find, (++) )-import safe Data.Maybe                  ( Maybe(..), maybe )-import safe Data.Ord                    ( Ord(..), Ordering(..) )-import safe Data.Semigroup              ( Semigroup((<>)) )-import safe Data.Tuple                  ( fst, snd )-import safe Data.Text                   ( Text, pack )-import safe Features.Compose            ( getFeatureData-                                        , Feature-                                        , nameFeature-                                        , FeatureN(..) )---- | Defines the return type for @'Criterion'@ indicating whether to include or --- exclude a subject.-data Status = Include | Exclude deriving (Eq, Show)---- | Defines subject's diposition in a cohort either included or which criterion--- they were excluded by. See @'checkCohortStatus'@ for evaluating a @'Criteria'@--- to determine CohortStatus.-data CohortStatus =-  Included | ExcludedBy (Natural, Text)-    deriving (Eq, Show, Generic)---- Defines an ordering to put @Included@ last in a container of @'CohortStatus'@.--- The @'ExcludedBy'@ are ordered by their number value.-instance Ord CohortStatus where-  compare Included Included = EQ-  compare Included (ExcludedBy _) = GT-  compare (ExcludedBy _) Included = LT-  compare (ExcludedBy (i, _)) (ExcludedBy (j, _)) = compare i j---- | Helper to convert a @Bool@ to a @'Status'@--- --- >>> includeIf True--- >>> includeIf False--- Include--- Exclude-includeIf :: Bool -> Status-includeIf True  = Include-includeIf False = Exclude---- | Helper to convert a @Bool@ to a @'Status'@--- --- >>> excludeIf True--- >>> excludeIf False--- Exclude--- Include-excludeIf :: Bool -> Status-excludeIf True  = Exclude-excludeIf False = Include---- | A type that is simply a @'FeatureN Status'@, that is, a feature that --- identifies whether to @'Include'@ or @'Exclude'@ a subject.-newtype Criterion = MkCriterion ( FeatureN Status ) deriving (Eq, Show)---- | Converts a @'Feature'@ to a @'Criterion'@.-criterion :: (KnownSymbol n) => Feature n Status -> Criterion-criterion x = MkCriterion (nameFeature x)---- | A nonempty collection of @'Criterion'@ paired with a @Natural@ number.-newtype Criteria = MkCriteria {-    getCriteria :: NE.NonEmpty (Natural, Criterion)-  } deriving (Eq, Show)---- | Constructs a @'Criteria'@ from a @'NE.NonEmpty'@ collection of @'Criterion'@.-criteria :: NE.NonEmpty Criterion -> Criteria-criteria l = MkCriteria $ NE.zip (NE.fromList [1..]) l---- | Unpacks a @'Criterion'@ into a (Text, Status) pair where the text is the--- name of the criterion and its @Status@ is the value of the status in the --- @'Criterion'@. In the case, that the value of the @'FeatureData'@ within the --- @'Criterion'@ is @Left@, the status is set to @'Exclude'@. -getStatus :: Criterion -> (Text, Status)-getStatus (MkCriterion x) =-  either (const (nm, Exclude)) (nm,) ((getFeatureData . getDataN) x)-    where nm = getNameN x---- | Converts a subject's @'Criteria'@ into a @'NE.NonEmpty'@ triple of --- (order of criterion, name of criterion, status)-getStatuses ::-  Criteria -> NE.NonEmpty (Natural, Text, Status)-getStatuses (MkCriteria x) =-  fmap (\c -> (fst c, (fst.getStatus.snd) c, (snd.getStatus.snd) c)) x---- | An internal function used to @'Data.List.find'@ excluded statuses. Used in--- 'checkCohortStatus'.-findExclude ::-  Criteria -> Maybe (Natural, Text, Status)-findExclude x =  find (\(_, _, z) -> z == Exclude) (getStatuses x)---- | Converts a subject's @'Criteria'@ to a @'CohortStatus'@. The status is set--- to @'Included'@ if none of the @'Criterion'@ have a status of @'Exclude'@.-checkCohortStatus ::-  Criteria -> CohortStatus-checkCohortStatus x =-    maybe Included (\(i, n, _) -> ExcludedBy (i, n)) (findExclude x)---- | Utility to get the name of a @'Criterion'@.-getCriterionName :: Criterion -> Text-getCriterionName (MkCriterion x) = getNameN x---- | Initializes a container of @'CohortStatus'@ from a @'Criteria'@. This can be used--- to collect generate all the possible Exclusion/Inclusion reasons. -initStatusInfo :: Criteria -> NE.NonEmpty CohortStatus-initStatusInfo (MkCriteria z) =-   NE.map (ExcludedBy . Data.Bifunctor.second getCriterionName) z <> pure Included
− src/Hasklepias/Cohort/Index.hs 
@@ -1,39 +0,0 @@-{-|-Module      : Cohort Index -Description : Defines the Index and related types and functions-Copyright   : (c) NoviSci, Inc 2020-License     : BSD3-Maintainer  : bsaul@novisci.com--}--{-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE DeriveGeneric #-}--- {-# LANGUAGE Safe #-}--module Hasklepias.Cohort.Index(-    Index-  , makeIndex-  , getIndex-) where--import  GHC.Show                    ( Show )-import GHC.Generics-import  Data.Eq                     ( Eq )-import  IntervalAlgebra             ( Intervallic )-import Data.Aeson--{-|-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.--}--newtype Index i a = MkIndex { -    getIndex :: i a -- ^ Unwrap an @Index@-  } deriving (Eq, Show, Generic)---- | Creates a new @'Index'@.-makeIndex :: Intervallic i a => i a -> Index i a-makeIndex = MkIndex--instance (Intervallic i a, ToJSON (i a)) => ToJSON (Index i a)
− src/Hasklepias/Cohort/Input.hs 
@@ -1,97 +0,0 @@-{-|-Module      : Functions for Parsing Hasklepias populations -Description : Defines FromJSON instances for Hasklepias populations .-Copyright   : (c) NoviSci, Inc 2020-License     : BSD3-Maintainer  : bsaul@novisci.com--}-{-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TupleSections #-}--module Hasklepias.Cohort.Input(-      parsePopulationLines-    , parsePopulationIntLines-    , parsePopulationDayLines-    , ParseError(..)-) where--import Control.Applicative                  ( Applicative((<*>)), (<$>) )-import Data.Aeson                           ( FromJSON(..)-                                            , ToJSON(..)-                                            , eitherDecode-                                            , Value(Array))-import qualified Data.ByteString.Lazy as B  ( fromStrict-                                            , toStrict-                                            , ByteString)-import qualified Data.ByteString.Char8 as C ( lines )-import Prelude                              (-                                             String)-import Data.Bifunctor                       ( Bifunctor(first) )-import Data.Either                          ( Either(..)-                                            , partitionEithers )-import Data.Eq                              ( Eq )-import Data.Function                        ( ($), id )                                        -import Data.Functor                         ( Functor(fmap) )-import Data.List                            ( sort, (++), zipWith )-import qualified Data.Map.Strict as M       ( toList, fromListWith)-import Data.Ord                             ( Ord )-import Data.Text                            (Text, pack)-import Data.Time.Calendar                   ( Day )-import Data.Vector                          ( (!) )-import EventData                            ( Events, event, Event )-import EventData.Aeson                      ()-import Hasklepias.Cohort.Core               ( Population(..)-                                            , ID-                                            , Subject(MkSubject) )-import GHC.Int                              ( Int )-import GHC.Num                              ( Natural )-import GHC.Show                             ( Show )-import IntervalAlgebra                      ( IntervalSizeable )---newtype SubjectEvent a = MkSubjectEvent (ID, Event a)--subjectEvent :: ID -> Event a -> SubjectEvent a-subjectEvent x y = MkSubjectEvent (x, y)--instance (FromJSON a, Show a, IntervalSizeable a b) => FromJSON (SubjectEvent a) where-    parseJSON (Array v) = subjectEvent <$>-        parseJSON (v ! 0) <*> (event <$> parseJSON (v ! 5) <*> parseJSON (Array v))--mapIntoPop :: (Ord a) => [SubjectEvent a] -> Population (Events a)-mapIntoPop l = MkPopulation $-    fmap (\(id, es) -> MkSubject (id, sort es)) -- TODO: is there a way to avoid the sort?-        (M.toList $ M.fromListWith (++) -        (fmap (\(MkSubjectEvent (id, e)) -> (id, [e])) l ))--decodeIntoSubj :: (FromJSON a, Show a, IntervalSizeable a b) => -        B.ByteString  -> Either Text (SubjectEvent a)-decodeIntoSubj x = first pack $ eitherDecode x ---- | Contains the line number and error message.-newtype ParseError = MkParseError (Natural, Text) deriving (Eq, Show)---- |  Parse @Event Int@ from json lines.-parseSubjectLines ::-    (FromJSON a, Show a, IntervalSizeable a b) =>-        B.ByteString -> ( [ParseError], [SubjectEvent a] )-parseSubjectLines l =-    partitionEithers $ zipWith-      (\x i -> first (\t -> MkParseError (i,t)) (decodeIntoSubj $ B.fromStrict x) )-      (C.lines $ B.toStrict l)-      [1..]---- |  Parse @Event Int@ from json lines.-parsePopulationLines :: (FromJSON a, Show a, IntervalSizeable a b) => -    B.ByteString -> ([ParseError], Population (Events a))-parsePopulationLines x = fmap mapIntoPop (parseSubjectLines x)---- |  Parse @Event Int@ from json lines.-parsePopulationIntLines :: B.ByteString -> ([ParseError], Population (Events Int))-parsePopulationIntLines x = fmap mapIntoPop (parseSubjectLines x)---- |  Parse @Event Day@ from json lines.-parsePopulationDayLines :: B.ByteString -> ([ParseError], Population (Events Day))-parsePopulationDayLines x = fmap mapIntoPop (parseSubjectLines x)
− src/Hasklepias/Cohort/Output.hs 
@@ -1,120 +0,0 @@-{-|-Module      : Hasklepias Cohorts-Description : Defines the options for outputting a cohort-Copyright   : (c) NoviSci, Inc 2020-License     : BSD3-Maintainer  : bsaul@novisci.com--}-{-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE DeriveAnyClass #-}--module Hasklepias.Cohort.Output(-    CohortShape-  , ShapeCohort(..)-  , toJSONCohortShape-) where--import Data.Aeson                           ( ToJSON(..)-                                            , Value-                                            , object-                                            , (.=) )-import Data.Function                        ( (.) )-import Data.Functor                         ( Functor(fmap) )-import Data.List.NonEmpty as NE             ( NonEmpty(..)-                                            , head-                                            , fromList-                                            , zip )-import Data.Tuple                           ( uncurry )-import GHC.Generics                         ( Generic )-import GHC.Types                            ( Type )-import GHC.Show                             ( Show )-import Hasklepias.Cohort.Core               ( AttritionInfo,-                                              Cohort,-                                              ObsUnit,-                                              ID,-                                              CohortData,-                                              getCohortData,-                                              getCohortIDs )-import Hasklepias.Cohort.Criteria           ( CohortStatus )-import Features.Featureset                  ( FeaturesetList(MkFeaturesetList)-                                            , Featureset-                                            , getFeatureset-                                            , getFeaturesetList-                                            , tpose )-import Features.Output                      ( ShapeOutput(dataOnly, nameAttr)-                                            , OutputShape )--instance (ToJSON d) => ToJSON (ObsUnit d) where-instance (ToJSON d) => ToJSON (CohortData d) where-instance (ToJSON d) => ToJSON (Cohort d) where-instance ToJSON CohortStatus where-instance ToJSON AttritionInfo where---- | A type used to determine the output shape of a Cohort.-data CohortShape d where-  ColumnWise :: (Show a, ToJSON a) => a -> CohortShape ColumnWise-  RowWise :: (Show a, ToJSON a) => a -> CohortShape RowWise--deriving instance Show d => Show (CohortShape d)---- | Maps CohortShape into an Aeson Value. --- TODO: implement Generic and ToJSON instance of CohortShape directly.-toJSONCohortShape :: CohortShape shape -> Value-toJSONCohortShape (ColumnWise x) = toJSON x-toJSONCohortShape (RowWise x)    = toJSON x--class ShapeCohort d where-  colWise :: Cohort d -> CohortShape ColumnWise-  rowWise :: Cohort d -> CohortShape RowWise--instance ShapeCohort Featureset where-  colWise x = ColumnWise (shapeColumnWise x)-  rowWise x = RowWise (shapeRowWise x)--data ColumnWise = MkColumnWise {-    colAttributes :: NonEmpty (OutputShape Type)-  , ids     :: [ID]-  , colData :: NonEmpty (NonEmpty (OutputShape Type))-  } deriving ( Show, Generic )--instance ToJSON ColumnWise where-  toJSON x = object [ "attributes" .= colAttributes x-                    , "ids"        .= ids x-                    , "data"       .= colData x ]--newtype IDRow = MkIDRow (ID, NonEmpty (OutputShape Type))-  deriving ( Show, Generic )--instance ToJSON IDRow where-  toJSON (MkIDRow x) = object [ uncurry (.=) x]--data RowWise = MkRowWise {-    attributes :: NonEmpty (OutputShape Type)-  , rowData :: NonEmpty IDRow-  } deriving ( Show, Generic )--instance ToJSON RowWise where-  toJSON x = object [ "attributes" .= attributes x-                    , "data"       .= rowData x ]--shapeColumnWise :: Cohort Featureset -> ColumnWise-shapeColumnWise x = MkColumnWise-        (fmap (nameAttr . NE.head . getFeatureset) z)-        (getCohortIDs x)-        (fmap (fmap dataOnly . getFeatureset)  z)-        -- TODO: don't use fromList; do something more principled-        where z = getFeaturesetList (tpose (MkFeaturesetList (NE.fromList (getCohortData x))))--shapeRowWise :: Cohort Featureset -> RowWise-shapeRowWise x = MkRowWise-        (fmap (nameAttr . NE.head . getFeatureset) z)-        (fmap MkIDRow (zip ids (fmap (fmap dataOnly . getFeatureset) z)))-        -- TODO: don't use fromList; do something more principled-        where z = NE.fromList (getCohortData x)-              ids = fromList (getCohortIDs x)
+ src/Hasklepias/FeatureEvents.hs view
@@ -0,0 +1,269 @@+{-|+Module      : Functions for composing features from events  +Description : Functions for composing features. +Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com++Provides functions used in defining @'Features.Feature'@ from +@'EventData.Event'@s.+-}+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Hasklepias.FeatureEvents(+    -- ** Container predicates+      isNotEmpty+    , atleastNofX+    , anyGapsWithinAtLeastDuration+    , allGapsWithinLessThanDuration++    -- **  Finding occurrences of concepts+    , nthConceptOccurrence+    , firstConceptOccurrence++    -- ** Reshaping containers+    , allPairs+    , splitByConcepts++    -- ** Create filters+    , makeConceptsFilter+    , makePairedFilter++    -- ** Functions for working with Event Domains+    , viewBirthYears+    , previewBirthYear++    -- ** Function for manipulating intervals+    , lookback+    , lookahead++    -- ** Misc functions+    , computeAgeAt+) where+++import IntervalAlgebra                      ( Intervallic+                                            , IntervalSizeable(..)+                                            , ComparativePredicateOf1+                                            , ComparativePredicateOf2+                                            , Interval+                                            , IntervalCombinable+                                            , begin+                                            , end+                                            , beginerval+                                            , enderval )+import IntervalAlgebra.PairedInterval       ( PairedInterval, getPairData )+import IntervalAlgebra.IntervalUtilities    ( durations, gapsWithin )+import EventData                            ( Events+                                            , Event+                                            , ConceptEvent+                                            , ctxt )+import EventData.Context                    ( Concept+                                            , Concepts+                                            , Context+                                            , HasConcept( hasConcepts )+                                            , facts )+import EventData.Context.Domain             ( Domain+                                            , demo+                                            , info+                                            , _Demographics )+import Safe                                 ( headMay, lastMay )+import Control.Applicative                  ( Applicative(liftA2) )+import Control.Monad                        ( Functor(fmap), (=<<) )+import Control.Lens                         ( preview, (^.) )+import Data.Bool                            ( Bool(..), (&&), not, (||) )+import Data.Either                          ( either )+import Data.Eq                              ( Eq )+import Data.Foldable                        ( Foldable(length, null)+                                            , all+                                            , any+                                            , toList )+import Data.Function                        ( (.), ($), const )+import Data.Functor                         ( Functor(fmap) )+import Data.Int                             ( Int )+import Data.Maybe                           ( Maybe(..), maybe, mapMaybe )+import Data.Monoid                          ( Monoid )+import Data.Ord                             ( Ord(..) )+import Data.Time.Calendar                   ( Day, Year, diffDays )+import Data.Text                            ( Text )+import Data.Text.Read                       ( rational )+import Data.Tuple                           ( fst )+import Witherable                           ( filter, Filterable, Witherable )+import GHC.Num                              ( Integer, fromInteger )+import GHC.Real                             ( RealFrac(floor), (/) )++-- | Is the input list empty? +isNotEmpty :: [a] -> Bool+isNotEmpty = not.null++-- | Filter 'Events' to those that have any of the provided concepts.+makeConceptsFilter ::+    ( Filterable f ) => +       [Text]    -- ^ the list of concepts by which to filter +    -> f (Event a)+    -> f (Event a)+makeConceptsFilter cpts = filter (`hasConcepts` cpts)++-- | Filter 'Events' to a single @'Maybe' 'Event'@, based on a provided function,+--   with the provided concepts. For example, see 'firstConceptOccurrence' and+--  'lastConceptOccurrence'.+nthConceptOccurrence ::+    ( Filterable f ) => +       (f (Event a) -> Maybe (Event a)) -- ^ function used to select a single event+    -> [Text]+    -> f (Event a)+    -> Maybe (Event a)+nthConceptOccurrence f c = f.makeConceptsFilter c++-- | Finds the *first* occurrence of an 'Event' with at least one of the concepts.+--   Assumes the input 'Events' list is appropriately sorted.+firstConceptOccurrence ::+    ( Witherable f ) => +      [Text]+    -> f (Event a)+    -> Maybe (Event a)+firstConceptOccurrence = nthConceptOccurrence (headMay . toList)++-- | Finds the *last* occurrence of an 'Event' with at least one of the concepts.+--   Assumes the input 'Events' list is appropriately sorted.+lastConceptOccurrence ::+    ( Witherable f ) =>+      [Text]+    -> f (Event a)+    -> Maybe (Event a)+lastConceptOccurrence = nthConceptOccurrence (lastMay . toList)++-- | Does 'Events' have at least @n@ events with any of the Concept in @x@.+atleastNofX ::+      Int -- ^ n+   -> [Text] -- ^ x+   -> Events a -> Bool+atleastNofX n x es = length (makeConceptsFilter x es) >= n++-- | Takes a predicate of intervals and a predicate on the data part of a +--   paired interval to create a single predicate such that both input+--   predicates should hold.+makePairPredicate ::  Ord a =>+       ComparativePredicateOf2 (i0 a) ((PairedInterval b) a)+    -> i0 a+    -> (b -> Bool)+    -> (PairedInterval b a -> Bool)+makePairPredicate pi i pd x =  pi i x && pd (getPairData x)++-- | +makePairedFilter :: Ord a =>+       ComparativePredicateOf2 (i0 a) ((PairedInterval b) a)+    -> i0 a+    -> (b -> Bool)+    -> [PairedInterval b a]+    -> [PairedInterval b a]+makePairedFilter fi i fc = filter (makePairPredicate fi i fc)++-- | Generate all pair-wise combinations from two lists.+allPairs :: [a] -> [b] -> [(a, b)]+allPairs = liftA2 (,)++-- | 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.+splitByConcepts :: +    ( Filterable f ) =>+       [Text]+    -> [Text]+    -> f (Event a)+    -> (f (Event a), f (Event a))+splitByConcepts c1 c2 es = ( filter (`hasConcepts` c1) es+                           , filter (`hasConcepts` c2) es)++-- | Create a predicate function that checks whether within a provided spanning+--   interval, are there (e.g. any, all) gaps of (e.g. <, <=, >=, >) a specified+--   duration among  the input intervals?+makeGapsWithinPredicate ::+       ( Monoid (t (Interval a))+       , Monoid (t (Maybe (Interval a)))+       , Applicative t+       , Witherable t+       , IntervalSizeable a b+       , IntervalCombinable i0 a+       , IntervalCombinable i1 a) =>+          ((b -> Bool) ->  t b -> Bool)+        -> (b -> b -> Bool)+        -> (b -> i0 a -> t (i1 a) -> Bool)+makeGapsWithinPredicate f op gapDuration interval l =+     maybe False (f (`op` gapDuration) . durations) (gapsWithin interval l)++-- | Within a provided spanning interval, are there any gaps of at least the+--   specified duration among the input intervals?+anyGapsWithinAtLeastDuration ::+      ( IntervalSizeable a b+      , IntervalCombinable 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+anyGapsWithinAtLeastDuration = makeGapsWithinPredicate any (>=)++-- | 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+allGapsWithinLessThanDuration ::+      ( IntervalSizeable a b+      , IntervalCombinable 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+allGapsWithinLessThanDuration = makeGapsWithinPredicate all (<)++-- | Utility for reading text into a maybe integer+intMayMap :: Text -> Maybe Integer -- TODO: this is ridiculous+intMayMap x = fmap floor (either (const Nothing) (Just . fst) (Data.Text.Read.rational x))++-- | Preview birth year from a domain+previewBirthYear :: Domain -> Maybe Year+previewBirthYear dmn = intMayMap =<< ((^.demo.info) =<< preview _Demographics dmn)++-- | Returns a (possibly emtpy) list of birth years from a set of events+viewBirthYears :: Events a -> [Year]+viewBirthYears = mapMaybe (\e -> previewBirthYear =<< Just (ctxt e^.facts ))++-- | Compute the "age" in years between two calendar days. The difference between+--   the days is rounded down.+computeAgeAt :: Day -> Day -> Integer+computeAgeAt bd at = floor (fromInteger (diffDays at bd) / 365.25)++-- | 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)+lookback :: (Intervallic i a, IntervalSizeable a b) =>+    b   -- ^ lookback duration+    -> i a+    -> Interval a+lookback d x = enderval d (begin x)++-- | 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)+lookahead :: (Intervallic i a, IntervalSizeable a b) =>+    b   -- ^ lookahead duration+    -> i a+    -> Interval a+lookahead d x = beginerval d (end x)+
src/Hasklepias/MakeApp.hs view
@@ -36,7 +36,7 @@ import GHC.IO                               ( IO )  import EventData                            ( Events )-import Hasklepias.Cohort+import Cohort import IntervalAlgebra                      ( IntervalSizeable )  import Control.Monad.IO.Class               (MonadIO, liftIO)
+ src/Hasklepias/Misc.hs view
@@ -0,0 +1,89 @@+{-|+Module      : Misc types and functions +Description : Misc types and functions useful in Hasklepias.+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com++These functions may be moved to more appropriate modules in future versions.+-}+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DeriveGeneric #-}++module Hasklepias.Misc (+    F+  , Def+  , Occurrence(..)+  , makeOccurrence+  , getOccurrenceReason+  , getOccurrenceTime+  , CensoringReason(..)+  , OccurrenceReason(..)+  , CensoredOccurrence(..)+  , adminCensor++) where++import Features.Compose           ( Feature, Definition )+import Data.Bool                  ( otherwise, (&&) )+import Data.Eq                    ( Eq(..) )+import Data.Ord                   ( Ord(..), Ordering(..) )+import Data.Semigroup             ( Semigroup((<>)) )+import GHC.Generics               ( Generic )+import GHC.Show                   ( Show(..) )+import Stype.Numeric.Censored     ( MaybeCensored(..) )+import Stype.Numeric.Continuous   ( EventTime )++-- | Type synonym for 'Feature'.+type F n a = Feature n a++-- | Type synonym for 'Definition'.+type Def d = Definition d++-- | A simple typeclass for making a type a "reason" for an event.+class (Ord a, Show a) => OccurrenceReason a where++-- | A type containing the time and when something occurred+newtype Occurrence what when = MkOccurrence ( what , EventTime when )+  deriving (Eq, Show, Generic)++-- | Create an 'Occurrence'+makeOccurrence :: (OccurrenceReason what) => +  what -> EventTime b -> Occurrence what b+makeOccurrence r t = MkOccurrence (r , t)++-- | Get the reason for an 'Occurrence'.+getOccurrenceReason :: Occurrence what b -> what +getOccurrenceReason (MkOccurrence (r, t)) = r++-- | Get the time of an 'Occurrence'.+getOccurrenceTime :: Occurrence what b -> EventTime b +getOccurrenceTime (MkOccurrence (r, t)) = t++-- Define a custom ordering based on times and then reasons.+instance (OccurrenceReason r, Ord b) => Ord (Occurrence r b) where+  compare (MkOccurrence (r1, t1)) (MkOccurrence (r2, t2))+    | t1 < t2 = LT+    | t1 == t2 && r1 < r2 = LT+    | t1 == t2 && r1 == r2 = EQ+    | otherwise = GT++-- | Sum type for possible censoring and outcome reasons, including administrative+--   censoring.+data CensoringReason cr or = AdminCensor | C cr | O or+  deriving (Eq, Show, Generic)++-- | A type to represent censored 'Occurrence'.+data CensoredOccurrence censors outcomes b = MkCensoredOccurrence {+    reason :: CensoringReason censors outcomes+  , time   :: MaybeCensored ( EventTime b )}+  deriving (Eq, Generic)++instance (OccurrenceReason c, OccurrenceReason o, Show b) => +  Show ( CensoredOccurrence c o b ) where+  show (MkCensoredOccurrence r t) = "(" <> show t <> ", " <> show r <> ")"++-- | Creates an administratively censored occurrence.+adminCensor :: EventTime b -> CensoredOccurrence c o b+adminCensor t = MkCensoredOccurrence AdminCensor ( RightCensored t )
src/Hasklepias/Reexports.hs view
@@ -13,22 +13,26 @@      -- * Re-exports       module GHC.Num+    , module GHC.Real     , module GHC.Generics     , module GHC.Show     , module GHC.TypeLits     , module Control.Monad     , module Control.Applicative+    , module Data.Bifunctor     , module Data.Bool     , module Data.Either     , module Data.Eq     , module Data.Int     , module Data.Maybe     , module Data.Monoid+    , module Data.Foldable     , module Data.Function-    , module Data.Functor     , module Data.List     , module Data.List.NonEmpty     , module Data.Ord+    , module Data.Proxy+    , module Set     , module Data.Time.Calendar      , module Data.Text     , module Data.Tuple@@ -42,21 +46,32 @@     , module Witherable ) where -import safe GHC.Num                         ( Integer )+import safe GHC.Num                         ( Integer(..)+                                            , Num(..)+                                            , Natural(..) )+import safe GHC.Real                        ( Integral(..), toInteger ) import safe GHC.Generics                    ( Generic ) import safe GHC.Show                        ( Show(..) )-import safe GHC.TypeLits                    ( KnownSymbol )-import safe Control.Monad                   ( Functor(fmap), Monad(..) )+import safe GHC.TypeLits                    ( KnownSymbol(..)+                                            , symbolVal ) import safe Control.Applicative             ( (<$>), Applicative(..) )+import safe Control.Monad                   ( Functor(..)+                                            , Monad(..)+                                            , join+                                            , (>>=)+                                            , (=<<) )+import safe Data.Bifunctor                  ( Bifunctor(..) ) import safe Data.Bool                       ( Bool(..)                                             , (&&), not, (||)                                             , bool                                             , otherwise ) import safe Data.Either                     ( Either(..)) import safe Data.Eq                         ( Eq, (==))-import safe Data.Function                   ( (.), ($), const, id )-import safe Data.Functor                    ( fmap )-import safe Data.Int                        ( Int )+import safe Data.Foldable                   ( Foldable(..)+                                            , minimum+                                            , maximum )+import safe Data.Function                   ( (.), ($), const, id, flip )+import safe Data.Int                        ( Int(..) ) import safe Data.List                       ( all                                             , any                                             , map@@ -79,8 +94,11 @@                                               mapMaybe,                                               maybeToList ) import safe Data.Monoid                     ( Monoid(..), (<>) )-import safe Data.Ord                        ( Ord((>=), (<), (>), (<=))+import safe Data.Ord                        ( Ord(..)+                                            , Ordering(..)                                             , max, min )+import safe Data.Proxy                      ( Proxy(..) )+import safe Data.Set as Set                 ( Set(..), fromList, member) import safe Data.Time.Calendar              ( Day, MonthOfYear, Year                                             , CalendarDiffDays(..)                                             , addGregorianDurationClip@@ -94,6 +112,6 @@ import safe IntervalAlgebra.IntervalUtilities import safe IntervalAlgebra.PairedInterval -import safe Witherable                      ( Filterable(filter) )+import safe Witherable                      ( Filterable(filter), Witherable ) import safe Flow                            ( (!>), (.>), (<!), (<.), (<|), (|>) ) import Safe                                 ( headMay, lastMay )
+ test/Cohort/CoreSpec.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}++module Cohort.CoreSpec (+  spec+ ) where++import Features+import Cohort+import Data.List.NonEmpty+import Test.Hspec ( describe, pending, shouldBe, it, Spec )++-- data Feat1++d1 :: Definition (Feature "feat" Int -> Feature "feat1" Bool)+d1 =+    defineA+    (\x ->+      if x < 0 then+        makeFeature $ featureDataL $ Other "at least 1 < 0"+      else+        pure ((x + 1) == 5)+    )+++d2 :: Definition (Feature "feat" Int -> Feature "feat2" Status)+d2 = define (\x -> includeIf (x*2 > 4))++d3 :: Definition (Feature "feat" Int -> Feature  "feat3" Int)+d3 = define (+ 2)+++testSubject1 :: Subject Int+testSubject1 = MkSubject ("1", 0)+testSubject2 :: Subject Int+testSubject2 = MkSubject ("2", 54)++testPopulation :: Population Int+testPopulation = MkPopulation [testSubject1, testSubject2]++buildCriteria :: Int -> Criteria+buildCriteria dat = criteria $ pure ( criterion feat1 )+  where feat1 = eval d2 $ pure dat++type Features = (Feature "feat1" Bool, Feature "feat3" Int)+buildFeatures :: Int -> Features+buildFeatures dat  =+    ( eval d1 input+    , eval d3 input+    )+    where input = pure dat++testCohort :: CohortSpec Int Features+testCohort = specifyCohort buildCriteria buildFeatures++testOut :: Cohort Features+testOut = MkCohort+  ( Just $ MkAttritionInfo $ (ExcludedBy (1, "feat2"), 1) :| [ (Included, 1) ]+  , MkCohortData [MkObsUnit "2" +                  ( makeFeature (featureDataR False)+                  , makeFeature (featureDataR 56)) ])++-- evalCohort testCohort testPopulation+spec :: Spec+spec = do++  describe "checking d1" $+    do++      it "include f1" $+        evalCohort testCohort testPopulation `shouldBe` testOut+
+ test/Cohort/CriteriaSpec.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+module Cohort.CriteriaSpec (+  spec+ ) where++import Features+import Cohort.Criteria+import Test.Hspec ( describe, pending, shouldBe, it, Spec )+import Data.List.NonEmpty+++f1 :: Status -> Criterion +f1 s = criterion (makeFeature (featureDataR s) :: Feature "f1" Status)++f2 :: Status -> Criterion +f2 s = criterion (makeFeature  (featureDataR s) :: Feature "f2" Status)++f3 :: Status -> Criterion +f3 s = criterion (makeFeature (featureDataR s) :: Feature "f3" Status)++f4 :: Criterion +f4 = criterion ( makeFeature (featureDataL $ Other "something") :: Feature "f4" Status)++spec :: Spec+spec = do++  describe "checking d1" $+    do++      it "include f1" $+          checkCohortStatus (criteria $ pure (f1 Include)) `shouldBe` Included++      it "include f1, f2, f3" $+          checkCohortStatus (criteria $ f1 Include :| [f2 Include, f3 Include] ) +            `shouldBe` Included++      it "exclude on f2" $+          checkCohortStatus (criteria $ f2 Exclude :| [f3 Include]) +            `shouldBe` ExcludedBy (1, "f2")++      it "exclude on f2" $+          checkCohortStatus (criteria $ f1 Include :| [f2 Exclude, f3 Include]) +            `shouldBe` ExcludedBy (2, "f2")++      it "error on f4" $+          checkCohortStatus (criteria $ f1 Include :| [f2 Include, f3 Include, f4]) +            `shouldBe` ExcludedBy (4, "f4")
+ test/Cohort/InputSpec.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings #-}+module Cohort.InputSpec (spec) where++import IntervalAlgebra+import EventData+import Cohort+import EventData.Context as HC+import EventData.Context.Domain+import Data.Aeson+import Data.Maybe+import Data.Time as DT+import Test.Hspec+import qualified Data.ByteString.Lazy as B++++testInputsDay1 :: B.ByteString+testInputsDay1 =+      "[\"abc\", \"2020-01-01\", \"2020-01-02\", \"Diagnosis\",\+      \[\"someThing\"],\+      \{\"domain\":\"Diagnosis\",\+      \ \"time\":{\"begin\":\"2020-01-01\",\"end\":\"2020-01-02\"}}]\n\+      \[\"abc\", \"2020-01-05\", \"2020-01-06\", \"Diagnosis\",\+      \[\"someThing\"],\+      \{\"domain\":\"Diagnosis\",\+      \ \"time\":{\"begin\":\"2020-01-05\",\"end\":\"2020-01-06\"}}]"+++testInputsDay2 :: B.ByteString+testInputsDay2 =+      "[\"def\", \"2020-01-01\", null, \"Diagnosis\",\+      \[\"someThing\"],\+      \{\"domain\":\"Diagnosis\",\+      \ \"time\":{\"begin\":\"2020-01-01\",\"end\":\"2020-01-02\"}}]\n\+      \[\"def\", \"2020-01-05\", null, \"Diagnosis\",\+      \[\"someThing\"],\+      \{\"domain\":\"Diagnosis\",\+      \ \"time\":{\"begin\":\"2020-01-05\",\"end\":\"2020-01-06\"}}]"++testInputsDayBad :: B.ByteString+testInputsDayBad =+      "[\"ghi\", \"2020-01-01\", null, \"Diagnosis\",\+      \[\"someThing\"],\+      \{\"time\":{\"begin\":\"2020-01-01\",\"end\":\"2020-01-02\"}}]\n\+      \[\"ghi\", \"2020-01-05\", null, \"Diagnosis\",\+      \[\"someThing\"],\+      \{\"domain\":\"Diagnosis\",\+      \ \"time\":{\"begin\":\"2020-01-05\",\"end\":\"2020-01-04\"}}]"++testInput = testInputsDay1 <> "\n" <> testInputsDay2+++testOutDay1 = event (beginerval 1 (fromGregorian 2020 1 1))+               (HC.context ( UnimplementedDomain () ) (packConcepts ["someThing"]))+testOutDay2 = event (beginerval 1 (fromGregorian 2020 1 5))+               (HC.context ( UnimplementedDomain () ) (packConcepts [ "someThing"]))+++testOutPop = MkPopulation [+          MkSubject ("abc", [testOutDay1, testOutDay2])+        , MkSubject ("def", [testOutDay1, testOutDay2])+      ]++spec :: Spec+spec = do+    it "a population is parsed" $+       parsePopulationDayLines testInput `shouldBe` ([], testOutPop)++    it "a population is parsed" $+       parsePopulationDayLines (testInput <> "\n" <> testInputsDayBad)`shouldBe`+        ([MkParseError  (5, "Error in $: key \"domain\" not found")+        , MkParseError (6, "Error in $: 2020-01-04<2020-01-05")], testOutPop)
test/EventDataSpec.hs view
@@ -3,7 +3,7 @@  import IntervalAlgebra import IntervalAlgebra.IntervalUtilities-import FeatureEvents +import Hasklepias.FeatureEvents  import EventData import EventData.Context as HC import EventData.Context.Domain ( Domain(UnimplementedDomain) )
− test/FeatureEventsSpec.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE FlexibleContexts #-}-module FeatureEventsSpec (spec) where--import IntervalAlgebra-import FeatureEvents ( firstConceptOccurrence )-import EventData ( Event, event )-import EventData.Context as HC ( context, packConcepts )-import EventData.Context.Domain-import Data.Maybe-import Test.Hspec ( it, shouldBe, Spec )---- | Toy events for unit tests-evnt1 :: Event Int-evnt1 = event ( beginerval (4 :: Int) (1 :: Int) ) -        ( HC.context (UnimplementedDomain ()) (packConcepts ["c1", "c2"] ))-evnt2 :: Event Int-evnt2 = event ( beginerval (4 :: Int) (2 :: Int) )-         ( HC.context (UnimplementedDomain ())  (packConcepts ["c3", "c4"] ))-evnts :: [Event Int]-evnts = [evnt1, evnt2]--spec :: Spec-spec = do-    it "find first occurrence of c1" $-      firstConceptOccurrence ["c1"] evnts `shouldBe` Just evnt1-    it "find first occurrence of c3" $-      firstConceptOccurrence ["c3"] evnts `shouldBe` Just evnt2-    it "find first occurrence of c5" $-      firstConceptOccurrence ["c5"] evnts `shouldBe` Nothing
test/Features/OutputSpec.hs view
@@ -8,7 +8,7 @@ import IntervalAlgebra import EventData import EventData.Context-import FeatureEvents+import Hasklepias.FeatureEvents import Features import Data.Aeson (encode) import Data.Maybe
− test/Hasklepias/Cohort/CoreSpec.hs 
@@ -1,72 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DataKinds #-}--module Hasklepias.Cohort.CoreSpec (-  spec- ) where--import Features-import Hasklepias.Cohort-import Data.List.NonEmpty-import Test.Hspec ( describe, pending, shouldBe, it, Spec )---- data Feat1--d1 :: Definition (Feature "feat" Int -> Feature "feat1" Bool)-d1 =-    defineA-    (\x ->-      if x < 0 then-        makeFeature $ featureDataL $ Other "at least 1 < 0"-      else-        pure ((x + 1) == 5)-    )---d2 :: Definition (Feature "feat" Int -> Feature "feat2" Status)-d2 = define (\x -> includeIf (x*2 > 4))--d3 :: Definition (Feature "feat" Int -> Feature  "feat3" Int)-d3 = define (+ 2)---testSubject1 :: Subject Int-testSubject1 = MkSubject ("1", 0)-testSubject2 :: Subject Int-testSubject2 = MkSubject ("2", 54)--testPopulation :: Population Int-testPopulation = MkPopulation [testSubject1, testSubject2]--buildCriteria :: Int -> Criteria-buildCriteria dat = criteria $ pure ( criterion feat1 )-  where feat1 = eval d2 $ pure dat--type Features = (Feature "feat1" Bool, Feature "feat3" Int)-buildFeatures :: Int -> Features-buildFeatures dat  =-    ( eval d1 input-    , eval d3 input-    )-    where input = pure dat--testCohort :: CohortSpec Int Features-testCohort = specifyCohort buildCriteria buildFeatures--testOut :: Cohort Features-testOut = MkCohort-  ( Just $ MkAttritionInfo $ (ExcludedBy (1, "feat2"), 1) :| [ (Included, 1) ]-  , MkCohortData [MkObsUnit "2" -                  ( makeFeature (featureDataR False)-                  , makeFeature (featureDataR 56)) ])---- evalCohort testCohort testPopulation-spec :: Spec-spec = do--  describe "checking d1" $-    do--      it "include f1" $-        evalCohort testCohort testPopulation `shouldBe` testOut-
− test/Hasklepias/Cohort/CriteriaSpec.hs 
@@ -1,48 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DataKinds #-}-module Hasklepias.Cohort.CriteriaSpec (-  spec- ) where--import Features-import Hasklepias.Cohort.Criteria-import Test.Hspec ( describe, pending, shouldBe, it, Spec )-import Data.List.NonEmpty---f1 :: Status -> Criterion -f1 s = criterion (makeFeature (featureDataR s) :: Feature "f1" Status)--f2 :: Status -> Criterion -f2 s = criterion (makeFeature  (featureDataR s) :: Feature "f2" Status)--f3 :: Status -> Criterion -f3 s = criterion (makeFeature (featureDataR s) :: Feature "f3" Status)--f4 :: Criterion -f4 = criterion ( makeFeature (featureDataL $ Other "something") :: Feature "f4" Status)--spec :: Spec-spec = do--  describe "checking d1" $-    do--      it "include f1" $-          checkCohortStatus (criteria $ pure (f1 Include)) `shouldBe` Included--      it "include f1, f2, f3" $-          checkCohortStatus (criteria $ f1 Include :| [f2 Include, f3 Include] ) -            `shouldBe` Included--      it "exclude on f2" $-          checkCohortStatus (criteria $ f2 Exclude :| [f3 Include]) -            `shouldBe` ExcludedBy (1, "f2")--      it "exclude on f2" $-          checkCohortStatus (criteria $ f1 Include :| [f2 Exclude, f3 Include]) -            `shouldBe` ExcludedBy (2, "f2")--      it "error on f4" $-          checkCohortStatus (criteria $ f1 Include :| [f2 Include, f3 Include, f4]) -            `shouldBe` ExcludedBy (4, "f4")
− test/Hasklepias/Cohort/InputSpec.hs 
@@ -1,73 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Hasklepias.Cohort.InputSpec (spec) where--import IntervalAlgebra-import EventData--- import Hasklepias.Cohort.Aeson-import Hasklepias.Cohort-import EventData.Context as HC-import EventData.Context.Domain-import Data.Aeson-import Data.Maybe-import Data.Time as DT-import Test.Hspec-import qualified Data.ByteString.Lazy as B----testInputsDay1 :: B.ByteString-testInputsDay1 =-      "[\"abc\", \"2020-01-01\", \"2020-01-02\", \"Diagnosis\",\-      \[\"someThing\"],\-      \{\"domain\":\"Diagnosis\",\-      \ \"time\":{\"begin\":\"2020-01-01\",\"end\":\"2020-01-02\"}}]\n\-      \[\"abc\", \"2020-01-05\", \"2020-01-06\", \"Diagnosis\",\-      \[\"someThing\"],\-      \{\"domain\":\"Diagnosis\",\-      \ \"time\":{\"begin\":\"2020-01-05\",\"end\":\"2020-01-06\"}}]"---testInputsDay2 :: B.ByteString-testInputsDay2 =-      "[\"def\", \"2020-01-01\", null, \"Diagnosis\",\-      \[\"someThing\"],\-      \{\"domain\":\"Diagnosis\",\-      \ \"time\":{\"begin\":\"2020-01-01\",\"end\":\"2020-01-02\"}}]\n\-      \[\"def\", \"2020-01-05\", null, \"Diagnosis\",\-      \[\"someThing\"],\-      \{\"domain\":\"Diagnosis\",\-      \ \"time\":{\"begin\":\"2020-01-05\",\"end\":\"2020-01-06\"}}]"--testInputsDayBad :: B.ByteString-testInputsDayBad =-      "[\"ghi\", \"2020-01-01\", null, \"Diagnosis\",\-      \[\"someThing\"],\-      \{\"time\":{\"begin\":\"2020-01-01\",\"end\":\"2020-01-02\"}}]\n\-      \[\"ghi\", \"2020-01-05\", null, \"Diagnosis\",\-      \[\"someThing\"],\-      \{\"domain\":\"Diagnosis\",\-      \ \"time\":{\"begin\":\"2020-01-05\",\"end\":\"2020-01-04\"}}]"--testInput = testInputsDay1 <> "\n" <> testInputsDay2---testOutDay1 = event (beginerval 1 (fromGregorian 2020 1 1))-               (HC.context ( UnimplementedDomain () ) (packConcepts ["someThing"]))-testOutDay2 = event (beginerval 1 (fromGregorian 2020 1 5))-               (HC.context ( UnimplementedDomain () ) (packConcepts [ "someThing"]))---testOutPop = MkPopulation [-          MkSubject ("abc", [testOutDay1, testOutDay2])-        , MkSubject ("def", [testOutDay1, testOutDay2])-      ]--spec :: Spec-spec = do-    it "a population is parsed" $-       parsePopulationDayLines testInput `shouldBe` ([], testOutPop)--    it "a population is parsed" $-       parsePopulationDayLines (testInput <> "\n" <> testInputsDayBad)`shouldBe`-        ([MkParseError  (5, "Error in $: key \"domain\" not found")-        , MkParseError (6, "Error in $: 2020-01-04<2020-01-05")], testOutPop)
+ test/Hasklepias/FeatureEventsSpec.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+module Hasklepias.FeatureEventsSpec (spec) where++import IntervalAlgebra+import Hasklepias.FeatureEvents ( firstConceptOccurrence )+import EventData ( Event, event )+import EventData.Context as HC ( context, packConcepts )+import EventData.Context.Domain+import Data.Maybe+import Test.Hspec ( it, shouldBe, Spec )++-- | Toy events for unit tests+evnt1 :: Event Int+evnt1 = event ( beginerval (4 :: Int) (1 :: Int) ) +        ( HC.context (UnimplementedDomain ()) (packConcepts ["c1", "c2"] ))+evnt2 :: Event Int+evnt2 = event ( beginerval (4 :: Int) (2 :: Int) )+         ( HC.context (UnimplementedDomain ())  (packConcepts ["c3", "c4"] ))+evnts :: [Event Int]+evnts = [evnt1, evnt2]++spec :: Spec+spec = do+    it "find first occurrence of c1" $+      firstConceptOccurrence ["c1"] evnts `shouldBe` Just evnt1+    it "find first occurrence of c3" $+      firstConceptOccurrence ["c3"] evnts `shouldBe` Just evnt2+    it "find first occurrence of c5" $+      firstConceptOccurrence ["c5"] evnts `shouldBe` Nothing