hasklepias 0.12.0 → 0.13.0

raw patch · 17 files changed

+389/−18 lines, 17 filesdep +nonempty-containersdep +semiring-simple

Dependencies added: nonempty-containers, semiring-simple

Files

• ChangeLog.md +5/−0
• exampleApp/Main.hs +4/−0
• examples/ExampleCohort1.hs +16/−9
• hasklepias.cabal +11/−1
• src/FeatureCompose.hs +17/−1
• src/FeatureCompose/Aeson.hs +16/−7
• src/FeatureCompose/Attributes.hs +39/−0
• src/Hasklepias.hs +8/−0
• src/Stype.hs +19/−0
• src/Stype/Categorical.hs +14/−0
• src/Stype/Categorical/Nominal.hs +17/−0
• src/Stype/Numeric.hs +26/−0
• src/Stype/Numeric/Censored.hs +43/−0
• src/Stype/Numeric/Continuous.hs +53/−0
• src/Stype/Numeric/Count.hs +49/−0
• test/FeatureCompose/AesonSpec.hs +17/−0
• test/FeatureComposeSpec.hs +35/−0

@@ -1,5 +1,10 @@ # Changelog for hasklepias +## 0.13.0++* Adds a rudimentary `Attributes` type and `HasAttributes` typeclass for adding attributes to `Feature`s. This interfaces will likely change in the future, but for now users have the ability to add information like labels to a `Feature`. In fact, `Feature`s which are encoded to JSON are *required* to have attributes.+* Adds rudimentary `Stype` module in order to (ultimately) interface with the [R `stype` package](https://docs.novisci.com/stype/). For now, this module simply creates a few of the types, some of which are *not* an appropriate implementation. For example, the `Nominal` type is simply `newtype Nominal a = Nominal a`. Essentially, it's just a way to label something as nominal at this point.+ ## 0.12.0  * Converts `AttritionStatus` from a List to a NonEmpty container.

@@ -12,6 +12,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-} module Main(   main ) where@@ -36,6 +37,9 @@    ( Feature "allEvents" (Events Day)    -> Feature "dummy" Status) critTrue = define $ pure Include ++instance HasAttributes "dummy" Bool where+  getAttributes _ = MkAttributes "Text" "Text" "Text"  {-------------------------------------------------------------------------------   Cohort Specifications and evaluation

@@ -8,10 +8,11 @@  {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} module ExampleCohort1(   exampleCohort1tests ) where@@ -65,17 +66,18 @@ -------------------------------------------------------------------------------}  -- | Defines a feature that returns 'True' ('False' otherwise) if either:---   * at least 1 event during the baseline interval has any of the 'c1' concepts---   * there are at least 2 event that have 'c2' concepts which have at least+--   * at least 1 event during the baseline interval has any of the 'cpts1' concepts+--   * there are at least 2 event that have 'cpts2' concepts which have at least --     7 days between them during the baseline interval twoOutOneIn ::-       [Text]-    -> [Text]+       [Text] -- ^ cpts1+    -> [Text] -- ^ cpts2     -> Definition     ( Feature "calendarIndex" (Index Interval Day)     -> Feature "allEvents" (Events Day)     -> Feature name Bool )-twoOutOneIn cpts1 cpts2 = define+twoOutOneIn cpts1 cpts2 = +  define     (\index events ->         atleastNofX 1 cpts1  (getBaselineConcur index events)          || ( @@ -181,7 +183,6 @@ critFemale :: Definition  (   Feature "allEvents" (Events Day)   -> Feature "isFemale" Status)- critFemale =     define       (\events ->@@ -243,8 +244,6 @@         --  excludeIf ( maybe False (beforeIndex index) mDeadDay) -- different way to write logic       ) -- {-------------------------------------------------------------------------------   Covariate features -------------------------------------------------------------------------------}@@ -260,6 +259,14 @@  diabetes :: BoolFeatDef "diabetes" diabetes = twoOutOneIn ["is_diabetes_outpatient"] ["is_diabetes_inpatient"]++instance HasAttributes  "diabetes" Bool where+  getAttributes _ = MkAttributes +    "Has Diabetes"+    "Has Diabetes within baseline"+    "Has at least 1 event during the baseline interval has any of the 'cpts1' concepts \+    \ OR there are at least 2 event that have 'cpts2' concepts which have at least 7 days \+    \ between them during the baseline interval"  ckd :: BoolFeatDef "ckd" ckd =  twoOutOneIn ["is_ckd_outpatient"] ["is_ckd_inpatient"]

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           hasklepias-version:        0.12.0+version:        0.13.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@@ -31,6 +31,7 @@       EventData.Context.Domain.Demographics       FeatureCompose       FeatureCompose.Aeson+      FeatureCompose.Attributes       FeatureEvents       Hasklepias       Hasklepias.Aeson@@ -40,6 +41,13 @@       Hasklepias.Cohort       Hasklepias.Cohort.Criteria       Hasklepias.Cohort.Index+      Stype+      Stype.Numeric+      Stype.Numeric.Count+      Stype.Numeric.Continuous+      Stype.Numeric.Censored+      Stype.Categorical+      Stype.Categorical.Nominal   other-modules:       Paths_hasklepias   autogen-modules:@@ -59,8 +67,10 @@     , lens == 5.0.1     , lens-aeson == 1.1.1     , mtl == 2.2.2+    , nonempty-containers == 0.3.4.1     , process == 1.6.12.0     , safe >= 0.3+    , semiring-simple == 1.0.0.1     , tasty  == 1.4.1     , tasty-hunit == 0.10.0.3     , text == 1.2.4.1

@@ -33,6 +33,7 @@   , missingBecause   , makeFeature   , getFeatureData+  , getFData   , getData   , getDataN   , getNameN@@ -45,6 +46,7 @@   , Eval   , eval +  , HasAttributes(..) ) where  import safe Control.Applicative        ( Applicative(..)@@ -62,15 +64,17 @@ import safe GHC.Generics               ( Generic ) import safe GHC.Show                   ( Show(show) ) import safe GHC.TypeLits               ( KnownSymbol, Symbol, symbolVal )-+import safe FeatureCompose.Attributes {- |  Defines the reasons that a @'FeatureData'@ value may be missing. Can be used to indicate the reason that a @'Feature'@'s data was unable to be derived or does not need to be derived.  -}+{- tag::missingReason[] -} data MissingReason =     InsufficientData -- ^ Insufficient information available to derive data.   | Other Text -- ^ User provided reason for missingness+{- end::missingReason[] -}   deriving (Eq, Show, Generic)  {- | @@ -82,9 +86,11 @@ constructed with @'featureDataL'@ or its synonym @'missingBecause'@.  -}+{- tag::featureData[] -} newtype FeatureData d = MkFeatureData {      getFeatureData :: Either MissingReason d  -- ^ Unwrap FeatureData.   }+{- end::featureData[] -}   deriving (Eq, Show, Generic)  -- | Creates a non-missing 'FeatureData'. Since @'FeatureData'@ is an instance of@@ -165,8 +171,10 @@ Except when using @'pure'@ to lift data into a @Feature@, @Feature@s can only be derived from other @Feature@ via a @'Definition'@. -}+{- tag::feature[] -} newtype (KnownSymbol name) => Feature name d =   MkFeature { getFData :: FeatureData d }+{- end::feature[] -}   deriving (Eq)  -- | A utility for constructing a @'Feature'@ from @'FeatureData'@.@@ -370,3 +378,11 @@       case liftA3 f x y z of           MkFeatureData (Left l)  -> MkFeature $ MkFeatureData (Left l)           MkFeatureData (Right r) -> r++{- | Initializes @Feature@ @Attributes@ to empty strings -}++class HasAttributes n a where+  getAttributes :: Feature n a -> Attributes++-- instance HasAttributes name d where+--   getAttributes x = MkAttributes "" "" ""

@@ -9,6 +9,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}  module FeatureCompose.Aeson( ) where@@ -19,7 +20,9 @@                                     , MissingReason                                     , FeatureData                                     , getFeatureData-                                    , getData )+                                    , getFData+                                    , HasAttributes(..) )+import FeatureCompose.Attributes import Data.Aeson                   ( object, KeyValue((.=)), ToJSON(toJSON) ) import Data.Proxy                   ( Proxy(Proxy) ) @@ -28,13 +31,19 @@  instance ToJSON MissingReason -instance (ToJSON d)=> ToJSON (FeatureData d) where+instance (ToJSON d) => ToJSON (FeatureData d) where     toJSON  x = case getFeatureData x of       (Left l)  -> toJSON l       (Right r) -> toJSON r -instance (KnownSymbol n, ToJSON d) => ToJSON (Feature n d) where-    toJSON x = object [ --"name"   .= getName x-                         "name"  .= show (symbolVal (Proxy @n))-                      --  , "attrs" .= toJSON (getAttr x)-                       , "data"  .= toJSON (getData x) ]+instance ToJSON Attributes where++-- instance (KnownSymbol n, ToJSON d) => ToJSON (Feature n d) where+--     toJSON x = object [  "name"  .= show (symbolVal (Proxy @n))+--                       --  , "attrs" .= toJSON (getAttributes x)+--                        , "data"  .= toJSON (getFData x) ]++instance (KnownSymbol n, ToJSON d, HasAttributes n d) => ToJSON (Feature n d) where+    toJSON x = object [  "name"  .= show (symbolVal (Proxy @n))+                       , "attrs" .= toJSON (getAttributes x)+                       , "data"  .= toJSON (getFData x) ]

@@ -0,0 +1,39 @@+{-|+Module      : Functions for defining attributes Feature data+Description : Defines attributes instances for Features.+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com+-}+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveGeneric #-}++module FeatureCompose.Attributes(+    Attributes(..)+  -- , HasAttributes(..)+) where++import safe Data.Eq         ( Eq )+import safe Data.Text       ( Text )+import safe GHC.Show        ( Show )+import safe GHC.Generics    ( Generic )++{- |+A data type for holding attritbutes of Features. This type and the @HasAttributes@+are likely to change in future versions.+-}+data Attributes = MkAttributes { +    getShortLabel :: Text+  , getLongLabel :: Text+  , getDerivation :: Text+  } deriving (Eq, Show, Generic)++-- class HasAttributes a where+--   getAttributes :: a -> Attributes++

@@ -21,6 +21,8 @@     , module EventData.Arbitrary          , module FeatureCompose+    -- ** Adding Attributes to Features+    , module FeatureCompose.Attributes     -- ** Writing Features to JSON     , module FeatureCompose.Aeson @@ -41,6 +43,9 @@     -- ** Creating an executable cohort application     , module Hasklepias.MakeApp +    -- * Statistical Types+    , module Stype+     -- * Rexported Functions and modules     , module Hasklepias.Reexports     , module Hasklepias.ReexportsUnsafe@@ -58,6 +63,7 @@  import FeatureCompose import FeatureCompose.Aeson+import FeatureCompose.Attributes import FeatureEvents import Hasklepias.Reexports import Hasklepias.ReexportsUnsafe@@ -65,3 +71,5 @@ import Hasklepias.Cohort.Criteria import Hasklepias.Aeson import Hasklepias.MakeApp++import Stype

@@ -0,0 +1,19 @@+{-|+Module      : Stype +Description : Statistical types+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com++-}++{-# OPTIONS_HADDOCK hide #-}+-- {-# LANGUAGE Safe #-}++module Stype (+    module Stype.Numeric+  , module Stype.Categorical+) where ++import Stype.Numeric+import Stype.Categorical

@@ -0,0 +1,14 @@+{-|+Module      : Stype categorical+Description : Statistical types+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com++-}+-- {-# LANGUAGE Safe #-}+module Stype.Categorical (+  module Stype.Categorical.Nominal +) where++import Stype.Categorical.Nominal

@@ -0,0 +1,17 @@+{-|+Module      : Stype categorical+Description : Statistical types+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com++-}+-- {-# LANGUAGE Safe #-}+module Stype.Categorical.Nominal (+  Nomimal(..)+) where++-- import qualified Data.Set.NonEmpty as NES++{- | a placeholder for a future nominal type -}+newtype Nomimal a = Nomimal a deriving ( Eq, Show, Ord )

@@ -0,0 +1,26 @@+{-|+Module      : Stype numeric types+Description : Statistical types+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com++-}++{-# LANGUAGE GADTs #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Safe #-}++module Stype.Numeric (+    module Stype.Numeric.Count+  , module Stype.Numeric.Continuous+  , module Stype.Numeric.Censored+) where++import safe Stype.Numeric.Count+import safe Stype.Numeric.Continuous+import safe Stype.Numeric.Censored++instance Censorable Double where+instance (Ord a) => Censorable (EventTime a) where

@@ -0,0 +1,43 @@+{-|+Module      : Stype censored types and typeclasses+Description : Statistical types+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com++-}++{-# LANGUAGE Safe #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}++module Stype.Numeric.Censored (+    Censorable(..)+  , MaybeCensored(..)+) where++import safe Data.Text                    (Text)++data MaybeCensored a where+  IntervalCensored :: a -> a -> MaybeCensored a+  RightCensored :: a -> MaybeCensored a+  LeftCensored :: a -> MaybeCensored a+  Uncensored :: a -> MaybeCensored a+  deriving( Eq, Show, Ord )++class (Ord a) => Censorable a where++  parseIntervalCensor :: a -> a -> Either Text (MaybeCensored a)+  parseIntervalCensor x y +    | x < y = Right $ IntervalCensored x y+    | otherwise = Left "y >= x"++  rightCensor ::  a -> a -> MaybeCensored a+  rightCensor c t+    | c < t     = RightCensored c +    | otherwise = Uncensored t++  leftCensor ::  a -> a -> MaybeCensored a+  leftCensor c t+    | c >= t    = LeftCensored c+    | otherwise = Uncensored t

@@ -0,0 +1,53 @@+{-|+Module      : Stype continuous types+Description : Statistical types+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com++-}++{-# LANGUAGE Safe #-}+module Stype.Numeric.Continuous (+    Continuous(..)+  , NonnegContinuous(..)+  , EventTime(..)+  , mkEventTime+) where++import safe Control.Applicative           ( Applicative(liftA2) )+++data Continuous a = NegContInf | Cont a | ContInf+  deriving (Eq, Show, Ord)++instance Functor Continuous where+  fmap f (Cont x) = Cont (f x)+  fmap f NegContInf = NegContInf+  fmap f ContInf = ContInf++instance Applicative Continuous where+  pure x = Cont x+  (<*>) (Cont f) (Cont x) =  Cont (f x)+  (<*>) NegContInf (Cont x) =  NegContInf+  (<*>) ContInf (Cont x) =  ContInf+  (<*>) _ NegContInf =  NegContInf+  (<*>) _ ContInf =  ContInf++instance Num a => Num (Continuous a) where+  (+) = liftA2 (+)+  (*) = liftA2 (*) +  abs = fmap abs+  fromInteger x = Cont $ fromInteger x+  signum = fmap signum+  negate = fmap negate++data NonnegContinuous a = NonNeg a | NonNegInf+  deriving (Eq, Show, Ord)++newtype EventTime a = EventTime { getEventTime :: NonnegContinuous a }+  deriving (Eq, Show, Ord)++mkEventTime :: Maybe a -> EventTime a+mkEventTime (Just x) = EventTime $ NonNeg x+mkEventTime Nothing  = EventTime NonNegInf

@@ -0,0 +1,49 @@+{-|+Module      : Stype count+Description : Statistical types+Copyright   : (c) NoviSci, Inc 2020+License     : BSD3+Maintainer  : bsaul@novisci.com++-}++{-# LANGUAGE Safe #-}++module Stype.Numeric.Count (+  Count(..)+) where++import safe GHC.Num                      ( Natural )+import safe Data.Semiring                ( Semiring(..) )++newtype Count = Count Natural+  deriving (Eq, Show, Ord)++instance Num Count where+  (+) (Count x) (Count y) = Count (x + y)+  (*) (Count x) (Count y) = Count (x * y) +  fromInteger x = Count $ fromInteger x+  abs = id -- useless+  signum x = Count 1 -- useless+  negate = id -- useless++instance Semigroup Natural where+  (<>) x y = x + y++instance Monoid Natural where+  mempty = 0++instance Semiring Natural where+  one = 1+  (<.>) = (*)++instance Semigroup Count where+  (<>) (Count x) (Count y) = Count (x <> y)++instance Monoid Count where+  mempty = Count 0++instance Semiring Count where+  one = Count 1+  (<.>) = (*)+

@@ -1,5 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} module FeatureCompose.AesonSpec (spec) where  import IntervalAlgebra@@ -8,6 +11,7 @@ import FeatureEvents import FeatureCompose import FeatureCompose.Aeson+import FeatureCompose.Attributes import Data.Aeson (encode) import Data.Maybe import Data.Time as DT@@ -27,10 +31,23 @@         Nothing -> featureDataL (Other "No Enrollment")         Just x  -> pure (getInterval x) +dummy ::  Feature "dummy" Bool+dummy = pure True +instance HasAttributes "dummy" Bool where+    getAttributes x = MkAttributes "some Label" "longer label..." "a description"++ spec :: Spec spec = do     it "an Int event is parsed correctly" $        encode (index ex1)  `shouldBe` "{\"end\":10,\"begin\":0}"++    it "dummy encodes correctly" $+        encode dummy `shouldBe` +        "{\"data\":true,\"name\":\"\\\"dummy\\\"\",\+        \\"attrs\":{\"getDerivation\":\"a description\",\+        \\"getLongLabel\":\"longer label...\",\+        \\"getShortLabel\":\"some Label\"}}"  

@@ -66,6 +66,32 @@ f3F = define f3  +featInts :: [Int] -> Feature "someInts" [Int]+featInts = pure++feat1 :: Definition (Feature "someInts" [Int] -> Feature "hasMoreThan3" Bool)+feat1 = defineA+  (\ints -> if null ints then makeFeature (missingBecause $ Other "no data")+           else makeFeature $ featureDataR (length ints > 3))++feat2 :: Definition (+      Feature "hasMoreThan3" Bool+  -> Feature "someInts" [Int]+  -> Feature "sum" Int)+feat2 = define (\b ints -> if b then sum ints else 0)++ex0 = featInts []+ex0a = eval feat1 ex0 -- MkFeature (MkFeatureData (Left (Other "no data")))+ex0b = eval feat2 (ex0a, ex0) -- MkFeature (MkFeatureData (Left (Other "no data")))++ex1 = featInts [3, 8]+ex1a = eval feat1 ex1 -- MkFeature (MkFeatureData (Right False))+ex1b = eval feat2 (ex1a, ex1) -- MkFeature (MkFeatureData (Right 0))++ex2 = featInts [1..4]+ex2a = eval feat1 ex2 -- MkFeature (MkFeatureData (Right True))+ex2b = eval feat2 (ex2a, ex2) -- MkFeature (MkFeatureData (Right 10))+ spec :: Spec spec = do @@ -131,3 +157,12 @@         eval f3F (pure True, eval f2F (pure False)) `shouldBe` makeFeature (missingBecause (Other "test"))       it "eval of f3F  returns correct value" $         eval f3F (pure True, eval f2F (pure True)) `shouldBe` pure "this"++  describe "checking ex0-2" $+    do+      it "ex0b" $+        ex0b `shouldBe` makeFeature (missingBecause (Other "no data"))+      it "ex1b" $+        ex1b `shouldBe` makeFeature (featureDataR 0)+      it "ex2b" $+        ex2b `shouldBe` makeFeature (featureDataR 10)