{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ToySolver.Combinatorial.BipartiteMatching
(
maximumCardinalityMatching
, maximumWeightMatching
, maximumWeightMatchingComplete
, maximumWeightPerfectMatching
, minimumWeightPerfectMatching
, maximumWeightPerfectMatchingComplete
, minimumWeightPerfectMatchingComplete
, minimumCardinalityEdgeCover
, minimumWeightEdgeCover
, minimumWeightEdgeCoverComplete
) where
import Control.Monad
import qualified Data.Foldable as F
import Data.IntMap.Strict (IntMap, (!))
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Maybe
maximumCardinalityMatching
:: IntSet
-> IntSet
-> [(Int,Int)]
-> IntMap Int
maximumCardinalityMatching :: IntSet -> IntSet -> [(Int, Int)] -> IntMap Int
maximumCardinalityMatching IntSet
_as IntSet
bs [(Int, Int)]
es =
case IntSet
-> (Int -> IntSet) -> IntMap Int -> (IntMap Int, IntSet, IntSet)
maximumCardinalityMatching' IntSet
bs (\Int
b -> forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault IntSet
IntSet.empty Int
b IntMap IntSet
e_b2a) forall a. IntMap a
IntMap.empty of
(IntMap Int
m, IntSet
_, IntSet
_) -> IntMap Int
m
where
e_b2a :: IntMap IntSet
e_b2a :: IntMap IntSet
e_b2a = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith IntSet -> IntSet -> IntSet
IntSet.union [(Int
b, Int -> IntSet
IntSet.singleton Int
a) | (Int
a,Int
b) <- [(Int, Int)]
es]
type AlternatingPath = (Int, [(Int,Int)], Int)
type AugmentingPath = ([(Int,Int)], Int)
maximumCardinalityMatching'
:: IntSet
-> (Int -> IntSet)
-> IntMap Int
-> (IntMap Int, IntSet, IntSet)
maximumCardinalityMatching' :: IntSet
-> (Int -> IntSet) -> IntMap Int -> (IntMap Int, IntSet, IntSet)
maximumCardinalityMatching' IntSet
bs Int -> IntSet
e_b2a IntMap Int
m0 = IntMap Int -> IntSet -> (IntMap Int, IntSet, IntSet)
loop IntMap Int
m0 IntSet
m0_b_exposed
where
m0_b_exposed :: IntSet
m0_b_exposed = IntSet
bs IntSet -> IntSet -> IntSet
`IntSet.difference` [Int] -> IntSet
IntSet.fromList (forall a. IntMap a -> [a]
IntMap.elems IntMap Int
m0)
loop :: IntMap Int -> IntSet -> (IntMap Int, IntSet, IntSet)
loop :: IntMap Int -> IntSet -> (IntMap Int, IntSet, IntSet)
loop IntMap Int
m IntSet
m_b_exposed =
case IntSet -> (IntSet, IntSet, [AugmentingPath])
search IntSet
m_b_exposed of
(IntSet
l_a, IntSet
l_b, []) -> (IntMap Int
m, IntSet
l_a, IntSet
l_b)
(IntSet
_, IntSet
_, [AugmentingPath]
ds) ->
let
ds2 :: [IntMap Int]
ds2 = [forall a. [(Int, a)] -> IntMap a
IntMap.fromList [(Int, Int)]
d2 | ([(Int, Int)]
d2,Int
_) <- [AugmentingPath]
ds]
m' :: IntMap Int
m' = forall (f :: * -> *) a. Foldable f => f (IntMap a) -> IntMap a
IntMap.unions [IntMap Int]
ds2 forall a. IntMap a -> IntMap a -> IntMap a
`IntMap.union` IntMap Int
m
m_b_exposed' :: IntSet
m_b_exposed' = IntSet
m_b_exposed IntSet -> IntSet -> IntSet
`IntSet.difference` [Int] -> IntSet
IntSet.fromList [Int
b0 | ([(Int, Int)]
_, Int
b0) <- [AugmentingPath]
ds]
in IntMap Int -> IntSet -> (IntMap Int, IntSet, IntSet)
loop IntMap Int
m' IntSet
m_b_exposed'
where
search :: IntSet -> (IntSet, IntSet, [AugmentingPath])
search :: IntSet -> (IntSet, IntSet, [AugmentingPath])
search IntSet
b_exposed = IntSet
-> IntSet
-> [AlternatingPath]
-> [AlternatingPath]
-> [AugmentingPath]
-> (IntSet, IntSet, [AugmentingPath])
loopB IntSet
IntSet.empty IntSet
b_exposed [(Int
b, [], Int
b) | Int
b <- IntSet -> [Int]
IntSet.toList IntSet
b_exposed] [] []
where
loopB :: IntSet -> IntSet -> [AlternatingPath] -> [AlternatingPath] -> [AugmentingPath] -> (IntSet, IntSet, [AugmentingPath])
loopB :: IntSet
-> IntSet
-> [AlternatingPath]
-> [AlternatingPath]
-> [AugmentingPath]
-> (IntSet, IntSet, [AugmentingPath])
loopB !IntSet
visitedA !IntSet
visitedB [] [] [AugmentingPath]
result = (IntSet
visitedA, IntSet
visitedB, [AugmentingPath]
result)
loopB !IntSet
visitedA !IntSet
visitedB [] [AlternatingPath]
nextB [AugmentingPath]
result = IntSet
-> IntSet
-> [AlternatingPath]
-> [AlternatingPath]
-> [AugmentingPath]
-> (IntSet, IntSet, [AugmentingPath])
loopB IntSet
visitedA IntSet
visitedB [AlternatingPath]
nextB [] [AugmentingPath]
result
loopB !IntSet
visitedA !IntSet
visitedB ((Int
b, [(Int, Int)]
d2, Int
b0) : [AlternatingPath]
currB) [AlternatingPath]
nextB [AugmentingPath]
result = IntSet
-> IntSet
-> [Int]
-> [AlternatingPath]
-> [AlternatingPath]
-> [AugmentingPath]
-> (IntSet, IntSet, [AugmentingPath])
loopA IntSet
visitedA IntSet
visitedB (IntSet -> [Int]
IntSet.toList (Int -> IntSet
e_b2a Int
b)) [AlternatingPath]
currB [AlternatingPath]
nextB [AugmentingPath]
result
where
loopA :: IntSet
-> IntSet
-> [Int]
-> [AlternatingPath]
-> [AlternatingPath]
-> [AugmentingPath]
-> (IntSet, IntSet, [AugmentingPath])
loopA !IntSet
visitedA !IntSet
visitedB [] [AlternatingPath]
currB [AlternatingPath]
nextB [AugmentingPath]
result = IntSet
-> IntSet
-> [AlternatingPath]
-> [AlternatingPath]
-> [AugmentingPath]
-> (IntSet, IntSet, [AugmentingPath])
loopB IntSet
visitedA IntSet
visitedB [AlternatingPath]
currB [AlternatingPath]
nextB [AugmentingPath]
result
loopA !IntSet
visitedA !IntSet
visitedB (Int
a:[Int]
as) [AlternatingPath]
currB [AlternatingPath]
nextB [AugmentingPath]
result
| Int
a Int -> IntSet -> Bool
`IntSet.member` IntSet
visitedA = IntSet
-> IntSet
-> [Int]
-> [AlternatingPath]
-> [AlternatingPath]
-> [AugmentingPath]
-> (IntSet, IntSet, [AugmentingPath])
loopA IntSet
visitedA IntSet
visitedB [Int]
as [AlternatingPath]
currB [AlternatingPath]
nextB [AugmentingPath]
result
| Bool
otherwise =
case forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
a IntMap Int
m of
Maybe Int
Nothing ->
IntSet
-> IntSet
-> [AlternatingPath]
-> [AlternatingPath]
-> [AugmentingPath]
-> (IntSet, IntSet, [AugmentingPath])
loopB (Int -> IntSet -> IntSet
IntSet.insert Int
a IntSet
visitedA) IntSet
visitedB (forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_,[(Int, Int)]
_,Int
b0') -> Int
b0forall a. Eq a => a -> a -> Bool
/=Int
b0') [AlternatingPath]
currB) (forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_,[(Int, Int)]
_,Int
b0') -> Int
b0forall a. Eq a => a -> a -> Bool
/=Int
b0') [AlternatingPath]
nextB) (((Int
a,Int
b) forall a. a -> [a] -> [a]
: [(Int, Int)]
d2, Int
b0) forall a. a -> [a] -> [a]
: [AugmentingPath]
result)
Just Int
b2
| Int
bforall a. Eq a => a -> a -> Bool
==Int
b2 -> IntSet
-> IntSet
-> [Int]
-> [AlternatingPath]
-> [AlternatingPath]
-> [AugmentingPath]
-> (IntSet, IntSet, [AugmentingPath])
loopA IntSet
visitedA IntSet
visitedB [Int]
as [AlternatingPath]
currB [AlternatingPath]
nextB [AugmentingPath]
result
| Int
b2 Int -> IntSet -> Bool
`IntSet.member` IntSet
visitedB -> IntSet
-> IntSet
-> [Int]
-> [AlternatingPath]
-> [AlternatingPath]
-> [AugmentingPath]
-> (IntSet, IntSet, [AugmentingPath])
loopA (Int -> IntSet -> IntSet
IntSet.insert Int
a IntSet
visitedA) IntSet
visitedB [Int]
as [AlternatingPath]
currB [AlternatingPath]
nextB [AugmentingPath]
result
| Bool
otherwise -> IntSet
-> IntSet
-> [Int]
-> [AlternatingPath]
-> [AlternatingPath]
-> [AugmentingPath]
-> (IntSet, IntSet, [AugmentingPath])
loopA (Int -> IntSet -> IntSet
IntSet.insert Int
a IntSet
visitedA) (Int -> IntSet -> IntSet
IntSet.insert Int
b2 IntSet
visitedB) [Int]
as [AlternatingPath]
currB ((Int
b2, (Int
a,Int
b)forall a. a -> [a] -> [a]
:[(Int, Int)]
d2, Int
b0) forall a. a -> [a] -> [a]
: [AlternatingPath]
nextB) [AugmentingPath]
result
maximumWeightMatchingComplete
:: forall w. (Real w)
=> IntSet
-> IntSet
-> (Int -> Int -> w)
-> (w, IntMap Int)
maximumWeightMatchingComplete :: forall w.
Real w =>
IntSet -> IntSet -> (Int -> Int -> w) -> (w, IntMap Int)
maximumWeightMatchingComplete IntSet
as IntSet
bs Int -> Int -> w
w =
case forall w.
Real w =>
IntSet -> IntSet -> (Int -> Int -> w) -> (w, IntMap Int)
maximumWeightMaximumMatchingComplete IntSet
as IntSet
bs (\Int
a Int
b -> forall a. Ord a => a -> a -> a
max w
0 (Int -> Int -> w
w Int
a Int
b)) of
(w
_, IntMap Int
m) ->
let m' :: IntMap Int
m' = forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
IntMap.filterWithKey (\Int
a Int
b -> Int -> Int -> w
w Int
a Int
b forall a. Ord a => a -> a -> Bool
> w
0) IntMap Int
m
in (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int -> Int -> w
w Int
a Int
b | (Int
a,Int
b) <- forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap Int
m'], IntMap Int
m')
maximumWeightMatching
:: forall w. (Real w)
=> IntSet
-> IntSet
-> [(Int, Int, w)]
-> (w, IntMap Int)
maximumWeightMatching :: forall w.
Real w =>
IntSet -> IntSet -> [(Int, Int, w)] -> (w, IntMap Int)
maximumWeightMatching IntSet
as IntSet
bs [(Int, Int, w)]
w =
case forall w.
Real w =>
IntSet -> IntSet -> (Int -> Int -> w) -> (w, IntMap Int)
maximumWeightMaximumMatchingComplete IntSet
as IntSet
bs Int -> Int -> w
g of
(w
_, IntMap Int
m) ->
let m' :: IntMap Int
m' = forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
IntMap.filterWithKey (\Int
a Int
b -> forall a. Maybe a -> Bool
isJust (Int -> Int -> Maybe w
f Int
a Int
b)) IntMap Int
m
in (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int -> Int -> w
g Int
a Int
b | (Int
a,Int
b) <- forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap Int
m'], IntMap Int
m')
where
tbl :: IntMap (IntMap w)
tbl :: IntMap (IntMap w)
tbl = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith forall a. IntMap a -> IntMap a -> IntMap a
IntMap.union [(Int
a, (forall a. Int -> a -> IntMap a
IntMap.singleton Int
b w
v)) | (Int
a,Int
b,w
v) <- [(Int, Int, w)]
w]
f :: Int -> Int -> Maybe w
f Int
a Int
b = do
IntMap w
t <- forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
a IntMap (IntMap w)
tbl
w
v <- forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
b IntMap w
t
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ w
v forall a. Ord a => a -> a -> Bool
>= w
0
forall (m :: * -> *) a. Monad m => a -> m a
return w
v
g :: Int -> Int -> w
g Int
a Int
b = forall a. a -> Maybe a -> a
fromMaybe w
0 (Int -> Int -> Maybe w
f Int
a Int
b)
maximumWeightMaximumMatchingComplete
:: forall w. (Real w)
=> IntSet
-> IntSet
-> (Int -> Int -> w)
-> (w, IntMap Int)
maximumWeightMaximumMatchingComplete :: forall w.
Real w =>
IntSet -> IntSet -> (Int -> Int -> w) -> (w, IntMap Int)
maximumWeightMaximumMatchingComplete IntSet
as IntSet
bs Int -> Int -> w
w =
case Int
as_size forall a. Ord a => a -> a -> Ordering
`compare` Int
bs_size of
Ordering
EQ ->
case forall w.
Real w =>
IntSet
-> IntSet
-> (Int -> Int -> w)
-> (w, IntMap Int, (IntMap w, IntMap w))
maximumWeightPerfectMatchingComplete IntSet
as IntSet
bs Int -> Int -> w
w of
(w
obj, IntMap Int
sol, (IntMap w, IntMap w)
_) -> (w
obj, IntMap Int
sol)
Ordering
GT ->
let bs' :: IntSet
bs' = IntSet
bs IntSet -> IntSet -> IntSet
`IntSet.union` [Int] -> IntSet
IntSet.fromAscList (forall a. Int -> [a] -> [a]
take (Int
as_sizeforall a. Num a => a -> a -> a
-Int
bs_size) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> IntSet -> Bool
`IntSet.notMember` IntSet
bs) [Int
0..])
w' :: Int -> Int -> w
w' Int
a Int
b
| Int
b Int -> IntSet -> Bool
`IntSet.member` IntSet
bs = Int -> Int -> w
w Int
a Int
b
| Bool
otherwise = w
0
in case forall w.
Real w =>
IntSet
-> IntSet
-> (Int -> Int -> w)
-> (w, IntMap Int, (IntMap w, IntMap w))
maximumWeightPerfectMatchingComplete IntSet
as IntSet
bs' Int -> Int -> w
w' of
(w
obj, IntMap Int
sol, (IntMap w, IntMap w)
_) ->
( w
obj
, forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
IntMap.filterWithKey (\Int
_ Int
b -> Int
b Int -> IntSet -> Bool
`IntSet.member` IntSet
bs) IntMap Int
sol
)
Ordering
LT ->
let as' :: IntSet
as' = IntSet
as IntSet -> IntSet -> IntSet
`IntSet.union` [Int] -> IntSet
IntSet.fromAscList (forall a. Int -> [a] -> [a]
take (Int
bs_sizeforall a. Num a => a -> a -> a
-Int
as_size) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> IntSet -> Bool
`IntSet.notMember` IntSet
as) [Int
0..])
w' :: Int -> Int -> w
w' Int
a Int
b
| Int
a Int -> IntSet -> Bool
`IntSet.member` IntSet
as = Int -> Int -> w
w Int
a Int
b
| Bool
otherwise = w
0
in case forall w.
Real w =>
IntSet
-> IntSet
-> (Int -> Int -> w)
-> (w, IntMap Int, (IntMap w, IntMap w))
maximumWeightPerfectMatchingComplete IntSet
as' IntSet
bs Int -> Int -> w
w' of
(w
obj, IntMap Int
sol, (IntMap w, IntMap w)
_) ->
( w
obj
, forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
IntMap.filterWithKey (\Int
a Int
_ -> Int
a Int -> IntSet -> Bool
`IntSet.member` IntSet
as) IntMap Int
sol
)
where
as_size :: Int
as_size = IntSet -> Int
IntSet.size IntSet
as
bs_size :: Int
bs_size = IntSet -> Int
IntSet.size IntSet
bs
maximumWeightPerfectMatchingComplete
:: forall w. (Real w)
=> IntSet
-> IntSet
-> (Int -> Int -> w)
-> (w, IntMap Int, (IntMap w, IntMap w))
maximumWeightPerfectMatchingComplete :: forall w.
Real w =>
IntSet
-> IntSet
-> (Int -> Int -> w)
-> (w, IntMap Int, (IntMap w, IntMap w))
maximumWeightPerfectMatchingComplete IntSet
as IntSet
bs Int -> Int -> w
w =
case forall w.
Real w =>
IntSet
-> IntSet
-> (Int -> Int -> w)
-> (w, IntMap Int, (IntMap w, IntMap w))
minimumWeightPerfectMatchingComplete IntSet
as IntSet
bs (\Int
a Int
b -> - Int -> Int -> w
w Int
a Int
b) of
(w
obj, IntMap Int
m, (IntMap w
ysA,IntMap w
ysB)) -> (- w
obj, IntMap Int
m, (forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map forall a. Num a => a -> a
negate IntMap w
ysA, forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map forall a. Num a => a -> a
negate IntMap w
ysB))
minimumWeightPerfectMatchingComplete
:: forall w. (Real w)
=> IntSet
-> IntSet
-> (Int -> Int -> w)
-> (w, IntMap Int, (IntMap w, IntMap w))
minimumWeightPerfectMatchingComplete :: forall w.
Real w =>
IntSet
-> IntSet
-> (Int -> Int -> w)
-> (w, IntMap Int, (IntMap w, IntMap w))
minimumWeightPerfectMatchingComplete IntSet
as IntSet
bs Int -> Int -> w
w
| Int
n forall a. Eq a => a -> a -> Bool
/= IntSet -> Int
IntSet.size IntSet
bs = forall a. HasCallStack => [Char] -> a
error [Char]
"minimumWeightPerfectMatchingComplete: two sets must be same size"
| Bool
otherwise = IntMap Int
-> (IntMap w, IntMap w)
-> IntMap IntSet
-> (w, IntMap Int, (IntMap w, IntMap w))
loop forall a. IntMap a
m0 (IntMap w, IntMap w)
ys0 ((IntMap w, IntMap w) -> IntMap IntSet
equalityGraph (IntMap w, IntMap w)
ys0)
where
n :: Int
n = IntSet -> Int
IntSet.size IntSet
as
ys0 :: (IntMap w, IntMap w)
ys0 :: (IntMap w, IntMap w)
ys0 = ( forall a. (Int -> a) -> IntSet -> IntMap a
IntMap.fromSet (\Int
a -> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int -> Int -> w
w Int
a Int
b | Int
b <- IntSet -> [Int]
IntSet.toList IntSet
bs]) IntSet
as
, forall a. (Int -> a) -> IntSet -> IntMap a
IntMap.fromSet (\Int
_ -> w
0) IntSet
bs
)
m0 :: IntMap a
m0 = forall a. IntMap a
IntMap.empty
loop
:: IntMap Int -> (IntMap w, IntMap w) -> IntMap IntSet
-> (w, IntMap Int, (IntMap w, IntMap w))
loop :: IntMap Int
-> (IntMap w, IntMap w)
-> IntMap IntSet
-> (w, IntMap Int, (IntMap w, IntMap w))
loop IntMap Int
m_pre ys :: (IntMap w, IntMap w)
ys@(IntMap w
ysA,IntMap w
ysB) IntMap IntSet
g_eq
| forall a. IntMap a -> Int
IntMap.size IntMap Int
m forall a. Eq a => a -> a -> Bool
== Int
n = (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
F.sum IntMap w
ysA forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
F.sum IntMap w
ysB, IntMap Int
m, (IntMap w, IntMap w)
ys)
| Bool
otherwise = IntMap Int
-> (IntMap w, IntMap w)
-> IntMap IntSet
-> (w, IntMap Int, (IntMap w, IntMap w))
loop IntMap Int
m (IntMap w, IntMap w)
ys' IntMap IntSet
g_eq'
where
(IntMap Int
m, IntSet
l_a, IntSet
l_b) = IntSet
-> (Int -> IntSet) -> IntMap Int -> (IntMap Int, IntSet, IntSet)
maximumCardinalityMatching' IntSet
bs (IntMap IntSet
g_eq forall a. IntMap a -> Int -> a
!) IntMap Int
m_pre
l_a' :: IntSet
l_a' = IntSet
as IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
l_a
slack :: w
slack :: w
slack = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum
[ Int -> Int -> w
w Int
a Int
b forall a. Num a => a -> a -> a
- (IntMap w
ysAforall a. IntMap a -> Int -> a
!Int
a forall a. Num a => a -> a -> a
+ IntMap w
ysBforall a. IntMap a -> Int -> a
!Int
b)
| Int
a <- IntSet -> [Int]
IntSet.toList IntSet
l_a'
, Int
b <- IntSet -> [Int]
IntSet.toList IntSet
l_b
]
ys' :: (IntMap w, IntMap w)
ys' :: (IntMap w, IntMap w)
ys' = (forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey Int -> w -> w
f IntMap w
ysA, forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey Int -> w -> w
g IntMap w
ysB)
where
f :: Int -> w -> w
f Int
a w
val
| Int
a Int -> IntSet -> Bool
`IntSet.notMember` IntSet
l_a = w
val forall a. Num a => a -> a -> a
+ w
slack
| Bool
otherwise = w
val
g :: Int -> w -> w
g Int
b w
val
| Int
b Int -> IntSet -> Bool
`IntSet.notMember` IntSet
l_b = w
val forall a. Num a => a -> a -> a
- w
slack
| Bool
otherwise = w
val
g_eq' :: IntMap IntSet
g_eq' :: IntMap IntSet
g_eq' = forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey Int -> IntSet -> IntSet
f IntMap IntSet
g_eq
where
f :: Int -> IntSet -> IntSet
f Int
b IntSet
as3
| Int
b Int -> IntSet -> Bool
`IntSet.member` IntSet
l_b =
IntSet
as3 IntSet -> IntSet -> IntSet
`IntSet.union` (Int -> Bool) -> IntSet -> IntSet
IntSet.filter (\Int
a -> Int -> Int -> w
w Int
a Int
b forall a. Eq a => a -> a -> Bool
== (forall a b. (a, b) -> a
fst (IntMap w, IntMap w)
ys' forall a. IntMap a -> Int -> a
! Int
a forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> b
snd (IntMap w, IntMap w)
ys' forall a. IntMap a -> Int -> a
! Int
b)) IntSet
l_a'
| Bool
otherwise = IntSet
as3 IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
l_a
equalityGraph :: (IntMap w, IntMap w) -> IntMap IntSet
equalityGraph :: (IntMap w, IntMap w) -> IntMap IntSet
equalityGraph (IntMap w
ysA,IntMap w
ysB) =
forall a. (Int -> a) -> IntSet -> IntMap a
IntMap.fromSet (\Int
b -> (Int -> Bool) -> IntSet -> IntSet
IntSet.filter (\Int
a -> Int -> Int -> w
w Int
a Int
b forall a. Eq a => a -> a -> Bool
== IntMap w
ysAforall a. IntMap a -> Int -> a
!Int
a forall a. Num a => a -> a -> a
+ IntMap w
ysBforall a. IntMap a -> Int -> a
!Int
b) IntSet
as) IntSet
bs
maximumWeightPerfectMatching
:: forall w. (Real w)
=> IntSet
-> IntSet
-> [(Int,Int,w)]
-> Maybe (w, IntMap Int, (IntMap w, IntMap w))
maximumWeightPerfectMatching :: forall w.
Real w =>
IntSet
-> IntSet
-> [(Int, Int, w)]
-> Maybe (w, IntMap Int, (IntMap w, IntMap w))
maximumWeightPerfectMatching IntSet
as IntSet
bs [(Int, Int, w)]
es = do
(w
obj, IntMap Int
m, (IntMap w
ysA,IntMap w
ysB)) <- forall w.
Real w =>
IntSet
-> IntSet
-> [(Int, Int, w)]
-> Maybe (w, IntMap Int, (IntMap w, IntMap w))
minimumWeightPerfectMatching IntSet
as IntSet
bs [(Int
a,Int
b,-w
w) |(Int
a,Int
b,w
w) <- [(Int, Int, w)]
es]
forall (m :: * -> *) a. Monad m => a -> m a
return (- w
obj, IntMap Int
m, (forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map forall a. Num a => a -> a
negate IntMap w
ysA, forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map forall a. Num a => a -> a
negate IntMap w
ysB))
minimumWeightPerfectMatching
:: forall w. (Real w)
=> IntSet
-> IntSet
-> [(Int,Int,w)]
-> Maybe (w, IntMap Int, (IntMap w, IntMap w))
minimumWeightPerfectMatching :: forall w.
Real w =>
IntSet
-> IntSet
-> [(Int, Int, w)]
-> Maybe (w, IntMap Int, (IntMap w, IntMap w))
minimumWeightPerfectMatching IntSet
as IntSet
bs [(Int, Int, w)]
es
| Int
n forall a. Eq a => a -> a -> Bool
/= IntSet -> Int
IntSet.size IntSet
bs = forall a. Maybe a
Nothing
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any forall a. IntMap a -> Bool
IntMap.null IntMap (IntMap w)
e_b2a = forall a. Maybe a
Nothing
| Bool
otherwise = IntMap Int
-> (IntMap w, IntMap w)
-> IntMap IntSet
-> Maybe (w, IntMap Int, (IntMap w, IntMap w))
loop forall a. IntMap a
m0 (IntMap w, IntMap w)
ys0 ((IntMap w, IntMap w) -> IntMap IntSet
equalityGraph (IntMap w, IntMap w)
ys0)
where
n :: Int
n = IntSet -> Int
IntSet.size IntSet
as
e_b2a :: IntMap (IntMap w)
e_b2a :: IntMap (IntMap w)
e_b2a = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [(Int, a)] -> IntMap a
IntMap.fromList forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith forall a. [a] -> [a] -> [a]
(++) [(Int
b,[(Int
a,w
w)]) | (Int
a,Int
b,w
w) <- [(Int, Int, w)]
es]
forall a. IntMap a -> IntMap a -> IntMap a
`IntMap.union` forall a. (Int -> a) -> IntSet -> IntMap a
IntMap.fromSet (\Int
_ -> []) IntSet
bs
ys0 :: (IntMap w, IntMap w)
ys0 :: (IntMap w, IntMap w)
ys0 = ( forall a. (Int -> a) -> IntSet -> IntMap a
IntMap.fromSet (\Int
_ -> w
0) IntSet
as
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
F.minimum IntMap (IntMap w)
e_b2a
)
m0 :: IntMap a
m0 = forall a. IntMap a
IntMap.empty
loop
:: IntMap Int -> (IntMap w, IntMap w) -> IntMap IntSet
-> Maybe (w, IntMap Int, (IntMap w, IntMap w))
loop :: IntMap Int
-> (IntMap w, IntMap w)
-> IntMap IntSet
-> Maybe (w, IntMap Int, (IntMap w, IntMap w))
loop IntMap Int
m_pre ys :: (IntMap w, IntMap w)
ys@(IntMap w
ysA,IntMap w
ysB) IntMap IntSet
g_eq
| forall a. IntMap a -> Int
IntMap.size IntMap Int
m forall a. Eq a => a -> a -> Bool
== Int
n = forall a. a -> Maybe a
Just (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
F.sum IntMap w
ysA forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
F.sum IntMap w
ysB, IntMap Int
m, (IntMap w, IntMap w)
ys)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [w]
slacks = forall a. Maybe a
Nothing
| Bool
otherwise = IntMap Int
-> (IntMap w, IntMap w)
-> IntMap IntSet
-> Maybe (w, IntMap Int, (IntMap w, IntMap w))
loop IntMap Int
m (IntMap w, IntMap w)
ys' IntMap IntSet
g_eq'
where
(IntMap Int
m, IntSet
l_a, IntSet
l_b) = IntSet
-> (Int -> IntSet) -> IntMap Int -> (IntMap Int, IntSet, IntSet)
maximumCardinalityMatching' IntSet
bs (IntMap IntSet
g_eq forall a. IntMap a -> Int -> a
!) IntMap Int
m_pre
slacks :: [w]
slacks :: [w]
slacks = [w
w forall a. Num a => a -> a -> a
- (IntMap w
ysAforall a. IntMap a -> Int -> a
!Int
a forall a. Num a => a -> a -> a
+ IntMap w
ysBforall a. IntMap a -> Int -> a
!Int
b) | Int
b <- IntSet -> [Int]
IntSet.toList IntSet
l_b, (Int
a,w
w) <- forall a. IntMap a -> [(Int, a)]
IntMap.toList (IntMap (IntMap w)
e_b2a forall a. IntMap a -> Int -> a
! Int
b), Int
a Int -> IntSet -> Bool
`IntSet.notMember` IntSet
l_a]
slack :: w
slack :: w
slack = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [w]
slacks
ys' :: (IntMap w, IntMap w)
ys' :: (IntMap w, IntMap w)
ys' = (forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey Int -> w -> w
f IntMap w
ysA, forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey Int -> w -> w
g IntMap w
ysB)
where
f :: Int -> w -> w
f Int
a w
val
| Int
a Int -> IntSet -> Bool
`IntSet.notMember` IntSet
l_a = w
val forall a. Num a => a -> a -> a
+ w
slack
| Bool
otherwise = w
val
g :: Int -> w -> w
g Int
b w
val
| Int
b Int -> IntSet -> Bool
`IntSet.notMember` IntSet
l_b = w
val forall a. Num a => a -> a -> a
- w
slack
| Bool
otherwise = w
val
g_eq' :: IntMap IntSet
g_eq' :: IntMap IntSet
g_eq' = forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey Int -> IntSet -> IntSet
f IntMap IntSet
g_eq
where
f :: Int -> IntSet -> IntSet
f Int
b IntSet
as3
| Int
b Int -> IntSet -> Bool
`IntSet.member` IntSet
l_b =
IntSet
as3 IntSet -> IntSet -> IntSet
`IntSet.union` [Int] -> IntSet
IntSet.fromAscList [Int
a | (Int
a,w
w) <- forall a. IntMap a -> [(Int, a)]
IntMap.toAscList (IntMap (IntMap w)
e_b2a forall a. IntMap a -> Int -> a
! Int
b), Int
a Int -> IntSet -> Bool
`IntSet.notMember` IntSet
l_a, w
w forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> a
fst (IntMap w, IntMap w)
ys' forall a. IntMap a -> Int -> a
! Int
a forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> b
snd (IntMap w, IntMap w)
ys' forall a. IntMap a -> Int -> a
! Int
b]
| Bool
otherwise = IntSet
as3 IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
l_a
equalityGraph :: (IntMap w, IntMap w) -> IntMap IntSet
equalityGraph :: (IntMap w, IntMap w) -> IntMap IntSet
equalityGraph (IntMap w
ysA,IntMap w
ysB) = forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey Int -> IntMap w -> IntSet
f IntMap (IntMap w)
e_b2a
where
f :: Int -> IntMap w -> IntSet
f Int
b IntMap w
xs = [Int] -> IntSet
IntSet.fromAscList [Int
a | (Int
a,w
w) <- forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap w
xs, w
w forall a. Eq a => a -> a -> Bool
== IntMap w
ysAforall a. IntMap a -> Int -> a
!Int
a forall a. Num a => a -> a -> a
+ IntMap w
ysBforall a. IntMap a -> Int -> a
!Int
b]
minimumCardinalityEdgeCover
:: IntSet
-> IntSet
-> [(Int,Int)]
-> Maybe (Set (Int,Int))
minimumCardinalityEdgeCover :: IntSet -> IntSet -> [(Int, Int)] -> Maybe (Set (Int, Int))
minimumCardinalityEdgeCover IntSet
as IntSet
bs [(Int, Int)]
es
| forall a. IntMap a -> Int
IntMap.size IntMap Int
ca forall a. Eq a => a -> a -> Bool
/= IntSet -> Int
IntSet.size IntSet
as = forall a. Maybe a
Nothing
| forall a. IntMap a -> Int
IntMap.size IntMap Int
cb forall a. Eq a => a -> a -> Bool
/= IntSet -> Int
IntSet.size IntSet
bs = forall a. Maybe a
Nothing
| Bool
otherwise =
case IntSet -> IntSet -> [(Int, Int)] -> IntMap Int
maximumCardinalityMatching IntSet
as IntSet
bs [(Int, Int)]
es of
IntMap Int
m ->
let ma :: IntSet
ma = forall a. IntMap a -> IntSet
IntMap.keysSet IntMap Int
m
mb :: IntSet
mb = [Int] -> IntSet
IntSet.fromList forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [a]
IntMap.elems IntMap Int
m
m2 :: Set (Int, Int)
m2 = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
[ forall a. Ord a => [a] -> Set a
Set.fromList (forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap Int
m)
, forall a. Ord a => [a] -> Set a
Set.fromList [(Int
a,Int
b) | Int
a <- IntSet -> [Int]
IntSet.toList (IntSet
as IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
ma), let b :: Int
b = IntMap Int
ca forall a. IntMap a -> Int -> a
IntMap.! Int
a]
, forall a. Ord a => [a] -> Set a
Set.fromList [(Int
a,Int
b) | Int
b <- IntSet -> [Int]
IntSet.toList (IntSet
bs IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
mb), let a :: Int
a = IntMap Int
cb forall a. IntMap a -> Int -> a
IntMap.! Int
b]
]
in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Set (Int, Int)
m2
where
ca :: IntMap Int
ca = forall a. [(Int, a)] -> IntMap a
IntMap.fromList [(Int, Int)]
es
cb :: IntMap Int
cb = forall a. [(Int, a)] -> IntMap a
IntMap.fromList [(Int
b,Int
a) | (Int
a,Int
b) <- [(Int, Int)]
es]
minimumWeightEdgeCover
:: forall w. (Real w)
=> IntSet
-> IntSet
-> [(Int,Int,w)]
-> Maybe (Set (Int,Int))
minimumWeightEdgeCover :: forall w.
Real w =>
IntSet -> IntSet -> [(Int, Int, w)] -> Maybe (Set (Int, Int))
minimumWeightEdgeCover IntSet
as IntSet
bs [(Int, Int, w)]
es
| forall a. IntMap a -> Int
IntMap.size IntMap (Int, w)
ca forall a. Eq a => a -> a -> Bool
/= IntSet -> Int
IntSet.size IntSet
as = forall a. Maybe a
Nothing
| forall a. IntMap a -> Int
IntMap.size IntMap (Int, w)
cb forall a. Eq a => a -> a -> Bool
/= IntSet -> Int
IntSet.size IntSet
bs = forall a. Maybe a
Nothing
| Bool
otherwise =
case forall w.
Real w =>
IntSet -> IntSet -> [(Int, Int, w)] -> (w, IntMap Int)
maximumWeightMatching IntSet
as' IntSet
bs' [(Int, Int, w)]
es' of
(w
_, IntMap Int
m) ->
let ma :: IntSet
ma = forall a. IntMap a -> IntSet
IntMap.keysSet IntMap Int
m
mb :: IntSet
mb = [Int] -> IntSet
IntSet.fromList forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [a]
IntMap.elems IntMap Int
m
m2 :: Set (Int, Int)
m2 = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
[ forall a. Ord a => [a] -> Set a
Set.fromList (forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap Int
m)
, forall a. Ord a => [a] -> Set a
Set.fromList [(Int
a,Int
b) | Int
a <- IntSet -> [Int]
IntSet.toList (IntSet
as IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
ma), let (Int
b,w
_) = IntMap (Int, w)
ca forall a. IntMap a -> Int -> a
IntMap.! Int
a]
, forall a. Ord a => [a] -> Set a
Set.fromList [(Int
a,Int
b) | Int
b <- IntSet -> [Int]
IntSet.toList (IntSet
bs IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
mb), let (Int
a,w
_) = IntMap (Int, w)
cb forall a. IntMap a -> Int -> a
IntMap.! Int
b]
, forall a. Ord a => [a] -> Set a
Set.fromList [(Int
a,Int
b) | (Int
a,Int
b,w
w) <- [(Int, Int, w)]
es, w
w forall a. Ord a => a -> a -> Bool
< w
0]
]
in forall a. a -> Maybe a
Just Set (Int, Int)
m2
where
minOnSnd :: (a, a) -> (a, a) -> (a, a)
minOnSnd xw1 :: (a, a)
xw1@(a
_,a
w1) xw2 :: (a, a)
xw2@(a
_,a
w2) = if a
w1 forall a. Ord a => a -> a -> Bool
<= a
w2 then (a, a)
xw1 else (a, a)
xw2
ca :: IntMap (Int, w)
ca = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith forall {a} {a}. Ord a => (a, a) -> (a, a) -> (a, a)
minOnSnd [(Int
a,(Int
b,w
w)) | (Int
a,Int
b,w
w) <- [(Int, Int, w)]
es]
cb :: IntMap (Int, w)
cb = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith forall {a} {a}. Ord a => (a, a) -> (a, a) -> (a, a)
minOnSnd [(Int
b,(Int
a,w
w)) | (Int
a,Int
b,w
w) <- [(Int, Int, w)]
es]
as' :: IntSet
as' = [Int] -> IntSet
IntSet.fromAscList [Int
a | (Int
a,(Int
_,w
w)) <- forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap (Int, w)
ca, w
w forall a. Ord a => a -> a -> Bool
>= w
0]
bs' :: IntSet
bs' = [Int] -> IntSet
IntSet.fromAscList [Int
b | (Int
b,(Int
_,w
w)) <- forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap (Int, w)
cb, w
w forall a. Ord a => a -> a -> Bool
>= w
0]
es' :: [(Int, Int, w)]
es' = [(Int
a, Int
b, (forall a b. (a, b) -> b
snd (IntMap (Int, w)
ca forall a. IntMap a -> Int -> a
IntMap.! Int
a) forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> b
snd (IntMap (Int, w)
cb forall a. IntMap a -> Int -> a
IntMap.! Int
b)) forall a. Num a => a -> a -> a
- w
w) | (Int
a,Int
b,w
w) <- [(Int, Int, w)]
es, w
w forall a. Ord a => a -> a -> Bool
>= w
0]
minimumWeightEdgeCoverComplete
:: forall w. (Real w)
=> IntSet
-> IntSet
-> (Int -> Int -> w)
-> Maybe (Set (Int,Int))
minimumWeightEdgeCoverComplete :: forall w.
Real w =>
IntSet -> IntSet -> (Int -> Int -> w) -> Maybe (Set (Int, Int))
minimumWeightEdgeCoverComplete IntSet
as IntSet
bs Int -> Int -> w
w
| forall a. IntMap a -> Int
IntMap.size IntMap (Int, w)
ca forall a. Eq a => a -> a -> Bool
/= IntSet -> Int
IntSet.size IntSet
as = forall a. Maybe a
Nothing
| forall a. IntMap a -> Int
IntMap.size IntMap (Int, w)
cb forall a. Eq a => a -> a -> Bool
/= IntSet -> Int
IntSet.size IntSet
bs = forall a. Maybe a
Nothing
| Bool
otherwise =
case forall w.
Real w =>
IntSet -> IntSet -> [(Int, Int, w)] -> (w, IntMap Int)
maximumWeightMatching IntSet
as' IntSet
bs' [(Int, Int, w)]
es' of
(w
_, IntMap Int
m) ->
let ma :: IntSet
ma = forall a. IntMap a -> IntSet
IntMap.keysSet IntMap Int
m
mb :: IntSet
mb = [Int] -> IntSet
IntSet.fromList forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [a]
IntMap.elems IntMap Int
m
m2 :: Set (Int, Int)
m2 = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
[ forall a. Ord a => [a] -> Set a
Set.fromList (forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap Int
m)
, forall a. Ord a => [a] -> Set a
Set.fromList [(Int
a,Int
b) | Int
a <- IntSet -> [Int]
IntSet.toList (IntSet
as IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
ma), let (Int
b,w
_) = IntMap (Int, w)
ca forall a. IntMap a -> Int -> a
IntMap.! Int
a]
, forall a. Ord a => [a] -> Set a
Set.fromList [(Int
a,Int
b) | Int
b <- IntSet -> [Int]
IntSet.toList (IntSet
bs IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
mb), let (Int
a,w
_) = IntMap (Int, w)
cb forall a. IntMap a -> Int -> a
IntMap.! Int
b]
, forall a. Ord a => [a] -> Set a
Set.fromList [(Int
a,Int
b) | Int
a <- IntSet -> [Int]
IntSet.toList IntSet
as, Int
b <- IntSet -> [Int]
IntSet.toList IntSet
bs, let w' :: w
w' = Int -> Int -> w
w Int
a Int
b, w
w' forall a. Ord a => a -> a -> Bool
< w
0]
]
in forall a. a -> Maybe a
Just Set (Int, Int)
m2
where
minOnSnd :: (a, a) -> (a, a) -> (a, a)
minOnSnd xw1 :: (a, a)
xw1@(a
_,a
w1) xw2 :: (a, a)
xw2@(a
_,a
w2) = if a
w1 forall a. Ord a => a -> a -> Bool
<= a
w2 then (a, a)
xw1 else (a, a)
xw2
ca :: IntMap (Int, w)
ca = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith forall {a} {a}. Ord a => (a, a) -> (a, a) -> (a, a)
minOnSnd [(Int
a, (Int
b, Int -> Int -> w
w Int
a Int
b)) | Int
a <- IntSet -> [Int]
IntSet.toList IntSet
as, Int
b <- IntSet -> [Int]
IntSet.toList IntSet
bs]
cb :: IntMap (Int, w)
cb = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith forall {a} {a}. Ord a => (a, a) -> (a, a) -> (a, a)
minOnSnd [(Int
b, (Int
a, Int -> Int -> w
w Int
a Int
b)) | Int
a <- IntSet -> [Int]
IntSet.toList IntSet
as, Int
b <- IntSet -> [Int]
IntSet.toList IntSet
bs]
as' :: IntSet
as' = [Int] -> IntSet
IntSet.fromAscList [Int
a | (Int
a,(Int
_,w
w)) <- forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap (Int, w)
ca, w
w forall a. Ord a => a -> a -> Bool
>= w
0]
bs' :: IntSet
bs' = [Int] -> IntSet
IntSet.fromAscList [Int
b | (Int
b,(Int
_,w
w)) <- forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap (Int, w)
cb, w
w forall a. Ord a => a -> a -> Bool
>= w
0]
es' :: [(Int, Int, w)]
es' = [ (Int
a, Int
b, (forall a b. (a, b) -> b
snd (IntMap (Int, w)
ca forall a. IntMap a -> Int -> a
IntMap.! Int
a) forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> b
snd (IntMap (Int, w)
cb forall a. IntMap a -> Int -> a
IntMap.! Int
b)) forall a. Num a => a -> a -> a
- w
w')
| Int
a <- IntSet -> [Int]
IntSet.toList IntSet
as, Int
b <- IntSet -> [Int]
IntSet.toList IntSet
bs, let w' :: w
w' = Int -> Int -> w
w Int
a Int
b, w
w' forall a. Ord a => a -> a -> Bool
>= w
0 ]