module Data.WeakSets.HomogeneousSet
(
Set,
set,
setToList,
isIncludedIn,
cardinal,
isIn,
(|&|),
(|||),
(|*|),
(|+|),
(|-|),
(|^|),
powerSet,
filterSet,
setToMaybe,
maybeToSet,
catMaybesToSet,
mapMaybeToSet,
AssociationList(..),
Function,
function,
functionToSet,
domain,
image,
(|$|),
(|!|),
findWithDefault,
(|.|),
memorizeFunction,
)
where
import Data.List (intercalate, nub, nubBy, intersect, union, (\\), subsequences)
import Data.Maybe
data Set a = Set [a]
set :: [a] -> Set a
set :: forall a. [a] -> Set a
set [a]
xs = [a] -> Set a
forall a. [a] -> Set a
Set [a]
xs
instance (Show a) => Show (Set a) where
show :: Set a -> String
show (Set [a]
xs) = String
"(set "String -> ShowS
forall a. [a] -> [a] -> [a]
++[a] -> String
forall a. Show a => a -> String
show [a]
xsString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"
isIncludedIn :: (Eq a) => Set a -> Set a -> Bool
(Set []) isIncludedIn :: forall a. Eq a => Set a -> Set a -> Bool
`isIncludedIn` Set a
_ = Bool
True
(Set (a
x:[a]
xs)) `isIncludedIn` (Set [a]
ys)
| a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ys = ([a] -> Set a
forall a. [a] -> Set a
Set [a]
xs) Set a -> Set a -> Bool
forall a. Eq a => Set a -> Set a -> Bool
`isIncludedIn` ([a] -> Set a
forall a. [a] -> Set a
Set [a]
ys)
| Bool
otherwise = Bool
False
instance (Eq a) => Eq (Set a) where
Set a
x == :: Set a -> Set a -> Bool
== Set a
y = Set a
x Set a -> Set a -> Bool
forall a. Eq a => Set a -> Set a -> Bool
`isIncludedIn` Set a
y Bool -> Bool -> Bool
&& Set a
y Set a -> Set a -> Bool
forall a. Eq a => Set a -> Set a -> Bool
`isIncludedIn` Set a
x
instance (Eq a) => Semigroup (Set a) where
(Set [a]
xs) <> :: Set a -> Set a -> Set a
<> (Set [a]
ys) = [a] -> Set a
forall a. [a] -> Set a
set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
ys
instance (Eq a) => Monoid (Set a) where
mempty :: Set a
mempty = [a] -> Set a
forall a. [a] -> Set a
Set []
instance Foldable Set where
foldr :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldr a -> b -> b
f b
d (Set [a]
xs) = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
d [a]
xs
instance Functor Set where
fmap :: forall a b. (a -> b) -> Set a -> Set b
fmap a -> b
f (Set [a]
xs) = [b] -> Set b
forall a. [a] -> Set a
Set ([b] -> Set b) -> [b] -> Set b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs
instance Applicative Set where
pure :: forall a. a -> Set a
pure a
x = [a] -> Set a
forall a. [a] -> Set a
Set [a
x]
<*> :: forall a b. Set (a -> b) -> Set a -> Set b
(<*>) (Set [a -> b]
fs) (Set [a]
xs) = [b] -> Set b
forall a. [a] -> Set a
Set ([b] -> Set b) -> [b] -> Set b
forall a b. (a -> b) -> a -> b
$ [a -> b]
fs [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a]
xs
instance Monad Set where
>>= :: forall a b. Set a -> (a -> Set b) -> Set b
(>>=) (Set [a]
xs) a -> Set b
f = [b] -> Set b
forall a. [a] -> Set a
Set ([b] -> Set b) -> [b] -> Set b
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Set b -> [b]
forall a. Set a -> [a]
unsafeSetToList(Set b -> [b]) -> (a -> Set b) -> a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Set b
f)
setToList :: (Eq a) => Set a -> [a]
setToList :: forall a. Eq a => Set a -> [a]
setToList (Set [a]
xs) = [a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
xs
unsafeSetToList :: Set a -> [a]
unsafeSetToList :: forall a. Set a -> [a]
unsafeSetToList (Set [a]
xs) = [a]
xs
cardinal :: (Eq a) => Set a -> Int
cardinal :: forall a. Eq a => Set a -> Int
cardinal = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length([a] -> Int) -> (Set a -> [a]) -> Set a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList
isIn :: (Eq a) => a -> Set a -> Bool
isIn :: forall a. Eq a => a -> Set a -> Bool
isIn a
x = (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x)([a] -> Bool) -> (Set a -> [a]) -> Set a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Set a -> [a]
unsafeSetToList
(|&|) :: (Eq a) => Set a -> Set a -> Set a
|&| :: forall a. Eq a => Set a -> Set a -> Set a
(|&|) (Set [a]
xs) (Set [a]
ys) = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [a]
ys
(|||) :: Set a -> Set a -> Set a
||| :: forall a. Set a -> Set a -> Set a
(|||) (Set [a]
xs) (Set [a]
ys) = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys
(|*|) :: Set a -> Set b -> Set (a,b)
|*| :: forall a b. Set a -> Set b -> Set (a, b)
(|*|) (Set [a]
xs) (Set [b]
ys) = [(a, b)] -> Set (a, b)
forall a. [a] -> Set a
Set ([(a, b)] -> Set (a, b)) -> [(a, b)] -> Set (a, b)
forall a b. (a -> b) -> a -> b
$ [(a
x,b
y) | a
x <- [a]
xs, b
y <- [b]
ys]
(|+|) :: Set a -> Set b -> Set (Either a b)
|+| :: forall a b. Set a -> Set b -> Set (Either a b)
(|+|) (Set [a]
xs) (Set [b]
ys) = [Either a b] -> Set (Either a b)
forall a. [a] -> Set a
Set ([Either a b] -> Set (Either a b))
-> [Either a b] -> Set (Either a b)
forall a b. (a -> b) -> a -> b
$ [a -> Either a b
forall a b. a -> Either a b
Left a
x | a
x <- [a]
xs] [Either a b] -> [Either a b] -> [Either a b]
forall a. [a] -> [a] -> [a]
++ [b -> Either a b
forall a b. b -> Either a b
Right b
y | b
y <- [b]
ys]
(|^|) :: (Num a, Eq a) => Set a -> a -> Set [a]
|^| :: forall a. (Num a, Eq a) => Set a -> a -> Set [a]
(|^|) Set a
_ a
0 = [[a]] -> Set [a]
forall a. [a] -> Set a
Set [[]]
(|^|) Set a
s a
n = (:) (a -> [a] -> [a]) -> Set a -> Set ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set a
s Set ([a] -> [a]) -> Set [a] -> Set [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set a
s Set a -> a -> Set [a]
forall a. (Num a, Eq a) => Set a -> a -> Set [a]
|^| (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1))
(|-|) :: (Eq a) => Set a -> Set a -> Set a
|-| :: forall a. Eq a => Set a -> Set a -> Set a
(|-|) (Set [a]
xs) (Set [a]
ys) = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
ys
powerSet :: Set a -> Set (Set a)
powerSet :: forall a. Set a -> Set (Set a)
powerSet (Set [a]
xs) = [Set a] -> Set (Set a)
forall a. [a] -> Set a
Set ([Set a] -> Set (Set a)) -> [Set a] -> Set (Set a)
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [[a]] -> [Set a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [[a]]
forall a. [a] -> [[a]]
subsequences [a]
xs
filterSet :: (a -> Bool) -> Set a -> Set a
filterSet :: forall a. (a -> Bool) -> Set a -> Set a
filterSet a -> Bool
f (Set [a]
xs) = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
f [a]
xs
setToMaybe :: Set a -> Maybe a
setToMaybe :: forall a. Set a -> Maybe a
setToMaybe = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe([a] -> Maybe a) -> (Set a -> [a]) -> Set a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Set a -> [a]
unsafeSetToList
maybeToSet :: Maybe a -> Set a
maybeToSet :: forall a. Maybe a -> Set a
maybeToSet Maybe a
x = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList Maybe a
x
catMaybesToSet :: Set (Maybe a) -> Set a
catMaybesToSet :: forall a. Set (Maybe a) -> Set a
catMaybesToSet = [a] -> Set a
forall a. [a] -> Set a
set([a] -> Set a) -> (Set (Maybe a) -> [a]) -> Set (Maybe a) -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes([Maybe a] -> [a])
-> (Set (Maybe a) -> [Maybe a]) -> Set (Maybe a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set (Maybe a) -> [Maybe a]
forall a. Set a -> [a]
unsafeSetToList
mapMaybeToSet :: (a -> Maybe b) -> Set a -> Set b
mapMaybeToSet :: forall a b. (a -> Maybe b) -> Set a -> Set b
mapMaybeToSet a -> Maybe b
f = [b] -> Set b
forall a. [a] -> Set a
set([b] -> Set b) -> (Set a -> [b]) -> Set a -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f)([a] -> [b]) -> (Set a -> [a]) -> Set a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Set a -> [a]
unsafeSetToList
data Function a b = Function (Set (a,b)) deriving (Function a b -> Function a b -> Bool
(Function a b -> Function a b -> Bool)
-> (Function a b -> Function a b -> Bool) -> Eq (Function a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Function a b -> Function a b -> Bool
/= :: Function a b -> Function a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Function a b -> Function a b -> Bool
== :: Function a b -> Function a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Function a b -> Function a b -> Bool
Eq)
instance (Show a, Show b) => Show (Function a b) where
show :: Function a b -> String
show (Function Set (a, b)
al) = String
"(function "String -> ShowS
forall a. [a] -> [a] -> [a]
++Set (a, b) -> String
forall a. Show a => a -> String
show Set (a, b)
alString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"
type AssociationList a b = [(a,b)]
function :: AssociationList a b -> Function a b
function :: forall a b. AssociationList a b -> Function a b
function AssociationList a b
al = Set (a, b) -> Function a b
forall a b. Set (a, b) -> Function a b
Function (Set (a, b) -> Function a b) -> Set (a, b) -> Function a b
forall a b. (a -> b) -> a -> b
$ AssociationList a b -> Set (a, b)
forall a. [a] -> Set a
Set (AssociationList a b -> Set (a, b))
-> AssociationList a b -> Set (a, b)
forall a b. (a -> b) -> a -> b
$ AssociationList a b
al
functionToSet :: (Eq a) => Function a b -> Set (a,b)
functionToSet :: forall a b. Eq a => Function a b -> Set (a, b)
functionToSet (Function (Set [(a, b)]
al)) = [(a, b)] -> Set (a, b)
forall a. [a] -> Set a
Set ([(a, b)] -> Set (a, b)) -> [(a, b)] -> Set (a, b)
forall a b. (a -> b) -> a -> b
$ ((a, b) -> (a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(a, b)
x (a, b)
y -> ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
y)) [(a, b)]
al
domain :: Function a b -> Set a
domain :: forall a b. Function a b -> Set a
domain (Function Set (a, b)
al) = (a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> Set (a, b) -> Set a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (a, b)
al
image :: Function a b -> Set b
image :: forall a b. Function a b -> Set b
image (Function Set (a, b)
al) = (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> Set (a, b) -> Set b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (a, b)
al
(|$|) :: (Eq a) => Function a b -> a -> Maybe b
|$| :: forall a b. Eq a => Function a b -> a -> Maybe b
(|$|) (Function (Set [])) a
_ = Maybe b
forall a. Maybe a
Nothing
(|$|) (Function (Set ((a
k,b
v):[(a, b)]
xs))) a
x
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k = b -> Maybe b
forall a. a -> Maybe a
Just b
v
| Bool
otherwise = (Set (a, b) -> Function a b
forall a b. Set (a, b) -> Function a b
Function ([(a, b)] -> Set (a, b)
forall a. [a] -> Set a
Set [(a, b)]
xs)) Function a b -> a -> Maybe b
forall a b. Eq a => Function a b -> a -> Maybe b
|$| a
x
(|!|) :: (Eq a) => Function a b -> a -> b
|!| :: forall a b. Eq a => Function a b -> a -> b
(|!|) (Function (Set [])) a
_ = String -> b
forall a. HasCallStack => String -> a
error String
"Function applied on a value not in the domain."
(|!|) (Function (Set ((a
k,b
v):[(a, b)]
xs))) a
x
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k = b
v
| Bool
otherwise = (Set (a, b) -> Function a b
forall a b. Set (a, b) -> Function a b
Function ([(a, b)] -> Set (a, b)
forall a. [a] -> Set a
Set [(a, b)]
xs)) Function a b -> a -> b
forall a b. Eq a => Function a b -> a -> b
|!| a
x
findWithDefault :: (Eq a) => Function a b -> b -> a -> b
findWithDefault :: forall a b. Eq a => Function a b -> b -> a -> b
findWithDefault (Function (Set [])) b
d a
_ = b
d
findWithDefault (Function (Set ((a
k,b
v):[(a, b)]
xs))) b
d a
x
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k = b
v
| Bool
otherwise = Function a b -> b -> a -> b
forall a b. Eq a => Function a b -> b -> a -> b
findWithDefault (Set (a, b) -> Function a b
forall a b. Set (a, b) -> Function a b
Function ([(a, b)] -> Set (a, b)
forall a. [a] -> Set a
Set [(a, b)]
xs)) b
d a
x
(|.|) :: (Eq a, Eq b) => Function b c -> Function a b -> Function a c
|.| :: forall a b c.
(Eq a, Eq b) =>
Function b c -> Function a b -> Function a c
(|.|) Function b c
f2 Function a b
f1 = Set (a, c) -> Function a c
forall a b. Set (a, b) -> Function a b
Function (Set (a, c) -> Function a c) -> Set (a, c) -> Function a c
forall a b. (a -> b) -> a -> b
$ [(a, c)] -> Set (a, c)
forall a. [a] -> Set a
Set [(a
k,(Function b c
f2 Function b c -> b -> c
forall a b. Eq a => Function a b -> a -> b
|!| (Function a b
f1 Function a b -> a -> b
forall a b. Eq a => Function a b -> a -> b
|!| a
k))) | a
k <- (Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList(Set a -> [a]) -> (Function a b -> Set a) -> Function a b -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Function a b -> Set a
forall a b. Function a b -> Set a
domain (Function a b -> [a]) -> Function a b -> [a]
forall a b. (a -> b) -> a -> b
$ Function a b
f1), Function a b
f1 Function a b -> a -> b
forall a b. Eq a => Function a b -> a -> b
|!| a
k b -> Set b -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` (Function b c -> Set b
forall a b. Function a b -> Set a
domain Function b c
f2)]
memorizeFunction :: (a -> b) -> Set a -> Function a b
memorizeFunction :: forall a b. (a -> b) -> Set a -> Function a b
memorizeFunction a -> b
f (Set [a]
xs) = Set (a, b) -> Function a b
forall a b. Set (a, b) -> Function a b
Function (Set (a, b) -> Function a b) -> Set (a, b) -> Function a b
forall a b. (a -> b) -> a -> b
$ [(a, b)] -> Set (a, b)
forall a. [a] -> Set a
Set [(a
k, a -> b
f a
k) | a
k <- [a]
xs]