{- |
Module : Persistence.Util
Copyright : (c) Eben Cowley, 2018
License : BSD 3 Clause
Maintainer : eben.cowley42@gmail.com
Stability : experimental
This module contains miscellaneous utility functions used throughout the Persistence library.
-}
module Util where
import Data.List as L
import Data.Vector as V
import Control.Parallel.Strategies
-- | Simple instance of Num where True is 1 and False is 0, all operations work like arithmetic modulo 2.
instance Num Bool where
p + q = p `xor` q
p * q = p && q
p - q = p `xor` (not q)
negate = not
abs = id
fromInteger 0 = False
fromInteger _ = True
signum bool = if bool then 1 else 0
-- | Exclusive or.
xor :: Bool -> Bool -> Bool
xor False False = False
xor True False = True
xor False True = True
xor True True = False
-- | First element of a triple.
one (a, _, _) = a
-- | Second element of a triple.
two (_, b, _) = b
-- | Third element of a triple.
thr (_, _, c) = c
-- | Last two elements of a triple.
not1 (_, b, c) = (b, c)
-- | First and last elements of a triple.
not2 (a, _, c) = (a, c)
-- | First two elements of a triple.
not3 (a, b, _) = (a, b)
-- | Concatenate a vector of vectors.
flatten :: Vector (Vector a) -> Vector a
flatten = V.foldl1 (V.++)
-- | Multiply a vector by a scalar.
mul :: Num a => a -> Vector a -> Vector a
mul s = V.map (*s)
{- |
Add two vectors together component-wise.
WARNING: If one vector is longer than the other,
the longer vector will simply be cut off.
-}
add :: Num a => Vector a -> Vector a -> Vector a
add = V.zipWith (+)
{- |
Subtract the second vector from the first vector component-wise.
WARNING: If one vector is longer than the other,
the longer vector will simply be cut off.
-}
subtr :: Num a => Vector a -> Vector a -> Vector a
subtr = V.zipWith (\x y -> x - y)
-- | Dot product.
dotProduct :: Num a => Vector a -> Vector a -> a
dotProduct vec1 vec2
| a && b = fromIntegral 0
| a = error "First vector passed to dotProduct too short."
| b = error "Second vector passed to dotProduct too short."
| otherwise = (V.head vec1)*(V.head vec2) + (dotProduct (V.tail vec1) (V.tail vec2))
where a = V.null vec1; b = V.null vec2
-- | Extended Euclidean algorithm. Finds the gcd of the two inputs plus the coefficients that multiply each input and sum to give the gcd.
extEucAlg :: Integral a => a -> a -> (a, a, a)
extEucAlg a b =
let eeaHelper r s t =
case snd r of
0 -> (fst r, fst s, fst t)
_ ->
let r1 = fst r
r2 = snd r
s2 = snd s
t2 = snd t
q = r1 `div` r2
nextr = r1 - q*r2
nexts = fst s - q*s2
nextt = fst t - q*t2
in eeaHelper (r2, nextr) (s2, nexts) (t2, nextt)
in (\(x, y, z) -> if x < 0 then (-x, -y, -z) else (x, y, z)) $ eeaHelper (a, b) (0, 1) (1, 0)
-- | Returns whether or not the first number divides the second number.
divides :: Int -> Int -> Bool
0 `divides` b = False
a `divides` b
| b < 0 = False
| b == 0 = True
| otherwise = a `divides` (b - (abs a))
-- | Switches the elements of the vector at the given indices.
switchElems ::Int -> Int -> Vector a -> Vector a
switchElems i j vector
| j == i = vector
| j < i =
let first = V.take j vector
second = V.drop (j + 1) (V.take i vector)
third = V.drop (i + 1) vector
in first V.++ (cons (vector ! i) second) V.++ (cons (vector ! j) third)
| otherwise =
let first = V.take i vector
second = V.drop (i + 1) (V.take j vector)
third = V.drop (j + 1) vector
in first V.++ (cons (vector ! j) second) V.++ (cons (vector ! i) third)
-- | Return all vectors missing exactly one element from the original vector.
getCombos :: Vector a -> Vector (Vector a)
getCombos vector =
let len = V.length vector
calc i =
if i == len then empty
else
let i1 = i + 1
in ((V.take i vector) V.++ (V.drop i1 vector)) `cons` (calc i1)
in calc 0
-- | Returns whether or not every element satisfies the predicate.
forallVec :: (a -> Bool) -> Vector a -> Bool
forallVec p vector =
if V.null vector then True
else (p $ V.head vector) && (forallVec p $ V.tail vector)
-- | Map a function that takes into account the index of each element.
mapWithIndex :: (Int -> a -> b) -> Vector a -> Vector b
mapWithIndex f vector =
let helper i vec =
if V.null vec then empty
else cons (f i $ V.head vec) $ helper (i + 1) (V.tail vec)
in helper 0 vector
-- | Map a function that takes into account the index of each element in parallel.
parMapWithIndex :: (Int -> a -> b) -> Vector a -> Vector b
parMapWithIndex f vector =
let helper i vec = runEval $
if V.null vec then return empty
else
let current = f i $ V.head vec; rest = helper (i + 1) $ V.tail vec
in rpar current >> rseq rest >> (return $ current `cons` rest)
in helper 0 vector
-- | Return the element satisfying the predicate and its index if it exists.
elemAndIndex :: (a -> Bool) -> Vector a -> Maybe (a, Int)
elemAndIndex p vector =
let helper i vec
| V.null vec = Nothing
| p $ V.head vec = Just (V.head vec, i)
| otherwise = helper (i + 1) $ V.tail vec
in helper 0 vector
-- | Return the elements satisfying the predicate and their indices.
elemAndIndices :: (a -> Bool) -> Vector a -> [(a, Int)]
elemAndIndices p vector =
let helper i vec
| V.null vec = []
| p $ V.head vec = (V.head vec, i) : (helper (i + 1) $ V.tail vec)
| otherwise = helper (i + 1) $ V.tail vec
in helper 0 vector
-- | Given a relation and two vectors, find all pairs of elements satisfying the relation.
findBothElems :: (a -> b -> Bool) -> Vector a -> Vector b -> Vector (a, b)
findBothElems rel vector1 vector2 =
let len = V.length vector1
calc i result =
let a = vector1 ! i
in
if i == len then result
else case V.find (\b -> rel a b) vector2 of
Just b -> calc (i + 1) $ result `snoc` (a, b)
Nothing -> calc (i + 1) result
in calc 0 V.empty
{- |
Return the vector of elements that satisfy the predicate in the first component and
the vector of elements that don't satisfy the predicate in the second component.
-}
biFilter :: (a -> Bool) -> Vector a -> (Vector a, Vector a)
biFilter p vector =
let calc true false v
| V.null v = (true, false)
| p x = calc (true `snoc` x) false $ V.tail v
| otherwise = calc true (false `snoc` x) $ V.tail v
where x = V.head v
in calc V.empty V.empty vector
-- | Orders a list of vectors from greatest to least length.
sortVecs :: [Vector a] -> [Vector a]
sortVecs [] = []
sortVecs (v:vs) =
let len = V.length v
less = sortVecs $ L.filter (\u -> V.length u < len) vs
more = sortVecs $ L.filter (\u -> V.length u >= len) vs
in more L.++ [v] L.++ less
-- | Parallel map a function over a vector.
parMapVec :: (a -> b) -> Vector a -> Vector b
parMapVec f v = runEval $ evalTraversable rpar $ V.map f v
-- | Filter a vector with a predicate that takes into account the index of the element.
filterWithIndex :: (Int -> a -> Bool) -> Vector a -> Vector a
filterWithIndex p vector =
let maxIndex = V.length vector - 1
calc i
| i == maxIndex = V.empty
| p i (vector ! i) = (vector ! i) `cons` calc (i + 1)
| otherwise = calc (i + 1)
in calc 0
-- | Generate a range of integers in vector form.
range :: Int -> Int -> Vector Int
range x y
| x == y = x `cons` empty
| x < y = x `cons` (range (x + 1) y)
| x > y = (range x (y + 1)) `snoc` y
-- | Replace the element at the given index with the given element.
replaceElem :: Int -> a -> Vector a -> Vector a
replaceElem i e v = (V.take i v) V.++ (e `cons` (V.drop (i + 1) v))
-- | Quicksort treating the given predicate as the < operator. Works like this because its more convenient to make a lambda instead of a complete instance of Ord.
quicksort :: (a -> a -> Bool) -> Vector a -> Vector a
quicksort rel vector = --rel is the > operator
if V.null vector then empty
else
let x = V.head vector
xs = V.tail vector
lesser = V.filter (rel x) xs
greater = V.filter (not . (rel x)) xs
in (quicksort rel lesser) V.++ (x `cons` (quicksort rel greater))
-- | Takes the union of all of the vectors.
bigU :: Eq a => Vector (Vector a) -> Vector a
bigU =
let exists x v
| V.null v = False
| V.head v == x = True
| otherwise = exists x (V.tail v)
union v1 v2 =
if V.null v1 then v2
else
let x = V.head v1
in
if exists x v2 then union (V.tail v1) v2
else union (V.tail v1) (x `cons` v2)
in V.foldl1 union
-- | The element being searched for, the vector being searched, and the lower and upper bounds on the indices.
binarySearch :: Ord a => a -> Vector a -> Int -> Int -> Maybe Int
binarySearch value xs low high
| high < low = Nothing
| xs ! mid > value = binarySearch value xs low (mid - 1)
| xs ! mid < value = binarySearch value xs (mid + 1) high
| otherwise = Just mid
where mid = low + ((high - low) `div` 2)
-- | Intersection of SORTED vectors.
(|^|) :: Ord a => Vector a -> Vector a -> Vector a
vector1 |^| vector2 =
let len = V.length vector2 - 1
calc acc v =
if V.null v then acc
else
let x = V.head v; xs = V.tail v
in case binarySearch x vector2 0 len of
Just _ -> calc (x `cons` acc) xs
Nothing -> calc acc xs
in calc V.empty vector1
-- | snocs the element if an only if it isn't already in the vector.
smartSnoc :: Eq a => Vector a -> a -> Vector a
smartSnoc v e =
case V.elemIndex e v of
Just _ -> v
Nothing -> v `snoc` e
-- | Returns whether or not there is an element that satisfies the predicate.
existsVec :: (a -> Bool) -> Vector a -> Bool
existsVec p v
| V.null v = False
| p $ V.head v = True
| otherwise = existsVec p $ V.tail v
-- | If the relation were the "greater than" operator, this would find the minimum element of the vector.
foldRelation :: (a -> a -> Bool) -> Vector a -> a
foldRelation rel vec =
let calc w v
| V.null v = w
| rel w x = calc x xs
| otherwise = calc w xs
where x = V.head v; xs = V.tail v
in calc (V.head vec) (V.tail vec)
-- | Unsafe index finding.
elemIndexUnsafe :: Eq a => a -> Vector a -> Int
elemIndexUnsafe elem vector =
let find i v
| V.null v = error "Element isn't here, Persistence.Util.elemIndexUnsafe"
| V.head v == elem = i
| otherwise = find (i + 1) $ V.tail v
in find 0 vector
{- |
Spark the first argument for parallel evaluation and force evaluation of the second argument,
then return the first argument concatenated to the second. This is useful especially if the second
argument is a recursive call that calls evalPar again, so that every elemment of the list will be
sparked for parallelism.
-}
evalPar :: a -> [a] -> [a]
evalPar c r = runEval $ rpar c >> rseq r >> return (c:r)