{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Combinatorial.SubsetSum
-- Copyright   :  (c) Masahiro Sakai 2015
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-- References
--
-- * D. Pisinger, "An exact algorithm for large multiple knapsack problems,"
--   European Journal of Operational Research, vol. 114, no. 3, pp. 528-541,
--   May 1999. DOI:10.1016/s0377-2217(98)00120-9
--   <http://www.sciencedirect.com/science/article/pii/S0377221798001209>
--   <http://www.diku.dk/~pisinger/95-6.ps>
--
-----------------------------------------------------------------------------
module ToySolver.Combinatorial.SubsetSum
  ( Weight
  , subsetSum
  , maxSubsetSum
  , minSubsetSum
  ) where

import Control.Exception (assert)
import Control.Monad
import Control.Monad.ST
import Data.STRef
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Vector.Generic ((!))
import qualified Data.Vector as V
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VM
import qualified Data.Vector.Unboxed as VU

type Weight = Integer

-- | Maximize Σ_{i=1}^n wi xi subject to Σ_{i=1}^n wi xi ≤ c and xi ∈ {0,1}.
--
-- Note: 0 (resp. 1) is identified with False (resp. True) in the assignment.
maxSubsetSum
  :: VG.Vector v Weight
  => v Weight -- ^ weights @[w1, w2 .. wn]@
  -> Weight -- ^ capacity @c@
  -> Maybe (Weight, VU.Vector Bool)
  -- ^
  -- * the objective value Σ_{i=1}^n wi xi, and
  --
  -- * the assignment @[x1, x2 .. xn]@, identifying 0 (resp. 1) with @False@ (resp. @True@).
maxSubsetSum :: forall (v :: * -> *).
Vector v Integer =>
v Integer -> Integer -> Maybe (Integer, Vector Bool)
maxSubsetSum v Integer
w Integer
c =
  case forall (v :: * -> *).
Vector v Integer =>
(v Integer, Integer)
-> (Vector Integer, Integer,
    (Integer, Vector Bool) -> (Integer, Vector Bool))
normalizeWeightsToPositive (v Integer
w,Integer
c) of
    (Vector Integer
w1, Integer
c1, (Integer, Vector Bool) -> (Integer, Vector Bool)
trans1)
      | Integer
c1 forall a. Ord a => a -> a -> Bool
< Integer
0 -> forall a. Maybe a
Nothing
      | Bool
otherwise ->
          case (Vector Integer, Integer)
-> (Vector Integer, Integer,
    (Integer, Vector Bool) -> (Integer, Vector Bool))
normalize2 (Vector Integer
w1, Integer
c1) of
            (Vector Integer
w2, Integer
c2, (Integer, Vector Bool) -> (Integer, Vector Bool)
trans2) ->
              case (Vector Integer, Integer)
-> (Vector Integer, Integer,
    (Integer, Vector Bool) -> (Integer, Vector Bool))
normalizeGCDLe (Vector Integer
w2, Integer
c2) of
                (Vector Integer
w3, Integer
c3, (Integer, Vector Bool) -> (Integer, Vector Bool)
trans3) ->
                  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Integer, Vector Bool) -> (Integer, Vector Bool)
trans1 forall a b. (a -> b) -> a -> b
$ (Integer, Vector Bool) -> (Integer, Vector Bool)
trans2 forall a b. (a -> b) -> a -> b
$ (Integer, Vector Bool) -> (Integer, Vector Bool)
trans3 forall a b. (a -> b) -> a -> b
$ Vector Integer -> Integer -> (Integer, Vector Bool)
maxSubsetSum' Vector Integer
w3 Integer
c3

normalizeWeightsToPositive
  :: VG.Vector v Weight
  => (v Weight, Weight)
  -> (V.Vector Weight, Weight, (Weight, VU.Vector Bool) -> (Weight, VU.Vector Bool))
normalizeWeightsToPositive :: forall (v :: * -> *).
Vector v Integer =>
(v Integer, Integer)
-> (Vector Integer, Integer,
    (Integer, Vector Bool) -> (Integer, Vector Bool))
normalizeWeightsToPositive (v Integer
w,Integer
c)
  | forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Bool
VG.all (forall a. Ord a => a -> a -> Bool
>=Integer
0) v Integer
w = (forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
VG.convert v Integer
w, Integer
c, forall a. a -> a
id)
  | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
      MVector (PrimState (ST s)) Integer
w2 <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
VM.new (forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length v Integer
w)
      let loop :: Int -> Integer -> ST s Integer
loop !Int
i !Integer
offset
            | Int
i forall a. Ord a => a -> a -> Bool
>= forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length v Integer
w = forall (m :: * -> *) a. Monad m => a -> m a
return Integer
offset
            | Bool
otherwise = do
                let wi :: Integer
wi = v Integer
w forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
i
                if Integer
wi forall a. Ord a => a -> a -> Bool
< Integer
0 then do
                  forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) Integer
w2 Int
i (- Integer
wi)
                  Int -> Integer -> ST s Integer
loop (Int
iforall a. Num a => a -> a -> a
+Int
1) (Integer
offset forall a. Num a => a -> a -> a
+ Integer
wi)
                else do
                  forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) Integer
w2 Int
i Integer
wi
                  Int -> Integer -> ST s Integer
loop (Int
iforall a. Num a => a -> a -> a
+Int
1) Integer
offset
      Integer
offset <- Int -> Integer -> ST s Integer
loop Int
0 (Integer
0::Integer)
      Vector Integer
w2' <- forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze MVector (PrimState (ST s)) Integer
w2
      let trans :: (Integer, Vector Bool) -> (Integer, Vector Bool)
trans (Integer
obj, Vector Bool
bs) = (Integer
obj forall a. Num a => a -> a -> a
+ Integer
offset, Vector Bool
bs2)
            where
              bs2 :: Vector Bool
bs2 = forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap (\Int
i Bool
bi -> if v Integer
w forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
i forall a. Ord a => a -> a -> Bool
< Integer
0 then Bool -> Bool
not Bool
bi else Bool
bi) Vector Bool
bs
      forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Integer
w2', Integer
c forall a. Num a => a -> a -> a
- Integer
offset, (Integer, Vector Bool) -> (Integer, Vector Bool)
trans)

normalize2
  :: (V.Vector Weight, Weight)
  -> (V.Vector Weight, Weight, (Weight, VU.Vector Bool) -> (Weight, VU.Vector Bool))
normalize2 :: (Vector Integer, Integer)
-> (Vector Integer, Integer,
    (Integer, Vector Bool) -> (Integer, Vector Bool))
normalize2 (Vector Integer
w,Integer
c)
  | forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Bool
VG.all (\Integer
wi -> Integer
0forall a. Ord a => a -> a -> Bool
<Integer
wi Bool -> Bool -> Bool
&& Integer
wiforall a. Ord a => a -> a -> Bool
<=Integer
c) Vector Integer
w = (Vector Integer
w, Integer
c, forall a. a -> a
id)
  | Bool
otherwise = (forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> v a
VG.filter (\Integer
wi -> Integer
0forall a. Ord a => a -> a -> Bool
<Integer
wi Bool -> Bool -> Bool
&& Integer
wiforall a. Ord a => a -> a -> Bool
<=Integer
c) Vector Integer
w, Integer
c, forall {v :: * -> *} {a}.
Vector v Bool =>
(a, v Bool) -> (a, Vector Bool)
trans)
  where
    trans :: (a, v Bool) -> (a, Vector Bool)
trans (a
obj, v Bool
bs) = (a
obj, Vector Bool
bs2)
      where
        bs2 :: Vector Bool
bs2 = forall a. Unbox a => (forall s. ST s (MVector s a)) -> Vector a
VU.create forall a b. (a -> b) -> a -> b
$ do
          MVector (PrimState (ST s)) Bool
v <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
VM.new (forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector Integer
w)
          let loop :: Int -> Int -> ST s ()
loop !Int
i !Int
j =
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector Integer
w) forall a b. (a -> b) -> a -> b
$ do
                  let wi :: Integer
wi = Vector Integer
w forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
i
                  if Integer
0 forall a. Ord a => a -> a -> Bool
< Integer
wi Bool -> Bool -> Bool
&& Integer
wi forall a. Ord a => a -> a -> Bool
<= Integer
c then do
                    forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) Bool
v Int
i (v Bool
bs forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
j)
                    Int -> Int -> ST s ()
loop (Int
iforall a. Num a => a -> a -> a
+Int
1) (Int
jforall a. Num a => a -> a -> a
+Int
1)
                  else do
                    forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) Bool
v Int
i Bool
False
                    Int -> Int -> ST s ()
loop (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j
          Int -> Int -> ST s ()
loop Int
0 Int
0
          forall (m :: * -> *) a. Monad m => a -> m a
return MVector (PrimState (ST s)) Bool
v

normalizeGCDLe
  :: (V.Vector Weight, Weight)
  -> (V.Vector Weight, Weight, (Weight, VU.Vector Bool) -> (Weight, VU.Vector Bool))
normalizeGCDLe :: (Vector Integer, Integer)
-> (Vector Integer, Integer,
    (Integer, Vector Bool) -> (Integer, Vector Bool))
normalizeGCDLe (Vector Integer
w,Integer
c)
  | forall (v :: * -> *) a. Vector v a => v a -> Bool
VG.null Vector Integer
w Bool -> Bool -> Bool
|| Integer
d forall a. Eq a => a -> a -> Bool
== Integer
1 = (Vector Integer
w, Integer
c, forall a. a -> a
id)
  | Bool
otherwise = (forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map (forall a. Integral a => a -> a -> a
`div` Integer
d) Vector Integer
w, Integer
c forall a. Integral a => a -> a -> a
`div` Integer
d, forall {b}. (Integer, b) -> (Integer, b)
trans)
  where
    d :: Integer
d = forall (v :: * -> *) a. Vector v a => (a -> a -> a) -> v a -> a
VG.foldl1' forall a. Integral a => a -> a -> a
gcd Vector Integer
w
    trans :: (Integer, b) -> (Integer, b)
trans (Integer
obj, b
bs) = (Integer
obj forall a. Num a => a -> a -> a
* Integer
d, b
bs)

normalizeGCDEq
  :: (V.Vector Weight, Weight)
  -> Maybe (V.Vector Weight, Weight, (Weight, VU.Vector Bool) -> (Weight, VU.Vector Bool))
normalizeGCDEq :: (Vector Integer, Integer)
-> Maybe
     (Vector Integer, Integer,
      (Integer, Vector Bool) -> (Integer, Vector Bool))
normalizeGCDEq (Vector Integer
w,Integer
c)
  | forall (v :: * -> *) a. Vector v a => v a -> Bool
VG.null Vector Integer
w Bool -> Bool -> Bool
|| Integer
d forall a. Eq a => a -> a -> Bool
== Integer
1 = forall a. a -> Maybe a
Just (Vector Integer
w, Integer
c, forall a. a -> a
id)
  | Integer
c forall a. Integral a => a -> a -> a
`mod` Integer
d forall a. Eq a => a -> a -> Bool
== Integer
0 = forall a. a -> Maybe a
Just (forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map (forall a. Integral a => a -> a -> a
`div` Integer
d) Vector Integer
w, Integer
c forall a. Integral a => a -> a -> a
`div` Integer
d, forall {b}. (Integer, b) -> (Integer, b)
trans)
  | Bool
otherwise = forall a. Maybe a
Nothing
  where
    d :: Integer
d = forall (v :: * -> *) a. Vector v a => (a -> a -> a) -> v a -> a
VG.foldl1' forall a. Integral a => a -> a -> a
gcd Vector Integer
w
    trans :: (Integer, b) -> (Integer, b)
trans (Integer
obj, b
bs) = (Integer
obj forall a. Num a => a -> a -> a
* Integer
d, b
bs)

maxSubsetSum' :: V.Vector Weight -> Weight -> (Weight, VU.Vector Bool)
maxSubsetSum' :: Vector Integer -> Integer -> (Integer, Vector Bool)
maxSubsetSum' !Vector Integer
w !Integer
c
  | Integer
wsum forall a. Ord a => a -> a -> Bool
<= Integer
c = (Integer
wsum, forall (v :: * -> *) a. Vector v a => Int -> a -> v a
VG.replicate (forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector Integer
w) Bool
True)
  | Integer
c forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int) =
      Vector Int -> Int -> Integer -> (Integer, Vector Bool)
maxSubsetSumInt' (forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
VG.generate (forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector Integer
w) (\Int
i -> forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Integer
w forall (v :: * -> *) a. Vector v a => v a -> Int -> a
VG.! Int
i))) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c) Integer
wsum
  | Bool
otherwise =
      Vector Integer -> Integer -> Integer -> (Integer, Vector Bool)
maxSubsetSumInteger' Vector Integer
w Integer
c Integer
wsum
  where
    wsum :: Integer
wsum = forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
VG.sum Vector Integer
w

maxSubsetSumInteger' :: V.Vector Weight -> Weight -> Weight -> (Weight, VU.Vector Bool)
maxSubsetSumInteger' :: Vector Integer -> Integer -> Integer -> (Integer, Vector Bool)
maxSubsetSumInteger' Vector Integer
w !Integer
c Integer
wsum = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Integer
wbar forall a. Ord a => a -> a -> Bool
<= Integer
c) forall a b. (a -> b) -> a -> b
$ forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Integer
wbar forall a. Num a => a -> a -> a
+ (Vector Integer
w forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
b) forall a. Ord a => a -> a -> Bool
> Integer
c) forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  STRef s (Integer, [Int], [Int])
objRef <- forall a s. a -> ST s (STRef s a)
newSTRef (Integer
wbar, [], [])
  let updateObj :: Map Integer [Int] -> Map Integer [Int] -> ST s ()
updateObj Map Integer [Int]
gs Map Integer [Int]
ft = do
        let loop :: [(Integer, [Int])] -> [(Integer, [Int])] -> ST s ()
loop [] [(Integer, [Int])]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
            loop [(Integer, [Int])]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
            loop xxs :: [(Integer, [Int])]
xxs@((Integer
gobj,[Int]
gsol):[(Integer, [Int])]
xs) yys :: [(Integer, [Int])]
yys@((Integer
fobj,[Int]
fsol):[(Integer, [Int])]
ys)
              | Integer
c forall a. Ord a => a -> a -> Bool
< Integer
gobj forall a. Num a => a -> a -> a
+ Integer
fobj = [(Integer, [Int])] -> [(Integer, [Int])] -> ST s ()
loop [(Integer, [Int])]
xs [(Integer, [Int])]
yys
              | Bool
otherwise = do
                  (Integer
curr, [Int]
_, [Int]
_) <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Integer, [Int], [Int])
objRef
                  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
curr forall a. Ord a => a -> a -> Bool
< Integer
gobj forall a. Num a => a -> a -> a
+ Integer
fobj) forall a b. (a -> b) -> a -> b
$ forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Integer, [Int], [Int])
objRef (Integer
gobj forall a. Num a => a -> a -> a
+ Integer
fobj, [Int]
gsol, [Int]
fsol)
                  [(Integer, [Int])] -> [(Integer, [Int])] -> ST s ()
loop [(Integer, [Int])]
xxs [(Integer, [Int])]
ys
        [(Integer, [Int])] -> [(Integer, [Int])] -> ST s ()
loop (forall k a. Map k a -> [(k, a)]
Map.toDescList Map Integer [Int]
gs) (forall k a. Map k a -> [(k, a)]
Map.toAscList Map Integer [Int]
ft)

  let loop :: Int
-> Int
-> Map Integer [Int]
-> Map Integer [Int]
-> Bool
-> ST s (Integer, v Bool)
loop !Int
s !Int
t !Map Integer [Int]
gs !Map Integer [Int]
ft !Bool
flag = do
        (Integer
obj, [Int]
gsol, [Int]
fsol) <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Integer, [Int], [Int])
objRef
        if Integer
obj forall a. Eq a => a -> a -> Bool
== Integer
c Bool -> Bool -> Bool
|| (Int
s forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
t forall a. Eq a => a -> a -> Bool
== Int
nforall a. Num a => a -> a -> a
-Int
1) then do
          let sol :: v Bool
sol = forall (v :: * -> *) a.
Vector v a =>
(forall s. ST s (Mutable v s a)) -> v a
VG.create forall a b. (a -> b) -> a -> b
$ do
                Mutable v s Bool
bs <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
VM.new Int
n
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
bforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i -> forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write Mutable v s Bool
bs Int
i Bool
True
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
b..Int
nforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i -> forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write Mutable v s Bool
bs Int
i Bool
False
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
fsol forall a b. (a -> b) -> a -> b
$ \Int
i -> forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write Mutable v s Bool
bs Int
i Bool
True
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
gsol forall a b. (a -> b) -> a -> b
$ \Int
i -> forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write Mutable v s Bool
bs Int
i Bool
False
                forall (m :: * -> *) a. Monad m => a -> m a
return Mutable v s Bool
bs
          forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
obj, v Bool
sol)
        else do
          let updateF :: ST s (Integer, v Bool)
updateF = do
                -- Compute f_{t+1} from f_t
                let t' :: Int
t' = Int
t forall a. Num a => a -> a -> a
+ Int
1
                    wt' :: Integer
wt' = Vector Integer
w forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
t'
                    m :: Map Integer [Int]
m = forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic (forall a. Num a => a -> a -> a
+ Integer
wt') forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Int
t' forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => k -> Map k v -> Map k v
splitLE (Integer
c forall a. Num a => a -> a -> a
- Integer
wt') Map Integer [Int]
ft
                    ft' :: Map Integer [Int]
ft' = Map Integer [Int]
ft forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map Integer [Int]
m
                Map Integer [Int] -> Map Integer [Int] -> ST s ()
updateObj Map Integer [Int]
gs Map Integer [Int]
m
                Int
-> Int
-> Map Integer [Int]
-> Map Integer [Int]
-> Bool
-> ST s (Integer, v Bool)
loop Int
s Int
t' Map Integer [Int]
gs Map Integer [Int]
ft' (Bool -> Bool
not Bool
flag)
              updateG :: ST s (Integer, v Bool)
updateG = do
                -- Compute g_{s-1} from g_s
                let s' :: Int
s' = Int
s forall a. Num a => a -> a -> a
- Int
1
                    ws :: Integer
ws = Vector Integer
w forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
s'
                    m :: Map Integer [Int]
m = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Int
s' forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ Map Integer [Int] -> Map Integer [Int]
g_drop forall a b. (a -> b) -> a -> b
$ forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic (forall a. Num a => a -> a -> a
subtract Integer
ws) forall a b. (a -> b) -> a -> b
$ Map Integer [Int]
gs
                    gs' :: Map Integer [Int]
gs' = Map Integer [Int]
gs forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map Integer [Int]
m
                Map Integer [Int] -> Map Integer [Int] -> ST s ()
updateObj Map Integer [Int]
m Map Integer [Int]
ft
                Int
-> Int
-> Map Integer [Int]
-> Map Integer [Int]
-> Bool
-> ST s (Integer, v Bool)
loop Int
s' Int
t Map Integer [Int]
gs' Map Integer [Int]
ft (Bool -> Bool
not Bool
flag)
          if Int
s forall a. Eq a => a -> a -> Bool
== Int
0 then
            ST s (Integer, v Bool)
updateF
          else if Int
t forall a. Eq a => a -> a -> Bool
== Int
nforall a. Num a => a -> a -> a
-Int
1 then
            ST s (Integer, v Bool)
updateG
          else
            if Bool
flag then ST s (Integer, v Bool)
updateG else ST s (Integer, v Bool)
updateF

  let -- f_{b-1}
      fb' :: Map Integer [Int]
      fb' :: Map Integer [Int]
fb' = forall k a. k -> a -> Map k a
Map.singleton Integer
0 []
      -- g_{b}
      gb :: Map Integer [Int]
      gb :: Map Integer [Int]
gb = forall k a. k -> a -> Map k a
Map.singleton Integer
wbar []
  forall {v :: * -> *}.
Vector v Bool =>
Int
-> Int
-> Map Integer [Int]
-> Map Integer [Int]
-> Bool
-> ST s (Integer, v Bool)
loop Int
b (Int
bforall a. Num a => a -> a -> a
-Int
1) Map Integer [Int]
gb Map Integer [Int]
fb' Bool
True

  where
    n :: Int
n = forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector Integer
w

    b :: Int
    b :: Int
b = Int -> Integer -> Int
loop (-Int
1) Integer
0
      where
        loop :: Int -> Integer -> Int
        loop :: Int -> Integer -> Int
loop !Int
i !Integer
s
          | Integer
s forall a. Ord a => a -> a -> Bool
> Integer
c = Int
i
          | Bool
otherwise = Int -> Integer -> Int
loop (Int
iforall a. Num a => a -> a -> a
+Int
1) (Integer
s forall a. Num a => a -> a -> a
+ (Vector Integer
w forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! (Int
iforall a. Num a => a -> a -> a
+Int
1)))

    wbar :: Weight
    wbar :: Integer
wbar = forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
VG.sum forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
VG.slice Int
0 Int
b Vector Integer
w

    max_f :: Weight
    max_f :: Integer
max_f = Integer
wsum forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
wbar

    min_g :: Weight
    min_g :: Integer
min_g = Integer
0 forall a. Ord a => a -> a -> a
`max` (Integer
c forall a. Num a => a -> a -> a
- Integer
max_f)

    g_drop :: Map Integer [Int] -> Map Integer [Int]
    g_drop :: Map Integer [Int] -> Map Integer [Int]
g_drop Map Integer [Int]
g =
      case forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
Map.splitLookup Integer
min_g Map Integer [Int]
g of
        (Map Integer [Int]
lo, Maybe [Int]
_, Map Integer [Int]
_) | forall k a. Map k a -> Bool
Map.null Map Integer [Int]
lo -> Map Integer [Int]
g
        (Map Integer [Int]
_, Just [Int]
v, Map Integer [Int]
hi) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Integer
min_g [Int]
v Map Integer [Int]
hi
        (Map Integer [Int]
lo, Maybe [Int]
Nothing, Map Integer [Int]
hi) ->
          case forall k a. Map k a -> (k, a)
Map.findMax Map Integer [Int]
lo of
            (Integer
k,[Int]
v) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Integer
k [Int]
v Map Integer [Int]
hi

    splitLE :: Ord k => k -> Map k v -> Map k v
    splitLE :: forall k v. Ord k => k -> Map k v -> Map k v
splitLE k
k Map k v
m =
      case forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
Map.splitLookup k
k Map k v
m of
        (Map k v
lo, Maybe v
Nothing, Map k v
_) -> Map k v
lo
        (Map k v
lo, Just v
v, Map k v
_) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k v
v Map k v
lo

maxSubsetSumInt' :: VU.Vector Int -> Int -> Weight -> (Weight, VU.Vector Bool)
maxSubsetSumInt' :: Vector Int -> Int -> Integer -> (Integer, Vector Bool)
maxSubsetSumInt' Vector Int
w !Int
c Integer
wsum = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
wbar forall a. Ord a => a -> a -> Bool
<= Int
c) forall a b. (a -> b) -> a -> b
$ forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
wbar forall a. Num a => a -> a -> a
+ (Vector Int
w forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
b) forall a. Ord a => a -> a -> Bool
> Int
c) forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  STRef s (Int, [Int], [Int])
objRef <- forall a s. a -> ST s (STRef s a)
newSTRef (Int
wbar, [], [])
  let updateObj :: IntMap [Int] -> IntMap [Int] -> ST s ()
updateObj IntMap [Int]
gs IntMap [Int]
ft = do
        let loop :: [(Int, [Int])] -> [(Int, [Int])] -> ST s ()
loop [] [(Int, [Int])]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
            loop [(Int, [Int])]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
            loop xxs :: [(Int, [Int])]
xxs@((Int
gobj,[Int]
gsol):[(Int, [Int])]
xs) yys :: [(Int, [Int])]
yys@((Int
fobj,[Int]
fsol):[(Int, [Int])]
ys)
              | Int
c forall a. Ord a => a -> a -> Bool
< Int
gobj forall a. Num a => a -> a -> a
+ Int
fobj = [(Int, [Int])] -> [(Int, [Int])] -> ST s ()
loop [(Int, [Int])]
xs [(Int, [Int])]
yys
              | Bool
otherwise = do
                  (Int
curr, [Int]
_, [Int]
_) <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Int, [Int], [Int])
objRef
                  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
curr forall a. Ord a => a -> a -> Bool
< Int
gobj forall a. Num a => a -> a -> a
+ Int
fobj) forall a b. (a -> b) -> a -> b
$ forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Int, [Int], [Int])
objRef (Int
gobj forall a. Num a => a -> a -> a
+ Int
fobj, [Int]
gsol, [Int]
fsol)
                  [(Int, [Int])] -> [(Int, [Int])] -> ST s ()
loop [(Int, [Int])]
xxs [(Int, [Int])]
ys
        [(Int, [Int])] -> [(Int, [Int])] -> ST s ()
loop (forall a. IntMap a -> [(Int, a)]
IntMap.toDescList IntMap [Int]
gs) (forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap [Int]
ft)

  let loop :: Int
-> Int -> IntMap [Int] -> IntMap [Int] -> Bool -> ST s (a, v Bool)
loop !Int
s !Int
t !IntMap [Int]
gs !IntMap [Int]
ft !Bool
flag = do
        (Int
obj, [Int]
gsol, [Int]
fsol) <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Int, [Int], [Int])
objRef
        if Int
obj forall a. Eq a => a -> a -> Bool
== Int
c Bool -> Bool -> Bool
|| (Int
s forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
t forall a. Eq a => a -> a -> Bool
== Int
nforall a. Num a => a -> a -> a
-Int
1) then do
          let sol :: v Bool
sol = forall (v :: * -> *) a.
Vector v a =>
(forall s. ST s (Mutable v s a)) -> v a
VG.create forall a b. (a -> b) -> a -> b
$ do
                Mutable v s Bool
bs <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
VM.new Int
n
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
bforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i -> forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write Mutable v s Bool
bs Int
i Bool
True
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
b..Int
nforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i -> forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write Mutable v s Bool
bs Int
i Bool
False
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
fsol forall a b. (a -> b) -> a -> b
$ \Int
i -> forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write Mutable v s Bool
bs Int
i Bool
True
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
gsol forall a b. (a -> b) -> a -> b
$ \Int
i -> forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write Mutable v s Bool
bs Int
i Bool
False
                forall (m :: * -> *) a. Monad m => a -> m a
return Mutable v s Bool
bs
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
obj, v Bool
sol)
        else do
          let updateF :: ST s (a, v Bool)
updateF = do
                -- Compute f_{t+1} from f_t
                let t' :: Int
t' = Int
t forall a. Num a => a -> a -> a
+ Int
1
                    wt' :: Int
wt' = Vector Int
w forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
t'
                    m :: IntMap [Int]
m = forall a. (Int -> Int) -> IntMap a -> IntMap a
IntMap.mapKeysMonotonic (forall a. Num a => a -> a -> a
+ Int
wt') forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map (Int
t' forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall v. Int -> IntMap v -> IntMap v
splitLE (Int
c forall a. Num a => a -> a -> a
- Int
wt') IntMap [Int]
ft
                    ft' :: IntMap [Int]
ft' = IntMap [Int]
ft forall a. IntMap a -> IntMap a -> IntMap a
`IntMap.union` IntMap [Int]
m
                IntMap [Int] -> IntMap [Int] -> ST s ()
updateObj IntMap [Int]
gs IntMap [Int]
m
                Int
-> Int -> IntMap [Int] -> IntMap [Int] -> Bool -> ST s (a, v Bool)
loop Int
s Int
t' IntMap [Int]
gs IntMap [Int]
ft' (Bool -> Bool
not Bool
flag)
              updateG :: ST s (a, v Bool)
updateG = do
                -- Compute g_{s-1} from g_s
                let s' :: Int
s' = Int
s forall a. Num a => a -> a -> a
- Int
1
                    ws :: Int
ws = Vector Int
w forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
s'
                    m :: IntMap [Int]
m = forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map (Int
s' forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ IntMap [Int] -> IntMap [Int]
g_drop forall a b. (a -> b) -> a -> b
$ forall a. (Int -> Int) -> IntMap a -> IntMap a
IntMap.mapKeysMonotonic (forall a. Num a => a -> a -> a
subtract Int
ws) forall a b. (a -> b) -> a -> b
$ IntMap [Int]
gs
                    gs' :: IntMap [Int]
gs' = IntMap [Int]
gs forall a. IntMap a -> IntMap a -> IntMap a
`IntMap.union` IntMap [Int]
m
                IntMap [Int] -> IntMap [Int] -> ST s ()
updateObj IntMap [Int]
m IntMap [Int]
ft
                Int
-> Int -> IntMap [Int] -> IntMap [Int] -> Bool -> ST s (a, v Bool)
loop Int
s' Int
t IntMap [Int]
gs' IntMap [Int]
ft (Bool -> Bool
not Bool
flag)
          if Int
s forall a. Eq a => a -> a -> Bool
== Int
0 then
            ST s (a, v Bool)
updateF
          else if Int
t forall a. Eq a => a -> a -> Bool
== Int
nforall a. Num a => a -> a -> a
-Int
1 then
            ST s (a, v Bool)
updateG
          else
            if Bool
flag then ST s (a, v Bool)
updateG else ST s (a, v Bool)
updateF

  let -- f_{b-1}
      fb' :: IntMap [Int]
      fb' :: IntMap [Int]
fb' = forall a. Int -> a -> IntMap a
IntMap.singleton Int
0 []
      -- g_{b}
      gb :: IntMap [Int]
      gb :: IntMap [Int]
gb = forall a. Int -> a -> IntMap a
IntMap.singleton Int
wbar []
  forall {a} {v :: * -> *}.
(Num a, Vector v Bool) =>
Int
-> Int -> IntMap [Int] -> IntMap [Int] -> Bool -> ST s (a, v Bool)
loop Int
b (Int
bforall a. Num a => a -> a -> a
-Int
1) IntMap [Int]
gb IntMap [Int]
fb' Bool
True

  where
    n :: Int
n = forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector Int
w

    b :: Int
    b :: Int
b = Int -> Integer -> Int
loop (-Int
1) Integer
0
      where
        loop :: Int -> Integer -> Int
        loop :: Int -> Integer -> Int
loop !Int
i !Integer
s
          | Integer
s forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c = Int
i
          | Bool
otherwise = Int -> Integer -> Int
loop (Int
iforall a. Num a => a -> a -> a
+Int
1) (Integer
s forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Int
w forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! (Int
iforall a. Num a => a -> a -> a
+Int
1)))

    wbar :: Int
    wbar :: Int
wbar = forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
VG.sum forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
VG.slice Int
0 Int
b Vector Int
w

    max_f :: Integer
    max_f :: Integer
max_f = Integer
wsum forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wbar

    min_g :: Int
    min_g :: Int
min_g = if Integer
max_f forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c then Int
c forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
max_f else Int
0

    g_drop :: IntMap [Int] -> IntMap [Int]
    g_drop :: IntMap [Int] -> IntMap [Int]
g_drop IntMap [Int]
g =
      case forall a. Int -> IntMap a -> (IntMap a, Maybe a, IntMap a)
IntMap.splitLookup Int
min_g IntMap [Int]
g of
        (IntMap [Int]
lo, Maybe [Int]
_, IntMap [Int]
_) | forall a. IntMap a -> Bool
IntMap.null IntMap [Int]
lo -> IntMap [Int]
g
        (IntMap [Int]
_, Just [Int]
v, IntMap [Int]
hi) -> forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
min_g [Int]
v IntMap [Int]
hi
        (IntMap [Int]
lo, Maybe [Int]
Nothing, IntMap [Int]
hi) ->
          case forall a. IntMap a -> (Int, a)
IntMap.findMax IntMap [Int]
lo of
            (Int
k,[Int]
v) -> forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
k [Int]
v IntMap [Int]
hi

    splitLE :: Int -> IntMap v -> IntMap v
    splitLE :: forall v. Int -> IntMap v -> IntMap v
splitLE Int
k IntMap v
m =
      case forall a. Int -> IntMap a -> (IntMap a, Maybe a, IntMap a)
IntMap.splitLookup Int
k IntMap v
m of
        (IntMap v
lo, Maybe v
Nothing, IntMap v
_) -> IntMap v
lo
        (IntMap v
lo, Just v
v, IntMap v
_) -> forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
k v
v IntMap v
lo

-- | Minimize Σ_{i=1}^n wi xi subject to Σ_{i=1}^n wi xi ≥ l and xi ∈ {0,1}.
--
-- Note: 0 (resp. 1) is identified with False (resp. True) in the assignment.
minSubsetSum
  :: VG.Vector v Weight
  => v Weight -- ^ weights @[w1, w2 .. wn]@
  -> Weight -- ^ @l@
  -> Maybe (Weight, VU.Vector Bool)
  -- ^
  -- * the objective value Σ_{i=1}^n wi xi, and
  --
  -- * the assignment @[x1, x2 .. xn]@, identifying 0 (resp. 1) with @False@ (resp. @True@).
minSubsetSum :: forall (v :: * -> *).
Vector v Integer =>
v Integer -> Integer -> Maybe (Integer, Vector Bool)
minSubsetSum v Integer
w Integer
l =
  case forall (v :: * -> *).
Vector v Integer =>
v Integer -> Integer -> Maybe (Integer, Vector Bool)
maxSubsetSum v Integer
w (Integer
wsum forall a. Num a => a -> a -> a
- Integer
l) of
    Maybe (Integer, Vector Bool)
Nothing -> forall a. Maybe a
Nothing
    Just (Integer
obj, Vector Bool
bs) -> forall a. a -> Maybe a
Just (Integer
wsum forall a. Num a => a -> a -> a
- Integer
obj, forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map Bool -> Bool
not Vector Bool
bs)
  where
    wsum :: Integer
wsum = forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
VG.sum v Integer
w

{-
minimize Σ wi xi = Σ wi (1 - ¬xi) = Σ wi - (Σ wi ¬xi)
subject to Σ wi xi ≥ n

maximize Σ wi ¬xi
subject to Σ wi ¬xi ≤ (Σ wi) - n

Σ wi xi ≥ n
Σ wi (1 - ¬xi) ≥ n
(Σ wi) - (Σ wi ¬xi) ≥ n
(Σ wi ¬xi) ≤ (Σ wi) - n
-}

-- | Solve Σ_{i=1}^n wi xi = c and xi ∈ {0,1}.
--
-- Note that this is different from usual definition of the subset sum problem,
-- as this definition allows all xi to be zero.
--
-- Note: 0 (resp. 1) is identified with False (resp. True) in the assignment.
subsetSum
  :: VG.Vector v Weight
  => v Weight -- ^ weights @[w1, w2 .. wn]@
  -> Weight -- ^ @l@
  -> Maybe (VU.Vector Bool)
  -- ^
  -- the assignment @[x1, x2 .. xn]@, identifying 0 (resp. 1) with @False@ (resp. @True@).
subsetSum :: forall (v :: * -> *).
Vector v Integer =>
v Integer -> Integer -> Maybe (Vector Bool)
subsetSum v Integer
w Integer
c =
  case forall (v :: * -> *).
Vector v Integer =>
(v Integer, Integer)
-> (Vector Integer, Integer,
    (Integer, Vector Bool) -> (Integer, Vector Bool))
normalizeWeightsToPositive (v Integer
w,Integer
c) of
    (Vector Integer
w1, Integer
c1, (Integer, Vector Bool) -> (Integer, Vector Bool)
trans1)
      | Integer
c1 forall a. Ord a => a -> a -> Bool
< Integer
0 -> forall a. Maybe a
Nothing
      | Bool
otherwise ->
          case (Vector Integer, Integer)
-> (Vector Integer, Integer,
    (Integer, Vector Bool) -> (Integer, Vector Bool))
normalize2 (Vector Integer
w1, Integer
c1) of
            (Vector Integer
w2, Integer
c2, (Integer, Vector Bool) -> (Integer, Vector Bool)
trans2) -> do
              (Vector Integer
w3, Integer
c3, (Integer, Vector Bool) -> (Integer, Vector Bool)
trans3) <- (Vector Integer, Integer)
-> Maybe
     (Vector Integer, Integer,
      (Integer, Vector Bool) -> (Integer, Vector Bool))
normalizeGCDEq (Vector Integer
w2,Integer
c2)
              let (Integer
obj, Vector Bool
sol) = Vector Integer -> Integer -> (Integer, Vector Bool)
maxSubsetSum' Vector Integer
w3 Integer
c3
              forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Integer
obj forall a. Eq a => a -> a -> Bool
== Integer
c3
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ (Integer, Vector Bool) -> (Integer, Vector Bool)
trans1 forall a b. (a -> b) -> a -> b
$ (Integer, Vector Bool) -> (Integer, Vector Bool)
trans2 forall a b. (a -> b) -> a -> b
$ (Integer, Vector Bool) -> (Integer, Vector Bool)
trans3 (Integer
obj, Vector Bool
sol)