Don't like ads? PRO users don't see any ads ;-)
Guest

Untitled

By: a guest on Apr 30th, 2012  |  syntax: None  |  size: 3.05 KB  |  hits: 76  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. Haskell Knapsack
  2. knapsack :: [ ( Int, Int ) ] -> [ ( Int, Int ) ] -> Int -> [ ( Int, Int ) ]
  3. knapsack xs [] _   = xs
  4. knapsack xs ys max =
  5.     foldr (maxOf) [ ] [ knapsack ( y : xs ) ( filter (y /=) ys ) max | y <- ys
  6.         , weightOf( y : xs ) <= max ]
  7.  
  8. maxOf :: [ ( Int, Int ) ] -> [ ( Int, Int ) ] -> [ ( Int, Int ) ]
  9. maxOf a b = if valueOf a > valueOf b then a else b
  10.  
  11. valueOf :: [ ( Int, Int ) ] -> Int
  12. valueOf [ ]        = 0
  13. valueOf ( x : xs ) = fst x + valueOf xs
  14.  
  15. weightOf :: [ ( Int, Int ) ] -> Int
  16. weightOf [ ]        = 0
  17. weightOf ( x : xs ) = snd x + weightOf xs
  18.        
  19. knapsack [] [(1,1),(2,2)] 5
  20. Expect: [(1,1),(2,2)]
  21. Produces: [(1,1),(2,2)]
  22.  
  23. knapsack [] [(1,1),(2,2),(3,3)] 5
  24. Expect: [(2,2),(3,3)]
  25. Produces: []
  26.  
  27. knapsack [] [(2,1),(3,2),(4,3),(6,4)] 5
  28. Expect: [(2,1),(6,4)]
  29. Produces: []
  30.        
  31. ks = knapsack []
  32.  
  33. knapsack :: [ ( Int, Int ) ] -> [ ( Int, Int ) ] -> Int -> [ ( Int, Int ) ]
  34. knapsack xs [] _   = xs
  35. knapsack xs ys max =
  36.     foldr (maxOf) [ ] ( xs : [ knapsack ( y : xs ) ( ys #- y ) max
  37.                              | y <- ys, weightOf( y : xs ) <= max ] )
  38.  
  39. (#-) :: [ ( Int, Int ) ] -> ( Int, Int ) -> [ ( Int, Int ) ]
  40. [ ]        #- _ = [ ]
  41. ( x : xs ) #- y = if x == y then xs else x : ( xs #- y )
  42.  
  43. maxOf :: [ ( Int, Int ) ] -> [ ( Int, Int ) ] -> [ ( Int, Int ) ]
  44. maxOf a b = if valueOf a > valueOf b then a else b
  45.  
  46. valueOf :: [ ( Int, Int ) ] -> Int
  47. valueOf [ ]        = 0
  48. valueOf ( x : xs ) = fst x + valueOf xs
  49.  
  50. weightOf :: [ ( Int, Int ) ] -> Int
  51. weightOf [ ]        = 0
  52. weightOf ( x : xs ) = snd x + weightOf xs
  53.        
  54. import Data.List
  55. import Data.Function(on)
  56.  
  57. ks = knapsack []
  58.  
  59. knapsack :: [(Int, Int)] -> [(Int, Int)] -> Int -> [(Int, Int)]
  60. knapsack xs [] _   = xs
  61. knapsack xs ys max =
  62.     foldr (maxOf) [] (xs: [knapsack (y:xs) (delete y ys) max
  63.                            | y <- ys, weightOf(y:xs) <= max ] ) where
  64.                              weightOf = sum . map snd
  65.  
  66. maxOf :: [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
  67. maxOf a b = maximumBy (compare `on` valueOf) [a,b] where
  68.             valueOf = sum . map fst
  69.        
  70. import Array
  71.  
  72. -- creates the dynamic programming table as an array
  73. dynProgTable (var,cap) = a where
  74.     a = array ((0,0),(length var,cap)) [ ((i,j), best i j)
  75.                        | i <- [0..length var] , j <- [0..cap] ] where
  76.         best 0 _ = 0
  77.         best _ 0 = 0
  78.         best i j
  79.             | snd (var !! (i-1)) > j = a!decline
  80.             | otherwise          = maximum [a!decline,value+a!accept]
  81.                 where decline = (i-1,j)
  82.                       accept  = (i-1,j - snd (var !! (i-1)))
  83.                       value   = fst (var !! (i-1))
  84.  
  85. --Backtracks the solution from the dynamic programming table
  86. --Output on the form [Int] where i'th element equals 1 if
  87. --i'th variable was accepted, 0 otherwise.
  88. solve (var,cap) =
  89.     let j = cap
  90.         i = length var
  91.         table = dynProgTable (var,cap)
  92.         step _ 0 _ = []
  93.         step a k 0 = step table (k-1) 0 ++ [0]
  94.         step a k l
  95.             | a!(k,l) == a!(k-1,l) = step a (k-1) l ++ [0]
  96.             | otherwise            = step a (k-1) (l - snd (var !! (k-1))) ++ [1]
  97.     in step table i j