From 5f700ec31840863e1b51fc589d42629c0f1899a0 Mon Sep 17 00:00:00 2001
From: manuel <manuel@mausz.at>
Date: Sun, 29 Apr 2012 15:45:29 +0200
Subject: complete part one of exercise 4 and adding some tests

---
 AufgabeFFP4.hs     | 24 ++++++++++++------------
 TestAufgabeFFP4.hs | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 66 insertions(+), 12 deletions(-)
 create mode 100644 TestAufgabeFFP4.hs

diff --git a/AufgabeFFP4.hs b/AufgabeFFP4.hs
index 758bee4..8e7cbf1 100644
--- a/AufgabeFFP4.hs
+++ b/AufgabeFFP4.hs
@@ -1,6 +1,8 @@
 module AufgabeFFP4
 where
 
+import List
+
 type Weight    = Int             -- Gewicht
 type Value     = Int             -- Wert
 type MaxWeight = Weight          -- Hoechstzulaessiges Rucksackgewicht
@@ -27,26 +29,17 @@ succKnp (v, w, limit, objects, psol) =
       v + v',
       w + w',
       limit,
-      filterOne (== (w', v')) objects,
+      filterOne (== (w', v')) objects2,
       (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 (_, _, _, [], _) = True
 goalKnp (_, w, limit, ((w', _) : _), _) = (w + w') > limit
 
 -------------------------------------------------------------------------------
@@ -85,9 +78,16 @@ searchDfs succ goal x = search' (push x emptyStack)
 
 -------------------------------------------------------------------------------
 
+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, objects, []))
+  where
+    (v, _, _, _, psol) = maximum (searchDfs succKnp goalKnp (0, 0, limit, sortBy cmpObject objects, []))
 
 -------------------------------------------------------------------------------
 
diff --git a/TestAufgabeFFP4.hs b/TestAufgabeFFP4.hs
new file mode 100644
index 0000000..55a257c
--- /dev/null
+++ b/TestAufgabeFFP4.hs
@@ -0,0 +1,54 @@
+module Main where
+
+import Test.HUnit
+import Control.Monad
+import AufgabeFFP4
+
+-------------------------------------------------------------------------------
+
+import Data.List
+
+type KnapsackWantedSolution = (SolKnp,Value)
+type KnapsackWantedSolutions = [KnapsackWantedSolution]
+type KnapsackGotSolution = (SolKnp,Value)
+
+
+knapsackOk :: KnapsackWantedSolutions -> KnapsackGotSolution -> Bool
+knapsackOk wanted got = any (equalKnapsack got) wanted
+  where
+    equalKnapsack (sg,vg) (sw,vw) = vg == vw && equalKnapsackContent sg sw
+    equalKnapsackContent sg sw = sort sg == sort sw
+
+
+assertKnapsackOneOf :: String -> KnapsackWantedSolutions -> KnapsackGotSolution -> Assertion
+assertKnapsackOneOf preface expected actual = unless (knapsackOk expected actual) (assertFailure msg)
+  where
+    msg = (if null preface then "" else preface ++ "\n") ++
+          "expected one of: " ++ show expected ++ "\n but got: " ++ show actual
+
+-------------------------------------------------------------------------------
+
+cases1 = TestLabel "knapsack" $ TestList [
+  TestCase $ assertKnapsackOneOf "exercise example"
+    [([(2,3), (2,3), (3,4), (3,4)], 14)]
+    (knapsack [(2,3), (2,3), (3,4), (3,4), (5,6)] 10),
+  TestCase $ assertKnapsackOneOf "no objects"
+    [([], 0)]
+    (knapsack [(2,3), (2,3), (3,4), (3,4), (5,6)] 1),
+  TestCase $ assertKnapsackOneOf "all objects"
+    [([(2,3), (2,3), (3,4), (3,4), (5,6)], 20)]
+    (knapsack [(2,3), (2,3), (3,4), (3,4), (5,6)] 100),
+  TestCase $ assertKnapsackOneOf "a"
+    [([(2,2), (3,3)], 5), ([(5,5)], 5)]
+    (knapsack [(2,2), (3,3), (4,4), (5,5)] 5)
+  ]
+
+cases2 = TestLabel "binomDyn" $ TestList [
+  ]
+
+tests :: [Test]
+tests = [cases1, cases2]
+
+main = do
+  forM tests $ \test ->
+    runTestTT test
-- 
cgit v1.2.3