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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
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))
-------------------------------------------------------------------------------
bndsB :: (Integer, Integer) -> ((Integer, Integer), (Integer, Integer))
bndsB (n, k) = ((0, 0), (n, k))
{-- | k == 0 = ((0,0), (1,1))
| n == k = ((0,0), (1,1))
| n < k = ((0,0), (0,0))
| otherwise = ((0, 0), (n, k))--}
compB :: Table (Integer, Integer) (Integer, Integer) -> (Integer, Integer) -> (Integer, Integer)
compB t (n, k)
| k == 0 = (1, 0)
| n == k = (1, 0)
| k == 1 = (n, 0)
| n < k = (0, 0)
| otherwise = findTable t (n - 1, k - 1)
binomDyn :: (Integer, Integer) -> (Integer, Integer)
binomDyn (m, n) = findTable t (m, n)
where
t = dynamic compB (bndsB (m, n))
|
