{-# LANGUAGE DeriveGeneric #-}
module Data.Clock.IntervalTree (
Stamp (..),
ITCId (..),
ITCEvent (..),
seed,
fork,
join,
peek,
event,
happenedBefore,
StampComparison (..),
stampCompare,
) where
import GHC.Generics
data Stamp = Stamp ITCId ITCEvent deriving (Stamp -> Stamp -> Bool
(Stamp -> Stamp -> Bool) -> (Stamp -> Stamp -> Bool) -> Eq Stamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stamp -> Stamp -> Bool
$c/= :: Stamp -> Stamp -> Bool
== :: Stamp -> Stamp -> Bool
$c== :: Stamp -> Stamp -> Bool
Eq, Int -> Stamp -> ShowS
[Stamp] -> ShowS
Stamp -> String
(Int -> Stamp -> ShowS)
-> (Stamp -> String) -> ([Stamp] -> ShowS) -> Show Stamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stamp] -> ShowS
$cshowList :: [Stamp] -> ShowS
show :: Stamp -> String
$cshow :: Stamp -> String
showsPrec :: Int -> Stamp -> ShowS
$cshowsPrec :: Int -> Stamp -> ShowS
Show, (forall x. Stamp -> Rep Stamp x)
-> (forall x. Rep Stamp x -> Stamp) -> Generic Stamp
forall x. Rep Stamp x -> Stamp
forall x. Stamp -> Rep Stamp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Stamp x -> Stamp
$cfrom :: forall x. Stamp -> Rep Stamp x
Generic)
data ITCId
= ITCIdBranch ITCId ITCId
| ITCIdOff
| ITCIdOn
deriving (ITCId -> ITCId -> Bool
(ITCId -> ITCId -> Bool) -> (ITCId -> ITCId -> Bool) -> Eq ITCId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ITCId -> ITCId -> Bool
$c/= :: ITCId -> ITCId -> Bool
== :: ITCId -> ITCId -> Bool
$c== :: ITCId -> ITCId -> Bool
Eq, Int -> ITCId -> ShowS
[ITCId] -> ShowS
ITCId -> String
(Int -> ITCId -> ShowS)
-> (ITCId -> String) -> ([ITCId] -> ShowS) -> Show ITCId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ITCId] -> ShowS
$cshowList :: [ITCId] -> ShowS
show :: ITCId -> String
$cshow :: ITCId -> String
showsPrec :: Int -> ITCId -> ShowS
$cshowsPrec :: Int -> ITCId -> ShowS
Show, (forall x. ITCId -> Rep ITCId x)
-> (forall x. Rep ITCId x -> ITCId) -> Generic ITCId
forall x. Rep ITCId x -> ITCId
forall x. ITCId -> Rep ITCId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ITCId x -> ITCId
$cfrom :: forall x. ITCId -> Rep ITCId x
Generic)
data ITCEvent
= ITCEventBranch !Integer ITCEvent ITCEvent
| ITCEventLeaf !Integer
deriving (ITCEvent -> ITCEvent -> Bool
(ITCEvent -> ITCEvent -> Bool)
-> (ITCEvent -> ITCEvent -> Bool) -> Eq ITCEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ITCEvent -> ITCEvent -> Bool
$c/= :: ITCEvent -> ITCEvent -> Bool
== :: ITCEvent -> ITCEvent -> Bool
$c== :: ITCEvent -> ITCEvent -> Bool
Eq, Int -> ITCEvent -> ShowS
[ITCEvent] -> ShowS
ITCEvent -> String
(Int -> ITCEvent -> ShowS)
-> (ITCEvent -> String) -> ([ITCEvent] -> ShowS) -> Show ITCEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ITCEvent] -> ShowS
$cshowList :: [ITCEvent] -> ShowS
show :: ITCEvent -> String
$cshow :: ITCEvent -> String
showsPrec :: Int -> ITCEvent -> ShowS
$cshowsPrec :: Int -> ITCEvent -> ShowS
Show, (forall x. ITCEvent -> Rep ITCEvent x)
-> (forall x. Rep ITCEvent x -> ITCEvent) -> Generic ITCEvent
forall x. Rep ITCEvent x -> ITCEvent
forall x. ITCEvent -> Rep ITCEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ITCEvent x -> ITCEvent
$cfrom :: forall x. ITCEvent -> Rep ITCEvent x
Generic)
seed :: Stamp
seed :: Stamp
seed = ITCId -> ITCEvent -> Stamp
Stamp ITCId
iT (Integer -> ITCEvent
ITCEventLeaf Integer
0)
fork :: Stamp -> (Stamp, Stamp)
fork :: Stamp -> (Stamp, Stamp)
fork (Stamp ITCId
i ITCEvent
e) = let (ITCId
i1, ITCId
i2) = ITCId -> (ITCId, ITCId)
split ITCId
i in (ITCId -> ITCEvent -> Stamp
Stamp ITCId
i1 ITCEvent
e, ITCId -> ITCEvent -> Stamp
Stamp ITCId
i2 ITCEvent
e)
join :: Stamp -> Stamp -> Stamp
join :: Stamp -> Stamp -> Stamp
join (Stamp ITCId
i1 ITCEvent
e1) (Stamp ITCId
i2 ITCEvent
e2) = ITCId -> ITCEvent -> Stamp
Stamp (ITCId -> ITCId -> ITCId
sumId ITCId
i1 ITCId
i2) (ITCEvent -> ITCEvent -> ITCEvent
joinEv ITCEvent
e1 ITCEvent
e2)
peek :: Stamp -> Stamp
peek :: Stamp -> Stamp
peek (Stamp ITCId
_ ITCEvent
e) = ITCId -> ITCEvent -> Stamp
Stamp ITCId
iF ITCEvent
e
event :: Stamp -> Stamp
event :: Stamp -> Stamp
event s :: Stamp
s@(Stamp ITCId
i ITCEvent
e) =
ITCId -> ITCEvent -> Stamp
Stamp ITCId
i (ITCEvent -> Stamp) -> ITCEvent -> Stamp
forall a b. (a -> b) -> a -> b
$
if ITCEvent
potentiallyNew ITCEvent -> ITCEvent -> Bool
forall a. Eq a => a -> a -> Bool
/= ITCEvent
e
then ITCEvent
potentiallyNew
else ITCEvent
e'
where
potentiallyNew :: ITCEvent
potentiallyNew = ITCId -> ITCEvent -> ITCEvent
fill' ITCId
i ITCEvent
e
(ITCEvent
e', Cost
_) = Stamp -> (ITCEvent, Cost)
grow' Stamp
s
data StampComparison
=
Before
|
After
|
Concurrent
deriving (StampComparison -> StampComparison -> Bool
(StampComparison -> StampComparison -> Bool)
-> (StampComparison -> StampComparison -> Bool)
-> Eq StampComparison
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StampComparison -> StampComparison -> Bool
$c/= :: StampComparison -> StampComparison -> Bool
== :: StampComparison -> StampComparison -> Bool
$c== :: StampComparison -> StampComparison -> Bool
Eq, Int -> StampComparison -> ShowS
[StampComparison] -> ShowS
StampComparison -> String
(Int -> StampComparison -> ShowS)
-> (StampComparison -> String)
-> ([StampComparison] -> ShowS)
-> Show StampComparison
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StampComparison] -> ShowS
$cshowList :: [StampComparison] -> ShowS
show :: StampComparison -> String
$cshow :: StampComparison -> String
showsPrec :: Int -> StampComparison -> ShowS
$cshowsPrec :: Int -> StampComparison -> ShowS
Show)
stampCompare :: Stamp -> Stamp -> StampComparison
stampCompare :: Stamp -> Stamp -> StampComparison
stampCompare Stamp
s1 Stamp
s2
| Stamp -> Stamp -> Bool
happenedBefore Stamp
s1 Stamp
s2 = StampComparison
Before
| Stamp -> Stamp -> Bool
happenedBefore Stamp
s2 Stamp
s1 = StampComparison
After
| Bool
otherwise = StampComparison
Concurrent
happenedBefore :: Stamp -> Stamp -> Bool
(Stamp ITCId
_ ITCEvent
e1) happenedBefore :: Stamp -> Stamp -> Bool
`happenedBefore` (Stamp ITCId
_ ITCEvent
e2) =
(ITCEvent
e1 ITCEvent -> ITCEvent -> Bool
`evLeq` ITCEvent
e2) Bool -> Bool -> Bool
&& Bool -> Bool
not (ITCEvent
e2 ITCEvent -> ITCEvent -> Bool
`evLeq` ITCEvent
e1)
iF, iT :: ITCId
iF :: ITCId
iF = ITCId
ITCIdOff
iT :: ITCId
iT = ITCId
ITCIdOn
iB :: ITCId -> ITCId -> ITCId
iB :: ITCId -> ITCId -> ITCId
iB = ITCId -> ITCId -> ITCId
ITCIdBranch
normId :: ITCId -> ITCId
normId :: ITCId -> ITCId
normId (ITCIdBranch ITCId
ITCIdOff ITCId
ITCIdOff) = ITCId
iF
normId (ITCIdBranch ITCId
ITCIdOn ITCId
ITCIdOn) = ITCId
iT
normId ITCId
leaf = ITCId
leaf
sumId :: ITCId -> ITCId -> ITCId
sumId :: ITCId -> ITCId -> ITCId
sumId ITCId
ITCIdOff ITCId
i = ITCId
i
sumId ITCId
i ITCId
ITCIdOff = ITCId
i
sumId (ITCIdBranch ITCId
l1 ITCId
r1) (ITCIdBranch ITCId
l2 ITCId
r2) = ITCId -> ITCId
normId (ITCId -> ITCId -> ITCId
ITCIdBranch (ITCId -> ITCId -> ITCId
sumId ITCId
l1 ITCId
l2) (ITCId -> ITCId -> ITCId
sumId ITCId
r1 ITCId
r2))
sumId ITCId
_ ITCId
_ = String -> ITCId
forall a. HasCallStack => String -> a
error String
"internal consistency error. Create ID's only by means of fork and join."
split :: ITCId -> (ITCId, ITCId)
split :: ITCId -> (ITCId, ITCId)
split ITCId
ITCIdOff = (ITCId
iF, ITCId
iF)
split ITCId
ITCIdOn = (ITCId -> ITCId -> ITCId
iB ITCId
iT ITCId
iF, ITCId -> ITCId -> ITCId
iB ITCId
iF ITCId
iT)
split (ITCIdBranch ITCId
ITCIdOff ITCId
i) = (ITCId -> ITCId -> ITCId
iB ITCId
iF ITCId
i1, ITCId -> ITCId -> ITCId
iB ITCId
iF ITCId
i2) where (ITCId
i1, ITCId
i2) = ITCId -> (ITCId, ITCId)
split ITCId
i
split (ITCIdBranch ITCId
i ITCId
ITCIdOff) = (ITCId -> ITCId -> ITCId
iB ITCId
i1 ITCId
iF, ITCId -> ITCId -> ITCId
iB ITCId
i2 ITCId
iF) where (ITCId
i1, ITCId
i2) = ITCId -> (ITCId, ITCId)
split ITCId
i
split (ITCIdBranch ITCId
l ITCId
r) = (ITCId -> ITCId -> ITCId
iB ITCId
l ITCId
iF, ITCId -> ITCId -> ITCId
iB ITCId
iF ITCId
r)
fill' :: ITCId -> ITCEvent -> ITCEvent
fill' :: ITCId -> ITCEvent -> ITCEvent
fill' ITCId
ITCIdOff ITCEvent
e = ITCEvent
e
fill' ITCId
ITCIdOn ITCEvent
e = Integer -> ITCEvent
ITCEventLeaf (Integer -> ITCEvent) -> Integer -> ITCEvent
forall a b. (a -> b) -> a -> b
$ ITCEvent -> Integer
maxEv ITCEvent
e
fill' ITCId
_ n :: ITCEvent
n@(ITCEventLeaf Integer
_) = ITCEvent
n
fill' (ITCIdBranch ITCId
ITCIdOn ITCId
ir) (ITCEventBranch Integer
n ITCEvent
l ITCEvent
r) =
ITCEvent -> ITCEvent
normEv (ITCEvent -> ITCEvent) -> ITCEvent -> ITCEvent
forall a b. (a -> b) -> a -> b
$
Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch
Integer
n
(Integer -> ITCEvent
ITCEventLeaf (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max (ITCEvent -> Integer
maxEv ITCEvent
l) (ITCEvent -> Integer
minEv ITCEvent
r')))
ITCEvent
r'
where
r' :: ITCEvent
r' = ITCId -> ITCEvent -> ITCEvent
fill' ITCId
ir ITCEvent
r
fill' (ITCIdBranch ITCId
il ITCId
ITCIdOn) (ITCEventBranch Integer
n ITCEvent
l ITCEvent
r) =
ITCEvent -> ITCEvent
normEv (ITCEvent -> ITCEvent) -> ITCEvent -> ITCEvent
forall a b. (a -> b) -> a -> b
$
Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch
Integer
n
ITCEvent
l'
(Integer -> ITCEvent
ITCEventLeaf (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max (ITCEvent -> Integer
maxEv ITCEvent
r) (ITCEvent -> Integer
minEv ITCEvent
l')))
where
l' :: ITCEvent
l' = ITCId -> ITCEvent -> ITCEvent
fill' ITCId
il ITCEvent
l
fill' (ITCIdBranch ITCId
il ITCId
ir) (ITCEventBranch Integer
n ITCEvent
l ITCEvent
r) = ITCEvent -> ITCEvent
normEv (ITCEvent -> ITCEvent) -> ITCEvent -> ITCEvent
forall a b. (a -> b) -> a -> b
$ Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch Integer
n (ITCId -> ITCEvent -> ITCEvent
fill' ITCId
il ITCEvent
l) (ITCId -> ITCEvent -> ITCEvent
fill' ITCId
ir ITCEvent
r)
newtype Cost = Cost Integer deriving (Cost -> Cost -> Bool
(Cost -> Cost -> Bool) -> (Cost -> Cost -> Bool) -> Eq Cost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cost -> Cost -> Bool
$c/= :: Cost -> Cost -> Bool
== :: Cost -> Cost -> Bool
$c== :: Cost -> Cost -> Bool
Eq, Eq Cost
Eq Cost
-> (Cost -> Cost -> Ordering)
-> (Cost -> Cost -> Bool)
-> (Cost -> Cost -> Bool)
-> (Cost -> Cost -> Bool)
-> (Cost -> Cost -> Bool)
-> (Cost -> Cost -> Cost)
-> (Cost -> Cost -> Cost)
-> Ord Cost
Cost -> Cost -> Bool
Cost -> Cost -> Ordering
Cost -> Cost -> Cost
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Cost -> Cost -> Cost
$cmin :: Cost -> Cost -> Cost
max :: Cost -> Cost -> Cost
$cmax :: Cost -> Cost -> Cost
>= :: Cost -> Cost -> Bool
$c>= :: Cost -> Cost -> Bool
> :: Cost -> Cost -> Bool
$c> :: Cost -> Cost -> Bool
<= :: Cost -> Cost -> Bool
$c<= :: Cost -> Cost -> Bool
< :: Cost -> Cost -> Bool
$c< :: Cost -> Cost -> Bool
compare :: Cost -> Cost -> Ordering
$ccompare :: Cost -> Cost -> Ordering
$cp1Ord :: Eq Cost
Ord)
ltCost :: Cost -> Cost -> Bool
ltCost :: Cost -> Cost -> Bool
ltCost (Cost Integer
c1) (Cost Integer
c2) = Integer
c1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
c2
addCost :: Cost -> Cost -> Cost
addCost :: Cost -> Cost -> Cost
addCost (Cost Integer
c1) (Cost Integer
c2) = Integer -> Cost
Cost (Integer -> Cost) -> Integer -> Cost
forall a b. (a -> b) -> a -> b
$ Integer
c1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
c2
grow' :: Stamp -> (ITCEvent, Cost)
grow' :: Stamp -> (ITCEvent, Cost)
grow' (Stamp ITCId
ITCIdOn (ITCEventLeaf Integer
n)) =
(Integer -> ITCEvent
ITCEventLeaf (Integer -> ITCEvent) -> Integer -> ITCEvent
forall a b. (a -> b) -> a -> b
$ Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, Integer -> Cost
Cost Integer
0)
grow' (Stamp ITCId
i (ITCEventLeaf Integer
n)) =
(ITCEvent
e', Cost
c Cost -> Cost -> Cost
`addCost` Cost
largeCost)
where
largeCost :: Cost
largeCost = Integer -> Cost
Cost Integer
1000
(ITCEvent
e', Cost
c) = Stamp -> (ITCEvent, Cost)
grow' (Stamp -> (ITCEvent, Cost)) -> Stamp -> (ITCEvent, Cost)
forall a b. (a -> b) -> a -> b
$ ITCId -> ITCEvent -> Stamp
Stamp ITCId
i (Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch Integer
n (Integer -> ITCEvent
ITCEventLeaf Integer
0) (Integer -> ITCEvent
ITCEventLeaf Integer
0))
grow' (Stamp (ITCIdBranch ITCId
ITCIdOff ITCId
i) (ITCEventBranch Integer
n ITCEvent
l ITCEvent
r)) =
(Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch Integer
n ITCEvent
l ITCEvent
r', Cost
cr Cost -> Cost -> Cost
`addCost` (Integer -> Cost
Cost Integer
1))
where
(ITCEvent
r', Cost
cr) = Stamp -> (ITCEvent, Cost)
grow' (Stamp -> (ITCEvent, Cost)) -> Stamp -> (ITCEvent, Cost)
forall a b. (a -> b) -> a -> b
$ ITCId -> ITCEvent -> Stamp
Stamp ITCId
i ITCEvent
r
grow' (Stamp (ITCIdBranch ITCId
i ITCId
ITCIdOff) (ITCEventBranch Integer
n ITCEvent
l ITCEvent
r)) =
((Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch Integer
n ITCEvent
l' ITCEvent
r), Cost
cl Cost -> Cost -> Cost
`addCost` (Integer -> Cost
Cost Integer
1))
where
(ITCEvent
l', Cost
cl) = Stamp -> (ITCEvent, Cost)
grow' (Stamp -> (ITCEvent, Cost)) -> Stamp -> (ITCEvent, Cost)
forall a b. (a -> b) -> a -> b
$ ITCId -> ITCEvent -> Stamp
Stamp ITCId
i ITCEvent
l
grow' (Stamp (ITCIdBranch ITCId
il ITCId
ir) (ITCEventBranch Integer
n ITCEvent
l ITCEvent
r))
| Cost
costL Cost -> Cost -> Bool
`ltCost` Cost
costR = ((Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch Integer
n ITCEvent
l' ITCEvent
r), Cost
costL Cost -> Cost -> Cost
`addCost` (Integer -> Cost
Cost Integer
1))
| Bool
otherwise = ((Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch Integer
n ITCEvent
l ITCEvent
r'), Cost
costR Cost -> Cost -> Cost
`addCost` (Integer -> Cost
Cost Integer
1))
where
(ITCEvent
l', Cost
costL) = Stamp -> (ITCEvent, Cost)
grow' (Stamp -> (ITCEvent, Cost)) -> Stamp -> (ITCEvent, Cost)
forall a b. (a -> b) -> a -> b
$ ITCId -> ITCEvent -> Stamp
Stamp ITCId
il ITCEvent
l
(ITCEvent
r', Cost
costR) = Stamp -> (ITCEvent, Cost)
grow' (Stamp -> (ITCEvent, Cost)) -> Stamp -> (ITCEvent, Cost)
forall a b. (a -> b) -> a -> b
$ ITCId -> ITCEvent -> Stamp
Stamp ITCId
ir ITCEvent
r
evLeq :: ITCEvent -> ITCEvent -> Bool
(ITCEventLeaf Integer
n1) evLeq :: ITCEvent -> ITCEvent -> Bool
`evLeq` (ITCEventLeaf Integer
n2) = Integer
n1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n2
(ITCEventLeaf Integer
n1) `evLeq` (ITCEventBranch Integer
n2 ITCEvent
_ ITCEvent
_) = Integer
n1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n2
(ITCEventBranch Integer
n1 ITCEvent
l1 ITCEvent
r1) `evLeq` (ITCEventLeaf Integer
n2) =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$
[ Integer
n1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n2
, (ITCEvent
l1 ITCEvent -> Integer -> ITCEvent
`liftEv` Integer
n1) ITCEvent -> ITCEvent -> Bool
`evLeq` (Integer -> ITCEvent
ITCEventLeaf Integer
n2)
, (ITCEvent
r1 ITCEvent -> Integer -> ITCEvent
`liftEv` Integer
n1) ITCEvent -> ITCEvent -> Bool
`evLeq` (Integer -> ITCEvent
ITCEventLeaf Integer
n2)
]
(ITCEventBranch Integer
n1 ITCEvent
l1 ITCEvent
r1) `evLeq` (ITCEventBranch Integer
n2 ITCEvent
l2 ITCEvent
r2) =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$
[ Integer
n1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n2
, (ITCEvent
l1 ITCEvent -> Integer -> ITCEvent
`liftEv` Integer
n1) ITCEvent -> ITCEvent -> Bool
`evLeq` (ITCEvent
l2 ITCEvent -> Integer -> ITCEvent
`liftEv` Integer
n2)
, (ITCEvent
r1 ITCEvent -> Integer -> ITCEvent
`liftEv` Integer
n1) ITCEvent -> ITCEvent -> Bool
`evLeq` (ITCEvent
r2 ITCEvent -> Integer -> ITCEvent
`liftEv` Integer
n2)
]
liftEv, sinkEv :: ITCEvent -> Integer -> ITCEvent
liftEv :: ITCEvent -> Integer -> ITCEvent
liftEv (ITCEventLeaf Integer
n) Integer
m = Integer -> ITCEvent
ITCEventLeaf (Integer -> ITCEvent) -> Integer -> ITCEvent
forall a b. (a -> b) -> a -> b
$ Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
m
liftEv (ITCEventBranch Integer
n ITCEvent
e1 ITCEvent
e2) Integer
m = Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
m) ITCEvent
e1 ITCEvent
e2
sinkEv :: ITCEvent -> Integer -> ITCEvent
sinkEv ITCEvent
e Integer
m = ITCEvent -> Integer -> ITCEvent
liftEv ITCEvent
e (- Integer
m)
joinEv :: ITCEvent -> ITCEvent -> ITCEvent
joinEv :: ITCEvent -> ITCEvent -> ITCEvent
joinEv (ITCEventLeaf Integer
n1) (ITCEventLeaf Integer
n2) = Integer -> ITCEvent
ITCEventLeaf (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
n1 Integer
n2)
joinEv (ITCEventLeaf Integer
n1) b :: ITCEvent
b@(ITCEventBranch Integer
_ ITCEvent
_ ITCEvent
_) = ITCEvent -> ITCEvent -> ITCEvent
joinEv (Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch Integer
n1 (Integer -> ITCEvent
ITCEventLeaf Integer
0) (Integer -> ITCEvent
ITCEventLeaf Integer
0)) ITCEvent
b
joinEv b :: ITCEvent
b@(ITCEventBranch Integer
_ ITCEvent
_ ITCEvent
_) (ITCEventLeaf Integer
n1) = ITCEvent -> ITCEvent -> ITCEvent
joinEv ITCEvent
b (Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch Integer
n1 (Integer -> ITCEvent
ITCEventLeaf Integer
0) (Integer -> ITCEvent
ITCEventLeaf Integer
0))
joinEv b1 :: ITCEvent
b1@(ITCEventBranch Integer
n1 ITCEvent
_ ITCEvent
_) b2 :: ITCEvent
b2@(ITCEventBranch Integer
n2 ITCEvent
_ ITCEvent
_) | Integer
n1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
n2 = ITCEvent -> ITCEvent -> ITCEvent
joinEv ITCEvent
b2 ITCEvent
b1
joinEv (ITCEventBranch Integer
n1 ITCEvent
l1 ITCEvent
r1) (ITCEventBranch Integer
n2 ITCEvent
l2 ITCEvent
r2) =
ITCEvent -> ITCEvent
normEv (ITCEvent -> ITCEvent) -> ITCEvent -> ITCEvent
forall a b. (a -> b) -> a -> b
$
Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch
Integer
n1
(ITCEvent -> ITCEvent -> ITCEvent
joinEv ITCEvent
l1 (ITCEvent -> ITCEvent) -> ITCEvent -> ITCEvent
forall a b. (a -> b) -> a -> b
$ ITCEvent -> Integer -> ITCEvent
liftEv ITCEvent
l2 (Integer -> ITCEvent) -> Integer -> ITCEvent
forall a b. (a -> b) -> a -> b
$ Integer
n2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
n1)
(ITCEvent -> ITCEvent -> ITCEvent
joinEv ITCEvent
r1 (ITCEvent -> ITCEvent) -> ITCEvent -> ITCEvent
forall a b. (a -> b) -> a -> b
$ ITCEvent -> Integer -> ITCEvent
liftEv ITCEvent
r2 (Integer -> ITCEvent) -> Integer -> ITCEvent
forall a b. (a -> b) -> a -> b
$ Integer
n2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
n1)
normEv :: ITCEvent -> ITCEvent
normEv :: ITCEvent -> ITCEvent
normEv n :: ITCEvent
n@(ITCEventLeaf Integer
_) = ITCEvent
n
normEv (ITCEventBranch Integer
n (ITCEventLeaf Integer
m) (ITCEventLeaf Integer
m'))
| Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
m' = Integer -> ITCEvent
ITCEventLeaf (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
m)
normEv (ITCEventBranch Integer
n ITCEvent
e1 ITCEvent
e2) = Integer -> ITCEvent -> ITCEvent -> ITCEvent
ITCEventBranch (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
m) (ITCEvent -> Integer -> ITCEvent
sinkEv ITCEvent
e1 Integer
m) (ITCEvent -> Integer -> ITCEvent
sinkEv ITCEvent
e2 Integer
m)
where
m :: Integer
m = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (ITCEvent -> Integer
minEv ITCEvent
e1) (ITCEvent -> Integer
minEv ITCEvent
e2)
minEv :: ITCEvent -> Integer
minEv :: ITCEvent -> Integer
minEv (ITCEventLeaf Integer
n) = Integer
n
minEv (ITCEventBranch Integer
n ITCEvent
e1 ITCEvent
e2) = Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (ITCEvent -> Integer
minEv ITCEvent
e1) (ITCEvent -> Integer
minEv ITCEvent
e2)
maxEv :: ITCEvent -> Integer
maxEv :: ITCEvent -> Integer
maxEv (ITCEventLeaf Integer
n) = Integer
n
maxEv (ITCEventBranch Integer
n ITCEvent
e1 ITCEvent
e2) = Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max (ITCEvent -> Integer
maxEv ITCEvent
e1) (ITCEvent -> Integer
maxEv ITCEvent
e2)