module Test.Extrapolate.Utils
( (+++)
, nubMerge
, nubMergeOn
, nubMergeBy
, foldr0
, fromLeft
, fromRight
, elemBy
, listEq, listOrd
, maybeEq, maybeOrd
, eitherEq, eitherOrd
, pairEq, pairOrd
, tripleEq, tripleOrd
, quadrupleEq, quadrupleOrd
, minimumOn
, maximumOn
, takeBound
, nubMergeMap
, compareIndex
)
where
import Data.Function (on)
import Data.List (minimumBy, elemIndex)
nubMergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp (a
x:[a]
xs) (a
y:[a]
ys) = case a
x a -> a -> Ordering
`cmp` a
y of
Ordering
LT -> a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
Ordering
GT -> a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
Ordering
EQ -> a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp [a]
xs [a]
ys
nubMergeBy a -> a -> Ordering
_ [a]
xs [a]
ys = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys
nubMergeOn :: Ord b => (a -> b) -> [a] -> [a] -> [a]
nubMergeOn :: (a -> b) -> [a] -> [a] -> [a]
nubMergeOn a -> b
f = (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering) -> (a -> b) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)
nubMerge :: Ord a => [a] -> [a] -> [a]
nubMerge :: [a] -> [a] -> [a]
nubMerge = (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
(+++) :: Ord a => [a] -> [a] -> [a]
+++ :: [a] -> [a] -> [a]
(+++) = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
nubMerge
infixr 5 +++
foldr0 :: (a -> a -> a) -> a -> [a] -> a
foldr0 :: (a -> a -> a) -> a -> [a] -> a
foldr0 a -> a -> a
f a
z [a]
xs | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs = a
z
| Bool
otherwise = (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 a -> a -> a
f [a]
xs
fromLeft :: Either a b -> a
fromLeft :: Either a b -> a
fromLeft (Left a
x) = a
x
fromLeft Either a b
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"fromLeft: not a left"
fromRight :: Either a b -> b
fromRight :: Either a b -> b
fromRight (Right b
x) = b
x
fromRight Either a b
_ = [Char] -> b
forall a. HasCallStack => [Char] -> a
error [Char]
"fromRight: not a right"
elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
elemBy a -> a -> Bool
(==) a
x = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> a -> Bool
== a
x)
listEq :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listEq :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listEq a -> a -> Bool
(==) [] [] = Bool
True
listEq a -> a -> Bool
(==) (a
x:[a]
xs) [] = Bool
False
listEq a -> a -> Bool
(==) [] (a
y:[a]
ys) = Bool
False
listEq a -> a -> Bool
(==) (a
x:[a]
xs) (a
y:[a]
ys) = a
x a -> a -> Bool
== a
y Bool -> Bool -> Bool
&& (a -> a -> Bool) -> [a] -> [a] -> Bool
forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
listEq a -> a -> Bool
(==) [a]
xs [a]
ys
listOrd :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listOrd :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listOrd a -> a -> Bool
(<=) [] [] = Bool
True
listOrd a -> a -> Bool
(<=) (a
x:[a]
xs) [] = Bool
False
listOrd a -> a -> Bool
(<=) [] (a
y:[a]
ys) = Bool
True
listOrd a -> a -> Bool
(<=) (a
x:[a]
xs) (a
y:[a]
ys) = a
x a -> a -> Bool
< a
y
Bool -> Bool -> Bool
|| a
x a -> a -> Bool
== a
y Bool -> Bool -> Bool
&& (a -> a -> Bool) -> [a] -> [a] -> Bool
forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
listOrd a -> a -> Bool
(<=) [a]
xs [a]
ys
where
a
x < :: a -> a -> Bool
< a
y = a
x a -> a -> Bool
<= a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (a
y a -> a -> Bool
<= a
x)
a
x == :: a -> a -> Bool
== a
y = a
x a -> a -> Bool
<= a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
<= a
x
maybeEq :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
maybeEq :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
maybeEq a -> a -> Bool
(==) Maybe a
Nothing Maybe a
Nothing = Bool
True
maybeEq a -> a -> Bool
(==) Maybe a
Nothing (Just a
y) = Bool
False
maybeEq a -> a -> Bool
(==) (Just a
x) Maybe a
Nothing = Bool
False
maybeEq a -> a -> Bool
(==) (Just a
x) (Just a
y) = a
x a -> a -> Bool
== a
y
maybeOrd :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
maybeOrd :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
maybeOrd a -> a -> Bool
(<=) Maybe a
Nothing Maybe a
Nothing = Bool
True
maybeOrd a -> a -> Bool
(<=) Maybe a
Nothing (Just a
y) = Bool
True
maybeOrd a -> a -> Bool
(<=) (Just a
x) Maybe a
Nothing = Bool
False
maybeOrd a -> a -> Bool
(<=) (Just a
x) (Just a
y) = a
x a -> a -> Bool
<= a
y
eitherEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
eitherEq :: (a -> a -> Bool)
-> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
eitherEq a -> a -> Bool
(==) b -> b -> Bool
_ (Left a
x) (Left a
y) = a
x a -> a -> Bool
== a
y
eitherEq a -> a -> Bool
_ b -> b -> Bool
(==) (Right b
x) (Right b
y) = b
x b -> b -> Bool
== b
y
eitherEq a -> a -> Bool
_ b -> b -> Bool
_ Either a b
_ Either a b
_ = Bool
False
eitherOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
eitherOrd :: (a -> a -> Bool)
-> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
eitherOrd a -> a -> Bool
(<=) b -> b -> Bool
_ (Left a
x) (Left a
y) = a
x a -> a -> Bool
<= a
y
eitherOrd a -> a -> Bool
_ b -> b -> Bool
(<=) (Right b
x) (Right b
y) = b
x b -> b -> Bool
<= b
y
eitherOrd a -> a -> Bool
_ b -> b -> Bool
_ (Left a
_) (Right b
_) = Bool
True
eitherOrd a -> a -> Bool
_ b -> b -> Bool
_ (Right b
_) (Left a
_) = Bool
False
pairEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a,b) -> (a,b) -> Bool
pairEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool
pairEq a -> a -> Bool
(==.) b -> b -> Bool
(.==) (a
x1,b
y1) (a
x2,b
y2) = a
x1 a -> a -> Bool
==. a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.== b
y2
pairOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a,b) -> (a,b) -> Bool
pairOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool
pairOrd a -> a -> Bool
(<=.) b -> b -> Bool
(.<=) (a
x1,b
y1) (a
x2,b
y2) = a
x1 a -> a -> Bool
<. a
x2
Bool -> Bool -> Bool
|| a
x1 a -> a -> Bool
==. a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.<= b
y2
where
a
x <. :: a -> a -> Bool
<. a
y = a
x a -> a -> Bool
<=. a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (a
y a -> a -> Bool
<=. a
x)
a
x ==. :: a -> a -> Bool
==. a
y = a
x a -> a -> Bool
<=. a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
<=. a
x
tripleEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> (c -> c -> Bool)
-> (a,b,c) -> (a,b,c) -> Bool
tripleEq :: (a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (a, b, c)
-> (a, b, c)
-> Bool
tripleEq a -> a -> Bool
(==..) b -> b -> Bool
(.==.) c -> c -> Bool
(..==) (a
x1,b
y1,c
z1) (a
x2,b
y2,c
z2) =
a
x1 a -> a -> Bool
==.. a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.==. b
y2 Bool -> Bool -> Bool
&& c
z1 c -> c -> Bool
..== c
z2
tripleOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> (c -> c -> Bool)
-> (a,b,c) -> (a,b,c) -> Bool
tripleOrd :: (a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (a, b, c)
-> (a, b, c)
-> Bool
tripleOrd a -> a -> Bool
(<=..) b -> b -> Bool
(.<=.) c -> c -> Bool
(..<=) (a
x1,b
y1,c
z1) (a
x2,b
y2,c
z2) =
a
x1 a -> a -> Bool
<.. a
x2 Bool -> Bool -> Bool
|| a
x1 a -> a -> Bool
==.. a
x2 Bool -> Bool -> Bool
&& (b -> b -> Bool) -> (c -> c -> Bool) -> (b, c) -> (b, c) -> Bool
forall a b.
(a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool
pairOrd b -> b -> Bool
(.<=.) c -> c -> Bool
(..<=) (b
y1,c
z1) (b
y2,c
z2)
where
a
x <.. :: a -> a -> Bool
<.. a
y = a
x a -> a -> Bool
<=.. a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (a
y a -> a -> Bool
<=.. a
x)
a
x ==.. :: a -> a -> Bool
==.. a
y = a
x a -> a -> Bool
<=.. a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
<=.. a
x
quadrupleEq :: (a->a->Bool) -> (b->b->Bool) -> (c->c->Bool) -> (d->d->Bool)
-> (a,b,c,d) -> (a,b,c,d) -> Bool
quadrupleEq :: (a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (d -> d -> Bool)
-> (a, b, c, d)
-> (a, b, c, d)
-> Bool
quadrupleEq a -> a -> Bool
(==...) b -> b -> Bool
(.==..) c -> c -> Bool
(..==.) d -> d -> Bool
(...==) (a
x1,b
y1,c
z1,d
w1) (a
x2,b
y2,c
z2,d
w2) =
a
x1 a -> a -> Bool
==... a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.==.. b
y2 Bool -> Bool -> Bool
&& c
z1 c -> c -> Bool
..==. c
z2 Bool -> Bool -> Bool
&& d
w1 d -> d -> Bool
...== d
w2
quadrupleOrd :: (a->a->Bool) -> (b->b->Bool) -> (c->c->Bool) -> (d->d->Bool)
-> (a,b,c,d) -> (a,b,c,d) -> Bool
quadrupleOrd :: (a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (d -> d -> Bool)
-> (a, b, c, d)
-> (a, b, c, d)
-> Bool
quadrupleOrd a -> a -> Bool
(<=...) b -> b -> Bool
(.<=..) c -> c -> Bool
(..<=.) d -> d -> Bool
(...<=) (a
x1,b
y1,c
z1,d
w1) (a
x2,b
y2,c
z2,d
w2) =
a
x1 a -> a -> Bool
<... a
x2 Bool -> Bool -> Bool
|| a
x1 a -> a -> Bool
==... a
x2 Bool -> Bool -> Bool
&& (b -> b -> Bool)
-> (c -> c -> Bool)
-> (d -> d -> Bool)
-> (b, c, d)
-> (b, c, d)
-> Bool
forall a b c.
(a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (a, b, c)
-> (a, b, c)
-> Bool
tripleOrd b -> b -> Bool
(.<=..) c -> c -> Bool
(..<=.) d -> d -> Bool
(...<=) (b
y1,c
z1,d
w1) (b
y2,c
z2,d
w2)
where
a
x <... :: a -> a -> Bool
<... a
y = a
x a -> a -> Bool
<=... a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (a
y a -> a -> Bool
<=... a
x)
a
x ==... :: a -> a -> Bool
==... a
y = a
x a -> a -> Bool
<=... a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
<=... a
x
minimumOn :: Ord b => (a -> b) -> [a] -> a
minimumOn :: (a -> b) -> [a] -> a
minimumOn a -> b
f = (a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering) -> (a -> b) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)
maximumOn :: Ord b => (a -> b) -> [a] -> a
maximumOn :: (a -> b) -> [a] -> a
maximumOn a -> b
f [] = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"maximumOn: empty list"
maximumOn a -> b
f [a
x] = a
x
maximumOn a -> b
f (a
x:[a]
xs) = let y :: a
y = (a -> b) -> [a] -> a
forall b a. Ord b => (a -> b) -> [a] -> a
maximumOn a -> b
f [a]
xs
in if a -> b
f a
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< a -> b
f a
y
then a
y
else a
x
takeBound :: Maybe Int -> [a] -> [a]
takeBound :: Maybe Int -> [a] -> [a]
takeBound Maybe Int
Nothing [a]
xs = [a]
xs
takeBound (Just Int
n) [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
xs
nubMerges :: Ord a => [[a]] -> [a]
nubMerges :: [[a]] -> [a]
nubMerges = (a -> a -> Ordering) -> [[a]] -> [a]
forall a. Ord a => (a -> a -> Ordering) -> [[a]] -> [a]
nubMergesBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
nubMergesBy :: Ord a => (a -> a -> Ordering) -> [[a]] -> [a]
nubMergesBy :: (a -> a -> Ordering) -> [[a]] -> [a]
nubMergesBy a -> a -> Ordering
cmp [] = []
nubMergesBy a -> a -> Ordering
cmp [[a]
xs] = [a]
xs
nubMergesBy a -> a -> Ordering
cmp [[a]]
xss = (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp ([[a]] -> [a]
forall a. Ord a => [[a]] -> [a]
nubMerges [[a]]
yss) ([[a]] -> [a]
forall a. Ord a => [[a]] -> [a]
nubMerges [[a]]
zss)
where
([[a]]
yss,[[a]]
zss) = [[a]] -> ([[a]], [[a]])
forall a. [a] -> ([a], [a])
splitHalf [[a]]
xss
splitHalf :: [a] -> ([a], [a])
splitHalf [a]
xs = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [a]
xs
nubMergeMap :: Ord b => (a -> [b]) -> [a] -> [b]
nubMergeMap :: (a -> [b]) -> [a] -> [b]
nubMergeMap a -> [b]
f = [[b]] -> [b]
forall a. Ord a => [[a]] -> [a]
nubMerges ([[b]] -> [b]) -> ([a] -> [[b]]) -> [a] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [b]) -> [a] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [b]
f
compareIndex :: Eq a => [a] -> a -> a -> Ordering
compareIndex :: [a] -> a -> a -> Ordering
compareIndex [a]
xs a
x a
y =
case (a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
x [a]
xs, a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
y [a]
xs) of
(Just Int
i, Just Int
j) -> Int
i Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
j
(Maybe Int
Nothing, Just Int
_) -> Ordering
GT
(Just Int
_, Maybe Int
Nothing) -> Ordering
LT
(Maybe Int, Maybe Int)
_ -> Ordering
EQ