-----------------------------------------------------------------------------
-- |
-- Module : Algebra.Graph.Label
-- Copyright : (c) Andrey Mokhov 2016-2018
-- License : MIT (see the file LICENSE)
-- Maintainer : andrey.mokhov@gmail.com
-- 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 (
-- * Type classes for edge labels
Semilattice (..), Dioid (..),
-- * Data types for edge labels
Distance (..)
) where
import Prelude ()
import Prelude.Compat
import Data.Set (Set)
import qualified Data.Set as Set
{-| A /bounded join semilattice/, satisfying the following laws:
* Commutativity:
> x \/ y == y \/ x
* Associativity:
> x \/ (y \/ z) == (x \/ y) \/ z
* Identity:
> x \/ zero == x
* Idempotence:
> x \/ x == x
-}
class Semilattice a where
zero :: a
(\/) :: a -> a -> a
{-| A /dioid/ is an /idempotent semiring/, i.e. it satisfies the following laws:
* Associativity:
> x /\ (y /\ z) == (x /\ y) /\ z
* Identity:
> x /\ one == x
> one /\ x == 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 Semilattice a => Dioid a where
one :: a
(/\) :: a -> a -> a
infixl 6 \/
infixl 7 /\
instance Semilattice Bool where
zero = False
(\/) = (||)
instance Dioid Bool where
one = True
(/\) = (&&)
-- | A /distance/ is a non-negative value that can be 'Finite' or 'Infinite'.
data Distance a = Finite a | Infinite deriving (Eq, Ord, Show)
instance (Ord a, Num a) => Num (Distance a) where
fromInteger = Finite . fromInteger
Infinite + _ = Infinite
_ + Infinite = Infinite
Finite x + Finite y = Finite (x + y)
Infinite * _ = Infinite
_ * Infinite = Infinite
Finite x * Finite y = Finite (x * y)
negate _ = error "Negative distances not allowed"
signum (Finite 0) = 0
signum _ = 1
abs = id
instance Ord a => Semilattice (Distance a) where
zero = Infinite
Infinite \/ x = x
x \/ Infinite = x
Finite x \/ Finite y = Finite (min x y)
instance (Num a, Ord a) => Dioid (Distance a) where
one = Finite 0
Infinite /\ _ = Infinite
_ /\ Infinite = Infinite
Finite x /\ Finite y = Finite (x + y)
instance Ord a => Semilattice (Set a) where
zero = Set.empty
(\/) = Set.union