-- Copyright (c) 2011, David Amos. All rights reserved.

{-# LANGUAGE NoMonomorphismRestriction, TupleSections #-}

-- |A module of simple utility functions which are used throughout the rest of the library
module Math.Core.Utils where

import Data.List as L
import qualified Data.Set as S


toSet :: [a] -> [a]
toSet = Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a -> [a]) -> ([a] -> Set a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList

sortDesc :: [a] -> [a]
sortDesc = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy ((a -> a -> Ordering) -> a -> a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare)

insertDesc :: a -> [a] -> [a]
insertDesc = (a -> a -> Ordering) -> a -> [a] -> [a]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
L.insertBy ((a -> a -> Ordering) -> a -> a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare)


-- |The set union of two ascending lists. If both inputs are strictly increasing, then the output is their union
-- and is strictly increasing. The code does not check that the lists are strictly increasing.
setUnionAsc :: Ord a => [a] -> [a] -> [a]
setUnionAsc :: [a] -> [a] -> [a]
setUnionAsc (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys) =
    case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
    LT -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
setUnionAsc [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
    EQ -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
setUnionAsc [a]
xs [a]
ys
    GT -> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
setUnionAsc (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
setUnionAsc xs :: [a]
xs ys :: [a]
ys = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys

setUnionDesc :: Ord a => [a] -> [a] -> [a]
setUnionDesc :: [a] -> [a] -> [a]
setUnionDesc (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys) =
    case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
    GT -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
setUnionDesc [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
    EQ -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
setUnionDesc [a]
xs [a]
ys
    LT -> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
setUnionDesc (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
setUnionDesc xs :: [a]
xs ys :: [a]
ys = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys

-- |The (multi-)set intersection of two ascending lists. If both inputs are strictly increasing,
-- then the output is the set intersection and is strictly increasing. If both inputs are weakly increasing,
-- then the output is the multiset intersection (with multiplicity), and is weakly increasing.
intersectAsc :: Ord a => [a] -> [a] -> [a]
intersectAsc :: [a] -> [a] -> [a]
intersectAsc (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys) =
    case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
    LT -> [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
intersectAsc [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
    EQ -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
intersectAsc [a]
xs [a]
ys
    GT -> [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
intersectAsc (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
intersectAsc _ _ = []

-- |The multiset sum of two ascending lists. If xs and ys are ascending, then multisetSumAsc xs ys == sort (xs++ys).
-- The code does not check that the lists are ascending.
multisetSumAsc :: Ord a => [a] -> [a] -> [a]
multisetSumAsc :: [a] -> [a] -> [a]
multisetSumAsc (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys) =
    case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
    LT -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
multisetSumAsc [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
    EQ -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
multisetSumAsc [a]
xs [a]
ys
    GT -> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
multisetSumAsc (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
multisetSumAsc xs :: [a]
xs ys :: [a]
ys = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys

-- |The multiset sum of two descending lists. If xs and ys are descending, then multisetSumDesc xs ys == sortDesc (xs++ys).
-- The code does not check that the lists are descending.
multisetSumDesc :: Ord a => [a] -> [a] -> [a]
multisetSumDesc :: [a] -> [a] -> [a]
multisetSumDesc (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys) =
    case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
    GT -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
multisetSumDesc [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
    EQ -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
multisetSumDesc [a]
xs [a]
ys
    LT -> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
multisetSumDesc (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
multisetSumDesc xs :: [a]
xs ys :: [a]
ys = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys


-- |The multiset or set difference between two ascending lists. If xs and ys are ascending, then diffAsc xs ys == xs \\ ys,
-- and diffAsc is more efficient. If xs and ys are sets (that is, have no repetitions), then diffAsc xs ys is the set difference.
-- The code does not check that the lists are ascending.
diffAsc :: Ord a => [a] -> [a] -> [a]
diffAsc :: [a] -> [a] -> [a]
diffAsc (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
                        LT -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
diffAsc [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
                        EQ -> [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
diffAsc [a]
xs [a]
ys
                        GT -> [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
diffAsc (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
diffAsc xs :: [a]
xs [] = [a]
xs
diffAsc [] _ = []

-- |The multiset or set difference between two descending lists. If xs and ys are descending, then diffDesc xs ys == xs \\ ys,
-- and diffDesc is more efficient. If xs and ys are sets (that is, have no repetitions), then diffDesc xs ys is the set difference.
-- The code does not check that the lists are descending.
diffDesc :: Ord a => [a] -> [a] -> [a]
diffDesc :: [a] -> [a] -> [a]
diffDesc (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
                        GT -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
diffDesc [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
                        EQ -> [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
diffDesc [a]
xs [a]
ys
                        LT -> [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
diffDesc (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
diffDesc xs :: [a]
xs [] = [a]
xs
diffDesc [] _ = []


isSubsetAsc :: [a] -> [a] -> Bool
isSubsetAsc = [a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
isSubMultisetAsc

isSubMultisetAsc :: [a] -> [a] -> Bool
isSubMultisetAsc (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys) =
    case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
    LT -> Bool
False
    EQ -> [a] -> [a] -> Bool
isSubMultisetAsc [a]
xs [a]
ys
    GT -> [a] -> [a] -> Bool
isSubMultisetAsc (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
isSubMultisetAsc [] ys :: [a]
ys = Bool
True
isSubMultisetAsc xs :: [a]
xs [] = Bool
False

-- |Is the element in the ascending list?
--
-- With infinite lists, this can fail to terminate.
-- For example, elemAsc 1 [1/2,3/4,7/8..] would fail to terminate.
-- However, with a list of Integer, this will always terminate.
elemAsc :: Ord a => a -> [a] -> Bool
elemAsc :: a -> [a] -> Bool
elemAsc x :: a
x (y :: a
y:ys :: [a]
ys) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
                   LT -> Bool
False
                   EQ -> Bool
True
                   GT -> a -> [a] -> Bool
forall a. Ord a => a -> [a] -> Bool
elemAsc a
x [a]
ys
-- or x `elemAsc` ys = x `elem` takeWhile (<= x) ys

-- |Is the element not in the ascending list? (With infinite lists, this can fail to terminate.)
notElemAsc :: Ord a => a -> [a] -> Bool
notElemAsc :: a -> [a] -> Bool
notElemAsc x :: a
x (y :: a
y:ys :: [a]
ys) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
                      LT -> Bool
True
                      EQ -> Bool
False
                      GT -> a -> [a] -> Bool
forall a. Ord a => a -> [a] -> Bool
notElemAsc a
x [a]
ys


-- From Conor McBride
-- http://stackoverflow.com/questions/12869097/splitting-list-into-a-list-of-possible-tuples/12872133#12872133
-- |Return all the ways to \"pick one and leave the others\" from a list
picks :: [a] -> [(a,[a])]
picks :: [a] -> [(a, [a])]
picks [] = []
picks (x :: a
x:xs :: [a]
xs) = (a
x,[a]
xs) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [(a
y,a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys) | (y :: a
y,ys :: [a]
ys) <- [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
picks [a]
xs]


pairs :: [t] -> [(t, t)]
pairs (x :: t
x:xs :: [t]
xs) = (t -> (t, t)) -> [t] -> [(t, t)]
forall a b. (a -> b) -> [a] -> [b]
map (t
x,) [t]
xs [(t, t)] -> [(t, t)] -> [(t, t)]
forall a. [a] -> [a] -> [a]
++ [t] -> [(t, t)]
pairs [t]
xs
pairs [] = []

ordpair :: b -> b -> (b, b)
ordpair x :: b
x y :: b
y | b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
y     = (b
x,b
y)
            | Bool
otherwise = (b
y,b
x)


-- fold a comparison operator through a list
foldcmpl :: (b -> b -> Bool) -> [b] -> Bool
foldcmpl p :: b -> b -> Bool
p xs :: [b]
xs = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (b -> b -> Bool) -> [b] -> [b] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith b -> b -> Bool
p [b]
xs ([b] -> [b]
forall a. [a] -> [a]
tail [b]
xs)
-- foldcmpl p (x1:x2:xs) = p x1 x2 && foldcmpl p (x2:xs)
-- foldcmpl _ _ = True

-- foldcmpl _ [] = True
-- foldcmpl p xs = and $ zipWith p xs (tail xs)

isWeaklyIncreasing :: Ord t => [t] -> Bool
isWeaklyIncreasing :: [t] -> Bool
isWeaklyIncreasing = (t -> t -> Bool) -> [t] -> Bool
forall b. (b -> b -> Bool) -> [b] -> Bool
foldcmpl t -> t -> Bool
forall a. Ord a => a -> a -> Bool
(<=)

isStrictlyIncreasing :: Ord t => [t] -> Bool
isStrictlyIncreasing :: [t] -> Bool
isStrictlyIncreasing = (t -> t -> Bool) -> [t] -> Bool
forall b. (b -> b -> Bool) -> [b] -> Bool
foldcmpl t -> t -> Bool
forall a. Ord a => a -> a -> Bool
(<)

isWeaklyDecreasing :: Ord t => [t] -> Bool
isWeaklyDecreasing :: [t] -> Bool
isWeaklyDecreasing = (t -> t -> Bool) -> [t] -> Bool
forall b. (b -> b -> Bool) -> [b] -> Bool
foldcmpl t -> t -> Bool
forall a. Ord a => a -> a -> Bool
(>=)

isStrictlyDecreasing :: Ord t => [t] -> Bool
isStrictlyDecreasing :: [t] -> Bool
isStrictlyDecreasing = (t -> t -> Bool) -> [t] -> Bool
forall b. (b -> b -> Bool) -> [b] -> Bool
foldcmpl t -> t -> Bool
forall a. Ord a => a -> a -> Bool
(>)

-- for use with L.sortBy
cmpfst :: (a, b) -> (a, b) -> Ordering
cmpfst x :: (a, b)
x y :: (a, b)
y = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x) ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
y)

-- for use with L.groupBy
eqfst :: (a, b) -> (a, b) -> Bool
eqfst x :: (a, b)
x y :: (a, b)
y = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x) ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
y)


fromBase :: a -> t a -> a
fromBase b :: a
b xs :: t a
xs = (a -> a -> a) -> a -> t a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\n :: a
n x :: a
x -> a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
x) 0 t a
xs

-- |Given a set @xs@, represented as an ordered list, @powersetdfs xs@ returns the list of all subsets of xs, in lex order
powersetdfs :: [a] -> [[a]]
powersetdfs :: [a] -> [[a]]
powersetdfs xs :: [a]
xs = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [([a], [a])] -> [[a]]
forall a. [([a], [a])] -> [[a]]
dfs [ ([],[a]
xs) ]
    where dfs :: [([a], [a])] -> [[a]]
dfs ( (ls :: [a]
ls,rs :: [a]
rs) : nodes :: [([a], [a])]
nodes ) = [a]
ls [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [([a], [a])] -> [[a]]
dfs (([a], [a]) -> [([a], [a])]
forall a. ([a], [a]) -> [([a], [a])]
successors ([a]
ls,[a]
rs) [([a], [a])] -> [([a], [a])] -> [([a], [a])]
forall a. [a] -> [a] -> [a]
++ [([a], [a])]
nodes)
          dfs [] = []
          successors :: ([a], [a]) -> [([a], [a])]
successors (ls :: [a]
ls,rs :: [a]
rs) = [ (a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls, [a]
rs') | r :: a
r:rs' :: [a]
rs' <- [a] -> [[a]]
forall a. [a] -> [[a]]
L.tails [a]
rs ]

-- |Given a set @xs@, represented as an ordered list, @powersetbfs xs@ returns the list of all subsets of xs, in shortlex order
powersetbfs :: [a] -> [[a]]
powersetbfs :: [a] -> [[a]]
powersetbfs xs :: [a]
xs = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [([a], [a])] -> [[a]]
forall a. [([a], [a])] -> [[a]]
bfs [ ([],[a]
xs) ]
    where bfs :: [([a], [a])] -> [[a]]
bfs ( (ls :: [a]
ls,rs :: [a]
rs) : nodes :: [([a], [a])]
nodes ) = [a]
ls [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [([a], [a])] -> [[a]]
bfs ( [([a], [a])]
nodes [([a], [a])] -> [([a], [a])] -> [([a], [a])]
forall a. [a] -> [a] -> [a]
++ ([a], [a]) -> [([a], [a])]
forall a. ([a], [a]) -> [([a], [a])]
successors ([a]
ls,[a]
rs) )
          bfs [] = []
          successors :: ([a], [a]) -> [([a], [a])]
successors (ls :: [a]
ls,rs :: [a]
rs) = [ (a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls, [a]
rs') | r :: a
r:rs' :: [a]
rs' <- [a] -> [[a]]
forall a. [a] -> [[a]]
L.tails [a]
rs ]


-- |Given a positive integer @k@, and a set @xs@, represented as a list,
-- @combinationsOf k xs@ returns all k-element subsets of xs.
-- The result will be in lex order, relative to the order of the xs.
combinationsOf :: Int -> [a] -> [[a]]
combinationsOf :: Int -> [a] -> [[a]]
combinationsOf 0 _ = [[]]
combinationsOf _ [] = []
combinationsOf k :: Int
k (x :: a
x:xs :: [a]
xs) | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinationsOf (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) [a]
xs) [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
k [a]
xs

-- |@choose n k@ is the number of ways of choosing k distinct elements from an n-set
choose :: (Integral a) => a -> a -> a
choose :: a -> a -> a
choose n :: a
n k :: a
k = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [a
na -> a -> a
forall a. Num a => a -> a -> a
-a
ka -> a -> a
forall a. Num a => a -> a -> a
+1..a
n] a -> a -> a
forall a. Integral a => a -> a -> a
`div` [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [1..a
k]


-- |The class of finite sets
class FinSet x where
    elts :: [x]

-- |A class representing algebraic structures having an inverse operation.
-- Note that in some cases not every element has an inverse.
class HasInverses a where
    inverse :: a -> a

infix 8 ^-

-- |A trick: x^-1 returns the inverse of x
(^-) :: (Num a, HasInverses a, Integral b) => a -> b -> a
x :: a
x ^- :: a -> b -> a
^- n :: b
n = a -> a
forall a. HasInverses a => a -> a
inverse a
x a -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ b
n