{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ToySolver.Combinatorial.Knapsack.DPDense
( Weight
, Value
, solve
) where
import Control.Exception (assert)
import Control.Loop
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Function (on)
import Data.List
type Weight = Int
type Value = Rational
solve
:: [(Value, Weight)]
-> Weight
-> (Value, Weight, [Bool])
solve :: [(Value, Weight)] -> Weight -> (Value, Weight, [Bool])
solve [(Value, Weight)]
items Weight
limit = forall a. (forall s. ST s a) -> a
runST forall s. ST s (Value, Weight, [Bool])
m
where
m :: forall s. ST s (Value, Weight, [Bool])
m :: forall s. ST s (Value, Weight, [Bool])
m = do
(STArray s Weight (Value, Weight, [Bool])
table :: STArray s Weight (Value, Weight, [Bool])) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Weight
0, Weight
limit) (Value
0,Weight
0,[])
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Value, Weight)]
items forall a b. (a -> b) -> a -> b
$ \(Value
v,Weight
w) -> do
forall (m :: * -> *) a.
Monad m =>
a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
forLoop Weight
limit (forall a. Ord a => a -> a -> Bool
>=Weight
0) (forall a. Num a => a -> a -> a
subtract Weight
1) forall a b. (a -> b) -> a -> b
$ \Weight
c -> do
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Weight
w forall a. Ord a => a -> a -> Bool
>= Weight
0) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
if Weight
w forall a. Ord a => a -> a -> Bool
<= Weight
c then do
(Value
obj1, Weight
w1, [Bool]
sol1) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s Weight (Value, Weight, [Bool])
table Weight
c
(Value
obj2, Weight
w2, [Bool]
sol2) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s Weight (Value, Weight, [Bool])
table (Weight
c forall a. Num a => a -> a -> a
- Weight
w)
seq :: forall a b. a -> b -> b
seq Weight
w1 forall a b. (a -> b) -> a -> b
$ seq :: forall a b. a -> b -> b
seq Weight
w2 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
if Value
v forall a. Ord a => a -> a -> Bool
>= Value
0 Bool -> Bool -> Bool
&& Value
obj2 forall a. Num a => a -> a -> a
+ Value
v forall a. Ord a => a -> a -> Bool
> Value
obj1 then do
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Weight (Value, Weight, [Bool])
table Weight
c (Value
obj2 forall a. Num a => a -> a -> a
+ Value
v, Weight
w2 forall a. Num a => a -> a -> a
+ Weight
w, Bool
True forall a. a -> [a] -> [a]
: [Bool]
sol2)
else
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Weight (Value, Weight, [Bool])
table Weight
c (Value
obj1, Weight
w1, Bool
False forall a. a -> [a] -> [a]
: [Bool]
sol1)
else do
(Value
obj1, Weight
w1, [Bool]
sol1) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s Weight (Value, Weight, [Bool])
table Weight
c
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Weight (Value, Weight, [Bool])
table Weight
c (Value
obj1, Weight
w1, Bool
False forall a. a -> [a] -> [a]
: [Bool]
sol1)
(Value
obj, Weight
w, [Bool]
sol) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s Weight (Value, Weight, [Bool])
table Weight
limit
forall (m :: * -> *) a. Monad m => a -> m a
return (Value
obj, Weight
w, forall a. [a] -> [a]
reverse [Bool]
sol)
test1 :: (Value, Weight, [Bool])
test1 = [(Value, Weight)] -> Weight -> (Value, Weight, [Bool])
solve [(Value
5,Weight
4), (Value
4,Weight
5), (Value
3,Weight
2)] Weight
9
test2 :: (Value, Weight, [Bool])
test2 = [(Value, Weight)] -> Weight -> (Value, Weight, [Bool])
solve [(Value
45,Weight
5), (Value
48,Weight
8), (Value
35,Weight
3)] Weight
10