-----------------------------------------------------------------------------
-- |
-- Module     : Algebra.Graph.Label
-- Copyright  : (c) Andrey Mokhov 2016-2022
-- License    : MIT (see the file LICENSE)
-- Maintainer : [email protected]
-- Stability  : experimental
--
-- __Alga__ is a library for algebraic construction and manipulation of graphs
-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the
-- motivation behind the library, the underlying theory, and implementation details.
--
-- This module provides basic data types and type classes for representing edge
-- labels in edge-labelled graphs, e.g. see "Algebra.Graph.Labelled".
--
-----------------------------------------------------------------------------
module Algebra.Graph.Label (
    -- * Semirings and dioids
    Semiring (..), zero, (<+>), StarSemiring (..), Dioid,

    -- * Data types for edge labels
    NonNegative, finite, finiteWord, unsafeFinite, infinite, getFinite,
    Distance, distance, getDistance, Capacity, capacity, getCapacity,
    Count, count, getCount, PowerSet (..), Minimum, getMinimum, noMinimum,
    Path, Label, isZero, RegularExpression,

    -- * Combining edge labels
    Optimum (..), ShortestPath, AllShortestPaths, CountShortestPaths, WidestPath
    ) where

import Control.Applicative
import Control.Monad
import Data.Coerce
import Data.Maybe
import Data.Monoid (Any (..), Monoid (..), Sum (..))
import Data.Semigroup (Max (..), Min (..))
import Data.Set (Set)
import GHC.Exts (IsList (..))

import Algebra.Graph.Internal

import qualified Data.Set as Set

{-| A /semiring/ extends a commutative 'Monoid' with operation '<.>' that acts
similarly to multiplication over the underlying (additive) monoid and has 'one'
as the identity. This module also provides two convenient aliases: 'zero' for
'mempty', and '<+>' for '<>', which makes the interface more uniform.

Instances of this type class must satisfy the following semiring laws:

    * Associativity of '<+>' and '<.>':

        > x <+> (y <+> z) == (x <+> y) <+> z
        > x <.> (y <.> z) == (x <.> y) <.> z

    * Identities of '<+>' and '<.>':

        > zero <+> x == x == x <+> zero
        >  one <.> x == x == x <.> one

    * Commutativity of '<+>':

        > x <+> y == y <+> x

    * Annihilating 'zero':

        > x <.> zero == zero
        > zero <.> x == zero

    * Distributivity:

        > x <.> (y <+> z) == x <.> y <+> x <.> z
        > (x <+> y) <.> z == x <.> z <+> y <.> z
-}
class (Monoid a, Semigroup a) => Semiring a where
    one   :: a
    (<.>) :: a -> a -> a

{-| A /star semiring/ is a 'Semiring' with an additional unary operator 'star'
satisfying the following two laws:

    > star a = one <+> a <.> star a
    > star a = one <+> star a <.> a
-}
class Semiring a => StarSemiring a where
    star :: a -> a

{-| A /dioid/ is an /idempotent semiring/, i.e. it satisfies the following
/idempotence/ law in addition to the 'Semiring' laws:

    > x <+> x == x
-}
class Semiring a => Dioid a

-- | An alias for 'mempty'.
zero :: Monoid a => a
zero :: forall a. Monoid a => a
zero = forall a. Monoid a => a
mempty

-- | An alias for '<>'.
(<+>) :: Semigroup a => a -> a -> a
<+> :: forall a. Semigroup a => a -> a -> a
(<+>) = forall a. Semigroup a => a -> a -> a
(<>)

infixr 6 <+>
infixr 7 <.>

instance Semiring Any where
    one :: Any
one             = Bool -> Any
Any Bool
True
    Any Bool
x <.> :: Any -> Any -> Any
<.> Any Bool
y = Bool -> Any
Any (Bool
x Bool -> Bool -> Bool
&& Bool
y)

instance StarSemiring Any where
    star :: Any -> Any
star Any
_ = Bool -> Any
Any Bool
True

instance Dioid Any

-- | A non-negative value that can be 'finite' or 'infinite'. Note: the current
-- implementation of the 'Num' instance raises an error on negative literals
-- and on the 'negate' method.
newtype NonNegative a = NonNegative (Extended a)
    deriving (Functor NonNegative
forall a. a -> NonNegative a
forall a b. NonNegative a -> NonNegative b -> NonNegative a
forall a b. NonNegative a -> NonNegative b -> NonNegative b
forall a b. NonNegative (a -> b) -> NonNegative a -> NonNegative b
forall a b c.
(a -> b -> c) -> NonNegative a -> NonNegative b -> NonNegative c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. NonNegative a -> NonNegative b -> NonNegative a
$c<* :: forall a b. NonNegative a -> NonNegative b -> NonNegative a
*> :: forall a b. NonNegative a -> NonNegative b -> NonNegative b
$c*> :: forall a b. NonNegative a -> NonNegative b -> NonNegative b
liftA2 :: forall a b c.
(a -> b -> c) -> NonNegative a -> NonNegative b -> NonNegative c
$cliftA2 :: forall a b c.
(a -> b -> c) -> NonNegative a -> NonNegative b -> NonNegative c
<*> :: forall a b. NonNegative (a -> b) -> NonNegative a -> NonNegative b
$c<*> :: forall a b. NonNegative (a -> b) -> NonNegative a -> NonNegative b
pure :: forall a. a -> NonNegative a
$cpure :: forall a. a -> NonNegative a
Applicative, NonNegative a -> NonNegative a -> Bool
forall a. Eq a => NonNegative a -> NonNegative a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonNegative a -> NonNegative a -> Bool
$c/= :: forall a. Eq a => NonNegative a -> NonNegative a -> Bool
== :: NonNegative a -> NonNegative a -> Bool
$c== :: forall a. Eq a => NonNegative a -> NonNegative a -> Bool
Eq, forall a b. a -> NonNegative b -> NonNegative a
forall a b. (a -> b) -> NonNegative a -> NonNegative b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> NonNegative b -> NonNegative a
$c<$ :: forall a b. a -> NonNegative b -> NonNegative a
fmap :: forall a b. (a -> b) -> NonNegative a -> NonNegative b
$cfmap :: forall a b. (a -> b) -> NonNegative a -> NonNegative b
Functor, NonNegative a -> NonNegative a -> Bool
NonNegative a -> NonNegative a -> Ordering
NonNegative a -> NonNegative a -> NonNegative a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (NonNegative a)
forall a. Ord a => NonNegative a -> NonNegative a -> Bool
forall a. Ord a => NonNegative a -> NonNegative a -> Ordering
forall a. Ord a => NonNegative a -> NonNegative a -> NonNegative a
min :: NonNegative a -> NonNegative a -> NonNegative a
$cmin :: forall a. Ord a => NonNegative a -> NonNegative a -> NonNegative a
max :: NonNegative a -> NonNegative a -> NonNegative a
$cmax :: forall a. Ord a => NonNegative a -> NonNegative a -> NonNegative a
>= :: NonNegative a -> NonNegative a -> Bool
$c>= :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
> :: NonNegative a -> NonNegative a -> Bool
$c> :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
<= :: NonNegative a -> NonNegative a -> Bool
$c<= :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
< :: NonNegative a -> NonNegative a -> Bool
$c< :: forall a. Ord a => NonNegative a -> NonNegative a -> Bool
compare :: NonNegative a -> NonNegative a -> Ordering
$ccompare :: forall a. Ord a => NonNegative a -> NonNegative a -> Ordering
Ord, Applicative NonNegative
forall a. a -> NonNegative a
forall a b. NonNegative a -> NonNegative b -> NonNegative b
forall a b. NonNegative a -> (a -> NonNegative b) -> NonNegative b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> NonNegative a
$creturn :: forall a. a -> NonNegative a
>> :: forall a b. NonNegative a -> NonNegative b -> NonNegative b
$c>> :: forall a b. NonNegative a -> NonNegative b -> NonNegative b
>>= :: forall a b. NonNegative a -> (a -> NonNegative b) -> NonNegative b
$c>>= :: forall a b. NonNegative a -> (a -> NonNegative b) -> NonNegative b
Monad)

instance (Num a, Show a) => Show (NonNegative a) where
    show :: NonNegative a -> String
show (NonNegative Extended a
Infinite  ) = String
"infinite"
    show (NonNegative (Finite a
x)) = forall a. Show a => a -> String
show a
x

instance Num a => Bounded (NonNegative a) where
    minBound :: NonNegative a
minBound = forall a. a -> NonNegative a
unsafeFinite a
0
    maxBound :: NonNegative a
maxBound = forall a. NonNegative a
infinite

instance (Num a, Ord a) => Num (NonNegative a) where
    fromInteger :: Integer -> NonNegative a
fromInteger Integer
x | a
f forall a. Ord a => a -> a -> Bool
< a
0     = forall a. HasCallStack => String -> a
error String
"NonNegative values cannot be negative"
                  | Bool
otherwise = forall a. a -> NonNegative a
unsafeFinite a
f
      where
        f :: a
f = forall a. Num a => Integer -> a
fromInteger Integer
x

    + :: NonNegative a -> NonNegative a -> NonNegative a
(+) = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Num a => a -> a -> a
(+) :: Extended a -> Extended a -> Extended a)
    * :: NonNegative a -> NonNegative a -> NonNegative a
(*) = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Num a => a -> a -> a
(*) :: Extended a -> Extended a -> Extended a)

    negate :: NonNegative a -> NonNegative a
negate NonNegative a
_ = forall a. HasCallStack => String -> a
error String
"NonNegative values cannot be negated"

    signum :: NonNegative a -> NonNegative a
signum (NonNegative Extended a
Infinite) = NonNegative a
1
    signum NonNegative a
x = forall a. Num a => a -> a
signum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonNegative a
x

    abs :: NonNegative a -> NonNegative a
abs = forall a. a -> a
id

-- | A finite non-negative value or @Nothing@ if the argument is negative.
finite :: (Num a, Ord a) => a -> Maybe (NonNegative a)
finite :: forall a. (Num a, Ord a) => a -> Maybe (NonNegative a)
finite a
x | a
x forall a. Ord a => a -> a -> Bool
< a
0      = forall a. Maybe a
Nothing
         | Bool
otherwise  = forall a. a -> Maybe a
Just (forall a. a -> NonNegative a
unsafeFinite a
x)

-- | A finite 'Word'.
finiteWord :: Word -> NonNegative Word
finiteWord :: Word -> NonNegative Word
finiteWord = forall a. a -> NonNegative a
unsafeFinite

-- | A non-negative finite value, created /unsafely/: the argument is not
-- checked for being non-negative, so @unsafeFinite (-1)@ compiles just fine.
unsafeFinite :: a -> NonNegative a
unsafeFinite :: forall a. a -> NonNegative a
unsafeFinite = forall a. Extended a -> NonNegative a
NonNegative forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Extended a
Finite

-- | The (non-negative) infinite value.
infinite :: NonNegative a
infinite :: forall a. NonNegative a
infinite = forall a. Extended a -> NonNegative a
NonNegative forall a. Extended a
Infinite

-- | Get a finite value or @Nothing@ if the value is infinite.
getFinite :: NonNegative a -> Maybe a
getFinite :: forall a. NonNegative a -> Maybe a
getFinite (NonNegative Extended a
x) = forall a. Extended a -> Maybe a
fromExtended Extended a
x

-- | A /capacity/ is a non-negative value that can be 'finite' or 'infinite'.
-- Capacities form a 'Dioid' as follows:
--
-- @
-- 'zero'  = 0
-- 'one'   = 'capacity' 'infinite'
-- ('<+>') = 'max'
-- ('<.>') = 'min'
-- @
newtype Capacity a = Capacity (Max (NonNegative a))
    deriving (Capacity a
forall a. a -> a -> Bounded a
forall a. Num a => Capacity a
maxBound :: Capacity a
$cmaxBound :: forall a. Num a => Capacity a
minBound :: Capacity a
$cminBound :: forall a. Num a => Capacity a
Bounded, Capacity a -> Capacity a -> Bool
forall a. Eq a => Capacity a -> Capacity a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Capacity a -> Capacity a -> Bool
$c/= :: forall a. Eq a => Capacity a -> Capacity a -> Bool
== :: Capacity a -> Capacity a -> Bool
$c== :: forall a. Eq a => Capacity a -> Capacity a -> Bool
Eq, Capacity a
[Capacity a] -> Capacity a
Capacity a -> Capacity a -> Capacity a
forall {a}. (Ord a, Num a) => Semigroup (Capacity a)
forall a. (Ord a, Num a) => Capacity a
forall a. (Ord a, Num a) => [Capacity a] -> Capacity a
forall a. (Ord a, Num a) => Capacity a -> Capacity a -> Capacity a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Capacity a] -> Capacity a
$cmconcat :: forall a. (Ord a, Num a) => [Capacity a] -> Capacity a
mappend :: Capacity a -> Capacity a -> Capacity a
$cmappend :: forall a. (Ord a, Num a) => Capacity a -> Capacity a -> Capacity a
mempty :: Capacity a
$cmempty :: forall a. (Ord a, Num a) => Capacity a
Monoid, Integer -> Capacity a
Capacity a -> Capacity a
Capacity a -> Capacity a -> Capacity a
forall a. (Num a, Ord a) => Integer -> Capacity a
forall a. (Num a, Ord a) => Capacity a -> Capacity a
forall a. (Num a, Ord a) => Capacity a -> Capacity a -> Capacity a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Capacity a
$cfromInteger :: forall a. (Num a, Ord a) => Integer -> Capacity a
signum :: Capacity a -> Capacity a
$csignum :: forall a. (Num a, Ord a) => Capacity a -> Capacity a
abs :: Capacity a -> Capacity a
$cabs :: forall a. (Num a, Ord a) => Capacity a -> Capacity a
negate :: Capacity a -> Capacity a
$cnegate :: forall a. (Num a, Ord a) => Capacity a -> Capacity a
* :: Capacity a -> Capacity a -> Capacity a
$c* :: forall a. (Num a, Ord a) => Capacity a -> Capacity a -> Capacity a
- :: Capacity a -> Capacity a -> Capacity a
$c- :: forall a. (Num a, Ord a) => Capacity a -> Capacity a -> Capacity a
+ :: Capacity a -> Capacity a -> Capacity a
$c+ :: forall a. (Num a, Ord a) => Capacity a -> Capacity a -> Capacity a
Num, Capacity a -> Capacity a -> Bool
Capacity a -> Capacity a -> Ordering
Capacity a -> Capacity a -> Capacity a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Capacity a)
forall a. Ord a => Capacity a -> Capacity a -> Bool
forall a. Ord a => Capacity a -> Capacity a -> Ordering
forall a. Ord a => Capacity a -> Capacity a -> Capacity a
min :: Capacity a -> Capacity a -> Capacity a
$cmin :: forall a. Ord a => Capacity a -> Capacity a -> Capacity a
max :: Capacity a -> Capacity a -> Capacity a
$cmax :: forall a. Ord a => Capacity a -> Capacity a -> Capacity a
>= :: Capacity a -> Capacity a -> Bool
$c>= :: forall a. Ord a => Capacity a -> Capacity a -> Bool
> :: Capacity a -> Capacity a -> Bool
$c> :: forall a. Ord a => Capacity a -> Capacity a -> Bool
<= :: Capacity a -> Capacity a -> Bool
$c<= :: forall a. Ord a => Capacity a -> Capacity a -> Bool
< :: Capacity a -> Capacity a -> Bool
$c< :: forall a. Ord a => Capacity a -> Capacity a -> Bool
compare :: Capacity a -> Capacity a -> Ordering
$ccompare :: forall a. Ord a => Capacity a -> Capacity a -> Ordering
Ord, NonEmpty (Capacity a) -> Capacity a
Capacity a -> Capacity a -> Capacity a
forall b. Integral b => b -> Capacity a -> Capacity a
forall a. Ord a => NonEmpty (Capacity a) -> Capacity a
forall a. Ord a => Capacity a -> Capacity a -> Capacity a
forall a b. (Ord a, Integral b) => b -> Capacity a -> Capacity a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Capacity a -> Capacity a
$cstimes :: forall a b. (Ord a, Integral b) => b -> Capacity a -> Capacity a
sconcat :: NonEmpty (Capacity a) -> Capacity a
$csconcat :: forall a. Ord a => NonEmpty (Capacity a) -> Capacity a
<> :: Capacity a -> Capacity a -> Capacity a
$c<> :: forall a. Ord a => Capacity a -> Capacity a -> Capacity a
Semigroup)

instance Show a => Show (Capacity a) where
    show :: Capacity a -> String
show (Capacity (Max (NonNegative (Finite a
x)))) = forall a. Show a => a -> String
show a
x
    show Capacity a
_ = String
"capacity infinite"

instance (Num a, Ord a) => Semiring (Capacity a) where
    one :: Capacity a
one   = forall a. NonNegative a -> Capacity a
capacity forall a. NonNegative a
infinite
    <.> :: Capacity a -> Capacity a -> Capacity a
(<.>) = forall a. Ord a => a -> a -> a
min

instance (Num a, Ord a) => StarSemiring (Capacity a) where
    star :: Capacity a -> Capacity a
star Capacity a
_ = forall a. Semiring a => a
one

instance (Num a, Ord a) => Dioid (Capacity a)

-- | A non-negative capacity.
capacity :: NonNegative a -> Capacity a
capacity :: forall a. NonNegative a -> Capacity a
capacity = forall a. Max (NonNegative a) -> Capacity a
Capacity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Max a
Max

-- | Get the value of a capacity.
getCapacity :: Capacity a -> NonNegative a
getCapacity :: forall a. Capacity a -> NonNegative a
getCapacity (Capacity (Max NonNegative a
x)) = NonNegative a
x

-- | A /count/ is a non-negative value that can be 'finite' or 'infinite'.
-- Counts form a 'Semiring' as follows:
--
-- @
-- 'zero'  = 0
-- 'one'   = 1
-- ('<+>') = ('+')
-- ('<.>') = ('*')
-- @
newtype Count a = Count (Sum (NonNegative a))
    deriving (Count a
forall a. a -> a -> Bounded a
forall a. Num a => Count a
maxBound :: Count a
$cmaxBound :: forall a. Num a => Count a
minBound :: Count a
$cminBound :: forall a. Num a => Count a
Bounded, Count a -> Count a -> Bool
forall a. Eq a => Count a -> Count a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Count a -> Count a -> Bool
$c/= :: forall a. Eq a => Count a -> Count a -> Bool
== :: Count a -> Count a -> Bool
$c== :: forall a. Eq a => Count a -> Count a -> Bool
Eq, Count a
[Count a] -> Count a
Count a -> Count a -> Count a
forall {a}. (Num a, Ord a) => Semigroup (Count a)
forall a. (Num a, Ord a) => Count a
forall a. (Num a, Ord a) => [Count a] -> Count a
forall a. (Num a, Ord a) => Count a -> Count a -> Count a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Count a] -> Count a
$cmconcat :: forall a. (Num a, Ord a) => [Count a] -> Count a
mappend :: Count a -> Count a -> Count a
$cmappend :: forall a. (Num a, Ord a) => Count a -> Count a -> Count a
mempty :: Count a
$cmempty :: forall a. (Num a, Ord a) => Count a
Monoid, Integer -> Count a
Count a -> Count a
Count a -> Count a -> Count a
forall a. (Num a, Ord a) => Integer -> Count a
forall a. (Num a, Ord a) => Count a -> Count a
forall a. (Num a, Ord a) => Count a -> Count a -> Count a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Count a
$cfromInteger :: forall a. (Num a, Ord a) => Integer -> Count a
signum :: Count a -> Count a
$csignum :: forall a. (Num a, Ord a) => Count a -> Count a
abs :: Count a -> Count a
$cabs :: forall a. (Num a, Ord a) => Count a -> Count a
negate :: Count a -> Count a
$cnegate :: forall a. (Num a, Ord a) => Count a -> Count a
* :: Count a -> Count a -> Count a
$c* :: forall a. (Num a, Ord a) => Count a -> Count a -> Count a
- :: Count a -> Count a -> Count a
$c- :: forall a. (Num a, Ord a) => Count a -> Count a -> Count a
+ :: Count a -> Count a -> Count a
$c+ :: forall a. (Num a, Ord a) => Count a -> Count a -> Count a
Num, Count a -> Count a -> Bool
Count a -> Count a -> Ordering
Count a -> Count a -> Count a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Count a)
forall a. Ord a => Count a -> Count a -> Bool
forall a. Ord a => Count a -> Count a -> Ordering
forall a. Ord a => Count a -> Count a -> Count a
min :: Count a -> Count a -> Count a
$cmin :: forall a. Ord a => Count a -> Count a -> Count a
max :: Count a -> Count a -> Count a
$cmax :: forall a. Ord a => Count a -> Count a -> Count a
>= :: Count a -> Count a -> Bool
$c>= :: forall a. Ord a => Count a -> Count a -> Bool
> :: Count a -> Count a -> Bool
$c> :: forall a. Ord a => Count a -> Count a -> Bool
<= :: Count a -> Count a -> Bool
$c<= :: forall a. Ord a => Count a -> Count a -> Bool
< :: Count a -> Count a -> Bool
$c< :: forall a. Ord a => Count a -> Count a -> Bool
compare :: Count a -> Count a -> Ordering
$ccompare :: forall a. Ord a => Count a -> Count a -> Ordering
Ord, NonEmpty (Count a) -> Count a
Count a -> Count a -> Count a
forall b. Integral b => b -> Count a -> Count a
forall a. (Num a, Ord a) => NonEmpty (Count a) -> Count a
forall a. (Num a, Ord a) => Count a -> Count a -> Count a
forall a b. (Num a, Ord a, Integral b) => b -> Count a -> Count a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Count a -> Count a
$cstimes :: forall a b. (Num a, Ord a, Integral b) => b -> Count a -> Count a
sconcat :: NonEmpty (Count a) -> Count a
$csconcat :: forall a. (Num a, Ord a) => NonEmpty (Count a) -> Count a
<> :: Count a -> Count a -> Count a
$c<> :: forall a. (Num a, Ord a) => Count a -> Count a -> Count a
Semigroup)

instance Show a => Show (Count a) where
    show :: Count a -> String
show (Count (Sum (NonNegative (Finite a
x)))) = forall a. Show a => a -> String
show a
x
    show Count a
_ = String
"count infinite"

instance (Num a, Ord a) => Semiring (Count a) where
    one :: Count a
one   = Count a
1
    <.> :: Count a -> Count a -> Count a
(<.>) = forall a. Num a => a -> a -> a
(*)

instance (Num a, Ord a) => StarSemiring (Count a) where
    star :: Count a -> Count a
star Count a
x | Count a
x forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
zero = forall a. Semiring a => a
one
           | Bool
otherwise = forall a. NonNegative a -> Count a
count forall a. NonNegative a
infinite

-- | A non-negative count.
count :: NonNegative a -> Count a
count :: forall a. NonNegative a -> Count a
count = forall a. Sum (NonNegative a) -> Count a
Count forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Sum a
Sum

-- | Get the value of a count.
getCount :: Count a -> NonNegative a
getCount :: forall a. Count a -> NonNegative a
getCount (Count (Sum NonNegative a
x)) = NonNegative a
x

-- | A /distance/ is a non-negative value that can be 'finite' or 'infinite'.
-- Distances form a 'Dioid' as follows:
--
-- @
-- 'zero'  = 'distance' 'infinite'
-- 'one'   = 0
-- ('<+>') = 'min'
-- ('<.>') = ('+')
-- @
newtype Distance a = Distance (Min (NonNegative a))
    deriving (Distance a
forall a. a -> a -> Bounded a
forall a. Num a => Distance a
maxBound :: Distance a
$cmaxBound :: forall a. Num a => Distance a
minBound :: Distance a
$cminBound :: forall a. Num a => Distance a
Bounded, Distance a -> Distance a -> Bool
forall a. Eq a => Distance a -> Distance a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Distance a -> Distance a -> Bool
$c/= :: forall a. Eq a => Distance a -> Distance a -> Bool
== :: Distance a -> Distance a -> Bool
$c== :: forall a. Eq a => Distance a -> Distance a -> Bool
Eq, Distance a
[Distance a] -> Distance a
Distance a -> Distance a -> Distance a
forall {a}. (Ord a, Num a) => Semigroup (Distance a)
forall a. (Ord a, Num a) => Distance a
forall a. (Ord a, Num a) => [Distance a] -> Distance a
forall a. (Ord a, Num a) => Distance a -> Distance a -> Distance a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Distance a] -> Distance a
$cmconcat :: forall a. (Ord a, Num a) => [Distance a] -> Distance a
mappend :: Distance a -> Distance a -> Distance a
$cmappend :: forall a. (Ord a, Num a) => Distance a -> Distance a -> Distance a
mempty :: Distance a
$cmempty :: forall a. (Ord a, Num a) => Distance a
Monoid, Integer -> Distance a
Distance a -> Distance a
Distance a -> Distance a -> Distance a
forall a. (Num a, Ord a) => Integer -> Distance a
forall a. (Num a, Ord a) => Distance a -> Distance a
forall a. (Num a, Ord a) => Distance a -> Distance a -> Distance a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Distance a
$cfromInteger :: forall a. (Num a, Ord a) => Integer -> Distance a
signum :: Distance a -> Distance a
$csignum :: forall a. (Num a, Ord a) => Distance a -> Distance a
abs :: Distance a -> Distance a
$cabs :: forall a. (Num a, Ord a) => Distance a -> Distance a
negate :: Distance a -> Distance a
$cnegate :: forall a. (Num a, Ord a) => Distance a -> Distance a
* :: Distance a -> Distance a -> Distance a
$c* :: forall a. (Num a, Ord a) => Distance a -> Distance a -> Distance a
- :: Distance a -> Distance a -> Distance a
$c- :: forall a. (Num a, Ord a) => Distance a -> Distance a -> Distance a
+ :: Distance a -> Distance a -> Distance a
$c+ :: forall a. (Num a, Ord a) => Distance a -> Distance a -> Distance a
Num, Distance a -> Distance a -> Bool
Distance a -> Distance a -> Ordering
Distance a -> Distance a -> Distance a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Distance a)
forall a. Ord a => Distance a -> Distance a -> Bool
forall a. Ord a => Distance a -> Distance a -> Ordering
forall a. Ord a => Distance a -> Distance a -> Distance a
min :: Distance a -> Distance a -> Distance a
$cmin :: forall a. Ord a => Distance a -> Distance a -> Distance a
max :: Distance a -> Distance a -> Distance a
$cmax :: forall a. Ord a => Distance a -> Distance a -> Distance a
>= :: Distance a -> Distance a -> Bool
$c>= :: forall a. Ord a => Distance a -> Distance a -> Bool
> :: Distance a -> Distance a -> Bool
$c> :: forall a. Ord a => Distance a -> Distance a -> Bool
<= :: Distance a -> Distance a -> Bool
$c<= :: forall a. Ord a => Distance a -> Distance a -> Bool
< :: Distance a -> Distance a -> Bool
$c< :: forall a. Ord a => Distance a -> Distance a -> Bool
compare :: Distance a -> Distance a -> Ordering
$ccompare :: forall a. Ord a => Distance a -> Distance a -> Ordering
Ord, NonEmpty (Distance a) -> Distance a
Distance a -> Distance a -> Distance a
forall b. Integral b => b -> Distance a -> Distance a
forall a. Ord a => NonEmpty (Distance a) -> Distance a
forall a. Ord a => Distance a -> Distance a -> Distance a
forall a b. (Ord a, Integral b) => b -> Distance a -> Distance a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Distance a -> Distance a
$cstimes :: forall a b. (Ord a, Integral b) => b -> Distance a -> Distance a
sconcat :: NonEmpty (Distance a) -> Distance a
$csconcat :: forall a. Ord a => NonEmpty (Distance a) -> Distance a
<> :: Distance a -> Distance a -> Distance a
$c<> :: forall a. Ord a => Distance a -> Distance a -> Distance a
Semigroup)

instance Show a => Show (Distance a) where
    show :: Distance a -> String
show (Distance (Min (NonNegative (Finite a
x)))) = forall a. Show a => a -> String
show a
x
    show Distance a
_ = String
"distance infinite"

instance (Num a, Ord a) => Semiring (Distance a) where
    one :: Distance a
one   = Distance a
0
    <.> :: Distance a -> Distance a -> Distance a
(<.>) = forall a. Num a => a -> a -> a
(+)

instance (Num a, Ord a) => StarSemiring (Distance a) where
    star :: Distance a -> Distance a
star Distance a
_ = forall a. Semiring a => a
one

instance (Num a, Ord a) => Dioid (Distance a)

-- | A non-negative distance.
distance :: NonNegative a -> Distance a
distance :: forall a. NonNegative a -> Distance a
distance = forall a. Min (NonNegative a) -> Distance a
Distance forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Min a
Min

-- | Get the value of a distance.
getDistance :: Distance a -> NonNegative a
getDistance :: forall a. Distance a -> NonNegative a
getDistance (Distance (Min NonNegative a
x)) = NonNegative a
x

-- This data type extends the underlying type @a@ with a new 'Infinite' value.
data Extended a = Finite a | Infinite
    deriving (Extended a -> Extended a -> Bool
forall a. Eq a => Extended a -> Extended a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extended a -> Extended a -> Bool
$c/= :: forall a. Eq a => Extended a -> Extended a -> Bool
== :: Extended a -> Extended a -> Bool
$c== :: forall a. Eq a => Extended a -> Extended a -> Bool
Eq, forall a b. a -> Extended b -> Extended a
forall a b. (a -> b) -> Extended a -> Extended b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Extended b -> Extended a
$c<$ :: forall a b. a -> Extended b -> Extended a
fmap :: forall a b. (a -> b) -> Extended a -> Extended b
$cfmap :: forall a b. (a -> b) -> Extended a -> Extended b
Functor, Extended a -> Extended a -> Bool
Extended a -> Extended a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Extended a)
forall a. Ord a => Extended a -> Extended a -> Bool
forall a. Ord a => Extended a -> Extended a -> Ordering
forall a. Ord a => Extended a -> Extended a -> Extended a
min :: Extended a -> Extended a -> Extended a
$cmin :: forall a. Ord a => Extended a -> Extended a -> Extended a
max :: Extended a -> Extended a -> Extended a
$cmax :: forall a. Ord a => Extended a -> Extended a -> Extended a
>= :: Extended a -> Extended a -> Bool
$c>= :: forall a. Ord a => Extended a -> Extended a -> Bool
> :: Extended a -> Extended a -> Bool
$c> :: forall a. Ord a => Extended a -> Extended a -> Bool
<= :: Extended a -> Extended a -> Bool
$c<= :: forall a. Ord a => Extended a -> Extended a -> Bool
< :: Extended a -> Extended a -> Bool
$c< :: forall a. Ord a => Extended a -> Extended a -> Bool
compare :: Extended a -> Extended a -> Ordering
$ccompare :: forall a. Ord a => Extended a -> Extended a -> Ordering
Ord, Int -> Extended a -> ShowS
forall a. Show a => Int -> Extended a -> ShowS
forall a. Show a => [Extended a] -> ShowS
forall a. Show a => Extended a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extended a] -> ShowS
$cshowList :: forall a. Show a => [Extended a] -> ShowS
show :: Extended a -> String
$cshow :: forall a. Show a => Extended a -> String
showsPrec :: Int -> Extended a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Extended a -> ShowS
Show)

instance Applicative Extended where
    pure :: forall a. a -> Extended a
pure  = forall a. a -> Extended a
Finite
    <*> :: forall a b. Extended (a -> b) -> Extended a -> Extended b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Extended where
    return :: forall a. a -> Extended a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure

    Extended a
Infinite >>= :: forall a b. Extended a -> (a -> Extended b) -> Extended b
>>= a -> Extended b
_ = forall a. Extended a
Infinite
    Finite a
x >>= a -> Extended b
f = a -> Extended b
f a
x

-- Extract the finite value or @Nothing@ if the value is 'Infinite'.
fromExtended :: Extended a -> Maybe a
fromExtended :: forall a. Extended a -> Maybe a
fromExtended (Finite a
a) = forall a. a -> Maybe a
Just a
a
fromExtended Extended a
Infinite   = forall a. Maybe a
Nothing

-- A type alias for a binary function on Extended.
instance (Num a, Eq a) => Num (Extended a) where
    fromInteger :: Integer -> Extended a
fromInteger = forall a. a -> Extended a
Finite forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger

    + :: Extended a -> Extended a -> Extended a
(+) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(+)

    Finite a
0 * :: Extended a -> Extended a -> Extended a
* Extended a
_ = forall a. a -> Extended a
Finite a
0
    Extended a
_ * Finite a
0 = forall a. a -> Extended a
Finite a
0
    Extended a
x * Extended a
y = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(*) Extended a
x Extended a
y

    negate :: Extended a -> Extended a
negate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
negate
    signum :: Extended a -> Extended a
signum = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
signum
    abs :: Extended a -> Extended a
abs    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
abs

-- | If @a@ is a monoid, 'Minimum' @a@ forms the following 'Dioid':
--
-- @
-- 'zero'  = 'noMinimum'
-- 'one'   = 'pure' 'mempty'
-- ('<+>') = 'liftA2' 'min'
-- ('<.>') = 'liftA2' 'mappend'
-- @
--
-- To create a singleton value of type 'Minimum' @a@ use the 'pure' function.
-- For example:
--
-- @
-- getMinimum ('pure' "Hello, " '<+>' 'pure' "World!") == Just "Hello, "
-- getMinimum ('pure' "Hello, " '<.>' 'pure' "World!") == Just "Hello, World!"
-- @
newtype Minimum a = Minimum (Extended a)
    deriving (Functor Minimum
forall a. a -> Minimum a
forall a b. Minimum a -> Minimum b -> Minimum a
forall a b. Minimum a -> Minimum b -> Minimum b
forall a b. Minimum (a -> b) -> Minimum a -> Minimum b
forall a b c. (a -> b -> c) -> Minimum a -> Minimum b -> Minimum c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Minimum a -> Minimum b -> Minimum a
$c<* :: forall a b. Minimum a -> Minimum b -> Minimum a
*> :: forall a b. Minimum a -> Minimum b -> Minimum b
$c*> :: forall a b. Minimum a -> Minimum b -> Minimum b
liftA2 :: forall a b c. (a -> b -> c) -> Minimum a -> Minimum b -> Minimum c
$cliftA2 :: forall a b c. (a -> b -> c) -> Minimum a -> Minimum b -> Minimum c
<*> :: forall a b. Minimum (a -> b) -> Minimum a -> Minimum b
$c<*> :: forall a b. Minimum (a -> b) -> Minimum a -> Minimum b
pure :: forall a. a -> Minimum a
$cpure :: forall a. a -> Minimum a
Applicative, Minimum a -> Minimum a -> Bool
forall a. Eq a => Minimum a -> Minimum a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Minimum a -> Minimum a -> Bool
$c/= :: forall a. Eq a => Minimum a -> Minimum a -> Bool
== :: Minimum a -> Minimum a -> Bool
$c== :: forall a. Eq a => Minimum a -> Minimum a -> Bool
Eq, forall a b. a -> Minimum b -> Minimum a
forall a b. (a -> b) -> Minimum a -> Minimum b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Minimum b -> Minimum a
$c<$ :: forall a b. a -> Minimum b -> Minimum a
fmap :: forall a b. (a -> b) -> Minimum a -> Minimum b
$cfmap :: forall a b. (a -> b) -> Minimum a -> Minimum b
Functor, Minimum a -> Minimum a -> Bool
Minimum a -> Minimum a -> Ordering
Minimum a -> Minimum a -> Minimum a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Minimum a)
forall a. Ord a => Minimum a -> Minimum a -> Bool
forall a. Ord a => Minimum a -> Minimum a -> Ordering
forall a. Ord a => Minimum a -> Minimum a -> Minimum a
min :: Minimum a -> Minimum a -> Minimum a
$cmin :: forall a. Ord a => Minimum a -> Minimum a -> Minimum a
max :: Minimum a -> Minimum a -> Minimum a
$cmax :: forall a. Ord a => Minimum a -> Minimum a -> Minimum a
>= :: Minimum a -> Minimum a -> Bool
$c>= :: forall a. Ord a => Minimum a -> Minimum a -> Bool
> :: Minimum a -> Minimum a -> Bool
$c> :: forall a. Ord a => Minimum a -> Minimum a -> Bool
<= :: Minimum a -> Minimum a -> Bool
$c<= :: forall a. Ord a => Minimum a -> Minimum a -> Bool
< :: Minimum a -> Minimum a -> Bool
$c< :: forall a. Ord a => Minimum a -> Minimum a -> Bool
compare :: Minimum a -> Minimum a -> Ordering
$ccompare :: forall a. Ord a => Minimum a -> Minimum a -> Ordering
Ord, Applicative Minimum
forall a. a -> Minimum a
forall a b. Minimum a -> Minimum b -> Minimum b
forall a b. Minimum a -> (a -> Minimum b) -> Minimum b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Minimum a
$creturn :: forall a. a -> Minimum a
>> :: forall a b. Minimum a -> Minimum b -> Minimum b
$c>> :: forall a b. Minimum a -> Minimum b -> Minimum b
>>= :: forall a b. Minimum a -> (a -> Minimum b) -> Minimum b
$c>>= :: forall a b. Minimum a -> (a -> Minimum b) -> Minimum b
Monad)

-- | Extract the minimum or @Nothing@ if it does not exist.
getMinimum :: Minimum a -> Maybe a
getMinimum :: forall a. Minimum a -> Maybe a
getMinimum (Minimum Extended a
x) = forall a. Extended a -> Maybe a
fromExtended Extended a
x

-- | The value corresponding to the lack of minimum, e.g. the minimum of the
-- empty set.
noMinimum :: Minimum a
noMinimum :: forall a. Minimum a
noMinimum = forall a. Extended a -> Minimum a
Minimum forall a. Extended a
Infinite

instance Ord a => Semigroup (Minimum a) where
    <> :: Minimum a -> Minimum a -> Minimum a
(<>) = forall a. Ord a => a -> a -> a
min

instance (Monoid a, Ord a) => Monoid (Minimum a) where
    mempty :: Minimum a
mempty = forall a. Minimum a
noMinimum

instance (Monoid a, Ord a) => Semiring (Minimum a) where
    one :: Minimum a
one   = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    <.> :: Minimum a -> Minimum a -> Minimum a
(<.>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend

instance (Monoid a, Ord a) => Dioid (Minimum a)

instance Show a => Show (Minimum a) where
    show :: Minimum a -> String
show (Minimum Extended a
Infinite  ) = String
"one"
    show (Minimum (Finite a
x)) = forall a. Show a => a -> String
show a
x

instance IsList a => IsList (Minimum a) where
    type Item (Minimum a) = Item a
    fromList :: [Item (Minimum a)] -> Minimum a
fromList = forall a. Extended a -> Minimum a
Minimum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Extended a
Finite forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList
    toList :: Minimum a -> [Item (Minimum a)]
toList (Minimum Extended a
x) = forall l. IsList l => l -> [Item l]
toList forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
errorMessage (forall a. Extended a -> Maybe a
fromExtended Extended a
x)
      where
        errorMessage :: a
errorMessage = forall a. HasCallStack => String -> a
error String
"Minimum.toList applied to noMinimum value."

-- | The /power set/ over the underlying set of elements @a@. If @a@ is a
-- monoid, then the power set forms a 'Dioid' as follows:
--
-- @
-- 'zero'    = PowerSet Set.'Set.empty'
-- 'one'     = PowerSet $ Set.'Set.singleton' 'mempty'
-- x '<+>' y = PowerSet $ Set.'Set.union' (getPowerSet x) (getPowerSet y)
-- x '<.>' y = PowerSet $ 'cartesianProductWith' 'mappend' (getPowerSet x) (getPowerSet y)
-- @
newtype PowerSet a = PowerSet { forall a. PowerSet a -> Set a
getPowerSet :: Set a }
    deriving (PowerSet a -> PowerSet a -> Bool
forall a. Eq a => PowerSet a -> PowerSet a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PowerSet a -> PowerSet a -> Bool
$c/= :: forall a. Eq a => PowerSet a -> PowerSet a -> Bool
== :: PowerSet a -> PowerSet a -> Bool
$c== :: forall a. Eq a => PowerSet a -> PowerSet a -> Bool
Eq, PowerSet a
[PowerSet a] -> PowerSet a
PowerSet a -> PowerSet a -> PowerSet a
forall {a}. Ord a => Semigroup (PowerSet a)
forall a. Ord a => PowerSet a
forall a. Ord a => [PowerSet a] -> PowerSet a
forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PowerSet a] -> PowerSet a
$cmconcat :: forall a. Ord a => [PowerSet a] -> PowerSet a
mappend :: PowerSet a -> PowerSet a -> PowerSet a
$cmappend :: forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
mempty :: PowerSet a
$cmempty :: forall a. Ord a => PowerSet a
Monoid, PowerSet a -> PowerSet a -> Bool
PowerSet a -> PowerSet a -> Ordering
PowerSet a -> PowerSet a -> PowerSet a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (PowerSet a)
forall a. Ord a => PowerSet a -> PowerSet a -> Bool
forall a. Ord a => PowerSet a -> PowerSet a -> Ordering
forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
min :: PowerSet a -> PowerSet a -> PowerSet a
$cmin :: forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
max :: PowerSet a -> PowerSet a -> PowerSet a
$cmax :: forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
>= :: PowerSet a -> PowerSet a -> Bool
$c>= :: forall a. Ord a => PowerSet a -> PowerSet a -> Bool
> :: PowerSet a -> PowerSet a -> Bool
$c> :: forall a. Ord a => PowerSet a -> PowerSet a -> Bool
<= :: PowerSet a -> PowerSet a -> Bool
$c<= :: forall a. Ord a => PowerSet a -> PowerSet a -> Bool
< :: PowerSet a -> PowerSet a -> Bool
$c< :: forall a. Ord a => PowerSet a -> PowerSet a -> Bool
compare :: PowerSet a -> PowerSet a -> Ordering
$ccompare :: forall a. Ord a => PowerSet a -> PowerSet a -> Ordering
Ord, NonEmpty (PowerSet a) -> PowerSet a
PowerSet a -> PowerSet a -> PowerSet a
forall b. Integral b => b -> PowerSet a -> PowerSet a
forall a. Ord a => NonEmpty (PowerSet a) -> PowerSet a
forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
forall a b. (Ord a, Integral b) => b -> PowerSet a -> PowerSet a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> PowerSet a -> PowerSet a
$cstimes :: forall a b. (Ord a, Integral b) => b -> PowerSet a -> PowerSet a
sconcat :: NonEmpty (PowerSet a) -> PowerSet a
$csconcat :: forall a. Ord a => NonEmpty (PowerSet a) -> PowerSet a
<> :: PowerSet a -> PowerSet a -> PowerSet a
$c<> :: forall a. Ord a => PowerSet a -> PowerSet a -> PowerSet a
Semigroup, Int -> PowerSet a -> ShowS
forall a. Show a => Int -> PowerSet a -> ShowS
forall a. Show a => [PowerSet a] -> ShowS
forall a. Show a => PowerSet a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PowerSet a] -> ShowS
$cshowList :: forall a. Show a => [PowerSet a] -> ShowS
show :: PowerSet a -> String
$cshow :: forall a. Show a => PowerSet a -> String
showsPrec :: Int -> PowerSet a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PowerSet a -> ShowS
Show)

instance (Monoid a, Ord a) => Semiring (PowerSet a) where
    one :: PowerSet a
one                       = forall a. Set a -> PowerSet a
PowerSet (forall a. a -> Set a
Set.singleton forall a. Monoid a => a
mempty)
    PowerSet Set a
x <.> :: PowerSet a -> PowerSet a -> PowerSet a
<.> PowerSet Set a
y = forall a. Set a -> PowerSet a
PowerSet (forall c a b. Ord c => (a -> b -> c) -> Set a -> Set b -> Set c
cartesianProductWith forall a. Monoid a => a -> a -> a
mappend Set a
x Set a
y)

instance (Monoid a, Ord a) => Dioid (PowerSet a) where

-- | The type of /free labels/ over the underlying set of symbols @a@. This data
-- type is an instance of classes 'StarSemiring' and 'Dioid'.
data Label a = Zero
             | One
             | Symbol a
             | Label a :+: Label a
             | Label a :*: Label a
             | Star (Label a)
             deriving forall a b. a -> Label b -> Label a
forall a b. (a -> b) -> Label a -> Label b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Label b -> Label a
$c<$ :: forall a b. a -> Label b -> Label a
fmap :: forall a b. (a -> b) -> Label a -> Label b
$cfmap :: forall a b. (a -> b) -> Label a -> Label b
Functor

infixl 6 :+:
infixl 7 :*:

instance IsList (Label a) where
    type Item (Label a) = a
    fromList :: [Item (Label a)] -> Label a
fromList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Label a
Symbol) forall a. Label a
Zero
    toList :: Label a -> [Item (Label a)]
toList   = forall a. HasCallStack => String -> a
error String
"Label.toList cannot be given a reasonable definition"

instance Show a => Show (Label a) where
    showsPrec :: Int -> Label a -> ShowS
showsPrec Int
p Label a
label = case Label a
label of
        Label a
Zero     -> forall a. Show a => a -> ShowS
shows (Int
0 :: Int)
        Label a
One      -> forall a. Show a => a -> ShowS
shows (Int
1 :: Int)
        Symbol a
x -> forall a. Show a => a -> ShowS
shows a
x
        Label a
x :+: Label a
y  -> Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
>= Int
6) forall a b. (a -> b) -> a -> b
$ forall a. Show a => Int -> a -> ShowS
showsPrec Int
6 Label a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" | " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
6 Label a
y
        Label a
x :*: Label a
y  -> Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
>= Int
7) forall a b. (a -> b) -> a -> b
$ forall a. Show a => Int -> a -> ShowS
showsPrec Int
7 Label a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" ; " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
7 Label a
y
        Star Label a
x   -> Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
>= Int
8) forall a b. (a -> b) -> a -> b
$ forall a. Show a => Int -> a -> ShowS
showsPrec Int
8 Label a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"*"   forall a. [a] -> [a] -> [a]
++)

instance Semigroup (Label a) where
    Label a
Zero   <> :: Label a -> Label a -> Label a
<> Label a
x      = Label a
x
    Label a
x      <> Label a
Zero   = Label a
x
    Label a
One    <> Label a
One    = forall a. Label a
One
    Label a
One    <> Star Label a
x = forall a. Label a -> Label a
Star Label a
x
    Star Label a
x <> Label a
One    = forall a. Label a -> Label a
Star Label a
x
    Label a
x      <> Label a
y      = Label a
x forall a. Label a -> Label a -> Label a
:+: Label a
y

instance Monoid (Label a) where
    mempty :: Label a
mempty = forall a. Label a
Zero

instance Semiring (Label a) where
    one :: Label a
one = forall a. Label a
One

    Label a
One  <.> :: Label a -> Label a -> Label a
<.> Label a
x    = Label a
x
    Label a
x    <.> Label a
One  = Label a
x
    Label a
Zero <.> Label a
_    = forall a. Label a
Zero
    Label a
_    <.> Label a
Zero = forall a. Label a
Zero
    Label a
x    <.> Label a
y    = Label a
x forall a. Label a -> Label a -> Label a
:*: Label a
y

instance StarSemiring (Label a) where
    star :: Label a -> Label a
star Label a
Zero     = forall a. Label a
One
    star Label a
One      = forall a. Label a
One
    star (Star Label a
x) = forall a. StarSemiring a => a -> a
star Label a
x
    star Label a
x        = forall a. Label a -> Label a
Star Label a
x

-- | Check if a 'Label' is 'zero'.
isZero :: Label a -> Bool
isZero :: forall a. Label a -> Bool
isZero Label a
Zero = Bool
True
isZero Label a
_    = Bool
False

-- | A type synonym for /regular expressions/, built on top of /free labels/.
type RegularExpression a = Label a

-- | An /optimum semiring/ obtained by combining a semiring @o@ that defines an
-- /optimisation criterion/, and a semiring @a@ that describes the /arguments/
-- of an optimisation problem. For example, by choosing @o = 'Distance' Int@ and
-- and @a = 'Minimum' ('Path' String)@, we obtain the /shortest path semiring/
-- for computing the shortest path in an @Int@-labelled graph with @String@
-- vertices.
--
-- We assume that the semiring @o@ is /selective/ i.e. for all @x@ and @y@:
--
-- > x <+> y == x || x <+> y == y
--
-- In words, the operation '<+>' always simply selects one of its arguments. For
-- example, the 'Capacity' and 'Distance' semirings are selective, whereas the
-- the 'Count' semiring is not.
data Optimum o a = Optimum { forall o a. Optimum o a -> o
getOptimum :: o, forall o a. Optimum o a -> a
getArgument :: a }
    deriving (Optimum o a -> Optimum o a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall o a. (Eq o, Eq a) => Optimum o a -> Optimum o a -> Bool
/= :: Optimum o a -> Optimum o a -> Bool
$c/= :: forall o a. (Eq o, Eq a) => Optimum o a -> Optimum o a -> Bool
== :: Optimum o a -> Optimum o a -> Bool
$c== :: forall o a. (Eq o, Eq a) => Optimum o a -> Optimum o a -> Bool
Eq, Optimum o a -> Optimum o a -> Bool
Optimum o a -> Optimum o a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {o} {a}. (Ord o, Ord a) => Eq (Optimum o a)
forall o a. (Ord o, Ord a) => Optimum o a -> Optimum o a -> Bool
forall o a.
(Ord o, Ord a) =>
Optimum o a -> Optimum o a -> Ordering
forall o a.
(Ord o, Ord a) =>
Optimum o a -> Optimum o a -> Optimum o a
min :: Optimum o a -> Optimum o a -> Optimum o a
$cmin :: forall o a.
(Ord o, Ord a) =>
Optimum o a -> Optimum o a -> Optimum o a
max :: Optimum o a -> Optimum o a -> Optimum o a
$cmax :: forall o a.
(Ord o, Ord a) =>
Optimum o a -> Optimum o a -> Optimum o a
>= :: Optimum o a -> Optimum o a -> Bool
$c>= :: forall o a. (Ord o, Ord a) => Optimum o a -> Optimum o a -> Bool
> :: Optimum o a -> Optimum o a -> Bool
$c> :: forall o a. (Ord o, Ord a) => Optimum o a -> Optimum o a -> Bool
<= :: Optimum o a -> Optimum o a -> Bool
$c<= :: forall o a. (Ord o, Ord a) => Optimum o a -> Optimum o a -> Bool
< :: Optimum o a -> Optimum o a -> Bool
$c< :: forall o a. (Ord o, Ord a) => Optimum o a -> Optimum o a -> Bool
compare :: Optimum o a -> Optimum o a -> Ordering
$ccompare :: forall o a.
(Ord o, Ord a) =>
Optimum o a -> Optimum o a -> Ordering
Ord, Int -> Optimum o a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall o a. (Show o, Show a) => Int -> Optimum o a -> ShowS
forall o a. (Show o, Show a) => [Optimum o a] -> ShowS
forall o a. (Show o, Show a) => Optimum o a -> String
showList :: [Optimum o a] -> ShowS
$cshowList :: forall o a. (Show o, Show a) => [Optimum o a] -> ShowS
show :: Optimum o a -> String
$cshow :: forall o a. (Show o, Show a) => Optimum o a -> String
showsPrec :: Int -> Optimum o a -> ShowS
$cshowsPrec :: forall o a. (Show o, Show a) => Int -> Optimum o a -> ShowS
Show)

-- TODO: Add tests.
-- This is similar to geodetic semirings.
-- See http://vlado.fmf.uni-lj.si/vlado/papers/SemiRingSNA.pdf
instance (Eq o, Monoid a, Monoid o) => Semigroup (Optimum o a) where
    Optimum o
o1 a
a1 <> :: Optimum o a -> Optimum o a -> Optimum o a
<> Optimum o
o2 a
a2
        | o
o1 forall a. Eq a => a -> a -> Bool
== o
o2  = forall o a. o -> a -> Optimum o a
Optimum o
o1 (forall a. Monoid a => a -> a -> a
mappend a
a1 a
a2)
        | Bool
otherwise = forall o a. o -> a -> Optimum o a
Optimum o
o a
a
            where
              o :: o
o = forall a. Monoid a => a -> a -> a
mappend o
o1 o
o2
              a :: a
a = if o
o forall a. Eq a => a -> a -> Bool
== o
o1 then a
a1 else a
a2

-- TODO: Add tests.
instance (Eq o, Monoid a, Monoid o) => Monoid (Optimum o a) where
    mempty :: Optimum o a
mempty = forall o a. o -> a -> Optimum o a
Optimum forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

-- TODO: Add tests.
instance (Eq o, Semiring a, Semiring o) => Semiring (Optimum o a) where
    one :: Optimum o a
one = forall o a. o -> a -> Optimum o a
Optimum forall a. Semiring a => a
one forall a. Semiring a => a
one
    Optimum o
o1 a
a1 <.> :: Optimum o a -> Optimum o a -> Optimum o a
<.> Optimum o
o2 a
a2 = forall o a. o -> a -> Optimum o a
Optimum (o
o1 forall a. Semiring a => a -> a -> a
<.> o
o2) (a
a1 forall a. Semiring a => a -> a -> a
<.> a
a2)

-- TODO: Add tests.
instance (Eq o, StarSemiring a, StarSemiring o) => StarSemiring (Optimum o a) where
    star :: Optimum o a -> Optimum o a
star (Optimum o
o a
a) = forall o a. o -> a -> Optimum o a
Optimum (forall a. StarSemiring a => a -> a
star o
o) (forall a. StarSemiring a => a -> a
star a
a)

-- TODO: Add tests.
instance (Eq o, Dioid a, Dioid o) => Dioid (Optimum o a) where

-- | A /path/ is a list of edges.
type Path a = [(a, a)]

-- TODO: Add tests.
-- | The 'Optimum' semiring specialised to
-- /finding the lexicographically smallest shortest path/.
type ShortestPath e a = Optimum (Distance e) (Minimum (Path a))

-- TODO: Add tests.
-- | The 'Optimum' semiring specialised to /finding all shortest paths/.
type AllShortestPaths e a = Optimum (Distance e) (PowerSet (Path a))

-- TODO: Add tests.
-- | The 'Optimum' semiring specialised to /counting all shortest paths/.
type CountShortestPaths e = Optimum (Distance e) (Count Integer)

-- TODO: Add tests.
-- | The 'Optimum' semiring specialised to
-- /finding the lexicographically smallest widest path/.
type WidestPath e a = Optimum (Capacity e) (Minimum (Path a))