hasklepias 0.6.1 → 0.7.0

raw patch · 6 files changed

+190/−183 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−1
• examples/ExampleFeatures1.hs +76/−113
• examples/ExampleFeatures3.hs +18/−27
• hasklepias.cabal +1/−1
• src/Hasklepias/Reexports.hs +2/−2
• src/Hasklepias/Types/Feature.hs +87/−39

@@ -1,12 +1,17 @@ # Changelog for hasklepias +## 0.7.0++* Modifies the way that `Feature`s are defined and evaluated. For one, the dependency between `Events` and `Feature`s is eliminated, thus decoupling the defining of Features from the input data type. There are now 4 functions for defining features:+`define0`, `define1`, `define2`, and `define2d`, and 3 functions for evaluating `eval0`, `eval1`, and `eval2` (and corresponding `evalSpec*`). These functions will hopefully be combined into a single interface at later time. See the function signatures for the types of functions passed to a `define*` function. Examples will be forthcoming as the API stabilizes.+ ## 0.6.1  * Adds `derving Eq` to `Feature` type.  ## 0.6.0 -* Adds `PolyKinds` extension to `Feature` module to enable poly-kind inputs to `FeatureDefinition`s. Adds a related `Defineable` typeclass with `define` and `eval` functions as a common interface for defining new definitions and evaluating them.+* Adds `PolyKinds` extension to `Feature` module to enable poly-kind inputs to `FeatureDefinition`s. Adds a related `Defineable` typeclass with `define` and `eval` functions as a common interface for defining new definitions and evaluating them.  * Removes `defineEF` and `applyEF` function (and other similar functions). The functionality is now handled by the `Defineable` class.  ## 0.5.1

@@ -18,28 +18,20 @@ import ExampleEvents import Test.Hspec import Data.Bifunctor--+import Control.Applicative+import Control.Monad  {- Index is defined as the first occurrence of an Orca bite. -}-indexDef :: (Ord a) => FeatureDefinition (Events a) (Interval a)-indexDef = define-      (\es ->-            case firstConceptOccurrence ["wasBitByOrca"] es of-                  Nothing -> featureDataL (Other "No occurrence of Orca bite")-                  Just x  -> featureDataR (getInterval x)-      )---- equivalent...-indexDef' :: (Ord a) => FeatureDefinition (Events a) (Interval a)-indexDef' = define $-      maybeFeature-            (Other "No occurrence of Orca bite")-            (firstConceptOccurrence ["wasBitByOrca"])-             getInterval+indexDef :: (Ord a) => Events a -> FeatureData (Interval a)+indexDef events =+  case firstConceptOccurrence ["wasBitByOrca"] events of+        Nothing -> featureDataL (Other "No occurrence of Orca bite")+        Just x  -> featureDataR (getInterval x) +indexSpec :: (Ord a) => FeatureSpec Text (*) (Events a) (Interval a)+indexSpec = makeFeatureSpec "index" "" (define0 indexDef)  {-   The baseline interval is the interval (b - 60, b), where b is the begin of @@ -55,12 +47,12 @@ bline :: (IntervalSizeable a b) =>      Events a   -> FeatureData (Interval a)-bline = baseline . eval indexDef+bline = baseline . indexDef  flwup :: (IntervalSizeable a b) =>      Events a   -> FeatureData (Interval a)-flwup = fmap (beginerval 30 . begin) . eval indexDef+flwup = fmap (beginerval 30 . begin) . indexDef  {- Define enrolled as the indicator of whether all of the gaps between the union of @@ -68,98 +60,70 @@ -} enrolledDef :: (IntervalSizeable a b) =>       b-      -> FeatureDefinition (FeatureData (Interval a), Events a) Bool-enrolledDef allowableGap = define-   ( \(dat, es) ->-         fmap-         (\i -> es-            |> makeConceptsFilter ["enrollment"]-            |> combineIntervals-            |> gapsWithin i-            |> maybe False (all (< allowableGap) . durations)-          )-         dat-   )-+      -> Interval a -> Events a -> Bool+enrolledDef allowableGap i events =+    events+      |> makeConceptsFilter ["enrollment"]+      |> combineIntervals+      |> gapsWithin i+      |> maybe False (all (< allowableGap) . durations)  {- Define features that identify whether a subject as bit/struck by a duck and bit/struck by a macaw. -}--- makeHxDef :: (Ord a) =>---          [Text] ---       -> FeatureDefinition * (Interval a) a (Bool, Maybe (Interval a))--- makeHxDef cnpts = defineFEF Excluded---    ( \i es ->---       (isNotEmpty (f i es), lastMay $ intervals (f i es))---    )---    where f i x = makePairedFilter enclose i (`hasConcepts` cnpts) x- makeHxDef :: (Ord a) =>          [Text]-      -> FeatureDefinition (FeatureData (Interval a), Events a) (Bool, Maybe (Interval a))-makeHxDef cnpts = define-   ( \(dat, es) ->-         fmap-         (\i -> (isNotEmpty (f i es), lastMay $ intervals (f i es)) )-         dat-   )+      -> Interval a+      -> Events a+      -> (Bool, Maybe (Interval a))+makeHxDef cnpts i events =+   (isNotEmpty (f i events), lastMay $ intervals (f i events))    where f i x = makePairedFilter enclose i (`hasConcepts` cnpts) x  duckHxDef :: (Ord a) =>-          FeatureDefinition (FeatureData (Interval a), Events a) (Bool, Maybe (Interval a))+         Interval a+      -> Events a+      -> (Bool, Maybe (Interval a)) duckHxDef = makeHxDef ["wasBitByDuck", "wasStruckByDuck"]  macawHxDef :: (Ord a) =>-          FeatureDefinition (FeatureData (Interval a), Events a) (Bool, Maybe (Interval a))+         Interval a+      -> Events a+      -> (Bool, Maybe (Interval a)) macawHxDef = makeHxDef ["wasBitByMacaw", "wasStruckByMacaw"]  -- | Define an event that identifies whether the subject has two minor or one major --   surgery. twoMinorOrOneMajorDef :: (Ord a) =>-         FeatureDefinition (FeatureData (Interval a), Events a) Bool-twoMinorOrOneMajorDef = define-      ( \(dat, es) ->-            fmap-            (\i -> twoXOrOneY ["hadMinorSurgery"] ["hadMajorSurgery"] (filterEnclose i es))-            dat-      )+         Interval a -> Events a ->  Bool+twoMinorOrOneMajorDef i events =+    twoXOrOneY ["hadMinorSurgery"] ["hadMajorSurgery"] (filterEnclose i events)  -- | Time from end of baseline to end of most recent Antibiotics --   with 5 day grace period timeSinceLastAntibioticsDef :: (IntervalSizeable a b) =>-      FeatureDefinition (FeatureData (Interval a), Events a) (Maybe b)-      --    FeatureDefinition * (Interval a) a (Maybe b)-timeSinceLastAntibioticsDef = define-      ( \(dat, es) ->-           fmap-            (\i ->-                  ( lastMay                                  -- want the last one-                  . map (max 0 . diff (end i) . end)        -- distances between end of baseline and antibiotic intervals-                  . filterNotDisjoint i                     -- filter to intervals not disjoint from baseline interval-                  . combineIntervals                        -- combine overlapping intervals-                  . map (expandr 5)                         -- allow grace period-                  . makeConceptsFilter ["tookAntibiotics"]) -- filter to only antibiotics events -                  es-            )-            dat-       )+      Interval a+      -> Events a+      -> Maybe b+timeSinceLastAntibioticsDef i  =+      lastMay                                 -- want the last one+    . map (max 0 . diff (end i) . end)        -- distances between end of baseline and antibiotic intervals+    . filterNotDisjoint i                     -- filter to intervals not disjoint from baseline interval+    . combineIntervals                        -- combine overlapping intervals+    . map (expandr 5)                         -- allow grace period+    . makeConceptsFilter ["tookAntibiotics"]  -- filter to only antibiotics events   -- | Count of hospital events in a interval and duration of the last one countOfHospitalEventsDef :: (IntervalSizeable a b) =>-      FeatureDefinition (FeatureData (Interval a), Events a) (Int, Maybe b)-countOfHospitalEventsDef = define-      ( \(dat, es) ->-            fmap-            ( \i ->-                   ( (\x -> (length x, duration <$> lastMay x))-                  . filterNotDisjoint i                    -- filter to intervals not disjoint from interval-                  . combineIntervals                       -- combine overlapping intervals-                  . makeConceptsFilter ["wasHospitalized"])  -- filter to only antibiotics events-                  es-            )-            dat-      )+      Interval a +      -> Events a +      -> (Int, Maybe b)+countOfHospitalEventsDef i =+       (\x -> (length x, duration <$> lastMay x))+    . filterNotDisjoint i                    -- filter to intervals not disjoint from interval+    . combineIntervals                       -- combine overlapping intervals+    . makeConceptsFilter ["wasHospitalized"]  -- filter to only antibiotics events  -- | time of distcontinuation of antibiotics --   and time from start of follow up@@ -169,27 +133,25 @@ so = unionPredicates [startedBy, overlappedBy]  discontinuationDef :: (IntervalSizeable a b) =>-      FeatureDefinition (FeatureData (Interval a), Events a) (Maybe (a, b))-                  --     FeatureDefinition * (Interval a) a (Maybe (a, b))-discontinuationDef = define-      (\(dat, es) ->-            fmap-            (\i -> (\x -> Just (begin x       -- we want the begin of this interval -                        , diff (begin x) (begin i)))-                  =<< headMay                    -- if there are any gaps the first one is the first discontinuation-                  =<< gapsWithin i               -- find gaps to intervals clipped to i-                  =<< (nothingIfNone (so i)      -- if none of the intervals start or overlap -                                     -- the followup, then never started antibiotics-                  . combineIntervals          -- combine overlapping intervals-                  . map (expandr 5)           -- allow grace period-                  . makeConceptsFilter        -- filter to only antibiotics events-                        ["tookAntibiotics"]) es)-            dat-      )+      Interval a +      -> Events a+      -> Maybe (a, b)+discontinuationDef i events = +    (\x -> Just (begin x       -- we want the begin of this interval +          , diff (begin x) (begin i)))+    =<< headMay                    -- if there are any gaps the first one is the first discontinuation+    =<< gapsWithin i               -- find gaps to intervals clipped to i+    =<< (nothingIfNone (so i)      -- if none of the intervals start or overlap +                        -- the followup, then never started antibiotics+    . combineIntervals          -- combine overlapping intervals+    . map (expandr 5)           -- allow grace period+    . makeConceptsFilter        -- filter to only antibiotics events+          ["tookAntibiotics"])+    events  getUnitFeatures ::       Events Int-  -> (FeatureData (Interval Int)+  -> ( FeatureData (Interval Int)      , FeatureData Bool      , FeatureData (Bool, Maybe (Interval Int))      , FeatureData (Bool, Maybe (Interval Int))@@ -199,15 +161,16 @@      , FeatureData (Maybe (Int, Int))      ) getUnitFeatures x = (-    eval indexDef x-  , eval (enrolledDef 8) (bline x, x)-  , eval duckHxDef (bline x, x)-  , eval macawHxDef (bline x, x)-  , eval twoMinorOrOneMajorDef (bline x, x)-  , eval timeSinceLastAntibioticsDef (bline x, x)-  , eval countOfHospitalEventsDef (bline x, x)-  , eval discontinuationDef (flwup x, x)-  )+    indexDef x+  , liftA2 (enrolledDef 8) (bline x) evs+  , liftA2 duckHxDef  (bline x) evs+  , liftA2 macawHxDef (bline x) evs+  , liftA2 twoMinorOrOneMajorDef (bline x) evs+  , liftA2 timeSinceLastAntibioticsDef (bline x) evs+  , liftA2 countOfHospitalEventsDef (bline x) evs+  , liftA2 discontinuationDef (flwup x) evs+  ) where evs = pure x+  exampleFeatures1Spec :: Spec exampleFeatures1Spec = do

@@ -20,31 +20,22 @@   examplePairComparison :: (IntervalSizeable a b) =>-    FeatureDefinition (FeatureData (Interval a), Events a) (Bool, Maybe a)-            --    FeatureDefinition * (Interval a) a (Bool, Maybe a)-examplePairComparison = define-    (\ (dat, es) ->-        fmap-         (\i -> -            es-            |> filterConcur i                   -- filter to concurring with followup interval    -            |> splitByConcepts ["c1"] ["c2"]    -- form a list of pairs where first element-            |> uncurry allPairs                 -- has "c1" events and second has "c2" events    -                                                -            |> filter                           -- filter this list of pairs to cases -                (\pr -> fst pr `concur`             -- where "c1" event concurs with +/- 3-                    expand 3 3 (snd pr) )           -- of any "c2" event -            |> fmap fst-            |> intervals                        -- get the intervals of any "c1" events-            |> (\x ->-                ( isNotEmpty x                  -- are there any?-                , fmap begin (lastMay x)))      -- if exists, keep the begin of the last "c1" interval-            )-        dat-    -    )--+    Interval a+    -> Events a+    -> (Bool, Maybe a)+examplePairComparison i es = +    es+    |> filterConcur i                   -- filter to concurring with followup interval    +    |> splitByConcepts ["c1"] ["c2"]    -- form a list of pairs where first element+    |> uncurry allPairs                 -- has "c1" events and second has "c2" events    +                                        +    |> filter                           -- filter this list of pairs to cases +        (\pr -> fst pr `concur`             -- where "c1" event concurs with +/- 3+            expand 3 3 (snd pr) )           -- of any "c2" event +    |> fmap fst+    |> (\x ->+        ( isNotEmpty x                  -- are there any?+        , fmap begin (lastMay x)))      -- if exists, keep the begin of the last "c1" interval  flwup :: FeatureData (Interval Int) flwup = featureDataR $ beginerval 50 0@@ -53,6 +44,6 @@ exampleFeatures3Spec = do      it "examplePairComparison"  $-        eval examplePairComparison (flwup, exampleEvents4) `shouldBe`+        liftA2 examplePairComparison flwup (pure exampleEvents4)+             `shouldBe`         featureDataR (True, Just 16)-

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           hasklepias-version:        0.6.1+version:        0.7.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

@@ -37,8 +37,8 @@ import safe GHC.Num                         ( Integer ) import safe GHC.Generics                    ( Generic ) import safe GHC.Show                        ( Show(..) )-import safe Control.Monad                   ( (=<<), Functor(fmap) )-import safe Control.Applicative             ( (<$>) )+import safe Control.Monad                   ( Functor(fmap), Monad(..) )+import safe Control.Applicative             ( (<$>), Applicative(..) ) import safe Data.Bool                       ( Bool(..)                                             , (&&), not, (||)                                             , bool

@@ -9,10 +9,11 @@  {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE Safe #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-} module Hasklepias.Types.Feature(     -- * Types       FeatureSpec(..)@@ -20,24 +21,33 @@     , FeatureData(..)     , MissingReason(..)     , FeatureDefinition(..)-    , Defineable(..)-    , maybeFeature+    , makeFeatureSpec     , featureDataR     , featureDataL+    , define0+    , define1+    , define2+    , define2d+    , eval0+    , eval1+    , eval2+    , evalSpec0+    , evalSpec1+    , evalSpec2 ) where -import GHC.Read                   ( Read )-import GHC.Show                   ( Show )-import GHC.Generics               ( Generic )-import Data.Either                ( Either(..) )-import Data.Eq                    ( Eq )-import Data.Functor               ( Functor(fmap) )-import Data.Function              ( ($), (.) )-import Data.Maybe                 ( Maybe(..), maybe )-import Data.Ord                   ( Ord )-import Data.Text                  ( Text )-import Hasklepias.Types.Event     ( Event, Events )-import IntervalAlgebra            ( Interval, Intervallic )+import safe GHC.Read                   ( Read )+import safe GHC.Show                   ( Show(show) )+import safe GHC.Generics               ( Generic, D )+import safe Control.Applicative        ( Applicative(..) )+import safe Control.Monad              ( Functor(..), Monad(..), join, liftM2)+import safe Data.Either                ( Either(..) )+import safe Data.Eq                    ( Eq )+import safe Data.Function              ( ($), (.) )+import safe Data.List             ( (++) )  +import safe Data.Maybe                 ( Maybe(..), maybe )+import safe Data.Ord                   ( Ord )+import safe Data.Text                  ( Text ) -- import safe Test.QuickCheck       ( Property )  {- | A 'FeatureSpec' contains all the information needed to derive a 'Feature':@@ -45,48 +55,65 @@       * its attributes       * the function needed to derive a feature (i.e. the 'FeatureDefinition') -}-data (Show b) => FeatureSpec b k d = FeatureSpec {+data (Show b) => FeatureSpec b f e d = MkFeatureSpec {         getSpecName :: Text       , getSpecAttr :: b-      , getDefn :: FeatureDefinition k d+      , getDefn :: FeatureDefinition f e d       -- To add in future: an optional list of properties to check       -- , getProp :: Maybe [Feature d -> Events a -> Property]      }  -- | TODO-makeFeatureSpec :: Show b => Text -> b -> FeatureDefinition k d ->-  FeatureSpec b k d-makeFeatureSpec = FeatureSpec+makeFeatureSpec :: Show b =>+     Text+  -> b+  -> FeatureDefinition f e d+  -> FeatureSpec b f e d+makeFeatureSpec = MkFeatureSpec  {- | A 'Feature' contains the following:       * a name       * its attributes       * 'FeatureData' -}-data (Show b) => Feature b d = Feature {+data (Show b) => Feature b d = MkFeature {         getName :: Text       , getAttr :: b       , getData :: FeatureData d       } deriving (Eq) +instance (Show b, Show d) => Show (Feature d b) where +    show x = "(" ++ show (getName x) ++ ": (" ++ show (getAttr x) ++ ") "  ++ show (getData x) ++ " )\n"++instance (Show b) => Functor (Feature b) where+  fmap f (MkFeature n a d) = MkFeature n a (fmap f d)+ {- | 'FeatureData' is @'Either' 'MissingReason' d@, where @d@ can be any type       of data derivable from 'Hasklepias.Event.Events'. -}-newtype FeatureData d = FeatureData { getFeatureData :: Either MissingReason d }+newtype FeatureData d = MkFeatureData { getFeatureData :: Either MissingReason d }   deriving (Generic, Show, Eq)  instance Functor FeatureData where-  fmap f (FeatureData x) = FeatureData (fmap f x)+  fmap f (MkFeatureData x) = MkFeatureData (fmap f x) +instance Applicative FeatureData where+  pure = featureDataR+  liftA2 f (MkFeatureData x) (MkFeatureData y) = MkFeatureData ( liftA2 f x y )++instance Monad FeatureData where+  return = MkFeatureData . return+  x >>= f = do x >>= f+ -- | Create the 'Right' side of 'FeatureData'. featureDataR :: d -> FeatureData d-featureDataR = FeatureData . Right+featureDataR = MkFeatureData . Right  -- | Create the 'Left' side of 'FeatureData'. featureDataL :: MissingReason -> FeatureData d-featureDataL = FeatureData . Left+featureDataL = MkFeatureData . Left --- | A 'Feature' may be missing for any number of reasons. +-- | 'FeatureData' may be missing for any number of reasons.  data MissingReason =     InsufficientData   | Excluded@@ -94,21 +121,42 @@   | Unknown   deriving (Eq, Read, Show, Generic) ++-- TODO: the code below should be generalized so that there is a single define/eval+--       interface. -- | A type to hold FeatureData definitions; i.e. functions that return ---  features.-newtype FeatureDefinition input d = MkFeatureDef (input -> FeatureData d)+--  features. +data FeatureDefinition f e d =+    FD0 (e -> FeatureData d)+  | FD1 (FeatureData e -> FeatureData d)+  | FD2 (FeatureData f -> FeatureData e -> FeatureData d) -class Defineable input where-  define :: (input -> FeatureData d) -> FeatureDefinition input d-  define = MkFeatureDef+define0 :: (e -> FeatureData d) -> FeatureDefinition * e d+define0 = FD0 -  eval :: FeatureDefinition input d -> input -> FeatureData d-  eval (MkFeatureDef def) x = def x+eval0 :: FeatureDefinition * e d -> e -> FeatureData d+eval0 (FD0 f) = f -instance Defineable (Events a) where-instance Defineable (FeatureData e, Events a) where-instance Defineable (FeatureData e, FeatureData f) where-instance Defineable (FeatureData e, FeatureData f, FeatureData g) where+evalSpec0 :: (Show b) => FeatureSpec b * e d -> e -> Feature b d+evalSpec0 (MkFeatureSpec nm attr def) y = MkFeature nm attr (eval0 def y) -maybeFeature :: MissingReason -> (a -> Maybe c) -> (c -> d) -> (a -> FeatureData d)-maybeFeature r f g x = maybe (featureDataL r) (featureDataR . g) (f x)+define1 :: (e -> d) -> FeatureDefinition * e d+define1 f = FD1 $ fmap f++eval1 :: FeatureDefinition * e d -> FeatureData e -> FeatureData d+eval1 (FD1 f) = f++evalSpec1 :: (Show b) => FeatureSpec b * e d -> Feature b e -> Feature b d+evalSpec1 (MkFeatureSpec nm attr def) y = MkFeature nm attr (eval1 def (getData y))++define2 :: (f -> e -> d) -> FeatureDefinition f e d+define2 f =  FD2 $ liftA2 f++define2d :: (f -> e -> FeatureData d) -> FeatureDefinition f e d +define2d f = FD2 (\x y -> join (liftM2 f x y))++eval2 :: FeatureDefinition f e d -> FeatureData f -> FeatureData e -> FeatureData d+eval2 (FD2 f) = f ++evalSpec2 :: (Show b) => FeatureSpec b f e d -> Feature b f -> Feature b e -> Feature b d+evalSpec2 (MkFeatureSpec nm attr def) y z = MkFeature nm attr (eval2 def (getData y) (getData z))