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 +10/−0
- examples/ExampleEvents.hs +1/−1
- examples/ExampleFeatures1.hs +133/−95
- examples/ExampleFeatures2.hs +5/−6
- examples/ExampleFeatures3.hs +27/−21
- hasklepias.cabal +4/−4
- src/Hasklepias/Functions.hs +2/−5
- src/Hasklepias/Reexports.hs +5/−1
- src/Hasklepias/Types/Feature.hs +37/−121
- test/Hasklepias/Types/Feature/AesonSpec.hs +2/−2
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