{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-|
Module: HyloDP.Semiring
Description: Declaration of the Semiring class and various instances
Copyright: (c) David Llorens and Juan Miguel Vilar, 2020
License: BSD-3-Clause
Stability: experimental

This module declares the 'Semiring' class and various instances.
-}
module HyloDP.Semiring (
  -- *Type Classes
  Semiring(..),
  Opt(..),
  -- *Semiring Helpers
  -- ** Min tropical semiring
  TMin(..),
  -- ** Max tropical semiring
  TMax(..),
  -- ** Min product semiring
  MinProd(..),
  -- ** Max product semiring
  MaxProd(..),
  -- ** Count semiring
  Count(..),
  -- ** Best solution semiring
  BestSolution(..),
  -- ** All solutions semiring
  AllSolutions(..),
  -- ** All best solutions semiring
  AllBestSolutions(..),
  -- * Other functions
  decisions
) where

import Data.Maybe(fromJust)

-- ----------------------
-- Typeclass definitions
-- ----------------------

{- | A 'Semiring' is a type with two operations '<+>' and '<.>' and two
distinguished elements, 'zero' and 'one', which satisfy the following
axioms:

* Conmutativity:

> a <+> b == b <+> a
> a <.> b == b <.> a

* Associativity:

> a <+> (b <+> c) == (a <+> b) <+> c
> a <.> (b <.> c) == (a <.> b) <.> c

* Identity:

> a <+> zero = zero <+> a == a
> a <.> one = one <.> a == a

* Distributive property:

> a <.> (b<+>c) == (a<.>b) <+> (a<.>c)
> (a<+>b) <.>c == (a<.>c) <+> (b<.>c)

* Anhiliation of multiplication by zero:

> a <.> zero = zero <.> a = zero
-}
class Semiring s where
    infixl 6 <+>
    (<+>) :: s -> s -> s
    infixl 7 <.>
    (<.>) :: s -> s -> s
    -- |Neutral element for '<+>'.
    zero  :: s
    -- |Neutral element for '<.>'.
    one   :: s

-- | This typeclass is used in optimization semirings. It is expected
-- that @optimum a b@ returns either @a@ or @b@.
class Opt t where
  optimum :: t -> t -> t

-- --------------------
-- Semiring definitions
-- --------------------

-- Number instances

instance Semiring Int  where
  <+> :: Int -> Int -> Int
(<+>) = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
  <.> :: Int -> Int -> Int
(<.>) = Int -> Int -> Int
forall a. Num a => a -> a -> a
(*)
  zero :: Int
zero = Int
0
  one :: Int
one = Int
1

instance Semiring Integer  where
  <+> :: Integer -> Integer -> Integer
(<+>) = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
  <.> :: Integer -> Integer -> Integer
(<.>) = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*)
  zero :: Integer
zero = Integer
0
  one :: Integer
one = Integer
1

instance Semiring Float  where
  <+> :: Float -> Float -> Float
(<+>) = Float -> Float -> Float
forall a. Num a => a -> a -> a
(+)
  <.> :: Float -> Float -> Float
(<.>) = Float -> Float -> Float
forall a. Num a => a -> a -> a
(*)
  zero :: Float
zero = Float
0
  one :: Float
one = Float
1

instance Semiring Double  where
  <+> :: Double -> Double -> Double
(<+>) = Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
  <.> :: Double -> Double -> Double
(<.>) = Double -> Double -> Double
forall a. Num a => a -> a -> a
(*)
  zero :: Double
zero = Double
0
  one :: Double
one = Double
1

-- |The tropical min semiring, a semiring that uses 'min' as '<+>' and
-- sum as '<.>'. It is used in problems that ask for minimizing a sum of
-- values.
newtype TMin v = TMin v deriving (TMin v -> TMin v -> Bool
(TMin v -> TMin v -> Bool)
-> (TMin v -> TMin v -> Bool) -> Eq (TMin v)
forall v. Eq v => TMin v -> TMin v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => TMin v -> TMin v -> Bool
== :: TMin v -> TMin v -> Bool
$c/= :: forall v. Eq v => TMin v -> TMin v -> Bool
/= :: TMin v -> TMin v -> Bool
Eq, Eq (TMin v)
Eq (TMin v) =>
(TMin v -> TMin v -> Ordering)
-> (TMin v -> TMin v -> Bool)
-> (TMin v -> TMin v -> Bool)
-> (TMin v -> TMin v -> Bool)
-> (TMin v -> TMin v -> Bool)
-> (TMin v -> TMin v -> TMin v)
-> (TMin v -> TMin v -> TMin v)
-> Ord (TMin v)
TMin v -> TMin v -> Bool
TMin v -> TMin v -> Ordering
TMin v -> TMin v -> TMin v
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 v. Ord v => Eq (TMin v)
forall v. Ord v => TMin v -> TMin v -> Bool
forall v. Ord v => TMin v -> TMin v -> Ordering
forall v. Ord v => TMin v -> TMin v -> TMin v
$ccompare :: forall v. Ord v => TMin v -> TMin v -> Ordering
compare :: TMin v -> TMin v -> Ordering
$c< :: forall v. Ord v => TMin v -> TMin v -> Bool
< :: TMin v -> TMin v -> Bool
$c<= :: forall v. Ord v => TMin v -> TMin v -> Bool
<= :: TMin v -> TMin v -> Bool
$c> :: forall v. Ord v => TMin v -> TMin v -> Bool
> :: TMin v -> TMin v -> Bool
$c>= :: forall v. Ord v => TMin v -> TMin v -> Bool
>= :: TMin v -> TMin v -> Bool
$cmax :: forall v. Ord v => TMin v -> TMin v -> TMin v
max :: TMin v -> TMin v -> TMin v
$cmin :: forall v. Ord v => TMin v -> TMin v -> TMin v
min :: TMin v -> TMin v -> TMin v
Ord, Int -> TMin v -> ShowS
[TMin v] -> ShowS
TMin v -> String
(Int -> TMin v -> ShowS)
-> (TMin v -> String) -> ([TMin v] -> ShowS) -> Show (TMin v)
forall v. Show v => Int -> TMin v -> ShowS
forall v. Show v => [TMin v] -> ShowS
forall v. Show v => TMin v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> TMin v -> ShowS
showsPrec :: Int -> TMin v -> ShowS
$cshow :: forall v. Show v => TMin v -> String
show :: TMin v -> String
$cshowList :: forall v. Show v => [TMin v] -> ShowS
showList :: [TMin v] -> ShowS
Show)

-- |The tropical max semiring, a semiring that uses 'max' as '<+>' and
-- sum as '<.>'. It is used in problems that ask for maximizing a sum of
-- values.
newtype TMax v = TMax v deriving (TMax v -> TMax v -> Bool
(TMax v -> TMax v -> Bool)
-> (TMax v -> TMax v -> Bool) -> Eq (TMax v)
forall v. Eq v => TMax v -> TMax v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => TMax v -> TMax v -> Bool
== :: TMax v -> TMax v -> Bool
$c/= :: forall v. Eq v => TMax v -> TMax v -> Bool
/= :: TMax v -> TMax v -> Bool
Eq, Eq (TMax v)
Eq (TMax v) =>
(TMax v -> TMax v -> Ordering)
-> (TMax v -> TMax v -> Bool)
-> (TMax v -> TMax v -> Bool)
-> (TMax v -> TMax v -> Bool)
-> (TMax v -> TMax v -> Bool)
-> (TMax v -> TMax v -> TMax v)
-> (TMax v -> TMax v -> TMax v)
-> Ord (TMax v)
TMax v -> TMax v -> Bool
TMax v -> TMax v -> Ordering
TMax v -> TMax v -> TMax v
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 v. Ord v => Eq (TMax v)
forall v. Ord v => TMax v -> TMax v -> Bool
forall v. Ord v => TMax v -> TMax v -> Ordering
forall v. Ord v => TMax v -> TMax v -> TMax v
$ccompare :: forall v. Ord v => TMax v -> TMax v -> Ordering
compare :: TMax v -> TMax v -> Ordering
$c< :: forall v. Ord v => TMax v -> TMax v -> Bool
< :: TMax v -> TMax v -> Bool
$c<= :: forall v. Ord v => TMax v -> TMax v -> Bool
<= :: TMax v -> TMax v -> Bool
$c> :: forall v. Ord v => TMax v -> TMax v -> Bool
> :: TMax v -> TMax v -> Bool
$c>= :: forall v. Ord v => TMax v -> TMax v -> Bool
>= :: TMax v -> TMax v -> Bool
$cmax :: forall v. Ord v => TMax v -> TMax v -> TMax v
max :: TMax v -> TMax v -> TMax v
$cmin :: forall v. Ord v => TMax v -> TMax v -> TMax v
min :: TMax v -> TMax v -> TMax v
Ord, Int -> TMax v -> ShowS
[TMax v] -> ShowS
TMax v -> String
(Int -> TMax v -> ShowS)
-> (TMax v -> String) -> ([TMax v] -> ShowS) -> Show (TMax v)
forall v. Show v => Int -> TMax v -> ShowS
forall v. Show v => [TMax v] -> ShowS
forall v. Show v => TMax v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> TMax v -> ShowS
showsPrec :: Int -> TMax v -> ShowS
$cshow :: forall v. Show v => TMax v -> String
show :: TMax v -> String
$cshowList :: forall v. Show v => [TMax v] -> ShowS
showList :: [TMax v] -> ShowS
Show)

instance (Num v, Ord v, Bounded v) => Semiring (TMin v) where
  TMin v
t1 <+> :: TMin v -> TMin v -> TMin v
<+> TMin v
t2 = TMin v -> TMin v -> TMin v
forall a. Ord a => a -> a -> a
min TMin v
t1 TMin v
t2
  t1 :: TMin v
t1@(TMin v
v1) <.> :: TMin v -> TMin v -> TMin v
<.> t2 :: TMin v
t2@(TMin v
v2)
    | TMin v
t1 TMin v -> TMin v -> Bool
forall a. Eq a => a -> a -> Bool
== TMin v
forall s. Semiring s => s
zero = TMin v
forall s. Semiring s => s
zero
    | TMin v
t2 TMin v -> TMin v -> Bool
forall a. Eq a => a -> a -> Bool
== TMin v
forall s. Semiring s => s
zero = TMin v
forall s. Semiring s => s
zero
    | Bool
otherwise = v -> TMin v
forall v. v -> TMin v
TMin (v
v1 v -> v -> v
forall a. Num a => a -> a -> a
+ v
v2)
  zero :: TMin v
zero = v -> TMin v
forall v. v -> TMin v
TMin v
forall a. Bounded a => a
maxBound
  one :: TMin v
one = v -> TMin v
forall v. v -> TMin v
TMin v
0

instance (Num v, Ord v, Bounded v) => Semiring (TMax v) where
  TMax v
t1 <+> :: TMax v -> TMax v -> TMax v
<+> TMax v
t2 = TMax v -> TMax v -> TMax v
forall a. Ord a => a -> a -> a
max TMax v
t1 TMax v
t2
  t1 :: TMax v
t1@(TMax v
v1) <.> :: TMax v -> TMax v -> TMax v
<.> t2 :: TMax v
t2@(TMax v
v2)
    | TMax v
t1 TMax v -> TMax v -> Bool
forall a. Eq a => a -> a -> Bool
== TMax v
forall s. Semiring s => s
zero = TMax v
forall s. Semiring s => s
zero
    | TMax v
t2 TMax v -> TMax v -> Bool
forall a. Eq a => a -> a -> Bool
== TMax v
forall s. Semiring s => s
zero = TMax v
forall s. Semiring s => s
zero
    | Bool
otherwise = v -> TMax v
forall v. v -> TMax v
TMax (v
v1 v -> v -> v
forall a. Num a => a -> a -> a
+ v
v2)
  zero :: TMax v
zero = v -> TMax v
forall v. v -> TMax v
TMax v
forall a. Bounded a => a
minBound
  one :: TMax v
one = v -> TMax v
forall v. v -> TMax v
TMax v
0

instance Ord v => Opt (TMin v) where
  optimum :: TMin v -> TMin v -> TMin v
optimum = TMin v -> TMin v -> TMin v
forall a. Ord a => a -> a -> a
min

instance Ord v => Opt (TMax v) where
  optimum :: TMax v -> TMax v -> TMax v
optimum = TMax v -> TMax v -> TMax v
forall a. Ord a => a -> a -> a
max

-- | The 'MinProd' semiring is the analogous to the 'TMin' semiring
-- for minimizing products.
newtype MinProd v = MinProd v deriving (MinProd v -> MinProd v -> Bool
(MinProd v -> MinProd v -> Bool)
-> (MinProd v -> MinProd v -> Bool) -> Eq (MinProd v)
forall v. Eq v => MinProd v -> MinProd v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => MinProd v -> MinProd v -> Bool
== :: MinProd v -> MinProd v -> Bool
$c/= :: forall v. Eq v => MinProd v -> MinProd v -> Bool
/= :: MinProd v -> MinProd v -> Bool
Eq, Eq (MinProd v)
Eq (MinProd v) =>
(MinProd v -> MinProd v -> Ordering)
-> (MinProd v -> MinProd v -> Bool)
-> (MinProd v -> MinProd v -> Bool)
-> (MinProd v -> MinProd v -> Bool)
-> (MinProd v -> MinProd v -> Bool)
-> (MinProd v -> MinProd v -> MinProd v)
-> (MinProd v -> MinProd v -> MinProd v)
-> Ord (MinProd v)
MinProd v -> MinProd v -> Bool
MinProd v -> MinProd v -> Ordering
MinProd v -> MinProd v -> MinProd v
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 v. Ord v => Eq (MinProd v)
forall v. Ord v => MinProd v -> MinProd v -> Bool
forall v. Ord v => MinProd v -> MinProd v -> Ordering
forall v. Ord v => MinProd v -> MinProd v -> MinProd v
$ccompare :: forall v. Ord v => MinProd v -> MinProd v -> Ordering
compare :: MinProd v -> MinProd v -> Ordering
$c< :: forall v. Ord v => MinProd v -> MinProd v -> Bool
< :: MinProd v -> MinProd v -> Bool
$c<= :: forall v. Ord v => MinProd v -> MinProd v -> Bool
<= :: MinProd v -> MinProd v -> Bool
$c> :: forall v. Ord v => MinProd v -> MinProd v -> Bool
> :: MinProd v -> MinProd v -> Bool
$c>= :: forall v. Ord v => MinProd v -> MinProd v -> Bool
>= :: MinProd v -> MinProd v -> Bool
$cmax :: forall v. Ord v => MinProd v -> MinProd v -> MinProd v
max :: MinProd v -> MinProd v -> MinProd v
$cmin :: forall v. Ord v => MinProd v -> MinProd v -> MinProd v
min :: MinProd v -> MinProd v -> MinProd v
Ord, Int -> MinProd v -> ShowS
[MinProd v] -> ShowS
MinProd v -> String
(Int -> MinProd v -> ShowS)
-> (MinProd v -> String)
-> ([MinProd v] -> ShowS)
-> Show (MinProd v)
forall v. Show v => Int -> MinProd v -> ShowS
forall v. Show v => [MinProd v] -> ShowS
forall v. Show v => MinProd v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> MinProd v -> ShowS
showsPrec :: Int -> MinProd v -> ShowS
$cshow :: forall v. Show v => MinProd v -> String
show :: MinProd v -> String
$cshowList :: forall v. Show v => [MinProd v] -> ShowS
showList :: [MinProd v] -> ShowS
Show)

instance (Num v, Ord v, Bounded v) => Semiring (MinProd v) where
  MinProd v
t1 <+> :: MinProd v -> MinProd v -> MinProd v
<+> MinProd v
t2 = MinProd v -> MinProd v -> MinProd v
forall a. Ord a => a -> a -> a
max MinProd v
t1 MinProd v
t2
  t1 :: MinProd v
t1@(MinProd v
v1) <.> :: MinProd v -> MinProd v -> MinProd v
<.> t2 :: MinProd v
t2@(MinProd v
v2)
    | MinProd v
t1 MinProd v -> MinProd v -> Bool
forall a. Eq a => a -> a -> Bool
== MinProd v
forall s. Semiring s => s
zero = MinProd v
forall s. Semiring s => s
zero
    | MinProd v
t2 MinProd v -> MinProd v -> Bool
forall a. Eq a => a -> a -> Bool
== MinProd v
forall s. Semiring s => s
zero = MinProd v
forall s. Semiring s => s
zero
    | Bool
otherwise = v -> MinProd v
forall v. v -> MinProd v
MinProd (v
v1 v -> v -> v
forall a. Num a => a -> a -> a
* v
v2)
  zero :: MinProd v
zero = v -> MinProd v
forall v. v -> MinProd v
MinProd v
forall a. Bounded a => a
maxBound
  one :: MinProd v
one = v -> MinProd v
forall v. v -> MinProd v
MinProd v
1

instance Ord v => Opt (MinProd v) where
  optimum :: MinProd v -> MinProd v -> MinProd v
optimum = MinProd v -> MinProd v -> MinProd v
forall a. Ord a => a -> a -> a
min

-- | The 'MaxProd' semiring is the analogous to the 'TMax' semiring
-- for maximizing products.
newtype MaxProd v = MaxProd v deriving (MaxProd v -> MaxProd v -> Bool
(MaxProd v -> MaxProd v -> Bool)
-> (MaxProd v -> MaxProd v -> Bool) -> Eq (MaxProd v)
forall v. Eq v => MaxProd v -> MaxProd v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => MaxProd v -> MaxProd v -> Bool
== :: MaxProd v -> MaxProd v -> Bool
$c/= :: forall v. Eq v => MaxProd v -> MaxProd v -> Bool
/= :: MaxProd v -> MaxProd v -> Bool
Eq, Eq (MaxProd v)
Eq (MaxProd v) =>
(MaxProd v -> MaxProd v -> Ordering)
-> (MaxProd v -> MaxProd v -> Bool)
-> (MaxProd v -> MaxProd v -> Bool)
-> (MaxProd v -> MaxProd v -> Bool)
-> (MaxProd v -> MaxProd v -> Bool)
-> (MaxProd v -> MaxProd v -> MaxProd v)
-> (MaxProd v -> MaxProd v -> MaxProd v)
-> Ord (MaxProd v)
MaxProd v -> MaxProd v -> Bool
MaxProd v -> MaxProd v -> Ordering
MaxProd v -> MaxProd v -> MaxProd v
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 v. Ord v => Eq (MaxProd v)
forall v. Ord v => MaxProd v -> MaxProd v -> Bool
forall v. Ord v => MaxProd v -> MaxProd v -> Ordering
forall v. Ord v => MaxProd v -> MaxProd v -> MaxProd v
$ccompare :: forall v. Ord v => MaxProd v -> MaxProd v -> Ordering
compare :: MaxProd v -> MaxProd v -> Ordering
$c< :: forall v. Ord v => MaxProd v -> MaxProd v -> Bool
< :: MaxProd v -> MaxProd v -> Bool
$c<= :: forall v. Ord v => MaxProd v -> MaxProd v -> Bool
<= :: MaxProd v -> MaxProd v -> Bool
$c> :: forall v. Ord v => MaxProd v -> MaxProd v -> Bool
> :: MaxProd v -> MaxProd v -> Bool
$c>= :: forall v. Ord v => MaxProd v -> MaxProd v -> Bool
>= :: MaxProd v -> MaxProd v -> Bool
$cmax :: forall v. Ord v => MaxProd v -> MaxProd v -> MaxProd v
max :: MaxProd v -> MaxProd v -> MaxProd v
$cmin :: forall v. Ord v => MaxProd v -> MaxProd v -> MaxProd v
min :: MaxProd v -> MaxProd v -> MaxProd v
Ord, Int -> MaxProd v -> ShowS
[MaxProd v] -> ShowS
MaxProd v -> String
(Int -> MaxProd v -> ShowS)
-> (MaxProd v -> String)
-> ([MaxProd v] -> ShowS)
-> Show (MaxProd v)
forall v. Show v => Int -> MaxProd v -> ShowS
forall v. Show v => [MaxProd v] -> ShowS
forall v. Show v => MaxProd v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> MaxProd v -> ShowS
showsPrec :: Int -> MaxProd v -> ShowS
$cshow :: forall v. Show v => MaxProd v -> String
show :: MaxProd v -> String
$cshowList :: forall v. Show v => [MaxProd v] -> ShowS
showList :: [MaxProd v] -> ShowS
Show)

instance (Num v, Ord v, Bounded v) => Semiring (MaxProd v) where
  MaxProd v
t1 <+> :: MaxProd v -> MaxProd v -> MaxProd v
<+> MaxProd v
t2 = MaxProd v -> MaxProd v -> MaxProd v
forall a. Ord a => a -> a -> a
max MaxProd v
t1 MaxProd v
t2
  t1 :: MaxProd v
t1@(MaxProd v
v1) <.> :: MaxProd v -> MaxProd v -> MaxProd v
<.> t2 :: MaxProd v
t2@(MaxProd v
v2)
    | MaxProd v
t1 MaxProd v -> MaxProd v -> Bool
forall a. Eq a => a -> a -> Bool
== MaxProd v
forall s. Semiring s => s
zero = MaxProd v
forall s. Semiring s => s
zero
    | MaxProd v
t2 MaxProd v -> MaxProd v -> Bool
forall a. Eq a => a -> a -> Bool
== MaxProd v
forall s. Semiring s => s
zero = MaxProd v
forall s. Semiring s => s
zero
    | Bool
otherwise = v -> MaxProd v
forall v. v -> MaxProd v
MaxProd (v
v1 v -> v -> v
forall a. Num a => a -> a -> a
* v
v2)
  zero :: MaxProd v
zero = v -> MaxProd v
forall v. v -> MaxProd v
MaxProd v
forall a. Bounded a => a
minBound
  one :: MaxProd v
one = v -> MaxProd v
forall v. v -> MaxProd v
MaxProd v
1

instance Ord v => Opt (MaxProd v) where
  optimum :: MaxProd v -> MaxProd v -> MaxProd v
optimum = MaxProd v -> MaxProd v -> MaxProd v
forall a. Ord a => a -> a -> a
max

-- |The 'Count' semiring is used for counting the number of different
-- solutions.
newtype Count = Count Integer deriving Int -> Count -> ShowS
[Count] -> ShowS
Count -> String
(Int -> Count -> ShowS)
-> (Count -> String) -> ([Count] -> ShowS) -> Show Count
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Count -> ShowS
showsPrec :: Int -> Count -> ShowS
$cshow :: Count -> String
show :: Count -> String
$cshowList :: [Count] -> ShowS
showList :: [Count] -> ShowS
Show

instance Semiring Count where
  Count Integer
n <+> :: Count -> Count -> Count
<+> Count Integer
n' = Integer -> Count
Count (Integer -> Count) -> Integer -> Count
forall a b. (a -> b) -> a -> b
$ Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n'
  Count Integer
n <.> :: Count -> Count -> Count
<.> Count Integer
n' = Integer -> Count
Count (Integer -> Count) -> Integer -> Count
forall a b. (a -> b) -> a -> b
$ Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
n'
  zero :: Count
zero = Integer -> Count
Count Integer
0
  one :: Count
one = Integer -> Count
Count Integer
1

-- |The `BestSolution` semiring is used for recovering the best sequence
-- of decisions together with its score. The score must be an instance of
-- 'Opt' to be able to decide which is the best of two scores.
data BestSolution d sc = BestSolution (Maybe [d]) sc deriving (BestSolution d sc -> BestSolution d sc -> Bool
(BestSolution d sc -> BestSolution d sc -> Bool)
-> (BestSolution d sc -> BestSolution d sc -> Bool)
-> Eq (BestSolution d sc)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall d sc.
(Eq d, Eq sc) =>
BestSolution d sc -> BestSolution d sc -> Bool
$c== :: forall d sc.
(Eq d, Eq sc) =>
BestSolution d sc -> BestSolution d sc -> Bool
== :: BestSolution d sc -> BestSolution d sc -> Bool
$c/= :: forall d sc.
(Eq d, Eq sc) =>
BestSolution d sc -> BestSolution d sc -> Bool
/= :: BestSolution d sc -> BestSolution d sc -> Bool
Eq, Int -> BestSolution d sc -> ShowS
[BestSolution d sc] -> ShowS
BestSolution d sc -> String
(Int -> BestSolution d sc -> ShowS)
-> (BestSolution d sc -> String)
-> ([BestSolution d sc] -> ShowS)
-> Show (BestSolution d sc)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d sc. (Show d, Show sc) => Int -> BestSolution d sc -> ShowS
forall d sc. (Show d, Show sc) => [BestSolution d sc] -> ShowS
forall d sc. (Show d, Show sc) => BestSolution d sc -> String
$cshowsPrec :: forall d sc. (Show d, Show sc) => Int -> BestSolution d sc -> ShowS
showsPrec :: Int -> BestSolution d sc -> ShowS
$cshow :: forall d sc. (Show d, Show sc) => BestSolution d sc -> String
show :: BestSolution d sc -> String
$cshowList :: forall d sc. (Show d, Show sc) => [BestSolution d sc] -> ShowS
showList :: [BestSolution d sc] -> ShowS
Show)

instance (Semiring sc, Opt sc, Eq sc) => Semiring (BestSolution d sc) where
    sol1 :: BestSolution d sc
sol1@(BestSolution Maybe [d]
_ sc
sc1) <+> :: BestSolution d sc -> BestSolution d sc -> BestSolution d sc
<+> sol2 :: BestSolution d sc
sol2@(BestSolution Maybe [d]
_ sc
sc2)
       | sc -> sc -> sc
forall t. Opt t => t -> t -> t
optimum sc
sc1 sc
sc2 sc -> sc -> Bool
forall a. Eq a => a -> a -> Bool
== sc
sc1 = BestSolution d sc
sol1
       | Bool
otherwise = BestSolution d sc
sol2
    BestSolution Maybe [d]
ds1 sc
sc1 <.> :: BestSolution d sc -> BestSolution d sc -> BestSolution d sc
<.> BestSolution Maybe [d]
ds2 sc
sc2 =
       Maybe [d] -> sc -> BestSolution d sc
forall d sc. Maybe [d] -> sc -> BestSolution d sc
BestSolution ([d] -> [d] -> [d]
forall a. [a] -> [a] -> [a]
(++) ([d] -> [d] -> [d]) -> Maybe [d] -> Maybe ([d] -> [d])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [d]
ds1 Maybe ([d] -> [d]) -> Maybe [d] -> Maybe [d]
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [d]
ds2) (sc
sc1 sc -> sc -> sc
forall s. Semiring s => s -> s -> s
<.> sc
sc2)
    zero :: BestSolution d sc
zero = Maybe [d] -> sc -> BestSolution d sc
forall d sc. Maybe [d] -> sc -> BestSolution d sc
BestSolution Maybe [d]
forall a. Maybe a
Nothing sc
forall s. Semiring s => s
zero
    one :: BestSolution d sc
one = Maybe [d] -> sc -> BestSolution d sc
forall d sc. Maybe [d] -> sc -> BestSolution d sc
BestSolution ([d] -> Maybe [d]
forall a. a -> Maybe a
Just []) sc
forall s. Semiring s => s
one

-- |Auxiliary function to recover the sequence of decisions from a `BestSolution`
decisions :: BestSolution d sc -> [d]
decisions :: forall d sc. BestSolution d sc -> [d]
decisions (BestSolution Maybe [d]
s sc
_) = Maybe [d] -> [d]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [d]
s

-- |With the 'AllSolutions' semiring it is possible to recover all possible
-- solutions to a problem, regardless of their scores.
newtype AllSolutions d sc = AllSolutions [([d], sc)] deriving Int -> AllSolutions d sc -> ShowS
[AllSolutions d sc] -> ShowS
AllSolutions d sc -> String
(Int -> AllSolutions d sc -> ShowS)
-> (AllSolutions d sc -> String)
-> ([AllSolutions d sc] -> ShowS)
-> Show (AllSolutions d sc)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d sc. (Show d, Show sc) => Int -> AllSolutions d sc -> ShowS
forall d sc. (Show d, Show sc) => [AllSolutions d sc] -> ShowS
forall d sc. (Show d, Show sc) => AllSolutions d sc -> String
$cshowsPrec :: forall d sc. (Show d, Show sc) => Int -> AllSolutions d sc -> ShowS
showsPrec :: Int -> AllSolutions d sc -> ShowS
$cshow :: forall d sc. (Show d, Show sc) => AllSolutions d sc -> String
show :: AllSolutions d sc -> String
$cshowList :: forall d sc. (Show d, Show sc) => [AllSolutions d sc] -> ShowS
showList :: [AllSolutions d sc] -> ShowS
Show

instance Semiring sc => Semiring (AllSolutions d sc) where
  AllSolutions [([d], sc)]
sols1 <+> :: AllSolutions d sc -> AllSolutions d sc -> AllSolutions d sc
<+> AllSolutions [([d], sc)]
sols2 = [([d], sc)] -> AllSolutions d sc
forall d sc. [([d], sc)] -> AllSolutions d sc
AllSolutions ([([d], sc)]
sols1 [([d], sc)] -> [([d], sc)] -> [([d], sc)]
forall a. [a] -> [a] -> [a]
++ [([d], sc)]
sols2)
  AllSolutions [([d], sc)]
sols1 <.> :: AllSolutions d sc -> AllSolutions d sc -> AllSolutions d sc
<.> AllSolutions [([d], sc)]
sols2 =
    [([d], sc)] -> AllSolutions d sc
forall d sc. [([d], sc)] -> AllSolutions d sc
AllSolutions [ ([d]
ds1 [d] -> [d] -> [d]
forall a. [a] -> [a] -> [a]
++ [d]
ds2, sc
sc1 sc -> sc -> sc
forall s. Semiring s => s -> s -> s
<.> sc
sc2) 
                 | ([d]
ds1, sc
sc1) <- [([d], sc)]
sols1, ([d]
ds2, sc
sc2) <- [([d], sc)]
sols2]
  zero :: AllSolutions d sc
zero = [([d], sc)] -> AllSolutions d sc
forall d sc. [([d], sc)] -> AllSolutions d sc
AllSolutions []
  one :: AllSolutions d sc
one = [([d], sc)] -> AllSolutions d sc
forall d sc. [([d], sc)] -> AllSolutions d sc
AllSolutions [([], sc
forall s. Semiring s => s
one)]

-- |With the 'AllBestSolutions' semiring it is possible to recover all the
-- solutions to a problem that reach the optimum score.
newtype AllBestSolutions d s = AllBestSolutions ([[d]], s) deriving Int -> AllBestSolutions d s -> ShowS
[AllBestSolutions d s] -> ShowS
AllBestSolutions d s -> String
(Int -> AllBestSolutions d s -> ShowS)
-> (AllBestSolutions d s -> String)
-> ([AllBestSolutions d s] -> ShowS)
-> Show (AllBestSolutions d s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d s.
(Show d, Show s) =>
Int -> AllBestSolutions d s -> ShowS
forall d s. (Show d, Show s) => [AllBestSolutions d s] -> ShowS
forall d s. (Show d, Show s) => AllBestSolutions d s -> String
$cshowsPrec :: forall d s.
(Show d, Show s) =>
Int -> AllBestSolutions d s -> ShowS
showsPrec :: Int -> AllBestSolutions d s -> ShowS
$cshow :: forall d s. (Show d, Show s) => AllBestSolutions d s -> String
show :: AllBestSolutions d s -> String
$cshowList :: forall d s. (Show d, Show s) => [AllBestSolutions d s] -> ShowS
showList :: [AllBestSolutions d s] -> ShowS
Show

instance (Semiring sc, Opt sc, Eq sc) => Semiring (AllBestSolutions d sc) where
  a1 :: AllBestSolutions d sc
a1@(AllBestSolutions ([[d]]
sols1, sc
sc1)) <+> :: AllBestSolutions d sc
-> AllBestSolutions d sc -> AllBestSolutions d sc
<+> a2 :: AllBestSolutions d sc
a2@(AllBestSolutions ([[d]]
sols2, sc
sc2))
    | sc
sc1 sc -> sc -> Bool
forall a. Eq a => a -> a -> Bool
== sc
sc2 = ([[d]], sc) -> AllBestSolutions d sc
forall d s. ([[d]], s) -> AllBestSolutions d s
AllBestSolutions ([[d]]
sols1 [[d]] -> [[d]] -> [[d]]
forall a. [a] -> [a] -> [a]
++ [[d]]
sols2, sc
sc1)
    | sc -> sc -> sc
forall t. Opt t => t -> t -> t
optimum sc
sc1 sc
sc2 sc -> sc -> Bool
forall a. Eq a => a -> a -> Bool
== sc
sc1 = AllBestSolutions d sc
a1
    | Bool
otherwise = AllBestSolutions d sc
a2
  AllBestSolutions ([[d]]
sols1, sc
sc1) <.> :: AllBestSolutions d sc
-> AllBestSolutions d sc -> AllBestSolutions d sc
<.> AllBestSolutions ([[d]]
sols2, sc
sc2) =
    ([[d]], sc) -> AllBestSolutions d sc
forall d s. ([[d]], s) -> AllBestSolutions d s
AllBestSolutions ([d] -> [d] -> [d]
forall a. [a] -> [a] -> [a]
(++) ([d] -> [d] -> [d]) -> [[d]] -> [[d] -> [d]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[d]]
sols1 [[d] -> [d]] -> [[d]] -> [[d]]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[d]]
sols2, sc
sc1 sc -> sc -> sc
forall s. Semiring s => s -> s -> s
<.> sc
sc2)
  zero :: AllBestSolutions d sc
zero = ([[d]], sc) -> AllBestSolutions d sc
forall d s. ([[d]], s) -> AllBestSolutions d s
AllBestSolutions ([], sc
forall s. Semiring s => s
zero)
  one :: AllBestSolutions d sc
one = ([[d]], sc) -> AllBestSolutions d sc
forall d s. ([[d]], s) -> AllBestSolutions d s
AllBestSolutions ([[]], sc
forall s. Semiring s => s
one)

instance (Semiring s1, Semiring s2) => Semiring (s1, s2) where
  (s1
s1, s2
s2) <+> :: (s1, s2) -> (s1, s2) -> (s1, s2)
<+> (s1
s1', s2
s2') = (s1
s1 s1 -> s1 -> s1
forall s. Semiring s => s -> s -> s
<+> s1
s1', s2
s2 s2 -> s2 -> s2
forall s. Semiring s => s -> s -> s
<+> s2
s2')
  (s1
s1, s2
s2) <.> :: (s1, s2) -> (s1, s2) -> (s1, s2)
<.> (s1
s1', s2
s2') = (s1
s1 s1 -> s1 -> s1
forall s. Semiring s => s -> s -> s
<.> s1
s1', s2
s2 s2 -> s2 -> s2
forall s. Semiring s => s -> s -> s
<.> s2
s2')
  zero :: (s1, s2)
zero = (s1
forall s. Semiring s => s
zero, s2
forall s. Semiring s => s
zero)
  one :: (s1, s2)
one = (s1
forall s. Semiring s => s
one, s2
forall s. Semiring s => s
one)