hasklepias 0.15.1 → 0.15.2
raw patch · 5 files changed
+116/−12 lines, 5 files
Files
- ChangeLog.md +6/−0
- hasklepias.cabal +1/−1
- src/Hasklepias/FeatureEvents.hs +79/−9
- src/Hasklepias/Reexports.hs +9/−1
- test/Hasklepias/FeatureEventsSpec.hs +21/−1
ChangeLog.md view
@@ -1,5 +1,11 @@ # Changelog for hasklepias +## 0.15.2++* Updates `viewBirthYears` utility to filter a list of events to those with `BirthYear` demographic facts. In this way, one doesn't need to prefilter the input list by, e.g., a concept.+* Adds `viewStates` and `viewGenders` utilities for extracting a list of Demographic `State`s and `Gender` (resp.) values from a collection of events. Note that these functions (like `viewBirthYears`) return a *List*, as the source data may contain be 0 or more values for a given subject. You probably only want one value for a given demographic, so you may need a function like `headMay` if you want the first element of the list (if it exists). Note too that the API of these accessor functions for `facts` in a `Context` need a careful design review and may be changed in the future.+* Adds `yearFromDay`, `monthFromDay`, and `dayOfMonthFromDay` utilities to get the year, month, and day of month, respectively from a `Day`.+ ## 0.15.1 * Tinkers with package version dependencies in `.cabal` file.
hasklepias.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: hasklepias-version: 0.15.1+version: 0.15.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
src/Hasklepias/FeatureEvents.hs view
@@ -32,9 +32,21 @@ -- ** Functions for working with Event Domains , viewBirthYears+ , viewGenders+ , viewStates+ , previewDemoInfo , previewBirthYear+ , isBirthYear+ , isGenderFact+ , isStateFact+ , filterByDomain - -- ** Function for manipulating intervals+ -- ** Manipulating Dates+ , yearFromDay+ , monthFromDay+ , dayOfMonthFromDay++ -- ** Functions for manipulating intervals , lookback , lookahead @@ -58,13 +70,17 @@ import EventData ( Events , Event , ConceptEvent- , ctxt )+ , ctxt, context, Domain (Demographics) ) import EventData.Context ( Concept , Concepts , Context , HasConcept( hasConcepts )- , facts )-import EventData.Context.Domain ( Domain+ , facts+ , _facts )+import EventData.Context.Domain ( Domain(..)+ , DemographicsFacts(..)+ , DemographicsInfo(..)+ , DemographicsField(..) , demo , info , _Demographics )@@ -85,7 +101,12 @@ import Data.Maybe ( Maybe(..), maybe, mapMaybe ) import Data.Monoid ( Monoid ) import Data.Ord ( Ord(..) )-import Data.Time.Calendar ( Day, Year, diffDays )+import Data.Time.Calendar ( Day+ , Year+ , MonthOfYear+ , DayOfMonth+ , diffDays+ , toGregorian ) import Data.Text ( Text ) import Data.Text.Read ( rational ) import Data.Tuple ( fst )@@ -228,22 +249,71 @@ -> Bool allGapsWithinLessThanDuration = makeGapsWithinPredicate all (<) +-- | Preview demographics information from a domain+previewDemoInfo :: Domain -> Maybe Text+previewDemoInfo dmn = (^.demo.info) =<< preview _Demographics dmn+ -- | Utility for reading text into a maybe integer intMayMap :: Text -> Maybe Integer -- TODO: this is ridiculous intMayMap x = fmap floor (either (const Nothing) (Just . fst) (Data.Text.Read.rational x)) -- | Preview birth year from a domain previewBirthYear :: Domain -> Maybe Year-previewBirthYear dmn = intMayMap =<< ((^.demo.info) =<< preview _Demographics dmn)+previewBirthYear dmn = intMayMap =<< previewDemoInfo dmn --- | Returns a (possibly emtpy) list of birth years from a set of events-viewBirthYears :: Events a -> [Year]-viewBirthYears = mapMaybe (\e -> previewBirthYear =<< Just (ctxt e^.facts ))+-- | Predicate for Birth Year facts+isBirthYear :: Domain -> Bool +isBirthYear (Demographics (DemographicsFacts (DemographicsInfo BirthYear _))) = True+isBirthYear _ = False +-- | Predicate for Gender facts+isGenderFact :: Domain -> Bool +isGenderFact (Demographics (DemographicsFacts (DemographicsInfo Gender _))) = True+isGenderFact _ = False++-- | Predicate for State facts+isStateFact :: Domain -> Bool +isStateFact (Demographics (DemographicsFacts (DemographicsInfo State _))) = True+isStateFact _ = False++-- | Filters a container of 'Event's by the 'Domain'.+filterByDomain :: (Witherable f) => (Domain -> Bool) -> f (Event a) -> f (Event a)+filterByDomain f = filter (f . _facts . ctxt) ++-- | Returns a (possibly empty) list of birth years from a set of events+viewBirthYears :: (Witherable f) => f (Event a) -> [Year]+viewBirthYears x = + mapMaybe (\e -> previewBirthYear =<< Just (ctxt e^.facts )) + (toList $ filterByDomain isBirthYear x)++-- | Returns a (possibly empty) list of Gender values from a set of events+viewGenders :: (Witherable f) => f (Event a) -> [Text]+viewGenders x = + mapMaybe (\e -> previewDemoInfo =<< Just (ctxt e^.facts )) + (toList $ filterByDomain isGenderFact x)++-- | Returns a (possibly empty) list of Gender values from a set of events+viewStates :: (Witherable f) => f (Event a) -> [Text]+viewStates x = + mapMaybe (\e -> previewDemoInfo =<< Just (ctxt e^.facts )) + (toList $ filterByDomain isStateFact x)+ -- | Compute the "age" in years between two calendar days. The difference between -- the days is rounded down. computeAgeAt :: Day -> Day -> Integer computeAgeAt bd at = floor (fromInteger (diffDays at bd) / 365.25)++-- | Gets the 'Year' from a 'Data.Time.Calendar.Day'.+yearFromDay :: Day -> Year+yearFromDay = (\(y, m, d) -> y) . toGregorian++-- | Gets the 'Data.Time.Calendar.MonthOfDay' from a 'Data.Time.Calendar.Day'.+monthFromDay :: Day -> MonthOfYear+monthFromDay = (\(y, m, d) -> m) . toGregorian++-- | Gets the 'Data.Time.Calendar.DayOfMonth' from a 'Data.Time.Calendar.Day'.+dayOfMonthFromDay :: Day -> DayOfMonth+dayOfMonthFromDay = (\(y, m, d) -> d) . toGregorian -- | Creates a new @Interval@ of a provided lookback duration ending at the -- 'begin' of the input interval.
src/Hasklepias/Reexports.hs view
@@ -99,12 +99,20 @@ , max, min ) import safe Data.Proxy ( Proxy(..) ) import safe Data.Set as Set ( Set(..), fromList, member)-import safe Data.Time.Calendar ( Day, MonthOfYear, Year+import safe Data.Time.Calendar ( Day+ , DayOfWeek+ , DayOfMonth+ , MonthOfYear+ , Year , CalendarDiffDays(..) , addGregorianDurationClip , fromGregorian+ , toGregorian , gregorianMonthLength , diffDays )+import safe Data.Time.Calendar.Quarter ( QuarterOfYear + , Quarter+ , dayQuarter ) import safe Data.Text ( pack, Text ) import safe Data.Tuple ( fst, snd, uncurry, curry )
test/Hasklepias/FeatureEventsSpec.hs view
@@ -5,11 +5,12 @@ module Hasklepias.FeatureEventsSpec (spec) where import IntervalAlgebra-import Hasklepias.FeatureEvents ( firstConceptOccurrence )+import Hasklepias.FeatureEvents import EventData ( Event, event ) import EventData.Context as HC ( context, packConcepts ) import EventData.Context.Domain import Data.Maybe+import Data.Time.Calendar ( fromGregorian ) import Test.Hspec ( it, shouldBe, Spec ) -- | Toy events for unit tests@@ -22,6 +23,11 @@ evnts :: [Event Int] evnts = [evnt1, evnt2] +evntGender :: Event Int+evntGender = event ( beginerval (4 :: Int) (2 :: Int) )+ ( HC.context (Demographics ( DemographicsFacts (DemographicsInfo Gender (Just "F"))))+ (packConcepts [] ))+ spec :: Spec spec = do it "find first occurrence of c1" $@@ -30,3 +36,17 @@ firstConceptOccurrence ["c3"] evnts `shouldBe` Just evnt2 it "find first occurrence of c5" $ firstConceptOccurrence ["c5"] evnts `shouldBe` Nothing++ it "yearFromDay" $+ yearFromDay (fromGregorian 2021 8 18) `shouldBe` 2021+ it "monthFromDay" $+ monthFromDay (fromGregorian 2021 8 18) `shouldBe` 8+ it "dayOfMonthFromDay" $+ dayOfMonthFromDay (fromGregorian 2021 8 18) `shouldBe` 18++ it "viewGenders on empty list" $+ viewGenders [] `shouldBe` []+ it "viewGenders with no demographic events" $+ viewGenders evnts `shouldBe` []+ it "viewGenders with a demographic event" $+ viewGenders [evntGender] `shouldBe` ["F"]