vector-clock-0.2.3: Vector clocks for versioning message flows

Safe HaskellTrustworthy
LanguageHaskell98

Data.VectorClock.Approximate

Contents

Description

An approximate vector clock implementation in terms of Data.VectorClock.Simple.

Synopsis

Usage example

See Data.VectorClock.Simple for a more detailed example of using vector clock.

An approximate vector clock, is like a normal one, but maps multiple keys to the same entry. Concretely, this is done by first hashing the keys, then using them modulo the vector clock's size. So, an approximate vector clock of size 1 would map all the keys to the same entry; an approximate vector clock of size 2 would map roughly half its keys to the first entry, and half to the second entry.

To create an approximate vector clock, start from empty and insert elements into it. As a shortcut, fromList just inserts all the elements in a list, in order. You must also specify the vector clock's maximum size when creating it. Experimental results suggest that small maximum sizes (e.g. 3 or 4) will yield good resulsts in practice. Higher maximum sizes will have no adverse effects, and will effectively turn approximate vector clocks into normal ones.

let vc = empty 4 in
let vc' = insert 'a' 1 vc in
let vc'' = insert 'b' 2 vc in
vc'' == fromList 4 [('a', 1), ('b', 2)]

Vector clock type

data VectorClock a b Source #

An approximate vector clock is a normal vector clock, but several keys are mapped to the same value. This can lead to false positive relations. In other words, the fact that one vector clock causes another is no longer enough information to say that one message causes the other. That said, experimental results show that approximate vector clocks have good results in practice; see the paper by R. Baldoni and M. Raynal for details.

Instances

Functor (VectorClock a) Source # 

Methods

fmap :: (a -> b) -> VectorClock a a -> VectorClock a b #

(<$) :: a -> VectorClock a b -> VectorClock a a #

Foldable (VectorClock a) Source # 

Methods

fold :: Monoid m => VectorClock a m -> m #

foldMap :: Monoid m => (a -> m) -> VectorClock a a -> m #

foldr :: (a -> b -> b) -> b -> VectorClock a a -> b #

foldr' :: (a -> b -> b) -> b -> VectorClock a a -> b #

foldl :: (b -> a -> b) -> b -> VectorClock a a -> b #

foldl' :: (b -> a -> b) -> b -> VectorClock a a -> b #

foldr1 :: (a -> a -> a) -> VectorClock a a -> a #

foldl1 :: (a -> a -> a) -> VectorClock a a -> a #

toList :: VectorClock a a -> [a] #

null :: VectorClock a a -> Bool #

length :: VectorClock a a -> Int #

elem :: Eq a => a -> VectorClock a a -> Bool #

maximum :: Ord a => VectorClock a a -> a #

minimum :: Ord a => VectorClock a a -> a #

sum :: Num a => VectorClock a a -> a #

product :: Num a => VectorClock a a -> a #

Traversable (VectorClock a) Source # 

Methods

traverse :: Applicative f => (a -> f b) -> VectorClock a a -> f (VectorClock a b) #

sequenceA :: Applicative f => VectorClock a (f a) -> f (VectorClock a a) #

mapM :: Monad m => (a -> m b) -> VectorClock a a -> m (VectorClock a b) #

sequence :: Monad m => VectorClock a (m a) -> m (VectorClock a a) #

Eq b => Eq (VectorClock a b) Source # 

Methods

(==) :: VectorClock a b -> VectorClock a b -> Bool #

(/=) :: VectorClock a b -> VectorClock a b -> Bool #

(Data a, Data b) => Data (VectorClock a b) Source # 

Methods

gfoldl :: (forall d c. Data d => c (d -> c) -> d -> c c) -> (forall g. g -> c g) -> VectorClock a b -> c (VectorClock a b) #

gunfold :: (forall c r. Data c => c (c -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (VectorClock a b) #

toConstr :: VectorClock a b -> Constr #

dataTypeOf :: VectorClock a b -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (VectorClock a b)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (VectorClock a b)) #

gmapT :: (forall c. Data c => c -> c) -> VectorClock a b -> VectorClock a b #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> VectorClock a b -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> VectorClock a b -> r #

gmapQ :: (forall d. Data d => d -> u) -> VectorClock a b -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> VectorClock a b -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> VectorClock a b -> m (VectorClock a b) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> VectorClock a b -> m (VectorClock a b) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> VectorClock a b -> m (VectorClock a b) #

Show b => Show (VectorClock a b) Source # 

Methods

showsPrec :: Int -> VectorClock a b -> ShowS #

show :: VectorClock a b -> String #

showList :: [VectorClock a b] -> ShowS #

Generic (VectorClock a b) Source # 

Associated Types

type Rep (VectorClock a b) :: * -> * #

Methods

from :: VectorClock a b -> Rep (VectorClock a b) x #

to :: Rep (VectorClock a b) x -> VectorClock a b #

Binary b => Binary (VectorClock a b) Source # 

Methods

put :: VectorClock a b -> Put #

get :: Get (VectorClock a b) #

putList :: [VectorClock a b] -> Put #

type Rep (VectorClock a b) Source # 
type Rep (VectorClock a b) = D1 (MetaData "VectorClock" "Data.VectorClock.Approximate" "vector-clock-0.2.3-8Jlja8XE59BAbbotxKfijy" False) (C1 (MetaCons "VectorClock" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "vcClock") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (VectorClock Int b))) (S1 (MetaSel (Just Symbol "vcSize") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int))))

Construction

empty Source #

Arguments

:: Int

size: the maximum number of entries in the vector clock

-> VectorClock a b 

O(1). The empty vector clock.

singleton Source #

Arguments

:: Hashable a 
=> Int

size: the maximum number of entries in the vector clock

-> a

key: the key for the entry

-> b

value: the value for the entry

-> VectorClock a b 

O(1). A vector clock with a single element.

fromList Source #

Arguments

:: Hashable a 
=> Int

size: the maximum number of entries in the vector clock

-> [(a, b)]

entries: the entries to insert in the newly created vector clock

-> VectorClock a b 

O(N). Insert each entry in the list one at a time.

toList :: VectorClock a b -> [(Int, b)] Source #

O(1). All the entries in the vector clock. Note that this is not the inverse of fromList. Note that the keys are returned hashed.

Query

null :: VectorClock a b -> Bool Source #

O(1). Is the vector clock empty?

size :: VectorClock a b -> Int Source #

O(N). The number of entries in the vector clock. Note that this may be less than the size at construction.

member :: Hashable a => a -> VectorClock a b -> Bool Source #

O(N). Is the given key a key in an entry of the vector clock?

lookup :: Hashable a => a -> VectorClock a b -> Maybe b Source #

O(N). Lookup the value for a key in the vector clock.

Insertion

insert :: Hashable a => a -> b -> VectorClock a b -> VectorClock a b Source #

O(N). Insert or replace the entry for a key.

inc :: (Hashable a, Num b) => a -> VectorClock a b -> Maybe (VectorClock a b) Source #

O(N). Increment the entry for a key.

incWithDefault Source #

Arguments

:: (Hashable a, Num b) 
=> a

key: the key of the entry

-> VectorClock a b

vc: the vector clock

-> b

default: if the key is not found, assume its value was the default and increment that

-> VectorClock a b 

O(N). Increment the entry for a key. If the key does not exist, assume it was the default.

Deletion

delete :: Hashable a => a -> VectorClock a b -> VectorClock a b Source #

O(N). Delete an entry from the vector clock. If the requested entry does not exist, does nothing.

Merges

combine Source #

Arguments

:: Ord b 
=> (Int -> Maybe b -> Maybe b -> Maybe b)

a function that takes the hashed key, the value of the entry in the left hand vector clock, if it exists, the value in the right hand vector clock, if it exists, and, if it wishes to keep a value for this key in the resulting vector clock, returns it.

-> VectorClock a b

lhs: the left hand vector clock

-> VectorClock a b

rhs: the right hand vector clock

-> VectorClock a b 

O(max(N, M)). Combine two vector clocks entry-by-entry. The size of the resulting vector clock is the maximum of the sizes of the given ones.

max :: Ord b => VectorClock a b -> VectorClock a b -> VectorClock a b Source #

O(max(N, M)). The maximum of the two vector clocks.

diff :: (Ord a, Ord b) => VectorClock a b -> VectorClock a b -> Maybe (VectorClock a b) Source #

O(M). If vc2 causes vc1, compute the smallest vc3 s.t. max vc3 vc2 == vc1. Note that the first parameter is the newer vector clock.

Relations

data Relation Source #

The relations two vector clocks may find themselves in.

Constructors

Causes 
CausedBy 
Concurrent 

relation :: Ord b => VectorClock a b -> VectorClock a b -> Relation Source #

O(min(N, M)). The relation between the two vector clocks.

causes :: (Ord a, Ord b) => VectorClock a b -> VectorClock a b -> Bool Source #

O(min(N, M)). Short-hand for relation vc1 vc2 == Causes.

Debugging

valid :: Ord b => VectorClock a b -> Bool Source #

O(N). Check whether the vector clock is valid or not.