hasklepias (empty) → 0.4.2
raw patch · 26 files changed
+1720/−0 lines, 26 filesdep +QuickCheckdep +aesondep +base
Dependencies added: QuickCheck, aeson, base, bytestring, containers, flow, hasklepias, hspec, interval-algebra, safe, text, time, unordered-containers, vector
Files
- ChangeLog.md +64/−0
- LICENSE +30/−0
- README.md +67/−0
- examples/ExampleEvents.hs +134/−0
- examples/ExampleFeatures1.hs +202/−0
- examples/ExampleFeatures2.hs +46/−0
- examples/ExampleFeatures3.hs +55/−0
- examples/Main.hs +18/−0
- hasklepias.cabal +111/−0
- src/Hasklepias.hs +24/−0
- src/Hasklepias/Functions.hs +143/−0
- src/Hasklepias/Reexports.hs +55/−0
- src/Hasklepias/Types.hs +20/−0
- src/Hasklepias/Types/Context.hs +132/−0
- src/Hasklepias/Types/Context/Arbitrary.hs +39/−0
- src/Hasklepias/Types/Event.hs +95/−0
- src/Hasklepias/Types/Event/Aeson.hs +80/−0
- src/Hasklepias/Types/Event/Arbitrary.hs +48/−0
- src/Hasklepias/Types/Feature.hs +113/−0
- src/Hasklepias/Types/Feature/Aeson.hs +28/−0
- test/Hasklepias/FunctionsSpec.hs +30/−0
- test/Hasklepias/Types/ContextSpec.hs +28/−0
- test/Hasklepias/Types/Event/AesonSpec.hs +64/−0
- test/Hasklepias/Types/EventSpec.hs +58/−0
- test/Hasklepias/Types/Feature/AesonSpec.hs +34/−0
- test/Spec.hs +2/−0
+ ChangeLog.md view
@@ -0,0 +1,64 @@+# Changelog for hasklepias++## 0.4.2++* Updates `interval-algebra` to 0.8.0++## 0.4.1++* Modifies the example in `example/ExampleFeatures3` to use the pipe `|>` operator.+* Adds the `hasAllConcepts` function to the `HasConcepts` class.+* Adds a `Reexports` module with the goal to re-export everything one might need from other Haskell libraries to build a cohort.+* Removes a number of unneeded/unused functions from the `Functions` module.+* Adds the `Safe` language extension to modules where possible.++## 0.4.0++* Adds the `FeatureDefinition` to represent common patterns for building `Feature`s:++```haskell+data FeatureDefinition e a d =+ EF (Events a -> Feature d)+ | FEF (Feature e -> Events a -> Feature d)+```++* Provides an initial set of functions designed to make defining `Feature`s easier, namely `defineEF` and `defineFEF`. These functions construct `FeatureDefinition`s of using `EF` and `FEF` constructors, respectively. The example features in `examples/ExampleFeatures1` demonstrate their use.+* Adds the `allPairs` function to form all pairs of elements of two lists.+* Adds the `splitByConcepts` to split a container of events into a pair such that first element contains+events have any of the first argument's concepts, and similarly for the second element.+* Demonstrates how `allPairs` and `splitByConcepts` might be used in the `examples/ExampleFeatures3` module.+* Adds a rudimentary `ToJSON` instance for `Feature`s so that data can be encoded and output from the software. This is pretty rough; e.g. encoding an `Interval Int` feature produces: `"{\"end\":10,\"begin\":0}"`.+* Removes the `Transformations` module and `transformToMeetingSequence` function. The same functionality is available by using the `formMeetingSequence` function from `interval-algebra`. See `examples/ExampleFeatures2` for the updated example.+* Adds the `toConceptEventOf` function which creates a `ConceptEvent` but takes the `intersection` of `Concepts` in the first argument and concepts in the context of the `Event` in the second argument to form the new `ConceptEvent`. This is a way to keep only those concepts you need in the event.++## 0.3.0++* Updates code as needed to work with interval-algebra v0.6.2. In particular, the `Event a` is now a synonym for `PairedInterval Context a`, hence any methods that work on the `PairedInterval` also work for the `Event` type.+* Adds the `ConceptEvent a` type which is a synonym for `PairedInterval Concept a`; i.e, this is an event without facts or a source.+* Adds the `toConceptEvent` function for dropping from an `Event a` to a `ConceptEvent a`, and `mkConceptEvent` function for directly making a `ConceptEvent` from concepts and an interval.+* Adds generators for lists of arbitrary events. The generator for `Concepts` is limited at this point; it simply takes a subsample of the first 10 letters of the alphabet. Currently, only generators for `Event Int` are provided by the `generateEventsInt`. For example, in the `repl` `generateEventsInt 2` produces two randomly generated events:++```haskell+*Hasklepias> generateEventsInt 2+[{(-33, -16), Context {getConcepts = fromList ["G","I"], getFacts = Nothing, getSource = Nothing}},{(12, 13), Context {getConcepts = fromList ["A","C","D","E","G","I"], getFacts = Nothing, getSource = Nothing}}]+```++* Adds the `transformToMeetingSequence` function which takes a set of concepts and a list of possibly non-disjoint `ConceptEvents`s and returns a list of `ConceptEvents`, where each consecutive event meets the next. Moreover, only those concepts selected (in the first argument) are kept in the output list of events. In the case that none of the events have the chosen concepts during an interval, an `ConceptEvent` with an empty set of concept is returned. A few examples might make this more clear.++```haskell+*Hasklepias> :set -XOverloadedStrings+*Hasklepias> x <- fmap (map toConceptEvent) (generateEventsInt 1)+*Hasklepias> x+[{(3, 4), fromList ["B","C"]}]+*Hasklepias> transformToMeetingSequence (map packConcept ["A"]) x+[{(3, 4), fromList []}]+*Hasklepias> transformToMeetingSequence (map packConcept ["B"]) x+[{(3, 4), fromList ["B"]}]+*Hasklepias> x <- fmap (map toConceptEvent) (generateEventsInt 10)+*Hasklepias> x+[{(-44, 7), fromList ["C","D","E","F","H","J"]},{(-30, -29), fromList ["A","B","F","G","H","I","J"]},{(-25, 5), fromList ["C","D","E","I"]},{(-20, -19), fromList ["A","C","E","G","I","J"]},{(-17, -16), fromList ["B","D","F","J"]},{(-6, -5), fromList ["E","F","H","J"]},{(2, 21), fromList ["A","F","J"]},{(18, 19), fromList ["D","F","G","H","I"]},{(19, 20), fromList ["B","C","D","E","F","H"]},{(30, 31), fromList ["B","C","D","H","J"]}]+*Hasklepias> transformToMeetingSequence (map packConcept ["B", "I"]) x+[{(-44, -30), fromList []},{(-30, -29), fromList ["B","I"]},{(-29, -25), fromList []},{(-25, -17), fromList ["I"]},{(-17, -16), fromList ["B","I"]},{(-16, 5), fromList ["I"]},{(5, 18), fromList []},{(18, 19), fromList ["I"]},{(19, 20), fromList ["B"]},{(20, 30), fromList []},{(30, 31), fromList ["B"]}]+```++* Adds an example of `transformToMeetingSequence` could be used to derive a feature that is the list of durations that a subject was both hospitalized and on antibiotics at the same time in the `examples/ExampleFeatures2` module.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Bradley Saul (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Bradley Saul nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,67 @@+# Project Asclepias++_Asclepias (n)_:++1. The genus of North American milkweeds, named after Linnaeus after the greek god of healing, Asclepius.+2. A language and software project for defining and deriving features from temporally ordered events using the [interval algebra](https://hackage.haskell.org/package/interval-algebra-0.8.0).++## Current status++The initial versions of `hasklepias` will focus on the ability to derive features from a sorted collection of events. At this time, developers can experiment with feature definitions (see the `examples` directory).++## Getting started++The official implementation of Asclepias is the embedded domain specific language (eDSL) provided by the `hasklepias` [Haskell](https://www.haskell.org/) library. To get started then, you'll need to install the Haskell toolchain, especially the [Glasgow Haskell Compiler](https://www.haskell.org/ghc/) (GHC) and the building and packaging system [cabal](https://www.haskell.org/cabal/), for which you can use the [`ghcup` utility](https://www.haskell.org/ghcup/).++You can use any development environment you chose, but for maximum coding pleasure, it is highly recommended that you install the [Haskell language server](https://github.com/haskell/haskell-language-server) (`hsl`). This can be installed using `ghcup` or some integrated development environments, such as [Visual Studio Code](https://code.visualstudio.com/), have [excellent `hsl` integration](https://marketplace.visualstudio.com/items?itemName=haskell.haskell).++## Defining features++At this time, `hasklepias` can be used for experimenting with `Feature` definitions. A `Feature d` is currently a wrapper of an [`Either`](https://hackage.haskell.org/package/base-4.15.0.0/docs/Data-Either.html) type:++```haskell+type Feature d = Feature { getFeature :: Either MissingReason d }+```++The `Either` type means there are two possibilities for the type of a `Feature`. The `Left` can be a `MissingReason`, which is a sum type enumerating the reasons that the data is missing:++```haskell+data MissingReason = -- this list may grow/change in the future+ InsufficientData+ | Excluded+ | Other String+ | Unknown+```++The `Right` has the type `d`, meaning it can be any type you choose. In the module`ExampleFeatures1`, the `index` feature has type `Feature (Interval a)`. The (`Right`) type of `index` is an `Interval a`, where again `a` can be any type you chose, subject to the constraints of intervals. The `hasDuckHistory` feature has the type `Feature (Bool, Maybe (Interval a)`, where the `Bool` is used an indicator of a history with ducks and the `Maybe (Interval a)` is the `Interval a` of the last encounter with a duck if it exists. The `countOfHospitalEvents` feature has the type `Feature (Int, Maybe b)` where the `Int` is the count of hospital visits and `Maybe b` is the duration of the last visit if one exists. These examples show how the data (or shape) of a `Feature` can be defined as `Interval a`, `(Bool, Maybe (Interval a))`, or `(Int, Maybe b)`. In fact, as long as the data is derivable from other `Feature`s and/or a list of `Event`s, you can shape a `Feature` however you'd like!++## Interactive use/development++To run the examples interactively, open a `ghci` session with:++```sh+cabal repl hasklepias:examples --repl-options -itest+```++The option flag `--repl-options -itest` allows to make changes to the files in the `examples` folder and reload with `:reload` (or `:r`) without exiting the `ghci` session. Developers working on `src` files can add the `--repl-options -isrc` option flag to make changes to `src` files too.++In `ghci` you have access to all exposed functions in `hasklepias`, `interval-algebra`, and those in the `examples` folders. For example, `exampleEvents1` is a list of events used to check some of the example features, which you can interact with:++```sh+*Main> headMay exampleEvents1+Just {(1, 10), Context {getConcepts = ["enrollment"], getFacts = Nothing, getSource = Nothing}}+*Main> length exampleEvents1+24+*Main> combineIntervals $ intervals exampleEvents1+[(1, 10),(11, 20),(21, 30),(31, 40),(45, 100)]+*Main> mapM_ print exampleEvents1+{(1, 10), Context {getConcepts = fromList ["enrollment"], getFacts = Nothing, getSource = Nothing}}+{(2, 3), Context {getConcepts = fromList ["wasScratchedByCat"], getFacts = Nothing, getSource = Nothing}}+{(5, 6), Context {getConcepts = fromList ["hadMinorSurgery"], getFacts = Nothing, getSource = Nothing}}+{(5, 10), Context {getConcepts = fromList ["tookAntibiotics"], getFacts = Nothing, getSource = Nothing}}+{(11, 20), Context {getConcepts = fromList ["enrollment"], getFacts = Nothing, getSource = Nothing}}+{(21, 30), Context {getConcepts = fromList ["enrollment"], getFacts = Nothing, getSource = Nothing}}+{(31, 40), Context {getConcepts = fromList ["enrollment"], getFacts = Nothing, getSource = Nothing}}+{(45, 46), Context {getConcepts = fromList ["wasStruckByDuck"], getFacts = Nothing, getSource = Nothing}}+<<<result truncated>>>+```
+ examples/ExampleEvents.hs view
@@ -0,0 +1,134 @@+{-|+Module : Example Hasklepias Events+Description : TODO+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}+{-# LANGUAGE OverloadedStrings #-}++module ExampleEvents (+ exampleEvents1+ , exampleEvents2+ , exampleEvents3+ , exampleEvents4+) where+ +import IntervalAlgebra ( beginerval, IntervalSizeable )+import Hasklepias.Types.Event ( event, Event, Events )+import Hasklepias.Types.Context ( context, packConcepts )+import Data.List ( sort )+import Data.Text(Text)++exampleEvents1 :: Events Int+exampleEvents1 = toEvents exampleEvents1Data++exampleEvents2 :: Events Int+exampleEvents2 = toEvents exampleEvents2Data++exampleEvents3 :: Events Int +exampleEvents3 = toEvents exampleEvents3Data++exampleEvents4 :: Events Int +exampleEvents4 = toEvents exampleEvents4Data++type EventData a = (a, a, Text)++toEvent :: (IntervalSizeable a 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+toEvents = sort.map toEvent++t1 :: (a, b, c) -> a+t1 (x , _ , _) = x+t2 :: (a, b, c) -> b+t2 (_ , x , _) = x+t3 :: (a, b, c) -> c+t3 (_ , _ , x) = x++exampleEvents1Data :: [EventData Int]+exampleEvents1Data = [+ (9, 1, "enrollment")+ , (9, 11, "enrollment")+ , (9, 21, "enrollment")+ , (9, 31, "enrollment")+ , (5, 45, "enrollment")+ , (9, 51, "enrollment")+ , (2, 61, "enrollment")+ , (9, 71, "enrollment")+ , (19, 81, "enrollment")+ , (1, 2, "wasScratchedByCat")+ , (1, 45, "wasStruckByDuck")+ , (1, 46, "wasBitByDuck")+ , (1, 49, "wasBitByDuck")+ , (1, 51, "wasBitByDuck")+ , (1, 60, "wasBitByOrca")+ , (1, 91, "wasStuckByCow")+ , (1, 5, "hadMinorSurgery")+ , (1, 52, "hadMajorSurgery")+ , (5, 5, "tookAntibiotics")+ , (8, 52, "wasHospitalized")+ , (6, 45, "tookAntibiotics")+ , (13, 60, "tookAntibiotics")+ , (3, 80, "tookAntibiotics")+ , (1, 95, "died")+ ]++exampleEvents2Data :: [EventData Int]+exampleEvents2Data = [+ (9, 1, "enrollment")+ , (14, 21, "enrollment")+ , (9, 31, "enrollment")+ , (14, 45, "enrollment")+ , (9, 60, "enrollment")+ , (2, 61, "enrollment")+ , (9, 80, "enrollment")+ , (1, 2, "wasPeckedByChicken")+ , (1, 3, "wasPeckedByChicken")+ , (1, 4, "wasPeckedByChicken")+ , (1, 5, "wasPeckedByChicken")+ , (1, 10, "wasInjuredBySquirrel")+ , (1, 15, "wasDiagnosedWithSciurophobia")+ , (1, 20, "hadSquirrelContact")+ , (1, 20, "hadAnxietyAttack")+ ]++exampleEvents3Data :: [EventData Int]+exampleEvents3Data = [+ (9, 1, "enrollment")+ , (9, 11, "enrollment")+ , (9, 21, "enrollment")+ , (9, 31, "enrollment")+ , (5, 45, "enrollment")+ , (9, 51, "enrollment")+ , (2, 61, "enrollment")+ , (9, 71, "enrollment")+ , (19, 81, "enrollment")+ , (1, 2, "wasScratchedByCat")+ , (1, 45, "wasStruckByDuck")+ , (1, 46, "wasBitByDuck")+ , (1, 49, "wasBitByDuck")+ , (1, 51, "wasBitByDuck")+ , (1, 60, "wasBitByOrca")+ , (1, 91, "wasStuckByCow")+ , (1, 5, "hadMinorSurgery")+ , (1, 52, "hadMajorSurgery")+ , (5, 5, "tookAntibiotics")+ , (8, 52, "wasHospitalized")+ , (10, 45, "tookAntibiotics")+ , (15, 58, "tookAntibiotics")+ , (3, 80, "tookAntibiotics")+ , (1, 95, "died") + ]++exampleEvents4Data :: [EventData Int]+exampleEvents4Data = [+ (1, 1, "c1")+ , (3, 11, "c1")+ , (9, 16, "c1")+ , (9, 31, "c1")+ , (5, 45, "c1")+ , (1, 10, "c2")+ , (1, 13, "c2")+ ]
+ examples/ExampleFeatures1.hs view
@@ -0,0 +1,202 @@+{-|+Module : ExampleFeatures1+Description : Demostrates how to define features using Hasklepias+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE NoImplicitPrelude #-}++module ExampleFeatures1(+ exampleFeatures1Spec+) where++import Hasklepias+import ExampleEvents+import Test.Hspec+++{-+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++{- +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 feature can be used to filter events+based on different predicate functions.+-}+baseline :: (Intervallic Interval a, IntervalSizeable a b) =>+ Feature (Interval a) -- ^ pass the result of index to get a baseline filter+ -> Feature (Interval a)+baseline = fmap (enderval 60 . begin)++bline :: (Intervallic Interval a, IntervalSizeable a b) =>+ Events a+ -> Feature (Interval a)+bline = baseline . applyEF indexDef++flwup :: (Intervallic Interval a, IntervalSizeable a b) =>+ Events a+ -> Feature (Interval a)+flwup = fmap (beginerval 30 . begin) . applyEF 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"]+ )++{-+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))+ )+ where f i x = makePairedFilter enclose i (`hasConcepts` cnpts) x++duckHxDef :: (Intervallic Interval a) =>+ FeatureDefinition (Interval a) a (Bool, Maybe (Interval a))+duckHxDef = makeHxDef ["wasBitByDuck", "wasStruckByDuck"]++macawHxDef :: (Intervallic Interval a) =>+ FeatureDefinition (Interval a) 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)+ )++-- | 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+ )++-- | 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+ )++-- | time of distcontinuation of antibiotics+-- and time from start of follow up+-- This needs to be generalized as Nothing could either indicate they didn't +-- discontinue or that they simply got no antibiotics records.+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 + -- 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+ )++getUnitFeatures ::+ Events Int+ -> (Feature (Interval Int)+ , Feature Bool+ , Feature (Bool, Maybe (Interval Int))+ , Feature (Bool, Maybe (Interval Int))+ , Feature Bool+ , Feature (Maybe Int)+ , Feature (Int, Maybe Int)+ , Feature (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+ )++exampleFeatures1Spec :: Spec+exampleFeatures1Spec = do++ 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)+ )++ 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+ )
+ examples/ExampleFeatures2.hs view
@@ -0,0 +1,46 @@+{-|+Module : ExampleFeatures2+Description : Demostrates how to define features using Hasklepias+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE NoImplicitPrelude #-}+module ExampleFeatures2(+ exampleFeatures2Spec+) where++import Hasklepias+import ExampleEvents+import Test.Hspec++durationOfHospitalizedAntibiotics:: (Intervallic (PairedInterval Concepts) a+ , Intervallic Interval a+ , IntervalSizeable a b) =>+ Events a+ -> Feature [b]+durationOfHospitalizedAntibiotics es+ | null y = featureL $ Other "no cases"+ | otherwise = featureR $ durations y+ where conceptsText = ["wasHospitalized", "tookAntibiotics"] + concepts = map packConcept conceptsText+ x = formMeetingSequence (map (toConceptEventOf concepts) es)+ y = filter (\z -> hasAllConcepts (getPairData z) conceptsText ) x +++exampleFeatures2Spec :: Spec+exampleFeatures2Spec = do++ it "durationOfHospitalizedAntibiotics from exampleEvents1" $+ durationOfHospitalizedAntibiotics exampleEvents1 `shouldBe` + featureL (Other "no cases")++ it "durationOfHospitalizedAntibiotics from exampleEvents3" $+ durationOfHospitalizedAntibiotics exampleEvents3 `shouldBe` + featureR [3, 2]
+ examples/ExampleFeatures3.hs view
@@ -0,0 +1,55 @@+{-|+Module : ExampleFeatures3+Description : Demostrates how to define features using Hasklepias+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE NoImplicitPrelude #-}++module ExampleFeatures3(+ exampleFeatures3Spec+) where++import Hasklepias+import ExampleEvents ( exampleEvents4 )+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+ )+++flwup :: Feature (Interval Int)+flwup = featureR $ beginerval 50 0++exampleFeatures3Spec :: Spec+exampleFeatures3Spec = do++ it "examplePairComparison" $+ applyFEF examplePairComparison flwup exampleEvents4 `shouldBe`+ featureR (True, Just 16)+
+ examples/Main.hs view
@@ -0,0 +1,18 @@+module Main(+ module Hasklepias+ , module ExampleEvents+ , module ExampleFeatures1+ , main+) where++import Hasklepias+import ExampleEvents+import ExampleFeatures1+import ExampleFeatures2+import ExampleFeatures3+import Test.Hspec ( hspec )++main :: IO ()+main = hspec $ do exampleFeatures1Spec+ exampleFeatures2Spec+ exampleFeatures3Spec
+ hasklepias.cabal view
@@ -0,0 +1,111 @@+cabal-version: 2.2+name: hasklepias+version: 0.4.2+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+author: Bradley Saul+maintainer: bsaul@novisci.com+copyright: NoviSci, Inc+category: Data Science+synopsis: Define features from events+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/novisci/asclepias++library+ exposed-modules:+ Hasklepias+ Hasklepias.Functions+ Hasklepias.Reexports+ Hasklepias.Types+ Hasklepias.Types.Feature+ Hasklepias.Types.Feature.Aeson+ Hasklepias.Types.Context+ Hasklepias.Types.Context.Arbitrary+ Hasklepias.Types.Event+ Hasklepias.Types.Event.Aeson+ Hasklepias.Types.Event.Arbitrary+ other-modules:+ Paths_hasklepias+ autogen-modules:+ Paths_hasklepias + hs-source-dirs:+ src+ build-depends:+ aeson >=1.4.0.0 && <2+ , base >=4.14 && <4.15+ , bytestring >=0.10+ , containers >=0.6.0+ , flow == 1.0.22+ , interval-algebra == 0.8.0+ , text >=1.2.3+ , time >=1.9+ , unordered-containers >=0.2.10+ , safe >= 0.3+ , vector >=0.12+ , QuickCheck+ default-language: Haskell2010++test-suite hasklepias-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Hasklepias.FunctionsSpec+ Hasklepias.Types.ContextSpec+ Hasklepias.Types.Event.AesonSpec+ Hasklepias.Types.EventSpec+ Hasklepias.Types.Feature.AesonSpec+ Paths_hasklepias+ autogen-modules:+ Paths_hasklepias + hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ aeson >=1.4.0.0 && <2+ , base >=4.7 && <5+ , bytestring >=0.10+ , containers >=0.6.0+ , flow == 1.0.22+ , hasklepias+ , hspec+ , interval-algebra == 0.8.0+ , text >=1.2.3+ , time >=1.9+ , unordered-containers >=0.2.10+ , vector >=0.12+ , QuickCheck+ default-language: Haskell2010++test-suite examples+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ ExampleEvents+ ExampleFeatures1+ ExampleFeatures2+ ExampleFeatures3+ hs-source-dirs:+ examples+ build-depends:+ hasklepias+ , hspec+ , base >=4.14 && <4.15+ , flow == 1.0.22+ , interval-algebra == 0.8.0+ , text >=1.2.3+ , bytestring >=0.10+ , containers >=0.6.0+ , time >=1.9+ , aeson >=1.4.0.0 && <2+ , unordered-containers >=0.2.10+ , vector >=0.12+ default-language: Haskell2010
+ src/Hasklepias.hs view
@@ -0,0 +1,24 @@+{-|+Module : Hasklepias+Description : Everything you should need to get up and running with + hasklepias.+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}++module Hasklepias (+ module Hasklepias.Types+ , module Hasklepias.Functions+ , module Hasklepias.Reexports+ , module IntervalAlgebra+ , module IntervalAlgebra.IntervalUtilities+ , module IntervalAlgebra.PairedInterval+) where++import IntervalAlgebra+import IntervalAlgebra.IntervalUtilities+import IntervalAlgebra.PairedInterval+import Hasklepias.Types+import Hasklepias.Functions+import Hasklepias.Reexports
+ src/Hasklepias/Functions.hs view
@@ -0,0 +1,143 @@+{-|+Module : Hasklepias Feature building functions +Description : Functions for composing features. +Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com++Provides functions used in defining 'Feature's.+-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE Safe #-}++module Hasklepias.Functions(++ -- * Container predicates+ isNotEmpty+ , atleastNofX+ , twoXOrOneY++ -- * Finding occurrences of concepts+ , nthConceptOccurrence+ , firstConceptOccurrence++ -- * Reshaping containers+ , allPairs+ , splitByConcepts++ -- * Create filters+ , makeConceptsFilter+ , makePairedFilter+) where++import Data.Text ( Text )+import Control.Applicative ( Applicative(liftA2) )+import IntervalAlgebra ( Intervallic(..)+ , ComparativePredicateOf1+ , ComparativePredicateOf2+ , Interval )+import IntervalAlgebra.PairedInterval ( PairedInterval, getPairData )+-- import IntervalAlgebra.IntervalUtilities ( compareIntervals )+import Hasklepias.Types.Event ( Events+ , Event+ , ConceptEvent+ , ctxt )+import Hasklepias.Types.Context ( Concept+ , Concepts+ , Context+ , HasConcept( hasConcepts ) )+import Safe ( headMay, lastMay ) +import safe Data.Bool ( Bool, (&&), not, (||) )+import safe Data.Function ( (.), ($) )+import safe Data.Int ( Int )+import safe Data.List ( filter, length, null )+import safe Data.Maybe ( Maybe(..) )+import safe Data.Ord ( Ord((>=)) )+++-- | Is the input list empty? +isNotEmpty :: [a] -> Bool+isNotEmpty = not.null++-- | Filter 'Events' to those that have any of the provided concepts.+makeConceptsFilter ::+ [Text] -- ^ the list of concepts by which to filter + -> Events a+ -> Events a+makeConceptsFilter cpts = filter (`hasConcepts` cpts)++-- | Filter 'Events' to a single @'Maybe' 'Event'@, based on a provided function,+-- with the provided concepts. For example, see 'firstConceptOccurrence' and+-- 'lastConceptOccurrence'.+nthConceptOccurrence ::+ (Events a -> Maybe (Event a)) -- ^ function used to select a single event+ -> [Text]+ -> Events a+ -> Maybe (Event a)+nthConceptOccurrence f c = f.makeConceptsFilter c++-- | Finds the *first* occurrence of an 'Event' with at least one of the concepts.+-- Assumes the input 'Events' list is appropriately sorted.+firstConceptOccurrence ::+ [Text]+ -> Events a+ -> Maybe (Event a)+firstConceptOccurrence = nthConceptOccurrence headMay++-- | Finds the *last* occurrence of an 'Event' with at least one of the concepts.+-- Assumes the input 'Events' list is appropriately sorted.+lastConceptOccurrence ::+ [Text]+ -> Events a+ -> Maybe (Event a)+lastConceptOccurrence = nthConceptOccurrence lastMay++-- | Does 'Events' have at least @n@ events with any of the Concept in @x@.+atleastNofX ::+ Int -- ^ n+ -> [Text] -- ^ x+ -> Events a -> Bool+atleastNofX n x es = length (makeConceptsFilter x es) >= n++-- | TODO+twoXOrOneY :: [Text] -> [Text] -> Events a -> Bool+twoXOrOneY x y es = atleastNofX 2 x es ||+ atleastNofX 1 y es++-- | 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) =>+ ComparativePredicateOf2 (i0 a) ((PairedInterval b) a)+ -> i0 a+ -> (b -> Bool)+ -> (PairedInterval b a -> Bool)+makePairPredicate pi i pd x = pi i x && pd (getPairData x)++-- | +makePairedFilter :: ( Intervallic i0 a+ , Intervallic (PairedInterval b) a) =>+ ComparativePredicateOf2 (i0 a) ((PairedInterval b) a)+ -> i0 a+ -> (b -> Bool)+ -> [PairedInterval b a]+ -> [PairedInterval b a]+makePairedFilter fi i fc = filter (makePairPredicate fi i fc)++-- | Generate all pair-wise combinations from two lists.+allPairs :: [a] -> [a] -> [(a, a)]+allPairs = liftA2 (,)++-- | Split an @Events a@ into a pair of @Events a@. The first element contains+-- events have any of the concepts in the first argument, similarly for the+-- second element.+splitByConcepts :: [Text] + -> [Text]+ -> Events a+ -> (Events a, Events a)+splitByConcepts c1 c2 es = ( filter (`hasConcepts` c1) es+ , filter (`hasConcepts` c2) es)
+ src/Hasklepias/Reexports.hs view
@@ -0,0 +1,55 @@+{-|+Module : Hasklepias Types+Description : Re-exports functions from other libraries needed for using+ Hasklepias as a standalone import.+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}++{-# LANGUAGE Safe #-}++module Hasklepias.Reexports (++ -- * Re-exports+ module Control.Monad+ , module Control.Applicative+ , module Data.Bool+ , module Data.Int+ , module Data.Maybe+ , module Data.Function+ , module Data.Functor+ , module Data.List+ , module Data.Ord+ , module Data.Text+ , module Data.Tuple+ , module Safe+ , module Flow+) where++import safe Control.Monad ( (=<<) )+import safe Control.Applicative ( (<$>) )+import safe Data.Bool ( Bool(..)+ , (&&), not, (||)+ , bool+ , otherwise )+import safe Data.Function ( (.), ($) )+import safe Data.Functor ( fmap )+import safe Data.Int ( Int )+import safe Data.List ( all, map, filter, length, null )+import safe Data.Maybe ( Maybe(..),+ maybe,+ isJust,+ catMaybes,+ fromJust,+ fromMaybe,+ isNothing,+ listToMaybe,+ mapMaybe,+ maybeToList )+import safe Data.Ord ( Ord((>=), (<), (>), (<=))+ , max, min )+import safe Data.Text ( pack, Text )+import safe Data.Tuple ( fst, snd, uncurry, curry )+import safe Flow ( (!>), (.>), (<!), (<.), (<|), (|>) )+import Safe ( headMay, lastMay )
+ src/Hasklepias/Types.hs view
@@ -0,0 +1,20 @@+{-|+Module : Hasklepias Types+Description : Re-exports all the Hasklepias type modules+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}++module Hasklepias.Types (+ module Hasklepias.Types.Context+ , module Hasklepias.Types.Event+ , module Hasklepias.Types.Feature+ , module Hasklepias.Types.Event.Arbitrary+ +) where++import Hasklepias.Types.Event+import Hasklepias.Types.Event.Arbitrary+import Hasklepias.Types.Context+import Hasklepias.Types.Feature
+ src/Hasklepias/Types/Context.hs view
@@ -0,0 +1,132 @@+{-|+Module : Hasklepias Contexts+Description : Defines the Context type and its component types, constructors, + and class instances+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Safe #-}++module Hasklepias.Types.Context(+ Context(getConcepts)+ , context+ , emptyContext++ , Concept+ , Concepts+ , toConcepts+ , fromConcepts+ , packConcept+ , unpackConcept+ , packConcepts+ , unpackConcepts+ , HasConcept(..)+) where++import GHC.Show ( Show(show) )+import Data.Bool ( Bool )+import Data.Eq ( Eq )+import Data.Function ((.), ($))+import Data.List ( all, any, map )+import Data.Maybe ( Maybe(Nothing) )+import Data.Monoid ( (<>), Monoid(mempty) )+import Data.Ord ( Ord )+import Data.Semigroup ( Semigroup((<>)) )+import Data.Text (Text)+import Data.Set (Set+ , fromList, union, empty, map, toList, member)++-- | A @Context@ consists of three parts: @concepts@, @facts@, and @source@. +-- +-- At this time, @facts@ and @source@ are simply stubs to be fleshed out in +-- later versions of hasklepias. +data Context = Context {+ getConcepts :: Concepts+ , getFacts :: Maybe Facts+ , getSource :: Maybe Source+} deriving (Eq, Show)++data Facts = Facts deriving (Eq, Show)+data Source = Source deriving (Eq, Show)++instance Semigroup Context where+ x <> y = Context (getConcepts x <> getConcepts y) Nothing Nothing++instance Monoid Context where+ mempty = emptyContext++instance HasConcept Context where+ hasConcept ctxt concept = + member (packConcept concept) (fromConcepts $ getConcepts ctxt)++-- | Smart contructor for Context type+--+-- Creates 'Context' from a list of 'Concept's. At this time, the @facts@ and+-- @source@ are both set to 'Nothing'.+context :: Concepts -> Context+context x = Context x Nothing Nothing++-- | Just an empty Context+emptyContext :: Context+emptyContext = Context mempty Nothing Nothing++-- | A @Concept@ is textual "tag" for a context.+newtype Concept = Concept Text deriving (Eq, Ord)++instance Show Concept where+ show (Concept x) = show x++-- | Pack text into a concept+packConcept :: Text -> Concept+packConcept = Concept++-- | Unpack text from a concept+unpackConcept :: Concept -> Text +unpackConcept (Concept x) = x++-- | @Concepts@ is a 'Set' of 'Concepts's.+newtype Concepts = Concepts ( Set Concept )+ deriving (Eq, Show)++instance Semigroup Concepts where+ Concepts x <> Concepts y = Concepts (x <> y)++instance Monoid Concepts where+ mempty = Concepts mempty++-- | Constructor for 'Concepts'.+toConcepts :: Set Concept -> Concepts+toConcepts = Concepts++fromConcepts :: Concepts -> Set Concept+fromConcepts (Concepts x) = x++-- | Put a list of text into a set concepts.+packConcepts :: [Text] -> Concepts+packConcepts x = Concepts $ fromList $ Data.List.map packConcept x++-- | Take a set of concepts to a list of text.+unpackConcepts :: Concepts -> [Text]+unpackConcepts (Concepts x) = toList $ Data.Set.map unpackConcept x ++{- |+The 'HasConcept' typeclass provides predicate functions for determining whether+an @a@ has a concept.+-}+class HasConcept a where+ -- | Does an @a@ have a particular 'Concept'?+ hasConcept :: a -> Text -> Bool++ -- | Does an @a@ have *any* of a list of 'Concept's?+ hasConcepts :: a -> [Text] -> Bool+ hasConcepts x = any (\c -> x `hasConcept` c)++ -- | Does an @a@ have *all* of a list of `Concept's?+ hasAllConcepts :: a -> [Text] -> Bool+ hasAllConcepts x = all (\c -> x `hasConcept` c) ++instance HasConcept Concepts where+ hasConcept (Concepts e) concept = member (packConcept concept) e
+ src/Hasklepias/Types/Context/Arbitrary.hs view
@@ -0,0 +1,39 @@+{-|+Module : Generate arbitrary events+Description : Functions for generating arbitrary events+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Safe #-}++module Hasklepias.Types.Context.Arbitrary() where++import Test.QuickCheck ( Arbitrary(arbitrary), elements, sublistOf ) +import Data.Function ( (.) )+import Data.Functor ( Functor(fmap) )+import Data.List ( map )+import Data.Set ( fromList )+import Hasklepias.Types.Context ( Concept+ , Concepts+ , Context+ , context+ , toConcepts+ , packConcepts+ , packConcept)++conceptChoices :: [Concept]+conceptChoices = map packConcept ["A", "B", "C", "D", "E", "F", "G", "H", "I", "J"]++instance Arbitrary Concept where+ arbitrary = elements conceptChoices++instance Arbitrary Context where+ arbitrary = fmap (context . toConcepts . fromList) (sublistOf conceptChoices)++-- instance Arbitrary Concepts where+-- arbitrary = fmap fromList (sublistOf conceptChoices)+
+ src/Hasklepias/Types/Event.hs view
@@ -0,0 +1,95 @@+{-|+Module : Hasklepias Event Type+Description : Defines the Event type and its component types, constructors, + and class instance+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Safe #-}++module Hasklepias.Types.Event(+ Event+ , Events+ , ConceptEvent+ , event+ , ctxt+ , toConceptEvent+ , toConceptEventOf+ , mkConceptEvent+) where++import GHC.Show ( Show(show) )+import Data.Function ( ($) )+import Data.Set ( member, fromList, intersection )+import Data.Ord ( Ord )+import IntervalAlgebra ( Interval+ , Intervallic+ , Intervallic (getInterval) )+import IntervalAlgebra.PairedInterval ( PairedInterval+ , makePairedInterval+ , getPairData )+import Hasklepias.Types.Context ( HasConcept(..)+ , Concepts+ , Concept+ , packConcept+ , Context (getConcepts)+ , fromConcepts+ , toConcepts )+++-- | An Event @a@ is simply a pair @(Interval a, Context)@.+type Event a = PairedInterval Context a++-- instance (Ord a, Show a) => Show (Event a) where+-- show x = "{" ++ show (getInterval x) ++ ", " ++ show (ctxt x) ++ "}"++instance HasConcept (Event a) where+ hasConcept x y = ctxt x `hasConcept` y++-- | A smart constructor for 'Event a's.+event :: Interval a -> Context -> Event a+event i c = makePairedInterval c i++-- | Access the 'Context' of an 'Event a'.+ctxt :: Event a -> Context+ctxt = getPairData++-- | An event containing only concepts and an interval+type ConceptEvent a = PairedInterval Concepts a++-- instance (Ord a, Show a) => Show (ConceptEvent a) where+-- show x = "{" ++ show (getInterval x) ++ ", " ++ show (getPairData x) ++ "}"++instance HasConcept (ConceptEvent a) where+ hasConcept e concept = member (packConcept concept) (fromConcepts $ getPairData e)++-- | Drops an @Event@ to a @ConceptEvent@ by moving the concepts in the data+-- position in the paired interval and throwing out the facts and source.+toConceptEvent :: (Show a, Ord a) => Event a -> ConceptEvent a+toConceptEvent e = makePairedInterval (getConcepts $ ctxt e) (getInterval e)++toConceptEventOf :: (Show a, Ord a) => [Concept] -> Event a -> ConceptEvent a+toConceptEventOf cpts e =+ makePairedInterval+ (toConcepts $ intersection (fromList cpts) (fromConcepts $ getConcepts $ ctxt e))+ (getInterval e)++-- |+mkConceptEvent :: (Show a, Ord a) => Interval a -> Concepts -> ConceptEvent a+mkConceptEvent i c = makePairedInterval c i++-- | A @List@ of @Event a@+-- +-- NOTE (20190911): I (B. Saul) am starting out the Events type as a +-- list of the Event type. This may be not be the optimal approach,+-- especially with regards to lookup/filtering the list. Ideally,+-- we could do one pass through the ordered container (whatever it is)+-- to identify events by concept; rather than repeated evaluations of+-- the lookup predicates. This could be handled by, for example, +-- representing Events has a Map with a list of concept indices. +-- But this gets us off the ground.+type Events a = [Event a]
+ src/Hasklepias/Types/Event/Aeson.hs view
@@ -0,0 +1,80 @@+{-|+Module : Functions for Parsing Hasklepias Event data+Description : Defines FromJSON instances for Events.+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}+{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}++module Hasklepias.Types.Event.Aeson(+ parseEventIntLines+ , parseEventDayLines+) where++import IntervalAlgebra+ ( beginerval, Interval, IntervalSizeable(diff) )+import Hasklepias.Types.Context+ ( Concepts, Concept, Context, context, packConcept, toConcepts )+import Hasklepias.Types.Event ( Event, event )+import Data.Aeson+ ( eitherDecode,+ (.:),+ withObject,+ FromJSON(parseJSON),+ Value(Array) )+import Data.Time ( Day )+import Data.Vector ((!))+import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Char8 as C+import Data.Either (rights, fromRight)++instance FromJSON (Interval Int) where+ parseJSON = withObject "Time" $ \o -> do+ t <- o .: "time"+ b <- t .: "begin"+ e <- t .: "end"+ return $ beginerval (diff e b) b+ --(parseInterval (b :: Day) (e :: Day))++instance FromJSON (Interval Day) where+ parseJSON = withObject "Time" $ \o -> do+ t <- o .: "time"+ b <- t .: "begin"+ e <- t .: "end"+ return $ beginerval (diff e b) b + --(parseInterval (b :: Day) (e :: Day))++instance FromJSON Concept where+ parseJSON c = packConcept <$> parseJSON c++instance FromJSON Concepts where+ parseJSON c = toConcepts <$> parseJSON c++instance FromJSON Context where+ parseJSON v = context <$> parseJSON v++instance FromJSON (Event Int) where+ parseJSON (Array v) = event <$>+ parseJSON (v ! 5) <*>+ parseJSON (v ! 4)++instance FromJSON (Event Day) where+ parseJSON (Array v) = event <$>+ parseJSON (v ! 5) <*>+ parseJSON (v ! 4)++-- | Parse @Event Int@ from json lines.+-- +-- This function and the event parsing in general needs a lot of work to be +-- production-ready. But this is good enough for prototyping.+parseEventIntLines :: B.ByteString -> [Event Int]+parseEventIntLines l =+ rights $ map (\x -> eitherDecode $ B.fromStrict x :: Either String (Event Int))+ (C.lines $ B.toStrict l)++-- | Parse @Event Day@ from json lines.+parseEventDayLines :: B.ByteString -> [Event Day]+parseEventDayLines l =+ rights $ map (\x -> eitherDecode $ B.fromStrict x :: Either String (Event Day))+ (C.lines $ B.toStrict l)
+ src/Hasklepias/Types/Event/Arbitrary.hs view
@@ -0,0 +1,48 @@+{-|+Module : Generate arbitrary events+Description : Functions for generating arbitrary events+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+Stability : experimental+-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module Hasklepias.Types.Event.Arbitrary(+ generateEventsInt+) where++import Test.QuickCheck (+ Arbitrary(arbitrary, shrink)+ , Gen+ , sample'+ , sample+ , generate+ , resize+ , suchThat + , orderedList )+import GHC.Show ( Show )+import GHC.IO ( IO )+import Control.Monad ( Functor(fmap), liftM2 )+import Data.Eq ( Eq((==)) )+import Data.Function (($))+import Data.Int ( Int )+import Data.Ord ( Ord )+import Data.List(length)+import IntervalAlgebra ( Interval )+import IntervalAlgebra.Arbitrary ()+import Hasklepias.Types.Event+ ( event, Event, ConceptEvent, toConceptEvent )+import Hasklepias.Types.Context.Arbitrary ()++instance (Arbitrary (Interval a)) => Arbitrary (Event a) where+ arbitrary = liftM2 event arbitrary arbitrary++instance (Ord a, Show a, Arbitrary (Interval a)) => Arbitrary (ConceptEvent a) where+ arbitrary = fmap toConceptEvent arbitrary++-- | Generate @n@ @Event Int@+generateEventsInt :: Int -> IO [Event Int]+generateEventsInt i = + generate $ suchThat (orderedList :: Gen [Event Int]) (\x -> length x == i)
+ src/Hasklepias/Types/Feature.hs view
@@ -0,0 +1,113 @@+{-|+Module : Hasklepias Feature Type+Description : Defines the Feature type and its component types, constructors, + and class instances+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE Safe #-}++module Hasklepias.Types.Feature(+ -- * Types+ Feature+ , getFeature+ , MissingReason(..)+ , FeatureDefinition(..)+ , applyEF+ , defineEF+ , defineFEF+ , applyFEF+ , featureR+ , featureL++) where++import GHC.Read ( Read )+import GHC.Show ( Show )+import GHC.Generics ( Generic, D )+import Data.Either ( Either(..) )+import Data.Eq ( Eq )+import Data.Functor ( Functor(fmap) )+import Data.Function ( ($), (.) )+import Data.Maybe ( Maybe(..) )+import Data.String ( String )+import Hasklepias.Types.Event ( Events )+import IntervalAlgebra ( Interval, Intervallic )++{- | A 'Feature' is a @'Either' 'MissingReason' d@, where @d@ can be any type + of data derivable from 'Hasklepias.Event.Events'.+-}+newtype Feature d = Feature { getFeature :: Either MissingReason d }+ deriving (Generic, Show, Eq)++instance Functor Feature where+ fmap f (Feature x) = Feature (fmap f x)++-- | Create the 'Right' side of a 'Feature'.+featureR :: d -> Feature d+featureR = Feature . Right++-- | Create the 'Left' side of a 'Feature'.+featureL :: MissingReason -> Feature d+featureL = Feature . Left++-- | A 'Feature' may be missing for any number of reasons. +data MissingReason =+ InsufficientData+ | Excluded+ | Other String+ | Unknown+ deriving (Eq, Read, Show, Generic)++-- | A type to hold common feature definitions; i.e. functions that return +-- features.+data FeatureDefinition e a d =+ EF (Events a -> Feature d)+ | FEF (Feature e -> Events a -> Feature 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@ feature 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 e a d -> Events a -> Feature d+applyEF (EF f) = f++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 (\(Feature feat) es ->+ case feat of+ (Left _) -> featureL r+ (Right x) -> featureR (g x es)+ )++-- | Extract a 'FEF' FeatureDefinition+applyFEF :: FeatureDefinition e a d -> Feature e -> Events a -> Feature d+applyFEF (FEF f) = f
+ src/Hasklepias/Types/Feature/Aeson.hs view
@@ -0,0 +1,28 @@+{-|+Module : Functions for encoding Hasklepias Feature data+Description : Defines ToJSON instances for Features.+Copyright : (c) NoviSci, Inc 2020+License : BSD3+Maintainer : bsaul@novisci.com+-}++{-# LANGUAGE OverloadedStrings #-}++module Hasklepias.Types.Feature.Aeson(+) where++import IntervalAlgebra+import GHC.Generics+import Hasklepias.Types.Feature ( MissingReason, Feature(..) )+import Data.Aeson+-- ( ToJSON, toJSON )++instance (ToJSON a, Ord a, Show a)=> ToJSON (Interval a) where+ toJSON x = + object ["begin" .= begin x, "end" .= end x]+instance ToJSON MissingReason +instance (ToJSON d)=> ToJSON (Feature d) where+ toJSON x = case getFeature x of + (Left l) -> toJSON l+ (Right r) -> toJSON r+
+ test/Hasklepias/FunctionsSpec.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+module Hasklepias.FunctionsSpec (spec) where++import IntervalAlgebra+import Hasklepias.Functions ( firstConceptOccurrence )+import Hasklepias.Types.Event ( Event, event )+import Hasklepias.Types.Context as HC ( context, packConcepts )+import Test.Hspec ( it, shouldBe, Spec )++-- | Toy events for unit tests+evnt1 :: Event Int+evnt1 = event ( beginerval (4 :: Int) (1 :: Int) ) + ( HC.context $ packConcepts ["c1", "c2"] )+evnt2 :: Event Int+evnt2 = event ( beginerval (4 :: Int) (2 :: Int) )+ ( HC.context $ packConcepts ["c3", "c4"] )+evnts :: [Event Int]+evnts = [evnt1, evnt2]++spec :: Spec+spec = do+ it "find first occurrence of c1" $+ firstConceptOccurrence ["c1"] evnts `shouldBe` Just evnt1+ it "find first occurrence of c3" $+ firstConceptOccurrence ["c3"] evnts `shouldBe` Just evnt2+ it "find first occurrence of c5" $+ firstConceptOccurrence ["c5"] evnts `shouldBe` Nothing
+ test/Hasklepias/Types/ContextSpec.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}+module Hasklepias.Types.ContextSpec (spec) where++import Hasklepias.Types.Context as HC+import Test.Hspec ( shouldBe, it, Spec )+import Data.Set(fromList)++ctxt1 :: Context+ctxt1 = HC.context $ packConcepts ["c1", "c2"]++ctxt2 :: Context+ctxt2 = HC.context $ packConcepts ["c2", "c3"]++spec :: Spec+spec = do+ it "getConcepts returns correct values" $+ getConcepts ctxt1 `shouldBe` packConcepts ["c1", "c2"]+ it "hasConcept returns True when concept is in context" $+ (ctxt1 `hasConcept` "c1") `shouldBe` True+ it "hasConcept returns False when concept is not in context" $+ (ctxt1 `hasConcept` "c3") `shouldBe` False+ it "hasConcepts returns True when at at least one concept is in context" $+ (ctxt1 `hasConcepts` ["c3", "c1"]) `shouldBe` True+ it "hasConcepts returns False when no concept is in context" $+ (ctxt1 `hasConcepts` ["c3", "c4"]) `shouldBe` False++ it "<> combines contexts" $+ (ctxt1 <> ctxt2) `shouldBe` HC.context (packConcepts ["c1", "c2", "c3"])
+ test/Hasklepias/Types/Event/AesonSpec.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}+module Hasklepias.Types.Event.AesonSpec (spec) where++import IntervalAlgebra+import Hasklepias.Types.Event+import Hasklepias.Types.Event.Aeson+import Data.Aeson+import Data.Time as DT+import Hasklepias.Types.Context as HC+import Test.Hspec+import qualified Data.ByteString.Lazy as B++testInInt :: B.ByteString+testInInt = "[\"abc\", 0, 1, \"Diagnosis\",\+ \[\"someThing\"],\+ \{\"domain\":\"Diagnosis\",\"time\":{\"begin\":0,\"end\":1}}]"++testInputsInt :: B.ByteString+testInputsInt = + "[\"abc\", 0, 1, \"Diagnosis\",\+ \[\"someThing\"],\+ \{\"domain\":\"Diagnosis\",\"time\":{\"begin\":0,\"end\":1}}]\n\+ \[\"abc\", 5, 6, \"Diagnosis\",\+ \[\"someThing\"],\+ \{\"domain\":\"Diagnosis\",\"time\":{\"begin\":5,\"end\":6}}]"++testInDay :: B.ByteString+testInDay = "[\"abc\", \"2020-01-01\", \"2020-01-02\", \"Diagnosis\",\+ \[\"someThing\"],\+ \{\"domain\":\"Diagnosis\",\+ \ \"time\":{\"begin\":\"2020-01-01\",\"end\":\"2020-01-02\"}}]"+++testInputsDay :: B.ByteString+testInputsDay = + "[\"abc\", \"2020-01-01\", \"2020-01-02\", \"Diagnosis\",\+ \[\"someThing\"],\+ \{\"domain\":\"Diagnosis\",\+ \ \"time\":{\"begin\":\"2020-01-01\",\"end\":\"2020-01-02\"}}]\n\+ \[\"abc\", \"2020-01-05\", \"2020-01-06\", \"Diagnosis\",\+ \[\"someThing\"],\+ \{\"domain\":\"Diagnosis\",\+ \ \"time\":{\"begin\":\"2020-01-05\",\"end\":\"2020-01-06\"}}]"++testOutInt1 = event (beginerval 1 (0 :: Int)) (HC.context $ packConcepts ["someThing"])+testOutInt2 = event (beginerval 1 (5 :: Int)) (HC.context $ packConcepts ["someThing"])++testOutDay1 = event (beginerval 1 (fromGregorian 2020 1 1))+ (HC.context $ packConcepts ["someThing"])+testOutDay2 = event (beginerval 1 (fromGregorian 2020 1 5)) + (HC.context $ packConcepts [ "someThing"])+++spec :: Spec +spec = do + it "an Int event is parsed correctly" $ + ( decode testInInt ) `shouldBe` (Just testOutInt1)+ it "lines of Int events are parsed correctly" $+ (parseEventIntLines testInputsInt) `shouldBe` [testOutInt1, testOutInt2]++ it "a Day event is parsed correctly" $ + ( decode testInDay ) `shouldBe` (Just testOutDay1)+ it "lines of Int events are parsed correctly" $+ (parseEventDayLines testInputsDay) `shouldBe` [testOutDay1, testOutDay2]
+ test/Hasklepias/Types/EventSpec.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}+module Hasklepias.Types.EventSpec (spec) where++import IntervalAlgebra+import IntervalAlgebra.IntervalUtilities+import Hasklepias.Functions+import Hasklepias.Types.Event+import Hasklepias.Types.Context as HC+import Test.Hspec ( it, shouldBe, Spec )++evnt1 :: Event Int+evnt1 = event ( beginerval 4 (1 :: Int))+ ( HC.context $ packConcepts ["c1", "c2"] )+evnt2 :: Event Int+evnt2 = event ( beginerval 4 (2 :: Int) )+ ( HC.context $ packConcepts ["c3", "c4"] )+evnts :: [Event Int]+evnts = [evnt1, evnt2]++containmentInt :: Interval Int+containmentInt = beginerval 10 (0 :: Int) ++noncontainmentInt :: Interval Int+noncontainmentInt = beginerval 6 (4 :: Int) ++anotherInt :: Interval Int+anotherInt = beginerval 5 (15 :: Int) ++spec :: Spec+spec = do+ it "hasConcept returns True when concept is in context" $+ (evnt1 `hasConcept` "c1") `shouldBe` True+ it "hasConcept returns False when concept is not in context" $+ (evnt1 `hasConcept` "c3") `shouldBe` False+ it "hasConcepts returns True when at at least one concept is in context" $+ (evnt1 `hasConcepts` ["c3", "c1"]) `shouldBe` True+ it "hasConcepts returns False when no concept is in context" $+ (evnt1 `hasConcepts` ["c3", "c4"]) `shouldBe` False++ it "filterEvents for evnt1" $+ filter (`hasConcept` "c1") evnts `shouldBe` [evnt1]+ it "filterEvents for evnt2" $+ filter (`hasConcept` "c3") evnts `shouldBe` [evnt2]+ it "filterEvents to no events" $+ filter (`hasConcept` "c5") evnts `shouldBe` []++ it "lift2IntervalPredicate meets" $+ meets evnt1 evnt2 `shouldBe` False+ it "lift2IntervalPredicate overlaps" $+ overlaps evnt1 evnt2 `shouldBe` True+ it "lift2IntervalPredicate overlaps" $+ overlappedBy evnt2 evnt1 `shouldBe` True++ it "filterEvents by interval containment" $+ filterContains containmentInt evnts `shouldBe` evnts+ it "filterEvents by interval containment" $+ filterContains noncontainmentInt evnts `shouldBe` []+
+ test/Hasklepias/Types/Feature/AesonSpec.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+module Hasklepias.Types.Feature.AesonSpec (spec) where++import IntervalAlgebra+import Hasklepias.Types+import Hasklepias.Functions+import Hasklepias.Types.Feature.Aeson+import Data.Aeson+import Data.Time as DT+-- import Hasklepias.Types.Context as HC+import Test.Hspec ( shouldBe, it, Spec )+import qualified Data.ByteString.Lazy as B+++ex1 :: Events Int+ex1 = [event (beginerval 10 0) (context $ packConcepts ["enrollment"])]++index:: (Intervallic Interval a) =>+ Events a+ -> Feature (Interval a)+index es =+ case firstConceptOccurrence ["enrollment"] es of+ Nothing -> featureL (Other "No Enrollment")+ Just x -> featureR (getInterval x)+++spec :: Spec+spec = do+ it "an Int event is parsed correctly" $+ encode (index ex1) `shouldBe` "{\"end\":10,\"begin\":0}"++
+ test/Spec.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+