{-|
Module      :  Features Templates 
Description : Templates for Features based on satisfying a set of predicates 
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com

-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TupleSections #-}

module Hasklepias.Templates.Features.NsatisfyP
  ( buildNsatisfyPTests
  , buildNofX
  , buildNofXBool
  , buildNofXBinary
  , buildNofXBinaryConcurBaseline
  , buildNofConceptsBinaryConcurBaseline
  , buildNofXWithGap
  , buildNofXWithGapBool
  , buildNofXWithGapBinary
  , buildNofUniqueBegins
  , buildNofXOrNofYWithGap
  , buildNofXOrNofYWithGapBool
  , buildNofXOrNofYWithGapBinary
  ) where

import           Cohort
import           EventData
import           Features
import           Hasklepias.FeatureEvents
import           Hasklepias.Reexports
import           Hasklepias.ReexportsUnsafe
import           Hasklepias.Templates.TestUtilities
import           Stype

-- | All the buildNSatisfyP tests.
buildNsatisfyPTests :: TestTree
buildNsatisfyPTests :: TestTree
buildNsatisfyPTests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"NsatisfyP" 
    [ TestTree
buildNofXTests
    , TestTree
buildNofXWithGapTests
    , TestTree
buildNofXOrNofYWithGapTests
    , TestTree
buildNofUniqueBeginsTests]

{-|
-}
buildNofXBase
  :: ( Intervallic i0 a
     , Intervallic i1 a
     , Witherable container0
     , Witherable container1
     )
  => (container0 (Event a) -> container1 (i1 a)) -- ^ function mapping a container of events to a container of intervallic intervals (which could be events!)
  -> (container1 (i1 a) -> t) -- ^ function mapping the processed events to an intermediate type
  -> (AssessmentInterval a -> t -> outputType) -- ^ function casting intermediate type to output type with the option to use the assessment interval
  -> (Index i0 a -> AssessmentInterval a) -- ^ function which maps index interval to interval in which to assess the feature
  -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -- ^ the interval relation of the input events to the assessment interval
  -> Predicate (Event a) -- ^ The predicate to filter to Enrollment events (e.g. 'FeatureEvents.isEnrollment')
  -> Definition
       (  Feature indexName (Index i0 a)
       -> Feature eventsName (container0 (Event a))
       -> Feature varName outputType
       )
buildNofXBase :: (container0 (Event a) -> container1 (i1 a))
-> (container1 (i1 a) -> t)
-> (AssessmentInterval a -> t -> outputType)
-> (Index i0 a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i0 a)
      -> Feature eventsName (container0 (Event a))
      -> Feature varName outputType)
buildNofXBase container0 (Event a) -> container1 (i1 a)
runPreProcess container1 (i1 a) -> t
runProcess AssessmentInterval a -> t -> outputType
runPostProcess Index i0 a -> AssessmentInterval a
makeAssessmentInterval ComparativePredicateOf2 (AssessmentInterval a) (Event a)
relation Predicate (Event a)
predicate
  = (Index i0 a -> container0 (Event a) -> outputType)
-> Definition
     (Feature indexName (Index i0 a)
      -> Feature eventsName (container0 (Event a))
      -> Feature varName outputType)
forall inputs def. Define inputs def => inputs -> Definition def
define
    (\Index i0 a
index ->
      -- filter events to those satisfying both
      -- the given relation to the assessment interval
      -- AND the given predicate
      (Event a -> Bool) -> container0 (Event a) -> container0 (Event a)
forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter
          (ComparativePredicateOf2 (AssessmentInterval a) (Event a)
relation (Index i0 a -> AssessmentInterval a
makeAssessmentInterval Index i0 a
index) (Event a -> Bool) -> (Event a -> Bool) -> Event a -> Bool
forall a. Predicatable a => a -> a -> a
&&& Predicate (Event a) -> Event a -> Bool
forall a. Predicate a -> a -> Bool
getPredicate Predicate (Event a)
predicate)
      -- run the preprocessing function
        (container0 (Event a) -> container0 (Event a))
-> (container0 (Event a) -> container1 (i1 a))
-> container0 (Event a)
-> container1 (i1 a)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> container0 (Event a) -> container1 (i1 a)
runPreProcess
      -- run the processing function
        (container0 (Event a) -> container1 (i1 a))
-> (container1 (i1 a) -> t) -> container0 (Event a) -> t
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> container1 (i1 a) -> t
runProcess
      -- run the postprocessing function
        (container0 (Event a) -> t)
-> (t -> outputType) -> container0 (Event a) -> outputType
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> AssessmentInterval a -> t -> outputType
runPostProcess (Index i0 a -> AssessmentInterval a
makeAssessmentInterval Index i0 a
index)
    )

{-| Do N events relating to the 'AssessmentInterval' in some way the satisfy 
    the given predicate? 
-}
buildNofX
  :: (Intervallic i a, Witherable container)
  => (Bool -> outputType) -- ^ casting function
  -> Natural -- ^ minimum number of cases
  -> (Index i a -> AssessmentInterval a) -- ^ function to transform a 'Cohort.Index' to an 'Cohort.AssessmentInterval'
  -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -- ^ interval predicate
  -> Predicate (Event a) -- ^ a predicate on events
  -> Definition
       (  Feature indexName (Index i a)
       -> Feature eventsName (container (Event a))
       -> Feature varName outputType
       )
buildNofX :: (Bool -> outputType)
-> Natural
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
buildNofX Bool -> outputType
f Natural
n = (container (Event a) -> container (Event a))
-> (container (Event a) -> Bool)
-> (AssessmentInterval a -> Bool -> outputType)
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
forall (i0 :: * -> *) a (i1 :: * -> *) (container0 :: * -> *)
       (container1 :: * -> *) t outputType (indexName :: Symbol)
       (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i0 a, Intervallic i1 a, Witherable container0,
 Witherable container1) =>
(container0 (Event a) -> container1 (i1 a))
-> (container1 (i1 a) -> t)
-> (AssessmentInterval a -> t -> outputType)
-> (Index i0 a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i0 a)
      -> Feature eventsName (container0 (Event a))
      -> Feature varName outputType)
buildNofXBase container (Event a) -> container (Event a)
forall a. a -> a
id (\container (Event a)
x -> container (Event a) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length container (Event a)
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural -> Int
naturalToInt Natural
n) ((Bool -> outputType) -> AssessmentInterval a -> Bool -> outputType
forall a b. a -> b -> a
const Bool -> outputType
f)

-- | 'buildNofX' specialized to return 'Bool'.
buildNofXBool
  :: (Intervallic i a, Witherable container)
  => Natural -- ^ minimum number of cases 
  -> (Index i a -> AssessmentInterval a) -- ^ function to transform a 'Cohort.Index' to an 'Cohort.AssessmentInterval'
  -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -- ^ interval predicate
  -> Predicate (Event a) -- ^ a predicate on events
  -> Definition
       (  Feature indexName (Index i a)
       -> Feature eventsName (container (Event a))
       -> Feature varName Bool
       )
buildNofXBool :: Natural
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Bool)
buildNofXBool = (Bool -> Bool)
-> Natural
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Bool)
forall (i :: * -> *) a (container :: * -> *) outputType
       (indexName :: Symbol) (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, Witherable container) =>
(Bool -> outputType)
-> Natural
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
buildNofX Bool -> Bool
forall a. a -> a
id

-- | 'buildNofX' specialized to return 'Stype.Binary'.
buildNofXBinary
  :: (Intervallic i a, Witherable container)
  => Natural
  -> (Index i a -> AssessmentInterval a)
  -> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
  -> Predicate (Event a)
  -> Definition
       (  Feature indexName (Index i a)
       -> Feature eventsName (container (Event a))
       -> Feature varName Binary
       )
buildNofXBinary :: Natural
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Binary)
buildNofXBinary = (Bool -> Binary)
-> Natural
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Binary)
forall (i :: * -> *) a (container :: * -> *) outputType
       (indexName :: Symbol) (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, Witherable container) =>
(Bool -> outputType)
-> Natural
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
buildNofX Bool -> Binary
fromBool

{- | 
'buildNofXBinary' specialized to filter to events that 'IntervalAlgebra.concur' 
with an 'Cohort.AssessmentInterval' created by 'Cohort.makeBaselineFromIndex' of
a specified duration and a provided 'Data.Functor.Contravariant.Predicate'.
-}
buildNofXBinaryConcurBaseline
  :: (Intervallic i0 a, Witherable t, IntervalSizeable a b, Baseline i0 a)
  => Natural -- ^ minimum number of events.
  -> b -- ^ duration of baseline (passed to 'Cohort.makeBaselineFromIndex')
  -> Predicate (Event a)
  -> Definition
       (  Feature indexName (Index i0 a)
       -> Feature eventsName (t (Event a))
       -> Feature varName Binary
       )
buildNofXBinaryConcurBaseline :: Natural
-> b
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i0 a)
      -> Feature eventsName (t (Event a)) -> Feature varName Binary)
buildNofXBinaryConcurBaseline Natural
n b
baselineDur =
  Natural
-> (Index i0 a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i0 a)
      -> Feature eventsName (t (Event a)) -> Feature varName Binary)
forall (i :: * -> *) a (container :: * -> *) (indexName :: Symbol)
       (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, Witherable container) =>
Natural
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Binary)
buildNofXBinary Natural
n (b -> Index i0 a -> AssessmentInterval a
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex b
baselineDur) ComparativePredicateOf2 (AssessmentInterval a) (Event a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur

{- | 
'buildNofXBinary' specialized to filter to events that 'IntervalAlgebra.concur' 
with an 'Cohort.AssessmentInterval' created by 'Cohort.makeBaselineFromIndex' of
a specified duration and that have a given set of 'EventData.Concepts'.
-}
buildNofConceptsBinaryConcurBaseline
  :: (Intervallic i0 a, Witherable t, IntervalSizeable a b, Baseline i0 a)
  => Natural -- ^ minimum number of events. 
  -> b  -- ^ duration of baseline (passed to 'Cohort.makeBaselineFromIndex')
  -> [Text] -- ^ list of 'EventData.Concepts' passed to 'EventData.containsConcepts'
  -> Definition
       (  Feature indexName (Index i0 a)
       -> Feature eventsName (t (Event a))
       -> Feature varName Binary 
       )
buildNofConceptsBinaryConcurBaseline :: Natural
-> b
-> [Text]
-> Definition
     (Feature indexName (Index i0 a)
      -> Feature eventsName (t (Event a)) -> Feature varName Binary)
buildNofConceptsBinaryConcurBaseline Natural
n b
baselineDur [Text]
cpts = Natural
-> (Index i0 a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i0 a)
      -> Feature eventsName (t (Event a)) -> Feature varName Binary)
forall (i :: * -> *) a (container :: * -> *) (indexName :: Symbol)
       (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, Witherable container) =>
Natural
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Binary)
buildNofXBinary
  Natural
n
  (b -> Index i0 a -> AssessmentInterval a
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex b
baselineDur)
  ComparativePredicateOf2 (AssessmentInterval a) (Event a)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur
  ([Text] -> Predicate (Event a)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text]
cpts)

--------------------------------------------------------------------------------
-- NofX examples/tests
--------------------------------------------------------------------------------

type NofXArgs
  = ( Natural
    , Index Interval Int -> AssessmentInterval Int
    , ComparativePredicateOf2 (AssessmentInterval Int) (Event Int)
    , Predicate (Event Int)
    )

makeTestInputs
  :: (Integral b, IntervalSizeable a b)
  => TestName
  -> bargs
  -> (a, a)
  -> [Event a]
  -> returnType 
  -> TestCase
       (F "index" (Index Interval a), F "events" [Event a])
       returnType
       bargs
makeTestInputs :: TestName
-> bargs
-> (a, a)
-> [Event a]
-> returnType
-> TestCase
     (F "index" (Index Interval a), F "events" [Event a])
     returnType
     bargs
makeTestInputs TestName
name bargs
buildArgs (a, a)
intrvl [Event a]
e returnType
b = bargs
-> TestName
-> (F "index" (Index Interval a), F "events" [Event a])
-> Feature "result" returnType
-> TestCase
     (F "index" (Index Interval a), F "events" [Event a])
     returnType
     bargs
forall a b builderArgs.
builderArgs
-> TestName -> a -> Feature "result" b -> TestCase a b builderArgs
MkTestCase
  bargs
buildArgs
  TestName
name
  (Index Interval a -> F "index" (Index Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Interval a -> Index Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Index i a
makeIndex ((a, a) -> Interval a
forall b a.
(Integral b, IntervalSizeable a b) =>
(a, a) -> Interval a
readIntervalSafe (a, a)
intrvl)), [Event a] -> F "events" [Event a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Event a]
e)
  (returnType -> Feature "result" returnType
forall (f :: * -> *) a. Applicative f => a -> f a
pure returnType
b)

type NofXTestCase
  = TestCase
      (F "index" (Index Interval Int), F "events" [Event Int])
      Bool
      NofXArgs

buildNofXTestCases :: [NofXTestCase]
buildNofXTestCases :: [NofXTestCase]
buildNofXTestCases =
  [ TestName
-> (Natural, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"False if no events"
      (Natural
1, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
      (Int
0, Int
1)
      []
      Bool
False
  , TestName
-> (Natural, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f
    TestName
"False if 1 event after index but looking for single event concurring with baseline"
    (Natural
1, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
    (Int
0, Int
1)
    [(Int, Int) -> PairedInterval Context Int
g (Int
2, Int
7)]
    Bool
False
  , TestName
-> (Natural, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f
    TestName
"True if 1 event before index and looking for single event concurring with baseline"
    (Natural
1, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
    (Int
0, Int
1)
    [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A", Text
"B"] (-Int
5, -Int
4)]
    Bool
True
  , TestName
-> (Natural, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f
    TestName
"True if 2 events before index and looking for at least 2 events concurring with baseline"
    (Natural
2, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
    (Int
0, Int
1)
    [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A", Text
"B"] (-Int
5, -Int
4), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A", Text
"C"] (-Int
3, -Int
2)]
    Bool
True
  , TestName
-> (Natural, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f
    TestName
"True if 3 events before index and looking for at least 2 events concurring with baseline"
    (Natural
2, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
    (Int
0, Int
1)
    [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A", Text
"B"] (-Int
7, -Int
6), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A", Text
"B"] (-Int
5, -Int
4), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A", Text
"C"] (-Int
3, -Int
2)]
    Bool
True
  , TestName
-> (Natural, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f
    TestName
"True if 2 events of same interval before index and looking for at least 2 events concurring with baseline"
    (Natural
2, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
    (Int
0, Int
1)
    [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (-Int
5, -Int
4), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A", Text
"B"] (-Int
5, -Int
4)]
    Bool
True
  , TestName
-> (Natural, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f
    TestName
"False if 1 event before index and looking for at least 2 events concurring with baseline"
    (Natural
2, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
    (Int
0, Int
1)
    [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A", Text
"C"] (-Int
3, -Int
2)]
    Bool
False
  ] where
  f :: TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f = TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
forall b a bargs returnType.
(Integral b, IntervalSizeable a b) =>
TestName
-> bargs
-> (a, a)
-> [Event a]
-> returnType
-> TestCase
     (F "index" (Index Interval a), F "events" [Event a])
     returnType
     bargs
makeTestInputs
  g :: (Int, Int) -> PairedInterval Context Int
g = (Int, Int) -> PairedInterval Context Int
forall b a. (Integral b, IntervalSizeable a b) => (a, a) -> Event a
makeEnrollmentEvent
  h :: [Text] -> (Int, Int) -> PairedInterval Context Int
h = [Text] -> (Int, Int) -> PairedInterval Context Int
forall b a.
(Integral b, IntervalSizeable a b) =>
[Text] -> (a, a) -> Event a
makeEventWithConcepts

buildNofXTests :: TestTree
buildNofXTests :: TestTree
buildNofXTests = TestName -> [TestTree] -> TestTree
testGroup
  TestName
"Tests of NofX template"
  ((NofXTestCase -> TestTree) -> [NofXTestCase] -> [TestTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\NofXTestCase
x -> TestName -> Assertion -> TestTree
testCase
      (NofXTestCase -> TestName
forall a b builderArgs. TestCase a b builderArgs -> TestName
getTestName NofXTestCase
x)
      (NofXTestCase
-> ((F "index" (Index Interval Int),
     F "events" [PairedInterval Context Int])
    -> Feature "result" Bool)
-> Assertion
forall b defArgs builderArgs.
(Eq b, Show b) =>
TestCase defArgs b builderArgs
-> (defArgs -> Feature "result" b) -> Assertion
makeAssertion NofXTestCase
x ((F "index" (Index Interval Int)
 -> F "events" [PairedInterval Context Int]
 -> Feature "result" Bool)
-> (F "index" (Index Interval Int),
    F "events" [PairedInterval Context Int])
-> Feature "result" Bool
forall a b. Curry a b => b -> a
uncurryN ((F "index" (Index Interval Int)
  -> F "events" [PairedInterval Context Int]
  -> Feature "result" Bool)
 -> (F "index" (Index Interval Int),
     F "events" [PairedInterval Context Int])
 -> Feature "result" Bool)
-> (F "index" (Index Interval Int)
    -> F "events" [PairedInterval Context Int]
    -> Feature "result" Bool)
-> (F "index" (Index Interval Int),
    F "events" [PairedInterval Context Int])
-> Feature "result" Bool
forall a b. (a -> b) -> a -> b
$ Definition
  (F "index" (Index Interval Int)
   -> F "events" [PairedInterval Context Int]
   -> Feature "result" Bool)
-> F "index" (Index Interval Int)
-> F "events" [PairedInterval Context Int]
-> Feature "result" Bool
forall d. Definition d -> d
eval ((Natural
 -> (Index Interval Int -> AssessmentInterval Int)
 -> ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int)
 -> Predicate (PairedInterval Context Int)
 -> Definition
      (F "index" (Index Interval Int)
       -> F "events" [PairedInterval Context Int]
       -> Feature "result" Bool))
-> (Natural, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> Definition
     (F "index" (Index Interval Int)
      -> F "events" [PairedInterval Context Int]
      -> Feature "result" Bool)
forall a b. Curry a b => b -> a
uncurryN Natural
-> (Index Interval Int -> AssessmentInterval Int)
-> ComparativePredicateOf2
     (AssessmentInterval Int) (PairedInterval Context Int)
-> Predicate (PairedInterval Context Int)
-> Definition
     (F "index" (Index Interval Int)
      -> F "events" [PairedInterval Context Int]
      -> Feature "result" Bool)
forall (i :: * -> *) a (container :: * -> *) (indexName :: Symbol)
       (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, Witherable container) =>
Natural
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Bool)
buildNofXBool (NofXTestCase
-> (Natural, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
forall a b builderArgs. TestCase a b builderArgs -> builderArgs
getBuilderArgs NofXTestCase
x))))
    )
    [NofXTestCase]
buildNofXTestCases
  )

{-| Are there N gaps of at least the given duration between any pair of events 
    that relate to the 'AssessmentInterval' by the given relation and the
    satisfy the given predicate? 
-}
buildNofXWithGap
  :: ( Intervallic i a
     , IntervalSizeable a b
     , IntervalCombinable i a
     , Witherable container
     )
  => (Bool -> outputType)
  -> Natural -- ^ the minimum number of gaps
  -> b -- ^ the minimum duration of a gap
  -> (Index i a -> AssessmentInterval a)
  -> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
  -> Predicate (Event a)
  -> Definition
       (  Feature indexName (Index i a)
       -> Feature eventsName (container (Event a))
       -> Feature varName outputType
       )
buildNofXWithGap :: (Bool -> outputType)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
buildNofXWithGap Bool -> outputType
cast Natural
nGaps b
allowableGap = (container (Event a) -> [Interval a])
-> ([Interval a] -> Bool)
-> (AssessmentInterval a -> Bool -> outputType)
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
forall (i0 :: * -> *) a (i1 :: * -> *) (container0 :: * -> *)
       (container1 :: * -> *) t outputType (indexName :: Symbol)
       (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i0 a, Intervallic i1 a, Witherable container0,
 Witherable container1) =>
(container0 (Event a) -> container1 (i1 a))
-> (container1 (i1 a) -> t)
-> (AssessmentInterval a -> t -> outputType)
-> (Index i0 a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i0 a)
      -> Feature eventsName (container0 (Event a))
      -> Feature varName outputType)
buildNofXBase
  (-- just need the intervals  
     (Event a -> Interval a)
-> container (Event a) -> container (Interval a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval
   -- pairGaps needs List input as the container type
    (container (Event a) -> container (Interval a))
-> (container (Interval a) -> [Interval a])
-> container (Event a)
-> [Interval a]
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> container (Interval a) -> [Interval a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
  (-- get (Maybe) durations of interval gaps between all pairs
    [Interval a] -> [Maybe b]
forall (i :: * -> *) a b.
(Intervallic i a, IntervalSizeable a b, IntervalCombinable i a) =>
[i a] -> [Maybe b]
pairGaps
   -- throw away any non-gaps
  ([Interval a] -> [Maybe b])
-> ([Maybe b] -> [b]) -> [Interval a] -> [b]
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> [Maybe b] -> [b]
forall a. [Maybe a] -> [a]
catMaybes
   -- keep only those gap durations at least the allowableGap
  ([Interval a] -> [b]) -> ([b] -> [b]) -> [Interval a] -> [b]
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> (b -> Bool) -> [b] -> [b]
forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter (b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>= b
allowableGap)
   -- are there at least as many events as desired?
  ([Interval a] -> [b]) -> ([b] -> Bool) -> [Interval a] -> Bool
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> \[b]
x -> [b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural -> Int
naturalToInt Natural
nGaps
  )
  ((Bool -> outputType) -> AssessmentInterval a -> Bool -> outputType
forall a b. a -> b -> a
const Bool -> outputType
cast)

-- | 'buildNofXWithGap' specialized to return 'Bool'. 
buildNofXWithGapBool
  :: ( Intervallic i a
     , IntervalSizeable a b
     , IntervalCombinable i a
     , Witherable container
     )
  => Natural -- ^ the minimum number of gaps
  -> b -- ^ the minimum duration of a gap
  -> (Index i a -> AssessmentInterval a)
  -> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
  -> Predicate (Event a)
  -> Definition
       (  Feature indexName (Index i a)
       -> Feature eventsName (container (Event a))
       -> Feature varName Bool
       )
buildNofXWithGapBool :: Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Bool)
buildNofXWithGapBool = (Bool -> Bool)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Bool)
forall (i :: * -> *) a b (container :: * -> *) outputType
       (indexName :: Symbol) (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, IntervalSizeable a b, IntervalCombinable i a,
 Witherable container) =>
(Bool -> outputType)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
buildNofXWithGap Bool -> Bool
forall a. a -> a
id


-- | 'buildNofXWithGap' specialized to return 'Stype.Binary'. 
buildNofXWithGapBinary
  :: ( Intervallic i a
     , IntervalSizeable a b
     , IntervalCombinable i a
     , Witherable container
     )
  => Natural -- ^ the minimum number of gaps
  -> b -- ^ the minimum duration of a gap
  -> (Index i a -> AssessmentInterval a)
  -> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
  -> Predicate (Event a)
  -> Definition
       (  Feature indexName (Index i a)
       -> Feature eventsName (container (Event a))
       -> Feature varName Binary
       )
buildNofXWithGapBinary :: Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Binary)
buildNofXWithGapBinary = (Bool -> Binary)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Binary)
forall (i :: * -> *) a b (container :: * -> *) outputType
       (indexName :: Symbol) (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, IntervalSizeable a b, IntervalCombinable i a,
 Witherable container) =>
(Bool -> outputType)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
buildNofXWithGap Bool -> Binary
fromBool

type NofXWithGapArgs
  = ( Natural
    , Int
    , Index Interval Int -> AssessmentInterval Int
    , ComparativePredicateOf2 (AssessmentInterval Int) (Event Int)
    , Predicate (Event Int)
    )

type NofXWithGapTestCase
  = TestCase
      (F "index" (Index Interval Int), F "events" [Event Int])
      Bool
      NofXWithGapArgs

buildNofXWithGapTestCases :: [NofXWithGapTestCase]
buildNofXWithGapTestCases :: [NofXWithGapTestCase]
buildNofXWithGapTestCases =
  [ TestName
-> (Natural, Int, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"True if looking for no events and there are no events"
      (Natural
0, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
      (Int
10, Int
11)
      []
      Bool
True
      {-
                   -          <- Index
         ----------           <- Baseline
                              <- Enrollment
        |--------------|
      -}
  , TestName
-> (Natural, Int, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f
    TestName
"True if looking for (at least) no events and there are events satisfying gap condition"
    (Natural
0, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
    (Int
10, Int
11)
    [(Int, Int) -> PairedInterval Context Int
g (Int
1, Int
2), (Int, Int) -> PairedInterval Context Int
g (Int
8, Int
9)]
    Bool
True
      {-
                   -          <- Index
         ----------           <- Baseline
         -       -            <- Enrollment
        |--------------|
      -}
  , TestName
-> (Natural, Int, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"False if no events and looking for 1 gap"
      (Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
      (Int
10, Int
11)
      []
      Bool
False
      {-
                   -          <- Index
         ----------           <- Baseline
                              <- Enrollment
        |--------------|
      -}
  , TestName
-> (Natural, Int, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"False if a single event and looking for gap"
      (Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
      (Int
10, Int
11)
      [(Int, Int) -> PairedInterval Context Int
g (Int
8, Int
9)]
      Bool
False
      {-
                   -          <- Index
         ----------           <- Baseline
                 -            <- Enrollment
        |--------------|
      -}
  , TestName
-> (Natural, Int, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"False if 1 gap but not satisfying gap condition"
      (Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
      (Int
10, Int
11)
      [(Int, Int) -> PairedInterval Context Int
g (Int
6, Int
7), (Int, Int) -> PairedInterval Context Int
g (Int
8, Int
9)]
      Bool
False
      {-
                   -          <- Index
         ----------           <- Baseline
               - -            <- Enrollment
        |--------------|
      -}
  , TestName
-> (Natural, Int, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"True if 1 gap satisfy gap condition"
      (Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
      (Int
10, Int
11)
      [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"C", Text
"A"] (Int
2, Int
3), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A", Text
"B"] (Int
8, Int
9)]
      Bool
True
      {-
                   -          <- Index
         ----------           <- Baseline
          -                   <- ["C", "A"]
                 -            <- ["A", "B"] 
        |--------------|
      -}
  , TestName
-> (Natural, Int, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"True if 1 gap satisfy gap condition "
      (Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
      (Int
10, Int
11)
      [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"C", Text
"A"] (Int
2, Int
3), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"D", Text
"E"] (Int
5, Int
6), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A", Text
"B"] (Int
8, Int
9)]
      Bool
True
      {-
                   -          <- Index
         ----------           <- Baseline
          -                   <- ["C", "A"]
              -               <- ["D", "E"]
                 -            <- ["A", "B"] 
        |--------------|
      -}
  , TestName
-> (Natural, Int, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f
    TestName
"True if 1 gap satisfy gap condition"
    (Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
    (Int
10, Int
11)
    [ [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
1, Int
2)
    , [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
2, Int
3)
    , [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
3, Int
4)
    , [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
4, Int
5)
    , [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
5, Int
6)
    ]
    Bool
True
      {-
                    -          <- Index
          ----------           <- Baseline
          -                    <- ["A"]
           -                   <- ["A"]
            -                  <- ["A"]
             -                 <- ["A"]
              -                <- ["A"]
        |--------------|
      -}
  , TestName
-> (Natural, Int, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"False if no gap satisfy gap condition"
      (Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
      (Int
10, Int
11)
      [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
1, Int
2), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
2, Int
3), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
3, Int
4), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
4, Int
5)]
      Bool
False
      {-
                    -          <- Index
          ----------           <- Baseline
          -                    <- ["A"]
           -                   <- ["A"]
            -                  <- ["A"]
             -                 <- ["A"]
        |--------------|
      -}
  ] where
  f :: TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f = TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
forall b a bargs returnType.
(Integral b, IntervalSizeable a b) =>
TestName
-> bargs
-> (a, a)
-> [Event a]
-> returnType
-> TestCase
     (F "index" (Index Interval a), F "events" [Event a])
     returnType
     bargs
makeTestInputs
  g :: (Int, Int) -> PairedInterval Context Int
g = (Int, Int) -> PairedInterval Context Int
forall b a. (Integral b, IntervalSizeable a b) => (a, a) -> Event a
makeEnrollmentEvent
  h :: [Text] -> (Int, Int) -> PairedInterval Context Int
h = [Text] -> (Int, Int) -> PairedInterval Context Int
forall b a.
(Integral b, IntervalSizeable a b) =>
[Text] -> (a, a) -> Event a
makeEventWithConcepts

buildNofXWithGapTests :: TestTree
buildNofXWithGapTests :: TestTree
buildNofXWithGapTests = TestName -> [TestTree] -> TestTree
testGroup
  TestName
"Tests of NofXWithGap template"
  ((NofXWithGapTestCase -> TestTree)
-> [NofXWithGapTestCase] -> [TestTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\NofXWithGapTestCase
x -> TestName -> Assertion -> TestTree
testCase
      (NofXWithGapTestCase -> TestName
forall a b builderArgs. TestCase a b builderArgs -> TestName
getTestName NofXWithGapTestCase
x)
      (NofXWithGapTestCase
-> ((F "index" (Index Interval Int),
     F "events" [PairedInterval Context Int])
    -> Feature "result" Bool)
-> Assertion
forall b defArgs builderArgs.
(Eq b, Show b) =>
TestCase defArgs b builderArgs
-> (defArgs -> Feature "result" b) -> Assertion
makeAssertion NofXWithGapTestCase
x ((F "index" (Index Interval Int)
 -> F "events" [PairedInterval Context Int]
 -> Feature "result" Bool)
-> (F "index" (Index Interval Int),
    F "events" [PairedInterval Context Int])
-> Feature "result" Bool
forall a b. Curry a b => b -> a
uncurryN ((F "index" (Index Interval Int)
  -> F "events" [PairedInterval Context Int]
  -> Feature "result" Bool)
 -> (F "index" (Index Interval Int),
     F "events" [PairedInterval Context Int])
 -> Feature "result" Bool)
-> (F "index" (Index Interval Int)
    -> F "events" [PairedInterval Context Int]
    -> Feature "result" Bool)
-> (F "index" (Index Interval Int),
    F "events" [PairedInterval Context Int])
-> Feature "result" Bool
forall a b. (a -> b) -> a -> b
$ Definition
  (F "index" (Index Interval Int)
   -> F "events" [PairedInterval Context Int]
   -> Feature "result" Bool)
-> F "index" (Index Interval Int)
-> F "events" [PairedInterval Context Int]
-> Feature "result" Bool
forall d. Definition d -> d
eval (Definition
   (F "index" (Index Interval Int)
    -> F "events" [PairedInterval Context Int]
    -> Feature "result" Bool)
 -> F "index" (Index Interval Int)
 -> F "events" [PairedInterval Context Int]
 -> Feature "result" Bool)
-> Definition
     (F "index" (Index Interval Int)
      -> F "events" [PairedInterval Context Int]
      -> Feature "result" Bool)
-> F "index" (Index Interval Int)
-> F "events" [PairedInterval Context Int]
-> Feature "result" Bool
forall a b. (a -> b) -> a -> b
$ (Natural
 -> Int
 -> (Index Interval Int -> AssessmentInterval Int)
 -> ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int)
 -> Predicate (PairedInterval Context Int)
 -> Definition
      (F "index" (Index Interval Int)
       -> F "events" [PairedInterval Context Int]
       -> Feature "result" Bool))
-> (Natural, Int, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> Definition
     (F "index" (Index Interval Int)
      -> F "events" [PairedInterval Context Int]
      -> Feature "result" Bool)
forall a b. Curry a b => b -> a
uncurryN Natural
-> Int
-> (Index Interval Int -> AssessmentInterval Int)
-> ComparativePredicateOf2
     (AssessmentInterval Int) (PairedInterval Context Int)
-> Predicate (PairedInterval Context Int)
-> Definition
     (F "index" (Index Interval Int)
      -> F "events" [PairedInterval Context Int]
      -> Feature "result" Bool)
forall (i :: * -> *) a b (container :: * -> *)
       (indexName :: Symbol) (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, IntervalSizeable a b, IntervalCombinable i a,
 Witherable container) =>
Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Bool)
buildNofXWithGapBool (NofXWithGapTestCase
-> (Natural, Int, Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
forall a b builderArgs. TestCase a b builderArgs -> builderArgs
getBuilderArgs NofXWithGapTestCase
x)))
    )
    [NofXWithGapTestCase]
buildNofXWithGapTestCases
  )

{-|
Is either 'buildNofX' or 'buildNofXWithGap' satisfied

-}
buildNofXOrNofYWithGap
  :: ( Intervallic i a
     , IntervalSizeable a b
     , IntervalCombinable i a
     , Witherable container
     )
  => (outputType -> outputType -> outputType) 
  -> (Bool -> outputType)
  -> Natural -- ^ count passed to 'buildNofX'
  -> Predicate (Event a)
  -> Natural -- ^ the minimum number of gaps passed to 'buildNofXWithGap'
  -> b -- ^ the minimum duration of a gap passed to 'buildNofXWithGap'
  -> (Index i a -> AssessmentInterval a)
  -> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
  -> Predicate (Event a)
  -> Definition
       (  Feature indexName (Index i a)
       -> Feature eventsName (container (Event a))
       -> Feature varName outputType
       )
buildNofXOrNofYWithGap :: (outputType -> outputType -> outputType)
-> (Bool -> outputType)
-> Natural
-> Predicate (Event a)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
buildNofXOrNofYWithGap outputType -> outputType -> outputType
f Bool -> outputType
cast Natural
xCount Predicate (Event a)
xPred Natural
gapCount b
gapDuration Index i a -> AssessmentInterval a
assess ComparativePredicateOf2 (AssessmentInterval a) (Event a)
intervalPred Predicate (Event a)
yPred = 
  (outputType -> outputType -> outputType)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a)) -> F Any outputType)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a)) -> F Any outputType)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
forall a2 a1 a (n2 :: Symbol) c (n1 :: Symbol) b (n02 :: Symbol)
       (n01 :: Symbol) (n0 :: Symbol).
(a2 -> a1 -> a)
-> Definition (F n2 c -> F n1 b -> F n02 a2)
-> Definition (F n2 c -> F n1 b -> F n01 a1)
-> Definition (F n2 c -> F n1 b -> F n0 a)
D2C outputType -> outputType -> outputType
f
      ((Bool -> outputType)
-> Natural
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a)) -> F Any outputType)
forall (i :: * -> *) a (container :: * -> *) outputType
       (indexName :: Symbol) (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, Witherable container) =>
(Bool -> outputType)
-> Natural
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
buildNofX Bool -> outputType
cast Natural
xCount Index i a -> AssessmentInterval a
assess ComparativePredicateOf2 (AssessmentInterval a) (Event a)
intervalPred Predicate (Event a)
xPred)
      ((Bool -> outputType)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a)) -> F Any outputType)
forall (i :: * -> *) a b (container :: * -> *) outputType
       (indexName :: Symbol) (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, IntervalSizeable a b, IntervalCombinable i a,
 Witherable container) =>
(Bool -> outputType)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
buildNofXWithGap Bool -> outputType
cast Natural
gapCount b
gapDuration Index i a -> AssessmentInterval a
assess ComparativePredicateOf2 (AssessmentInterval a) (Event a)
intervalPred Predicate (Event a)
yPred)

-- | 'buildNofXOrNofYWithGap' specialized to return @Bool@. 
buildNofXOrNofYWithGapBool
  :: ( Intervallic i a
     , IntervalSizeable a b
     , IntervalCombinable i a
     , Witherable container
     )
  => Natural -- ^ count passed to 'buildNofX'
  -> Predicate (Event a)
  -> Natural -- ^ the minimum number of gaps passed to 'buildNofXWithGap'
  -> b -- ^ the minimum duration of a gap passed to 'buildNofXWithGap'
  -> (Index i a -> AssessmentInterval a)
  -> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
  -> Predicate (Event a)
  -> Definition
       (  Feature indexName (Index i a)
       -> Feature eventsName (container (Event a))
       -> Feature varName Bool
       )
buildNofXOrNofYWithGapBool :: Natural
-> Predicate (Event a)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Bool)
buildNofXOrNofYWithGapBool = (Bool -> Bool -> Bool)
-> (Bool -> Bool)
-> Natural
-> Predicate (Event a)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Bool)
forall (i :: * -> *) a b (container :: * -> *) outputType
       (indexName :: Symbol) (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, IntervalSizeable a b, IntervalCombinable i a,
 Witherable container) =>
(outputType -> outputType -> outputType)
-> (Bool -> outputType)
-> Natural
-> Predicate (Event a)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
buildNofXOrNofYWithGap Bool -> Bool -> Bool
(||) Bool -> Bool
forall a. a -> a
id

-- | 'buildNofXOrNofYWithGap' specialized to return @Binary@. 
buildNofXOrNofYWithGapBinary
  :: ( Intervallic i a
     , IntervalSizeable a b
     , IntervalCombinable i a
     , Witherable container
     )
  => Natural -- ^ count passed to 'buildNofX'
  -> Predicate (Event a)
  -> Natural -- ^ the minimum number of gaps passed to 'buildNofXWithGap'
  -> b -- ^ the minimum duration of a gap passed to 'buildNofXWithGap'
  -> (Index i a -> AssessmentInterval a)
  -> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
  -> Predicate (Event a)
  -> Definition
       (  Feature indexName (Index i a)
       -> Feature eventsName (container (Event a))
       -> Feature varName Binary
       )
buildNofXOrNofYWithGapBinary :: Natural
-> Predicate (Event a)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Binary)
buildNofXOrNofYWithGapBinary = 
  (Binary -> Binary -> Binary)
-> (Bool -> Binary)
-> Natural
-> Predicate (Event a)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Binary)
forall (i :: * -> *) a b (container :: * -> *) outputType
       (indexName :: Symbol) (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, IntervalSizeable a b, IntervalCombinable i a,
 Witherable container) =>
(outputType -> outputType -> outputType)
-> (Bool -> outputType)
-> Natural
-> Predicate (Event a)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName outputType)
buildNofXOrNofYWithGap (\Binary
x Binary
y -> Bool -> Binary
fromBool (Bool -> Binary) -> Bool -> Binary
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
(||) (Binary -> Bool
toBool Binary
x)  (Binary -> Bool
toBool Binary
y) ) Bool -> Binary
fromBool

type NofXOrNofYWithGapArgs
  = ( Natural
    , Predicate (Event Int)
    , Natural
    , Int
    , Index Interval Int -> AssessmentInterval Int
    , ComparativePredicateOf2 (AssessmentInterval Int) (Event Int)
    , Predicate (Event Int)
    )

type NofXOrNofYWithGapTestCase
  = TestCase
      (F "index" (Index Interval Int), F "events" [Event Int])
      Bool
      NofXOrNofYWithGapArgs

buildNofXOrNofYWithGapTestCases :: [NofXOrNofYWithGapTestCase]
buildNofXOrNofYWithGapTestCases :: [NofXOrNofYWithGapTestCase]
buildNofXOrNofYWithGapTestCases =
  [ TestName
-> (Natural, Predicate (PairedInterval Context Int), Natural, Int,
    Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXOrNofYWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"True if looking for no events and there are no events"
      (Natural
0, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"], Natural
0, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
      (Int
10, Int
11)
      []
      Bool
True
      {-
                   -          <- Index
         ----------           <- Baseline
                              
        |--------------|
      -}
  , TestName
-> (Natural, Predicate (PairedInterval Context Int), Natural, Int,
    Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXOrNofYWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f
    TestName
"True if looking for (at least) no events and there are events satisfying gap condition"
    (Natural
0, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"], Natural
0, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
    (Int
10, Int
11)
    [(Int, Int) -> PairedInterval Context Int
g (Int
1, Int
2), (Int, Int) -> PairedInterval Context Int
g (Int
8, Int
9)]
    Bool
True
      {-
                   -          <- Index
         ----------           <- Baseline
         -       -            <- Enrollment
        |--------------|
      -}
  , TestName
-> (Natural, Predicate (PairedInterval Context Int), Natural, Int,
    Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXOrNofYWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"False if no X or Y events and looking for 1 X or 1 Y gap"
      (Natural
1, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"], Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
      (Int
10, Int
11)
      []
      Bool
False
      {-
                   -          <- Index
         ----------           <- Baseline
                              <- Enrollment
        |--------------|
      -}
  , TestName
-> (Natural, Predicate (PairedInterval Context Int), Natural, Int,
    Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXOrNofYWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"False if a no X and Y single event and looking for gap"
      (Natural
1, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"], Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
      (Int
10, Int
11)
      [(Int, Int) -> PairedInterval Context Int
g (Int
8, Int
9)]
      Bool
False
      {-
                   -          <- Index
         ----------           <- Baseline
                 -            <- Enrollment
        |--------------|
      -}
  , TestName
-> (Natural, Predicate (PairedInterval Context Int), Natural, Int,
    Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXOrNofYWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"False if no X 1 gap but not satisfying gap condition"
      (Natural
1, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"], Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
      (Int
10, Int
11)
      [(Int, Int) -> PairedInterval Context Int
g (Int
6, Int
7), (Int, Int) -> PairedInterval Context Int
g (Int
8, Int
9)]
      Bool
False
      {-
                   -          <- Index
         ----------           <- Baseline
               - -            <- Enrollment
        |--------------|
      -}
  , TestName
-> (Natural, Predicate (PairedInterval Context Int), Natural, Int,
    Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXOrNofYWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"True if 1 gap satisfy gap condition"
      (Natural
1, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"D"], Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
      (Int
10, Int
11)
      [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"C", Text
"A"] (Int
2, Int
3), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A", Text
"B"] (Int
8, Int
9)]
      Bool
True
      {-
                   -          <- Index
         ----------           <- Baseline
          -                   <- ["C", "A"]
                 -            <- ["A", "B"] 
        |--------------|
      -}
    , TestName
-> (Natural, Predicate (PairedInterval Context Int), Natural, Int,
    Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXOrNofYWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"True if 1 X event"
      (Natural
1, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"C"], Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
      (Int
10, Int
11)
      [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"C", Text
"A"] (Int
2, Int
3)]
      Bool
True
      {-
                   -          <- Index
         ----------           <- Baseline
          -                   <- ["C", "A"]
        |--------------|
      -}
  , TestName
-> (Natural, Predicate (PairedInterval Context Int), Natural, Int,
    Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXOrNofYWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"True if 1 gap satisfy gap condition "
      (Natural
2, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"D"], Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
      (Int
10, Int
11)
      [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"C", Text
"A"] (Int
2, Int
3), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"D", Text
"E"] (Int
5, Int
6), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A", Text
"B"] (Int
8, Int
9)]
      Bool
True
      {-
                   -          <- Index
         ----------           <- Baseline
          -                   <- ["C", "A"]
              -               <- ["D", "E"]
                 -            <- ["A", "B"] 
        |--------------|
      -}
  , TestName
-> (Natural, Predicate (PairedInterval Context Int), Natural, Int,
    Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXOrNofYWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"False if only one X and if no gap satisfy gap condition "
      (Natural
2, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"D"], Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
      (Int
10, Int
11)
      [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"C", Text
"A"] (Int
2, Int
3), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"D", Text
"A"] (Int
4, Int
5)]
      Bool
False
      {-
                   -          <- Index
         ----------           <- Baseline
          -                   <- ["C", "A"]
            -                 <- ["D", "A"]
        |--------------|
      -}
  , TestName
-> (Natural, Predicate (PairedInterval Context Int), Natural, Int,
    Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> Bool
-> NofXOrNofYWithGapTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"True if two X and if no gap satisfy gap condition "
      (Natural
2, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"D"], Natural
1, Int
3, Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Baseline i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeBaselineFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
      (Int
10, Int
11)
      [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"D", Text
"A"] (Int
2, Int
3), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"D", Text
"A"] (Int
4, Int
5)]
      Bool
True
      {-
                   -          <- Index
         ----------           <- Baseline
          -                   <- ["D", "A"]
            -                 <- ["D", "A"]
        |--------------|
      -}

  ] where
  f :: TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f = TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
forall b a bargs returnType.
(Integral b, IntervalSizeable a b) =>
TestName
-> bargs
-> (a, a)
-> [Event a]
-> returnType
-> TestCase
     (F "index" (Index Interval a), F "events" [Event a])
     returnType
     bargs
makeTestInputs
  g :: (Int, Int) -> PairedInterval Context Int
g = (Int, Int) -> PairedInterval Context Int
forall b a. (Integral b, IntervalSizeable a b) => (a, a) -> Event a
makeEnrollmentEvent
  h :: [Text] -> (Int, Int) -> PairedInterval Context Int
h = [Text] -> (Int, Int) -> PairedInterval Context Int
forall b a.
(Integral b, IntervalSizeable a b) =>
[Text] -> (a, a) -> Event a
makeEventWithConcepts

buildNofXOrNofYWithGapTests :: TestTree
buildNofXOrNofYWithGapTests :: TestTree
buildNofXOrNofYWithGapTests = TestName -> [TestTree] -> TestTree
testGroup
  TestName
"Tests of NofXOrNofYWithGap template"
  ((NofXOrNofYWithGapTestCase -> TestTree)
-> [NofXOrNofYWithGapTestCase] -> [TestTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\NofXOrNofYWithGapTestCase
x -> TestName -> Assertion -> TestTree
testCase
      (NofXOrNofYWithGapTestCase -> TestName
forall a b builderArgs. TestCase a b builderArgs -> TestName
getTestName NofXOrNofYWithGapTestCase
x)
      (NofXOrNofYWithGapTestCase
-> ((F "index" (Index Interval Int),
     F "events" [PairedInterval Context Int])
    -> Feature "result" Bool)
-> Assertion
forall b defArgs builderArgs.
(Eq b, Show b) =>
TestCase defArgs b builderArgs
-> (defArgs -> Feature "result" b) -> Assertion
makeAssertion NofXOrNofYWithGapTestCase
x ((F "index" (Index Interval Int)
 -> F "events" [PairedInterval Context Int]
 -> Feature "result" Bool)
-> (F "index" (Index Interval Int),
    F "events" [PairedInterval Context Int])
-> Feature "result" Bool
forall a b. Curry a b => b -> a
uncurryN ((F "index" (Index Interval Int)
  -> F "events" [PairedInterval Context Int]
  -> Feature "result" Bool)
 -> (F "index" (Index Interval Int),
     F "events" [PairedInterval Context Int])
 -> Feature "result" Bool)
-> (F "index" (Index Interval Int)
    -> F "events" [PairedInterval Context Int]
    -> Feature "result" Bool)
-> (F "index" (Index Interval Int),
    F "events" [PairedInterval Context Int])
-> Feature "result" Bool
forall a b. (a -> b) -> a -> b
$ Definition
  (F "index" (Index Interval Int)
   -> F "events" [PairedInterval Context Int]
   -> Feature "result" Bool)
-> F "index" (Index Interval Int)
-> F "events" [PairedInterval Context Int]
-> Feature "result" Bool
forall d. Definition d -> d
eval (Definition
   (F "index" (Index Interval Int)
    -> F "events" [PairedInterval Context Int]
    -> Feature "result" Bool)
 -> F "index" (Index Interval Int)
 -> F "events" [PairedInterval Context Int]
 -> Feature "result" Bool)
-> Definition
     (F "index" (Index Interval Int)
      -> F "events" [PairedInterval Context Int]
      -> Feature "result" Bool)
-> F "index" (Index Interval Int)
-> F "events" [PairedInterval Context Int]
-> Feature "result" Bool
forall a b. (a -> b) -> a -> b
$ (Natural
 -> Predicate (PairedInterval Context Int)
 -> Natural
 -> Int
 -> (Index Interval Int -> AssessmentInterval Int)
 -> ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int)
 -> Predicate (PairedInterval Context Int)
 -> Definition
      (F "index" (Index Interval Int)
       -> F "events" [PairedInterval Context Int]
       -> Feature "result" Bool))
-> (Natural, Predicate (PairedInterval Context Int), Natural, Int,
    Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> Definition
     (F "index" (Index Interval Int)
      -> F "events" [PairedInterval Context Int]
      -> Feature "result" Bool)
forall a b. Curry a b => b -> a
uncurryN Natural
-> Predicate (PairedInterval Context Int)
-> Natural
-> Int
-> (Index Interval Int -> AssessmentInterval Int)
-> ComparativePredicateOf2
     (AssessmentInterval Int) (PairedInterval Context Int)
-> Predicate (PairedInterval Context Int)
-> Definition
     (F "index" (Index Interval Int)
      -> F "events" [PairedInterval Context Int]
      -> Feature "result" Bool)
forall (i :: * -> *) a b (container :: * -> *)
       (indexName :: Symbol) (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, IntervalSizeable a b, IntervalCombinable i a,
 Witherable container) =>
Natural
-> Predicate (Event a)
-> Natural
-> b
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName Bool)
buildNofXOrNofYWithGapBool (NofXOrNofYWithGapTestCase
-> (Natural, Predicate (PairedInterval Context Int), Natural, Int,
    Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
forall a b builderArgs. TestCase a b builderArgs -> builderArgs
getBuilderArgs NofXOrNofYWithGapTestCase
x)))
    )
    [NofXOrNofYWithGapTestCase]
buildNofXOrNofYWithGapTestCases
  )

{-| Do N events relating to the 'AssessmentInterval' in some way the satisfy 
    the given predicate? 
-}
buildNofUniqueBegins
  :: (Intervallic i a, IntervalSizeable a b, Witherable container)
  => (Index i a -> AssessmentInterval a) -- ^ function to transform a 'Cohort.Index' to an 'Cohort.AssessmentInterval'
  -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -- ^ interval predicate
  -> Predicate (Event a) -- ^ a predicate on events
  -> Definition
       (  Feature indexName (Index i a)
       -> Feature eventsName (container (Event a))
       -> Feature varName [(EventTime b, Count)]
       )
buildNofUniqueBegins :: (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName [(EventTime b, Count)])
buildNofUniqueBegins = (container (Event a) -> container (Interval a))
-> (container (Interval a) -> [(Interval a, Natural)])
-> (AssessmentInterval a
    -> [(Interval a, Natural)] -> [(EventTime b, Count)])
-> (Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName [(EventTime b, Count)])
forall (i0 :: * -> *) a (i1 :: * -> *) (container0 :: * -> *)
       (container1 :: * -> *) t outputType (indexName :: Symbol)
       (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i0 a, Intervallic i1 a, Witherable container0,
 Witherable container1) =>
(container0 (Event a) -> container1 (i1 a))
-> (container1 (i1 a) -> t)
-> (AssessmentInterval a -> t -> outputType)
-> (Index i0 a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i0 a)
      -> Feature eventsName (container0 (Event a))
      -> Feature varName outputType)
buildNofXBase 
  ( (Event a -> Interval a)
-> container (Event a) -> container (Interval a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Interval a -> Interval a
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i a) =>
i a -> i a
momentize (Interval a -> Interval a)
-> (Event a -> Interval a) -> Event a -> Interval a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Interval a
forall (i :: * -> *) a. Intervallic i a => i a -> Interval a
getInterval) )
  (  (Interval a -> (Interval a, Natural))
-> container (Interval a) -> container (Interval a, Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Natural
1 :: Natural)
  (container (Interval a) -> container (Interval a, Natural))
-> (container (Interval a, Natural) -> [(Interval a, Natural)])
-> container (Interval a)
-> [(Interval a, Natural)]
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> container (Interval a, Natural) -> [(Interval a, Natural)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  (container (Interval a) -> [(Interval a, Natural)])
-> ([(Interval a, Natural)] -> Map (Interval a) Natural)
-> container (Interval a)
-> Map (Interval a) Natural
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> [(Interval a, Natural)] -> Map (Interval a) Natural
forall k a. Ord k => [(k, a)] -> Map k a
mapFromList
  (container (Interval a) -> Map (Interval a) Natural)
-> (Map (Interval a) Natural -> [(Interval a, Natural)])
-> container (Interval a)
-> [(Interval a, Natural)]
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Map (Interval a) Natural -> [(Interval a, Natural)]
forall k a. Ord k => Map k a -> [(k, a)]
mapToList
  (container (Interval a) -> [(Interval a, Natural)])
-> ([(Interval a, Natural)] -> [(Interval a, Natural)])
-> container (Interval a)
-> [(Interval a, Natural)]
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> \[(Interval a, Natural)]
x -> ([Interval a] -> [Natural] -> [(Interval a, Natural)])
-> ([Interval a], [Natural]) -> [(Interval a, Natural)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Interval a] -> [Natural] -> [(Interval a, Natural)]
forall a b. [a] -> [b] -> [(a, b)]
zip (([Natural] -> [Natural])
-> ([Interval a], [Natural]) -> ([Interval a], [Natural])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Natural -> Natural -> Natural) -> [Natural] -> [Natural]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(+)) ([(Interval a, Natural)] -> ([Interval a], [Natural])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Interval a, Natural)]
x)) 
  ) 
  (\AssessmentInterval a
window ->
    ((Interval a, Natural) -> (EventTime b, Count))
-> [(Interval a, Natural)] -> [(EventTime b, Count)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Interval a, Natural)
i -> (Maybe b -> EventTime b
forall a. Maybe a -> EventTime a
mkEventTime (Maybe b -> EventTime b) -> Maybe b -> EventTime b
forall a b. (a -> b) -> a -> b
$ b -> Maybe b
forall a. a -> Maybe a
Just (a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
diff (Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin ((Interval a, Natural) -> Interval a
forall a b. (a, b) -> a
fst (Interval a, Natural)
i)) (AssessmentInterval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin AssessmentInterval a
window)), Natural -> Count
Count ((Interval a, Natural) -> Natural
forall a b. (a, b) -> b
snd (Interval a, Natural)
i)))  
  )

type NofUniqueBeginsArgs
  = ( Index Interval Int -> AssessmentInterval Int
    , ComparativePredicateOf2 (AssessmentInterval Int) (Event Int)
    , Predicate (Event Int)
    )

type NofUniqueBeginsTestCase
  = TestCase
      (F "index" (Index Interval Int), F "events" [Event Int])
      [(EventTime Int, Count)]
      NofUniqueBeginsArgs

buildNofUniqueBeginsTestCases :: [NofUniqueBeginsTestCase]
buildNofUniqueBeginsTestCases :: [NofUniqueBeginsTestCase]
buildNofUniqueBeginsTestCases =
  [ TestName
-> (Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> [(EventTime Int, Count)]
-> NofUniqueBeginsTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"empty input"
      (Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Followup i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeFollowupFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, Predicate (PairedInterval Context Int)
forall a. Predicate (Event a)
isEnrollmentEvent)
      (Int
0, Int
1)
      []
      [] 
      {-
         -                    <- Index
         ----------           <- Baseline

        |--------------|
      -}
  , TestName
-> (Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> [(EventTime Int, Count)]
-> NofUniqueBeginsTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"2 results if 2 different begins"
      (Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Followup i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeFollowupFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
      (Int
0, Int
1)
      [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
2, Int
5), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
4, Int
5)]
      [(Maybe Int -> EventTime Int
forall a. Maybe a -> EventTime a
mkEventTime (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2), Count
1), (Maybe Int -> EventTime Int
forall a. Maybe a -> EventTime a
mkEventTime (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4), Count
2)] 
      {-
         -                    <- Index
         ----------           <- Followup
           ---                <- "A"
             _                <- "A"
        |--------------|
      -}
  , TestName
-> (Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> [(EventTime Int, Count)]
-> NofUniqueBeginsTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"2 results when multiple begins at same time"
      (Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Followup i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeFollowupFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
      (Int
0, Int
1)
      [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
2, Int
3),[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
2, Int
5), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
4, Int
5)]
      [(Maybe Int -> EventTime Int
forall a. Maybe a -> EventTime a
mkEventTime (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2), Count
1), (Maybe Int -> EventTime Int
forall a. Maybe a -> EventTime a
mkEventTime (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4), Count
2)] 
      {-
         -                    <- Index
         ----------           <- Followup 
           -                  <- "A"
           ---                <- "A"
             -                <- "A"
        |--------------|
      -}
  , TestName
-> (Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> (Int, Int)
-> [PairedInterval Context Int]
-> [(EventTime Int, Count)]
-> NofUniqueBeginsTestCase
forall bargs returnType.
TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f TestName
"1 result based on predicate filter"
      (Int -> Index Interval Int -> AssessmentInterval Int
forall (i :: * -> *) a b.
(Followup i a, IntervalSizeable a b) =>
b -> Index i a -> AssessmentInterval a
makeFollowupFromIndex Int
10, ComparativePredicateOf2
  (AssessmentInterval Int) (PairedInterval Context Int)
forall (i0 :: * -> *) a (i1 :: * -> *).
(Intervallic i0 a, Intervallic i1 a) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur, [Text] -> Predicate (PairedInterval Context Int)
forall a. [Text] -> Predicate (Event a)
containsConcepts [Text
"A"])
      (Int
0, Int
1)
      [[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"B"] (Int
2, Int
3),[Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"B"] (Int
2, Int
5), [Text] -> (Int, Int) -> PairedInterval Context Int
h [Text
"A"] (Int
4, Int
5)]
      [(Maybe Int -> EventTime Int
forall a. Maybe a -> EventTime a
mkEventTime (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4), Count
1)] 
      {-
         -                    <- Index
         ----------           <- Followup 
           -                  <- "B"
           ---                <- "B"
             -                <- "A"
        |--------------|
      -}
  ] where
  f :: TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
f = TestName
-> bargs
-> (Int, Int)
-> [PairedInterval Context Int]
-> returnType
-> TestCase
     (F "index" (Index Interval Int),
      F "events" [PairedInterval Context Int])
     returnType
     bargs
forall b a bargs returnType.
(Integral b, IntervalSizeable a b) =>
TestName
-> bargs
-> (a, a)
-> [Event a]
-> returnType
-> TestCase
     (F "index" (Index Interval a), F "events" [Event a])
     returnType
     bargs
makeTestInputs
  h :: [Text] -> (Int, Int) -> PairedInterval Context Int
h = [Text] -> (Int, Int) -> PairedInterval Context Int
forall b a.
(Integral b, IntervalSizeable a b) =>
[Text] -> (a, a) -> Event a
makeEventWithConcepts

buildNofUniqueBeginsTests :: TestTree
buildNofUniqueBeginsTests :: TestTree
buildNofUniqueBeginsTests = TestName -> [TestTree] -> TestTree
testGroup
  TestName
"Tests ofNofUniqueBegins template"
  ((NofUniqueBeginsTestCase -> TestTree)
-> [NofUniqueBeginsTestCase] -> [TestTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\NofUniqueBeginsTestCase
x -> TestName -> Assertion -> TestTree
testCase
      (NofUniqueBeginsTestCase -> TestName
forall a b builderArgs. TestCase a b builderArgs -> TestName
getTestName NofUniqueBeginsTestCase
x)
      (NofUniqueBeginsTestCase
-> ((F "index" (Index Interval Int),
     F "events" [PairedInterval Context Int])
    -> Feature "result" [(EventTime Int, Count)])
-> Assertion
forall b defArgs builderArgs.
(Eq b, Show b) =>
TestCase defArgs b builderArgs
-> (defArgs -> Feature "result" b) -> Assertion
makeAssertion NofUniqueBeginsTestCase
x ((F "index" (Index Interval Int)
 -> F "events" [PairedInterval Context Int]
 -> Feature "result" [(EventTime Int, Count)])
-> (F "index" (Index Interval Int),
    F "events" [PairedInterval Context Int])
-> Feature "result" [(EventTime Int, Count)]
forall a b. Curry a b => b -> a
uncurryN ((F "index" (Index Interval Int)
  -> F "events" [PairedInterval Context Int]
  -> Feature "result" [(EventTime Int, Count)])
 -> (F "index" (Index Interval Int),
     F "events" [PairedInterval Context Int])
 -> Feature "result" [(EventTime Int, Count)])
-> (F "index" (Index Interval Int)
    -> F "events" [PairedInterval Context Int]
    -> Feature "result" [(EventTime Int, Count)])
-> (F "index" (Index Interval Int),
    F "events" [PairedInterval Context Int])
-> Feature "result" [(EventTime Int, Count)]
forall a b. (a -> b) -> a -> b
$ Definition
  (F "index" (Index Interval Int)
   -> F "events" [PairedInterval Context Int]
   -> Feature "result" [(EventTime Int, Count)])
-> F "index" (Index Interval Int)
-> F "events" [PairedInterval Context Int]
-> Feature "result" [(EventTime Int, Count)]
forall d. Definition d -> d
eval (Definition
   (F "index" (Index Interval Int)
    -> F "events" [PairedInterval Context Int]
    -> Feature "result" [(EventTime Int, Count)])
 -> F "index" (Index Interval Int)
 -> F "events" [PairedInterval Context Int]
 -> Feature "result" [(EventTime Int, Count)])
-> Definition
     (F "index" (Index Interval Int)
      -> F "events" [PairedInterval Context Int]
      -> Feature "result" [(EventTime Int, Count)])
-> F "index" (Index Interval Int)
-> F "events" [PairedInterval Context Int]
-> Feature "result" [(EventTime Int, Count)]
forall a b. (a -> b) -> a -> b
$ ((Index Interval Int -> AssessmentInterval Int)
 -> ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int)
 -> Predicate (PairedInterval Context Int)
 -> Definition
      (F "index" (Index Interval Int)
       -> F "events" [PairedInterval Context Int]
       -> Feature "result" [(EventTime Int, Count)]))
-> (Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
-> Definition
     (F "index" (Index Interval Int)
      -> F "events" [PairedInterval Context Int]
      -> Feature "result" [(EventTime Int, Count)])
forall a b. Curry a b => b -> a
uncurryN (Index Interval Int -> AssessmentInterval Int)
-> ComparativePredicateOf2
     (AssessmentInterval Int) (PairedInterval Context Int)
-> Predicate (PairedInterval Context Int)
-> Definition
     (F "index" (Index Interval Int)
      -> F "events" [PairedInterval Context Int]
      -> Feature "result" [(EventTime Int, Count)])
forall (i :: * -> *) a b (container :: * -> *)
       (indexName :: Symbol) (eventsName :: Symbol) (varName :: Symbol).
(Intervallic i a, IntervalSizeable a b, Witherable container) =>
(Index i a -> AssessmentInterval a)
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)
-> Predicate (Event a)
-> Definition
     (Feature indexName (Index i a)
      -> Feature eventsName (container (Event a))
      -> Feature varName [(EventTime b, Count)])
buildNofUniqueBegins (NofUniqueBeginsTestCase
-> (Index Interval Int -> AssessmentInterval Int,
    ComparativePredicateOf2
      (AssessmentInterval Int) (PairedInterval Context Int),
    Predicate (PairedInterval Context Int))
forall a b builderArgs. TestCase a b builderArgs -> builderArgs
getBuilderArgs NofUniqueBeginsTestCase
x)))
    )
    [NofUniqueBeginsTestCase]
buildNofUniqueBeginsTestCases
  )