{-# 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 :: v Weight -> Weight -> Maybe (Weight, Vector Bool)
maxSubsetSum v Weight
w Weight
c =
  case (v Weight, Weight)
-> (Vector Weight, Weight,
    (Weight, Vector Bool) -> (Weight, Vector Bool))
forall (v :: * -> *).
Vector v Weight =>
(v Weight, Weight)
-> (Vector Weight, Weight,
    (Weight, Vector Bool) -> (Weight, Vector Bool))
normalizeWeightsToPositive (v Weight
w,Weight
c) of
    (Vector Weight
w1, Weight
c1, (Weight, Vector Bool) -> (Weight, Vector Bool)
trans1)
      | Weight
c1 Weight -> Weight -> Bool
forall a. Ord a => a -> a -> Bool
< Weight
0 -> Maybe (Weight, Vector Bool)
forall a. Maybe a
Nothing
      | Bool
otherwise ->
          case (Vector Weight, Weight)
-> (Vector Weight, Weight,
    (Weight, Vector Bool) -> (Weight, Vector Bool))
normalize2 (Vector Weight
w1, Weight
c1) of
            (Vector Weight
w2, Weight
c2, (Weight, Vector Bool) -> (Weight, Vector Bool)
trans2) ->
              case (Vector Weight, Weight)
-> (Vector Weight, Weight,
    (Weight, Vector Bool) -> (Weight, Vector Bool))
normalizeGCDLe (Vector Weight
w2, Weight
c2) of
                (Vector Weight
w3, Weight
c3, (Weight, Vector Bool) -> (Weight, Vector Bool)
trans3) ->
                  (Weight, Vector Bool) -> Maybe (Weight, Vector Bool)
forall a. a -> Maybe a
Just ((Weight, Vector Bool) -> Maybe (Weight, Vector Bool))
-> (Weight, Vector Bool) -> Maybe (Weight, Vector Bool)
forall a b. (a -> b) -> a -> b
$ (Weight, Vector Bool) -> (Weight, Vector Bool)
trans1 ((Weight, Vector Bool) -> (Weight, Vector Bool))
-> (Weight, Vector Bool) -> (Weight, Vector Bool)
forall a b. (a -> b) -> a -> b
$ (Weight, Vector Bool) -> (Weight, Vector Bool)
trans2 ((Weight, Vector Bool) -> (Weight, Vector Bool))
-> (Weight, Vector Bool) -> (Weight, Vector Bool)
forall a b. (a -> b) -> a -> b
$ (Weight, Vector Bool) -> (Weight, Vector Bool)
trans3 ((Weight, Vector Bool) -> (Weight, Vector Bool))
-> (Weight, Vector Bool) -> (Weight, Vector Bool)
forall a b. (a -> b) -> a -> b
$ Vector Weight -> Weight -> (Weight, Vector Bool)
maxSubsetSum' Vector Weight
w3 Weight
c3

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

normalize2
  :: (V.Vector Weight, Weight)
  -> (V.Vector Weight, Weight, (Weight, VU.Vector Bool) -> (Weight, VU.Vector Bool))
normalize2 :: (Vector Weight, Weight)
-> (Vector Weight, Weight,
    (Weight, Vector Bool) -> (Weight, Vector Bool))
normalize2 (Vector Weight
w,Weight
c)
  | (Weight -> Bool) -> Vector Weight -> Bool
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> Bool
VG.all (\Weight
wi -> Weight
0Weight -> Weight -> Bool
forall a. Ord a => a -> a -> Bool
<Weight
wi Bool -> Bool -> Bool
&& Weight
wiWeight -> Weight -> Bool
forall a. Ord a => a -> a -> Bool
<=Weight
c) Vector Weight
w = (Vector Weight
w, Weight
c, (Weight, Vector Bool) -> (Weight, Vector Bool)
forall a. a -> a
id)
  | Bool
otherwise = ((Weight -> Bool) -> Vector Weight -> Vector Weight
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> v a
VG.filter (\Weight
wi -> Weight
0Weight -> Weight -> Bool
forall a. Ord a => a -> a -> Bool
<Weight
wi Bool -> Bool -> Bool
&& Weight
wiWeight -> Weight -> Bool
forall a. Ord a => a -> a -> Bool
<=Weight
c) Vector Weight
w, Weight
c, (Weight, Vector Bool) -> (Weight, Vector Bool)
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 s. ST s (MVector s Bool)) -> Vector Bool
forall a. Unbox a => (forall s. ST s (MVector s a)) -> Vector a
VU.create ((forall s. ST s (MVector s Bool)) -> Vector Bool)
-> (forall s. ST s (MVector s Bool)) -> Vector Bool
forall a b. (a -> b) -> a -> b
$ do
          MVector s Bool
v <- Int -> ST s (MVector (PrimState (ST s)) Bool)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
VM.new (Vector Weight -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector Weight
w)
          let loop :: Int -> Int -> ST s ()
loop !Int
i !Int
j =
                Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector Weight -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector Weight
w) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
                  let wi :: Weight
wi = Vector Weight
w Vector Weight -> Int -> Weight
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
i
                  if Weight
0 Weight -> Weight -> Bool
forall a. Ord a => a -> a -> Bool
< Weight
wi Bool -> Bool -> Bool
&& Weight
wi Weight -> Weight -> Bool
forall a. Ord a => a -> a -> Bool
<= Weight
c then do
                    MVector (PrimState (ST s)) Bool -> Int -> Bool -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write MVector s Bool
MVector (PrimState (ST s)) Bool
v Int
i (v Bool
bs v Bool -> Int -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
j)
                    Int -> Int -> ST s ()
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                  else do
                    MVector (PrimState (ST s)) Bool -> Int -> Bool -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write MVector s Bool
MVector (PrimState (ST s)) Bool
v Int
i Bool
False
                    Int -> Int -> ST s ()
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
j
          Int -> Int -> ST s ()
loop Int
0 Int
0
          MVector s Bool -> ST s (MVector s Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Bool
v

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

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

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

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

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

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

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

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

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

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

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

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

    splitLE :: Ord k => k -> Map k v -> Map k v
    splitLE :: k -> Map k v -> Map k v
splitLE k
k Map k v
m =
      case k -> Map k v -> (Map k v, Maybe v, Map k v)
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
_) -> k -> v -> Map k 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 -> Weight -> (Weight, Vector Bool)
maxSubsetSumInt' Vector Int
w !Int
c Weight
wsum = Bool -> (Weight, Vector Bool) -> (Weight, Vector Bool)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
wbar Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
c) ((Weight, Vector Bool) -> (Weight, Vector Bool))
-> (Weight, Vector Bool) -> (Weight, Vector Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> (Weight, Vector Bool) -> (Weight, Vector Bool)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
wbar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Vector Int
w Vector Int -> Int -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
b) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
c) ((Weight, Vector Bool) -> (Weight, Vector Bool))
-> (Weight, Vector Bool) -> (Weight, Vector Bool)
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (Weight, Vector Bool)) -> (Weight, Vector Bool)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Weight, Vector Bool)) -> (Weight, Vector Bool))
-> (forall s. ST s (Weight, Vector Bool)) -> (Weight, Vector Bool)
forall a b. (a -> b) -> a -> b
$ do
  STRef s (Int, [Int], [Int])
objRef <- (Int, [Int], [Int]) -> ST s (STRef s (Int, [Int], [Int]))
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])]
_ = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            loop [(Int, [Int])]
_ [] = () -> ST s ()
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
gobj Int -> Int -> Int
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]
_) <- STRef s (Int, [Int], [Int]) -> ST s (Int, [Int], [Int])
forall s a. STRef s a -> ST s a
readSTRef STRef s (Int, [Int], [Int])
objRef
                  Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
curr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
gobj Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fobj) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ STRef s (Int, [Int], [Int]) -> (Int, [Int], [Int]) -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Int, [Int], [Int])
objRef (Int
gobj Int -> Int -> Int
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 (IntMap [Int] -> [(Int, [Int])]
forall a. IntMap a -> [(Int, a)]
IntMap.toDescList IntMap [Int]
gs) (IntMap [Int] -> [(Int, [Int])]
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) <- STRef s (Int, [Int], [Int]) -> ST s (Int, [Int], [Int])
forall s a. STRef s a -> ST s a
readSTRef STRef s (Int, [Int], [Int])
objRef
        if Int
obj Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c Bool -> Bool -> Bool
|| (Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) then do
          let sol :: v Bool
sol = (forall s. ST s (Mutable v s Bool)) -> v Bool
forall (v :: * -> *) a.
Vector v a =>
(forall s. ST s (Mutable v s a)) -> v a
VG.create ((forall s. ST s (Mutable v s Bool)) -> v Bool)
-> (forall s. ST s (Mutable v s Bool)) -> v Bool
forall a b. (a -> b) -> a -> b
$ do
                Mutable v s Bool
bs <- Int -> ST s (Mutable v (PrimState (ST s)) Bool)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
VM.new Int
n
                [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> Mutable v (PrimState (ST s)) Bool -> Int -> Bool -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write Mutable v s Bool
Mutable v (PrimState (ST s)) Bool
bs Int
i Bool
True
                [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
b..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> Mutable v (PrimState (ST s)) Bool -> Int -> Bool -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write Mutable v s Bool
Mutable v (PrimState (ST s)) Bool
bs Int
i Bool
False
                [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
fsol ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> Mutable v (PrimState (ST s)) Bool -> Int -> Bool -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write Mutable v s Bool
Mutable v (PrimState (ST s)) Bool
bs Int
i Bool
True
                [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
gsol ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> Mutable v (PrimState (ST s)) Bool -> Int -> Bool -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VM.write Mutable v s Bool
Mutable v (PrimState (ST s)) Bool
bs Int
i Bool
False
                Mutable v s Bool -> ST s (Mutable v s Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Mutable v s Bool
bs
          (a, v Bool) -> ST s (a, v Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> a
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    wt' :: Int
wt' = Vector Int
w Vector Int -> Int -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
t'
                    m :: IntMap [Int]
m = (Int -> Int) -> IntMap [Int] -> IntMap [Int]
forall a. (Int -> Int) -> IntMap a -> IntMap a
IntMap.mapKeysMonotonic (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wt') (IntMap [Int] -> IntMap [Int]) -> IntMap [Int] -> IntMap [Int]
forall a b. (a -> b) -> a -> b
$ ([Int] -> [Int]) -> IntMap [Int] -> IntMap [Int]
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map (Int
t' Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) (IntMap [Int] -> IntMap [Int]) -> IntMap [Int] -> IntMap [Int]
forall a b. (a -> b) -> a -> b
$ Int -> IntMap [Int] -> IntMap [Int]
forall v. Int -> IntMap v -> IntMap v
splitLE (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wt') IntMap [Int]
ft
                    ft' :: IntMap [Int]
ft' = IntMap [Int]
ft IntMap [Int] -> IntMap [Int] -> IntMap [Int]
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                    ws :: Int
ws = Vector Int
w Vector Int -> Int -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
s'
                    m :: IntMap [Int]
m = ([Int] -> [Int]) -> IntMap [Int] -> IntMap [Int]
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map (Int
s' Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) (IntMap [Int] -> IntMap [Int]) -> IntMap [Int] -> IntMap [Int]
forall a b. (a -> b) -> a -> b
$ IntMap [Int] -> IntMap [Int]
g_drop (IntMap [Int] -> IntMap [Int]) -> IntMap [Int] -> IntMap [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> IntMap [Int] -> IntMap [Int]
forall a. (Int -> Int) -> IntMap a -> IntMap a
IntMap.mapKeysMonotonic (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
ws) (IntMap [Int] -> IntMap [Int]) -> IntMap [Int] -> IntMap [Int]
forall a b. (a -> b) -> a -> b
$ IntMap [Int]
gs
                    gs' :: IntMap [Int]
gs' = IntMap [Int]
gs IntMap [Int] -> IntMap [Int] -> IntMap [Int]
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
            ST s (a, v Bool)
updateF
          else if Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nInt -> Int -> Int
forall 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' = Int -> [Int] -> IntMap [Int]
forall a. Int -> a -> IntMap a
IntMap.singleton Int
0 []
      -- g_{b}
      gb :: IntMap [Int]
      gb :: IntMap [Int]
gb = Int -> [Int] -> IntMap [Int]
forall a. Int -> a -> IntMap a
IntMap.singleton Int
wbar []
  Int
-> Int
-> IntMap [Int]
-> IntMap [Int]
-> Bool
-> ST s (Weight, Vector Bool)
forall a (v :: * -> *).
(Num a, Vector v Bool) =>
Int
-> Int -> IntMap [Int] -> IntMap [Int] -> Bool -> ST s (a, v Bool)
loop Int
b (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) IntMap [Int]
gb IntMap [Int]
fb' Bool
True

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

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

    wbar :: Int
    wbar :: Int
wbar = Vector Int -> Int
forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
VG.sum (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector Int -> Vector Int
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 :: Weight
max_f = Weight
wsum Weight -> Weight -> Weight
forall a. Num a => a -> a -> a
- Int -> Weight
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wbar

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

    g_drop :: IntMap [Int] -> IntMap [Int]
    g_drop :: IntMap [Int] -> IntMap [Int]
g_drop IntMap [Int]
g =
      case Int -> IntMap [Int] -> (IntMap [Int], Maybe [Int], IntMap [Int])
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]
_) | IntMap [Int] -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap [Int]
lo -> IntMap [Int]
g
        (IntMap [Int]
_, Just [Int]
v, IntMap [Int]
hi) -> Int -> [Int] -> IntMap [Int] -> IntMap [Int]
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 IntMap [Int] -> (Int, [Int])
forall a. IntMap a -> (Int, a)
IntMap.findMax IntMap [Int]
lo of
            (Int
k,[Int]
v) -> Int -> [Int] -> IntMap [Int] -> IntMap [Int]
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
k [Int]
v IntMap [Int]
hi

    splitLE :: Int -> IntMap v -> IntMap v
    splitLE :: Int -> IntMap v -> IntMap v
splitLE Int
k IntMap v
m =
      case Int -> IntMap v -> (IntMap v, Maybe v, IntMap v)
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
_) -> Int -> v -> IntMap 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 x≥ 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 :: v Weight -> Weight -> Maybe (Weight, Vector Bool)
minSubsetSum v Weight
w Weight
l =
  case v Weight -> Weight -> Maybe (Weight, Vector Bool)
forall (v :: * -> *).
Vector v Weight =>
v Weight -> Weight -> Maybe (Weight, Vector Bool)
maxSubsetSum v Weight
w (Weight
wsum Weight -> Weight -> Weight
forall a. Num a => a -> a -> a
- Weight
l) of
    Maybe (Weight, Vector Bool)
Nothing -> Maybe (Weight, Vector Bool)
forall a. Maybe a
Nothing
    Just (Weight
obj, Vector Bool
bs) -> (Weight, Vector Bool) -> Maybe (Weight, Vector Bool)
forall a. a -> Maybe a
Just (Weight
wsum Weight -> Weight -> Weight
forall a. Num a => a -> a -> a
- Weight
obj, (Bool -> Bool) -> Vector Bool -> Vector Bool
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 :: Weight
wsum = v Weight -> Weight
forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
VG.sum v Weight
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 x = 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 :: v Weight -> Weight -> Maybe (Vector Bool)
subsetSum v Weight
w Weight
c =
  case (v Weight, Weight)
-> (Vector Weight, Weight,
    (Weight, Vector Bool) -> (Weight, Vector Bool))
forall (v :: * -> *).
Vector v Weight =>
(v Weight, Weight)
-> (Vector Weight, Weight,
    (Weight, Vector Bool) -> (Weight, Vector Bool))
normalizeWeightsToPositive (v Weight
w,Weight
c) of
    (Vector Weight
w1, Weight
c1, (Weight, Vector Bool) -> (Weight, Vector Bool)
trans1)
      | Weight
c1 Weight -> Weight -> Bool
forall a. Ord a => a -> a -> Bool
< Weight
0 -> Maybe (Vector Bool)
forall a. Maybe a
Nothing
      | Bool
otherwise ->
          case (Vector Weight, Weight)
-> (Vector Weight, Weight,
    (Weight, Vector Bool) -> (Weight, Vector Bool))
normalize2 (Vector Weight
w1, Weight
c1) of
            (Vector Weight
w2, Weight
c2, (Weight, Vector Bool) -> (Weight, Vector Bool)
trans2) -> do
              (Vector Weight
w3, Weight
c3, (Weight, Vector Bool) -> (Weight, Vector Bool)
trans3) <- (Vector Weight, Weight)
-> Maybe
     (Vector Weight, Weight,
      (Weight, Vector Bool) -> (Weight, Vector Bool))
normalizeGCDEq (Vector Weight
w2,Weight
c2)
              let (Weight
obj, Vector Bool
sol) = Vector Weight -> Weight -> (Weight, Vector Bool)
maxSubsetSum' Vector Weight
w3 Weight
c3
              Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Weight
obj Weight -> Weight -> Bool
forall a. Eq a => a -> a -> Bool
== Weight
c3
              Vector Bool -> Maybe (Vector Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Bool -> Maybe (Vector Bool))
-> Vector Bool -> Maybe (Vector Bool)
forall a b. (a -> b) -> a -> b
$ (Weight, Vector Bool) -> Vector Bool
forall a b. (a, b) -> b
snd ((Weight, Vector Bool) -> Vector Bool)
-> (Weight, Vector Bool) -> Vector Bool
forall a b. (a -> b) -> a -> b
$ (Weight, Vector Bool) -> (Weight, Vector Bool)
trans1 ((Weight, Vector Bool) -> (Weight, Vector Bool))
-> (Weight, Vector Bool) -> (Weight, Vector Bool)
forall a b. (a -> b) -> a -> b
$ (Weight, Vector Bool) -> (Weight, Vector Bool)
trans2 ((Weight, Vector Bool) -> (Weight, Vector Bool))
-> (Weight, Vector Bool) -> (Weight, Vector Bool)
forall a b. (a -> b) -> a -> b
$ (Weight, Vector Bool) -> (Weight, Vector Bool)
trans3 (Weight
obj, Vector Bool
sol)