initial implementation of Aufgabe4 exercise 1

1 files changed, 97 insertions, 0 deletions

diff --git a/AufgabeFFP4.hs b/AufgabeFFP4.hs
new file mode 100644
index 0000000..758bee4
--- /dev/null
+++ b/AufgabeFFP4.hs
@@ -0,0 +1,97 @@
+module AufgabeFFP4
+where
+
+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')) objects,
+      (w', v') : psol
+    )
+  ) objects2
+  where
+    objects2 = filter (\(w', v') -> (w + w') <= limit) objects
+
+-- TODO: delete?
+succKnp2 :: NodeKnp -> [(Value, Weight, MaxWeight, [Object], SolKnp)]
+succKnp2 (v, w, limit, objects, psol) =
+  [(v + v',
+    w + w',
+   limit,
+   [ (w'', v'') | (w'', v'') <- objects, (w'' >= w')],
+   (w', v') : psol)
+  | (w', v') <- objects, w + w' <= limit ]
+
+-------------------------------------------------------------------------------
+
+goalKnp :: NodeKnp -> Bool
+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))
+
+-------------------------------------------------------------------------------
+
+knapsack :: Objects -> MaxWeight -> (SolKnp, Value)
+knapsack objects limit = (psol, v)
+  where (v, _, _, _, psol) = maximum (searchDfs succKnp goalKnp (0, 0, limit, objects, []))
+
+-------------------------------------------------------------------------------
+
+--binomDyn :: (Integer, Integer) -> Integer
+--binomDyn (m, n) = ...
+--  where ... dynamic compB... bndsB...
+