1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
module AufgabeFFP4
where
import List
import Data.Array
type Weight = Int -- Gewicht
type Value = Int -- Wert
type MaxWeight = Weight -- Hoechstzulaessiges Rucksackgewicht
type Object = (Weight, Value) -- Gegenstand als Gewichts-/Wertpaar
type Objects = [Object] -- Menge der anfaenglich gegebenen Gegenstaende
type SolKnp = [Object] -- Auswahl aus der Menge der anfaenglich
-- gegebenen Gegenstaende; moegliche
-- Rucksackbeladung, falls zulaessig
type NodeKnp = (Value, Weight, MaxWeight, [Object], SolKnp)
-------------------------------------------------------------------------------
filterOne :: (a -> Bool) -> [a] -> [a]
filterOne p [] = []
filterOne p (x:xs)
| p x = xs
| otherwise = x : filterOne p xs
succKnp :: NodeKnp -> [NodeKnp]
succKnp (v, w, limit, objects, psol) =
map (
\(w', v') -> (
v + v',
w + w',
limit,
filterOne (== (w', v')) objects2,
(w', v') : psol
)
) objects2
where
objects2 = filter (\(w', v') -> (w + w') <= limit) objects
-------------------------------------------------------------------------------
goalKnp :: NodeKnp -> Bool
goalKnp (_, _, _, [], _) = True
goalKnp (_, w, limit, ((w', _) : _), _) = (w + w') > limit
-------------------------------------------------------------------------------
-- see lecture slide #167 ff.
data Stack a = EmptyStk
| Stk a (Stack a)
push :: a -> Stack a -> Stack a
push x s = Stk x s
pop :: Stack a -> Stack a
pop EmptyStk = error "pop from an empty stack"
pop (Stk _ s) = s
top :: Stack a -> a
top EmptyStk = error "top from an empty stack"
top (Stk x _) = x
emptyStack :: Stack a
emptyStack = EmptyStk
stackEmpty :: Stack a -> Bool
stackEmpty EmptyStk = True
stackEmpty _ = False
searchDfs :: (Eq node) => (node -> [node]) -> (node -> Bool) -> node -> [node]
searchDfs succ goal x = search' (push x emptyStack)
where
search' s
| stackEmpty s = []
| goal (top s) = top s : search' (pop s)
| otherwise =
let x = top s
in search' (foldr push (pop s) (succ x))
-------------------------------------------------------------------------------
cmpObject :: Object -> Object -> Ordering
cmpObject (w, v) (w', v')
| w == w' = compare v v'
| otherwise = compare w w'
-- it's safe to use maximum here as it will look at the first value of each tuple only
knapsack :: Objects -> MaxWeight -> (SolKnp, Value)
knapsack objects limit = (psol, v)
where
(v, _, _, _, psol) = maximum (searchDfs succKnp goalKnp (0, 0, limit, sortBy cmpObject objects, []))
-------------------------------------------------------------------------------
-- see lecture slide #207 ff.
newtype Table a b = Tbl (Array b a)
deriving Show
newTable :: (Ix b) => [(b, a)] -> Table a b
newTable l = Tbl (array (lo, hi) l)
where
indices = map fst l
lo = minimum indices
hi = maximum indices
findTable :: (Ix b) => Table a b -> b -> a
findTable (Tbl a) i = a ! i
updTable :: (Ix b) => (b, a) -> Table a b -> Table a b
updTable p@(i, x) (Tbl a) = Tbl (a // [p])
dynamic :: (Ix coord) => (Table entry coord -> coord -> entry) -> (coord, coord) -> (Table entry coord)
dynamic compute bnds = t
where
t = newTable (map (\coord -> (coord, compute t coord)) (range bnds))
-------------------------------------------------------------------------------
|
