packages feed

hasklepias 0.5.0 → 0.6.0

raw patch · 10 files changed

+226/−256 lines, 10 filesdep ~interval-algebraPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: interval-algebra

API changes (from Hackage documentation)

- Hasklepias.Types.Feature: EF :: (Events a -> FeatureData d) -> FeatureDefinition f e a d
- Hasklepias.Types.Feature: FEF :: (FeatureData e -> Events a -> FeatureData d) -> FeatureDefinition f e a d
- Hasklepias.Types.Feature: FFF :: (FeatureData f -> FeatureData e -> FeatureData d) -> FeatureDefinition f e a d
- Hasklepias.Types.Feature: applyEF :: FeatureDefinition * * a d -> Events a -> FeatureData d
- Hasklepias.Types.Feature: applyFEF :: FeatureDefinition * e a d -> FeatureData e -> Events a -> FeatureData d
- Hasklepias.Types.Feature: applyFFF :: FeatureDefinition f e * d -> FeatureData f -> FeatureData e -> FeatureData d
- Hasklepias.Types.Feature: data FeatureDefinition f e a d
- Hasklepias.Types.Feature: defineEF :: Intervallic Interval a => MissingReason -> (Events a -> Maybe c) -> (c -> d) -> FeatureDefinition * e a d
- Hasklepias.Types.Feature: defineFEF :: Intervallic Interval a => MissingReason -> (e -> Events a -> d) -> FeatureDefinition * e a d
- Hasklepias.Types.Feature: defineFEF2 :: Intervallic Interval a => MissingReason -> (e -> Events a -> FeatureData d) -> FeatureDefinition * e a d
- Hasklepias.Types.Feature: defineFFF :: MissingReason -> MissingReason -> (f -> e -> d) -> FeatureDefinition f e * d
- Hasklepias.Types.Feature: evalEFFeature :: Show b => FeatureSpec b * * a d -> Events a -> Feature b d
- Hasklepias.Types.Feature: evalFEFFeature :: Show b => FeatureSpec b * e a d -> Feature b e -> Events a -> Feature b d
- Hasklepias.Types.Feature: evalFFFFeature :: Show b => FeatureSpec b f e * d -> Feature b f -> Feature b e -> Feature b d
- Hasklepias.Types.Feature: featureL :: MissingReason -> FeatureData d
- Hasklepias.Types.Feature: featureR :: d -> FeatureData d
+ Hasklepias.Reexports: class Functor (f :: Type -> Type)
+ Hasklepias.Reexports: class Generic a
+ Hasklepias.Reexports: class Show a
+ Hasklepias.Reexports: show :: Show a => a -> String
+ Hasklepias.Reexports: showList :: Show a => [a] -> ShowS
+ Hasklepias.Reexports: showsPrec :: Show a => Int -> a -> ShowS
+ Hasklepias.Types.Feature: MkFeatureDef :: (input -> FeatureData d) -> FeatureDefinition input d
+ Hasklepias.Types.Feature: class Defineable input
+ Hasklepias.Types.Feature: define :: Defineable input => (input -> FeatureData d) -> FeatureDefinition input d
+ Hasklepias.Types.Feature: eval :: Defineable input => FeatureDefinition input d -> input -> FeatureData d
+ Hasklepias.Types.Feature: featureDataL :: MissingReason -> FeatureData d
+ Hasklepias.Types.Feature: featureDataR :: d -> FeatureData d
+ Hasklepias.Types.Feature: instance Hasklepias.Types.Feature.Defineable (Hasklepias.Types.Event.Events a)
+ Hasklepias.Types.Feature: instance Hasklepias.Types.Feature.Defineable (Hasklepias.Types.Feature.FeatureData e, Hasklepias.Types.Event.Events a)
+ Hasklepias.Types.Feature: instance Hasklepias.Types.Feature.Defineable (Hasklepias.Types.Feature.FeatureData e, Hasklepias.Types.Feature.FeatureData f)
+ Hasklepias.Types.Feature: instance Hasklepias.Types.Feature.Defineable (Hasklepias.Types.Feature.FeatureData e, Hasklepias.Types.Feature.FeatureData f, Hasklepias.Types.Feature.FeatureData g)
+ Hasklepias.Types.Feature: maybeFeature :: MissingReason -> (a -> Maybe c) -> (c -> d) -> a -> FeatureData d
+ Hasklepias.Types.Feature: newtype FeatureDefinition input d
- Hasklepias.Functions: makePairedFilter :: (Intervallic i0 a, Intervallic (PairedInterval b) a) => ComparativePredicateOf2 (i0 a) (PairedInterval b a) -> i0 a -> (b -> Bool) -> [PairedInterval b a] -> [PairedInterval b a]
+ Hasklepias.Functions: makePairedFilter :: Ord a => ComparativePredicateOf2 (i0 a) (PairedInterval b a) -> i0 a -> (b -> Bool) -> [PairedInterval b a] -> [PairedInterval b a]
- Hasklepias.Types.Feature: FeatureSpec :: Text -> b -> FeatureDefinition f e a d -> FeatureSpec b f e a d
+ Hasklepias.Types.Feature: FeatureSpec :: Text -> b -> FeatureDefinition k d -> FeatureSpec b k d
- Hasklepias.Types.Feature: [getDefn] :: FeatureSpec b f e a d -> FeatureDefinition f e a d
+ Hasklepias.Types.Feature: [getDefn] :: FeatureSpec b k d -> FeatureDefinition k d
- Hasklepias.Types.Feature: [getSpecAttr] :: FeatureSpec b f e a d -> b
+ Hasklepias.Types.Feature: [getSpecAttr] :: FeatureSpec b k d -> b
- Hasklepias.Types.Feature: [getSpecName] :: FeatureSpec b f e a d -> Text
+ Hasklepias.Types.Feature: [getSpecName] :: FeatureSpec b k d -> Text
- Hasklepias.Types.Feature: data (Show b) => FeatureSpec b f e a d
+ Hasklepias.Types.Feature: data (Show b) => FeatureSpec b k d

Files

ChangeLog.md view
@@ -1,5 +1,15 @@ # Changelog for hasklepias +## 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.+* Removes `defineEF` and `applyEF` function (and other similar functions). The functionality is now handled by the `Defineable` class.++## 0.5.1++* Adds `Show`, `Functor`, and `Generic` to Reexports.+* Updates `interval-algebra` to `0.8.2`.+ ## 0.5.0  * Changes what was the `Feature` type into `FeatureData`. The `Feature` type becomes a container for `FeatureData` with a name and attributes.
examples/ExampleEvents.hs view
@@ -34,7 +34,7 @@  type EventData a = (a, a, Text) -toEvent :: (IntervalSizeable a a) => EventData a -> Event a+toEvent :: (IntervalSizeable a a, Show a) => EventData a -> Event a toEvent x = event (beginerval (t1 x) (t2 x)) (context $ packConcepts [t3 x])  toEvents :: (Ord a, Show a, IntervalSizeable a a) => [EventData a] -> Events a
examples/ExampleFeatures1.hs view
@@ -18,111 +18,148 @@ import Hasklepias import ExampleEvents import Test.Hspec+import Data.Bifunctor  + {- Index is defined as the first occurrence of an Orca bite. -}-indexDef :: (Intervallic Interval a) =>-          FeatureDefinition * e a (Interval a)-indexDef = defineEF-      (Other "No occurrence of Orca bite")-      (firstConceptOccurrence ["wasBitByOrca"])-      getInterval+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++ {-   The baseline interval is the interval (b - 60, b), where b is the begin of  index. Here, baseline is defined as function that takes a filtration function as an argument, so that the baseline FeatureData can be used to filter events based on different predicate functions. -}-baseline :: (Intervallic Interval a, IntervalSizeable a b) =>+baseline :: (IntervalSizeable a b) =>      FeatureData (Interval a) -- ^ pass the result of index to get a baseline filter   -> FeatureData (Interval a) baseline = fmap (enderval 60 . begin) -bline :: (Intervallic Interval a, IntervalSizeable a b) =>+bline :: (IntervalSizeable a b) =>      Events a   -> FeatureData (Interval a)-bline = baseline . applyEF indexDef+bline = baseline . eval indexDef -flwup :: (Intervallic Interval a, IntervalSizeable a b) =>+flwup :: (IntervalSizeable a b) =>      Events a   -> FeatureData (Interval a)-flwup = fmap (beginerval 30 . begin) . applyEF indexDef+flwup = fmap (beginerval 30 . begin) . eval indexDef  {- Define enrolled as the indicator of whether all of the gaps between the union of  all enrollment intervals (+ allowableGap)  -}-enrolledDef :: IntervalSizeable a b => b -> FeatureDefinition * (Interval a) a Bool-enrolledDef allowableGap = defineFEF Excluded-   (  \i ->-        maybe False (all (< allowableGap) . durations)-      . gapsWithin i-      . combineIntervals-      . intervals-      . makeConceptsFilter ["enrollment"]+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    ) + {- Define features that identify whether a subject as bit/struck by a duck and bit/struck by a macaw. -}-makeHxDef :: (Intervallic Interval 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))+-- 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    )    where f i x = makePairedFilter enclose i (`hasConcepts` cnpts) x  duckHxDef :: (Intervallic Interval a) =>-          FeatureDefinition * (Interval a) a (Bool, Maybe (Interval a))+          FeatureDefinition (FeatureData (Interval a), Events a) (Bool, Maybe (Interval a)) duckHxDef = makeHxDef ["wasBitByDuck", "wasStruckByDuck"]  macawHxDef :: (Intervallic Interval a) =>-          FeatureDefinition * (Interval a) a (Bool, Maybe (Interval a))+          FeatureDefinition (FeatureData (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 :: (Intervallic Interval a) =>-         FeatureDefinition * (Interval a) a Bool-twoMinorOrOneMajorDef = defineFEF Excluded-      ( \i es ->-          twoXOrOneY ["hadMinorSurgery"] ["hadMajorSurgery"] (filterEnclose i es)+twoMinorOrOneMajorDef :: (Ord a) =>+         FeatureDefinition (FeatureData (Interval a), Events a) Bool+twoMinorOrOneMajorDef = define+      ( \(dat, es) ->+            fmap+            (\i -> twoXOrOneY ["hadMinorSurgery"] ["hadMajorSurgery"] (filterEnclose i es))+            dat       )  -- | Time from end of baseline to end of most recent Antibiotics --   with 5 day grace period-timeSinceLastAntibioticsDef :: ( Intervallic Interval a-                               , IntervalSizeable a b) =>-         FeatureDefinition * (Interval a) a (Maybe b)-timeSinceLastAntibioticsDef = defineFEF Excluded-      ( \i es ->-           ( 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-           . intervals                              -- extract intervals-           . makeConceptsFilter ["tookAntibiotics"])-- filter to only antibiotics events -            es-      )+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+       )  -- | Count of hospital events in a interval and duration of the last one-countOfHospitalEventsDef :: (IntervalCombinable Interval a-                            , IntervalSizeable a b) =>-                            FeatureDefinition * (Interval a) a (Int, Maybe b)-countOfHospitalEventsDef = defineFEF Excluded-      ( \i es ->-            ((\x -> (length x, duration <$> lastMay x))-            .filterNotDisjoint i                    -- filter to intervals not disjoint from interval-            .combineIntervals                       -- combine overlapping intervals-            .intervals                              -- extract intervals-            .makeConceptsFilter ["wasHospitalized"])  -- filter to only antibiotics events-            es+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       )  -- | time of distcontinuation of antibiotics@@ -132,22 +169,23 @@ so :: (Intervallic Interval a)=> ComparativePredicateOf1 (Interval a) so = unionPredicates [startedBy, overlappedBy] -discontinuationDef :: (IntervalSizeable a b-                      , Intervallic Interval a) =>-                      FeatureDefinition * (Interval a) a (Maybe (a, b))-discontinuationDef = defineFEF Excluded-      ( \i es ->-          (\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 +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-         . intervals                 -- extract intervals-         . makeConceptsFilter        -- filter to only antibiotics events-            ["tookAntibiotics"]) es+                  . combineIntervals          -- combine overlapping intervals+                  . map (expandr 5)           -- allow grace period+                  . makeConceptsFilter        -- filter to only antibiotics events+                        ["tookAntibiotics"]) es)+            dat       )  getUnitFeatures ::@@ -162,14 +200,14 @@      , FeatureData (Maybe (Int, Int))      ) getUnitFeatures x = (-    applyEF  indexDef x-  , applyFEF (enrolledDef 8) (bline x) x-  , applyFEF duckHxDef (bline x) x-  , applyFEF macawHxDef (bline x) x-  , applyFEF twoMinorOrOneMajorDef (bline x) x-  , applyFEF timeSinceLastAntibioticsDef (bline x) x-  , applyFEF countOfHospitalEventsDef (bline x) x-  , applyFEF discontinuationDef (flwup x) 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)   )  exampleFeatures1Spec :: Spec@@ -177,24 +215,24 @@      it "getUnitFeatures from exampleEvents1" $       getUnitFeatures exampleEvents1 `shouldBe`-      ( featureR (beginerval 1 (60 :: Int))-      , featureR True-      , featureR (True, Just $ beginerval 1 (51 :: Int))-      , featureR (False, Nothing)-      , featureR True-      , featureR $ Just 4-      , featureR (1, Just 8)-      , featureR $ Just (78, 18)+      ( featureDataR (beginerval 1 (60 :: Int))+      , featureDataR True+      , featureDataR (True, Just $ beginerval 1 (51 :: Int))+      , featureDataR (False, Nothing)+      , featureDataR True+      , featureDataR $ Just 4+      , featureDataR (1, Just 8)+      , featureDataR $ Just (78, 18)       )      it "getUnitFeatures from exampleEvents2" $       getUnitFeatures exampleEvents2 `shouldBe`-      ( featureL (Other "No occurrence of Orca bite")-      , featureL Excluded-      , featureL Excluded-      , featureL Excluded-      , featureL Excluded-      , featureL Excluded-      , featureL Excluded-      , featureL Excluded+      ( featureDataL (Other "No occurrence of Orca bite")+      , featureDataL (Other "No occurrence of Orca bite")+      , featureDataL (Other "No occurrence of Orca bite")+      , featureDataL (Other "No occurrence of Orca bite")+      , featureDataL (Other "No occurrence of Orca bite")+      , featureDataL (Other "No occurrence of Orca bite")+      , featureDataL (Other "No occurrence of Orca bite")+      , featureDataL (Other "No occurrence of Orca bite")       )
examples/ExampleFeatures2.hs view
@@ -18,14 +18,13 @@ import ExampleEvents import Test.Hspec -durationOfHospitalizedAntibiotics:: (Intervallic (PairedInterval Concepts) a-                                    , Intervallic Interval a+durationOfHospitalizedAntibiotics:: ( Show a                                     , IntervalSizeable a b) =>      Events a   -> FeatureData [b] durationOfHospitalizedAntibiotics es-    | null y    = featureL $ Other "no cases"-    | otherwise = featureR $ durations y+    | null y    = featureDataL $ Other "no cases"+    | otherwise = featureDataR $ durations y     where conceptsText = ["wasHospitalized", "tookAntibiotics"]            concepts = map packConcept conceptsText           x = formMeetingSequence (map (toConceptEventOf concepts) es)@@ -37,8 +36,8 @@      it "durationOfHospitalizedAntibiotics from exampleEvents1" $         durationOfHospitalizedAntibiotics exampleEvents1 `shouldBe` -            featureL (Other "no cases")+            featureDataL (Other "no cases")      it "durationOfHospitalizedAntibiotics from exampleEvents3" $         durationOfHospitalizedAntibiotics exampleEvents3 `shouldBe` -            featureR [3, 2]+            featureDataR [3, 2]
examples/ExampleFeatures3.hs view
@@ -20,34 +20,40 @@ import Test.Hspec  -examplePairComparison :: (Intervallic Interval a-              , IntervalSizeable a b) =>-               FeatureDefinition * (Interval a) a (Bool, Maybe a)-examplePairComparison = defineFEF Unknown-    ( \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-    |> 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+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+         )  + flwup :: FeatureData (Interval Int)-flwup = featureR $ beginerval 50 0+flwup = featureDataR $ beginerval 50 0  exampleFeatures3Spec :: Spec exampleFeatures3Spec = do      it "examplePairComparison"  $-        applyFEF examplePairComparison flwup exampleEvents4 `shouldBe`-        featureR (True, Just 16)+        eval examplePairComparison (flwup, exampleEvents4) `shouldBe`+        featureDataR (True, Just 16) 
hasklepias.cabal view
@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           hasklepias-version:        0.5.0+version:        0.6.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@@ -45,7 +45,7 @@     , bytestring >=0.10     , containers >=0.6.0     , flow == 1.0.22-    , interval-algebra == 0.8.0+    , interval-algebra == 0.8.2      , text >=1.2.3     , time >=1.11     , unordered-containers >=0.2.10@@ -78,7 +78,7 @@     , flow == 1.0.22     , hasklepias     , hspec-    , interval-algebra == 0.8.0+    , interval-algebra == 0.8.2      , text >=1.2.3     , time >=1.11     , unordered-containers >=0.2.10@@ -101,7 +101,7 @@     , hspec     , base >=4.14 && <4.15     , flow == 1.0.22-    , interval-algebra == 0.8.0+    , interval-algebra == 0.8.2      , text >=1.2.3     , bytestring >=0.10     , containers >=0.6.0
src/Hasklepias/Functions.hs view
@@ -10,7 +10,6 @@  {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE Safe #-}  module Hasklepias.Functions(@@ -110,8 +109,7 @@ -- | 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 :: ( Intervallic (PairedInterval b) a-                     , Intervallic i0 a) =>+makePairPredicate ::  Ord a =>        ComparativePredicateOf2 (i0 a) ((PairedInterval b) a)     -> i0 a     -> (b -> Bool)@@ -119,8 +117,7 @@ makePairPredicate pi i pd x =  pi i x && pd (getPairData x)  -- | -makePairedFilter :: ( Intervallic i0 a-                    , Intervallic (PairedInterval b) a) =>+makePairedFilter :: Ord a =>         ComparativePredicateOf2 (i0 a) ((PairedInterval b) a)     -> i0 a     -> (b -> Bool)
src/Hasklepias/Reexports.hs view
@@ -13,6 +13,8 @@      -- * Re-exports       module GHC.Num+    , module GHC.Generics+    , module GHC.Show     , module Control.Monad     , module Control.Applicative     , module Data.Bool@@ -33,7 +35,9 @@ ) where  import safe GHC.Num                         ( Integer )-import safe Control.Monad                   ( (=<<) )+import safe GHC.Generics                    ( Generic )+import safe GHC.Show                        ( Show(..) )+import safe Control.Monad                   ( (=<<), Functor(fmap) ) import safe Control.Applicative             ( (<$>) ) import safe Data.Bool                       ( Bool(..)                                             , (&&), not, (||)
src/Hasklepias/Types/Feature.hs view
@@ -9,9 +9,9 @@  {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE Safe #-}+{-# LANGUAGE FlexibleInstances #-}  module Hasklepias.Types.Feature(     -- * Types@@ -20,30 +20,23 @@     , FeatureData(..)     , MissingReason(..)     , FeatureDefinition(..)-    , defineEF-    , defineFEF-    , defineFEF2-    , defineFFF-    , applyEF-    , applyFEF-    , applyFFF-    , featureR-    , featureL-    , evalEFFeature-    , evalFEFFeature-    , evalFFFFeature+    , Defineable(..)+    , maybeFeature+    , featureDataR+    , featureDataL ) where  import GHC.Read                   ( Read ) import GHC.Show                   ( Show )-import GHC.Generics               ( Generic, D )+import GHC.Generics               ( Generic ) import Data.Either                ( Either(..) ) import Data.Eq                    ( Eq ) import Data.Functor               ( Functor(fmap) ) import Data.Function              ( ($), (.) )-import Data.Maybe                 ( Maybe(..) )+import Data.Maybe                 ( Maybe(..), maybe )+import Data.Ord                   ( Ord ) import Data.Text                  ( Text )-import Hasklepias.Types.Event     ( Events )+import Hasklepias.Types.Event     ( Event, Events ) import IntervalAlgebra            ( Interval, Intervallic ) -- import safe Test.QuickCheck       ( Property ) @@ -52,14 +45,19 @@       * its attributes       * the function needed to derive a feature (i.e. the 'FeatureDefinition') -}-data (Show b) => FeatureSpec b f e a d = FeatureSpec {+data (Show b) => FeatureSpec b k d = FeatureSpec {         getSpecName :: Text       , getSpecAttr :: b-      , getDefn :: FeatureDefinition f e a d+      , getDefn :: FeatureDefinition k 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+ {- | A 'Feature' contains the following:       * a name       * its attributes@@ -68,7 +66,7 @@ data (Show b) => Feature b d = Feature {         getName :: Text       , getAttr :: b-      , getData :: FeatureData d +      , getData :: FeatureData d       }  {- | 'FeatureData' is @'Either' 'MissingReason' d@, where @d@ can be any type @@ -80,13 +78,13 @@ instance Functor FeatureData where   fmap f (FeatureData x) = FeatureData (fmap f x) --- | Create the 'Right' side of a 'Feature'.-featureR :: d -> FeatureData d-featureR = FeatureData . Right+-- | Create the 'Right' side of 'FeatureData'.+featureDataR :: d -> FeatureData d+featureDataR = FeatureData . Right --- | Create the 'Left' side of a 'Feature'.-featureL :: MissingReason -> FeatureData d-featureL = FeatureData . Left+-- | Create the 'Left' side of 'FeatureData'.+featureDataL :: MissingReason -> FeatureData d+featureDataL = FeatureData . Left  -- | A 'Feature' may be missing for any number of reasons.  data MissingReason =@@ -96,103 +94,21 @@   | Unknown   deriving (Eq, Read, Show, Generic) --- | A type to hold common FeatureData definitions; i.e. functions that return +-- | A type to hold FeatureData definitions; i.e. functions that return  --  features.-data FeatureDefinition f e a d =-    EF  (Events a -> FeatureData d)-  | FEF (FeatureData e -> Events a -> FeatureData d)-  | FFF (FeatureData f -> FeatureData e -> FeatureData d)---- | Define an 'EF' FeatureDefinition-defineEF :: (Intervallic Interval a) =>-             MissingReason -          -- ^ The reason if @f@ returns 'Nothing' -          -> (Events a -> Maybe c) -          -- ^ A function that maps events to an some intermediary Maybe type. -          --   In the case that this function returns 'Nothing', you get a -          --   @Left@ FeatureData with the provided @MissingReason@. Otherwise, -          --   the 'Just' result is passed to the next function for final-          --   transformation to the desired @Feature@ type.-          -> (c -> d)              -          -- ^ A function that transforms the intermediary data to the desired -          --   type.-          -> FeatureDefinition * e a d-defineEF r f g = EF (\es ->-  case f es of-    Nothing -> featureL r-    Just x  -> featureR (g x)-  )---- | Extract an 'EF' FeatureDefinition.-applyEF :: FeatureDefinition * * a d -> Events a -> FeatureData d-applyEF (EF f) = f---- | TODO-defineFEF :: (Intervallic Interval a) =>-             MissingReason-          -- ^ The reason if the input 'Feature' is a 'Left'.-          -> (e -> Events a -> d)-          -- ^ A function that tranforms the data of a 'Right' input 'Feature'-          --   and a collection of events into the desired type.-          -> FeatureDefinition * e a d-defineFEF r g = FEF (\(FeatureData feat) es ->-  case feat of-    (Left _)  -> featureL r-    (Right x) -> featureR (g x es)-  )---- | TODO-defineFEF2 :: (Intervallic Interval a) =>-             MissingReason-          -- ^ The reason if the input 'Feature' is a 'Left'.-          -> (e -> Events a -> FeatureData d)-          -- ^ A function that tranforms the data of a 'Right' input 'Feature'-          --   and a collection of events into the desired type.-          -> FeatureDefinition * e a d-defineFEF2 r g = FEF (\(FeatureData feat) es ->-  case feat of-    (Left _)  -> featureL r-    (Right x) -> g x es-  )---- | Extract a 'FEF' FeatureDefinition-applyFEF :: FeatureDefinition * e a d -> FeatureData e -> Events a -> FeatureData d-applyFEF (FEF f) = f---- | TODO-defineFFF :: -        MissingReason-    ->  MissingReason      -    -> (f -> e -> d) -    -> FeatureDefinition f e * d-defineFFF r1 r2 g = FFF (\(FeatureData feat1) (FeatureData feat2) ->-    case ( feat1, feat2 ) of -      ( Left _ , Left _ ) -> featureL r1-      ( Left _ , _      ) -> featureL r1-      ( _      , Left _ ) -> featureL r2-      ( Right x, Right y) -> featureR $ g x y-  )---- | Extract a 'FFF' FeatureDefinition-applyFFF :: FeatureDefinition f e * d -> FeatureData f -> FeatureData e -> FeatureData d-applyFFF (FFF f) = f+newtype FeatureDefinition input d = MkFeatureDef (input -> FeatureData d) --- | TODO-makeFeatureSpec :: Show b => Text -> b -> FeatureDefinition f e a d ->  -  FeatureSpec b f e a d-makeFeatureSpec = FeatureSpec+class Defineable input where+  define :: (input -> FeatureData d) -> FeatureDefinition input d+  define = MkFeatureDef --- | TODO-evalEFFeature :: Show b => FeatureSpec b * * a d -> Events a -> Feature b d -evalEFFeature (FeatureSpec n atr def) es = -    Feature n atr (applyEF def es)+  eval :: FeatureDefinition input d -> input -> FeatureData d+  eval (MkFeatureDef def) x = def x --- | TODO -evalFEFFeature :: Show b => FeatureSpec b * e a d -> Feature b e -> Events a -> Feature b d -evalFEFFeature (FeatureSpec n atr def) feat es =-    Feature n atr (applyFEF def (getData feat) es)+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 --- | TODO-evalFFFFeature :: Show b => FeatureSpec b f e * d -> Feature b f -> Feature b e -> Feature b d -evalFFFFeature (FeatureSpec n atr def) feat1 feat2 =-    Feature n atr (applyFFF def (getData feat1) (getData feat2))+maybeFeature :: MissingReason -> (a -> Maybe c) -> (c -> d) -> (a -> FeatureData d)+maybeFeature r f g x = maybe (featureDataL r) (featureDataR . g) (f x)
test/Hasklepias/Types/Feature/AesonSpec.hs view
@@ -22,8 +22,8 @@   -> FeatureData (Interval a) index es =     case firstConceptOccurrence ["enrollment"] es of-        Nothing -> featureL (Other "No Enrollment")-        Just x  -> featureR (getInterval x)+        Nothing -> featureDataL (Other "No Enrollment")+        Just x  -> featureDataR (getInterval x)   spec :: Spec