summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authormanuel <manuel@mausz.at>2012-05-15 12:00:05 +0200
committermanuel <manuel@mausz.at>2012-05-15 12:00:05 +0200
commit4df5a0cf24b811320f27e377dead9768aac54174 (patch)
tree3404d994a34bd0dc208f9b42a7063f1bd80dc540
parentcc9fb7c09a62e1811aef5c22e3633e3bd42e2662 (diff)
downloadffp-4df5a0cf24b811320f27e377dead9768aac54174.tar.gz
ffp-4df5a0cf24b811320f27e377dead9768aac54174.tar.bz2
ffp-4df5a0cf24b811320f27e377dead9768aac54174.zip
add div by zero protection + some indentions fixes
-rw-r--r--AufgabeFFP6.hs60
-rw-r--r--TestAufgabeFFP6.hs78
2 files changed, 96 insertions, 42 deletions
diff --git a/AufgabeFFP6.hs b/AufgabeFFP6.hs
index c60053d..1f2faff 100644
--- a/AufgabeFFP6.hs
+++ b/AufgabeFFP6.hs
@@ -4,6 +4,7 @@ module AufgabeFFP6
4where 4where
5 5
6import Data.Array 6import Data.Array
7import Debug.Trace
7 8
8type F = Array Int Int 9type F = Array Int Int
9type Op = Int -> Int -> Int 10type Op = Int -> Int -> Int
@@ -33,11 +34,30 @@ yield = yield_bt
33 34
34-------------------------------------------------------------------------------- 35--------------------------------------------------------------------------------
35 36
37instance Eq (Integer -> Integer -> Integer) where
38 (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0
39instance Eq (Int -> Int -> Int) where
40 (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0
41
42check_divByZero :: F -> G -> Bool
43check_divByZero f g = check_divByZero' (tail (elems f)) (elems g)
44 where
45 check_divByZero' _ [] = True
46 check_divByZero' [] _ = True
47 check_divByZero' (f:fs) (g:gs)
48 | f == 0 && g == (./.) = False
49 | otherwise = True && check_divByZero' fs gs
50
51--------------------------------------------------------------------------------
52
36type Node = ([Int], [Int], W, [Op]) 53type Node = ([Int], [Int], W, [Op])
37 54
38goal_yield_bt :: Node -> Bool 55goal_yield_bt :: Node -> Bool
39goal_yield_bt (_, _, _, []) = False -- no operators 56goal_yield_bt (_, _, _, []) = False -- no operators
40goal_yield_bt (f, [], w, g) = eval (listArray (1, length f) f) (listArray (1, length g) g) == w 57goal_yield_bt (f, [], w, g) = check_divByZero f' g' && eval f' g' == w
58 where
59 f' = listArray (1, length f) f
60 g' = listArray (1, length g) g
41goal_yield_bt (_, _, _, _) = False 61goal_yield_bt (_, _, _, _) = False
42 62
43succ_yield_bt :: Node -> [Node] 63succ_yield_bt :: Node -> [Node]
@@ -93,31 +113,31 @@ yield_gtf = filt . transform . generate
93 113
94-- produce [G] by using get_combinations 114-- produce [G] by using get_combinations
95generate :: F -> W -> (F, W, [G]) 115generate :: F -> W -> (F, W, [G])
96generate f w = (f, w, [ array (1,n) entries | entries <- get_combinations n ] ) 116generate f w = (f, w, [ array (1,n) entries | entries <- get_combinations n ])
97 where 117 where
98 n = (snd $ bounds f) - 1 118 n = (snd $ bounds f) - 1
99 119
100-- provide all selections of length n, work recursively and attach index for level (convenient for creating arrays) 120-- provide all selections of length n, work recursively and attach index for
121-- level (convenient for creating arrays)
101get_combinations :: Int -> [[(Int, Op)]] 122get_combinations :: Int -> [[(Int, Op)]]
102get_combinations 1 = [[(1,(+))], [(1, (-))], [(1, (*))], [(1,(./.))]] 123get_combinations 1 = [[(1,(+))], [(1,(-))], [(1,(*))], [(1,(./.))]]
103get_combinations n = [ (up i) ++ entr | entr <- get_combinations (n-1), i <- get_combinations 1 ] 124get_combinations n = [ (up i) ++ entr | entr <- get_combinations (n-1), i <- get_combinations 1 ]
104 where 125 where
105 up = map (\(num, x) -> ((num+n-1), x)) 126 up = map (\(num, x) -> ((num + n - 1), x))
106 127
107-- attaches a list of results 128-- attaches a list of results
108transform :: (W -> (F,W,[G])) -> W -> ((F, W, [G]), [W]) 129transform :: (W -> (F, W, [G])) -> W -> ((F, W, [G]), [W])
109transform fun w = ((f, w, g), map (eval f) g ) 130transform fun w = ((f, w, g'), map (eval f) g')
110 where 131 where
111 (f, w, g) = fun w 132 (f, w, g) = fun w
133 g' = filter (\g'' -> check_divByZero f g'') g
112 134
113-- take those, where the entry in the result list corresponds to 135-- take those, where the entry in the result list corresponds to
114filt :: (W -> ((F,W,[G]),[W]) ) -> W -> [G] 136filt :: (W -> ((F, W, [G]), [W]) ) -> W -> [G]
115filt fun w = [ g!!i | i <- [0..n], res!!i == w ] 137filt fun w = [ g!!i | i <- [0..n], res!!i == w ]
116 where 138 where
117 ( (f, _, g), res ) = fun w 139 ( (f, _, g), res ) = fun w
118 n = (length g) - 1 140 n = (length g) - 1
119
120
121 141
122-------------------------------------------------------------------------------- 142--------------------------------------------------------------------------------
123 143
diff --git a/TestAufgabeFFP6.hs b/TestAufgabeFFP6.hs
index c435045..1f661e6 100644
--- a/TestAufgabeFFP6.hs
+++ b/TestAufgabeFFP6.hs
@@ -13,39 +13,73 @@ cases1 = TestLabel "eval" $ TestList [
13 TestCase $ assertEqual "eval3" (-3) 13 TestCase $ assertEqual "eval3" (-3)
14 (eval (array (1,3) [(1,1), (2,2), (3,3)]) (array (1,2) [(1,(-)), (2,(*))])), 14 (eval (array (1,3) [(1,1), (2,2), (3,3)]) (array (1,2) [(1,(-)), (2,(*))])),
15 TestCase $ assertEqual "eval4" (-1) 15 TestCase $ assertEqual "eval4" (-1)
16 (eval (array (1,6) [(1,3), (2,5), (3,2), (4,-2), (5,7), (6,0)]) (array (1,5) [(1,(+)), (2,(./.)), (3,(*)), (4,(+)), (5,(-))])), 16 (eval (array (1,6) [(1,3), (2,5), (3,2), (4,-2), (5,7), (6,0)])
17 (array (1,5) [(1,(+)), (2,(./.)), (3,(*)), (4,(+)), (5,(-))])),
17 TestCase $ assertEqual "eval5" (1) 18 TestCase $ assertEqual "eval5" (1)
18 (eval (array (1,6) [(1,3), (2,5), (3,2), (4,-2), (5,7), (6,0)]) (array (1,5) [(1,(*)), (2,(-)), (3,(+)), (4,(./.)), (5,(+))])), 19 (eval (array (1,6) [(1,3), (2,5), (3,2), (4,-2), (5,7), (6,0)])
20 (array (1,5) [(1,(*)), (2,(-)), (3,(+)), (4,(./.)), (5,(+))])),
19 TestCase $ assertEqual "eval6" (-5) 21 TestCase $ assertEqual "eval6" (-5)
20 (eval (array (1,6) [(1,4), (2,2), (3,3), (4,-4), (5,5), (6,2)]) (array (1,5) [(1,(+)), (2,(./.)), (3,(*)), (4,(+)), (5,(-))])), 22 (eval (array (1,6) [(1,4), (2,2), (3,3), (4,-4), (5,5), (6,2)])
23 (array (1,5) [(1,(+)), (2,(./.)), (3,(*)), (4,(+)), (5,(-))])),
21 TestCase $ assertEqual "eval7" (2) 24 TestCase $ assertEqual "eval7" (2)
22 (eval (array (1,6) [(1,4), (2,2), (3,3), (4,-4), (5,5), (6,2)]) (array (1,5) [(1,(*)), (2,(-)), (3,(+)), (4,(./.)), (5,(+))])) 25 (eval (array (1,6) [(1,4), (2,2), (3,3), (4,-4), (5,5), (6,2)])
26 (array (1,5) [(1,(*)), (2,(-)), (3,(+)), (4,(./.)), (5,(+))]))
23 ] 27 ]
24 28
25instance Eq (Integer -> Integer -> Integer) where 29--------------------------------------------------------------------------------
26 (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0
27instance Eq (Int -> Int -> Int) where
28 (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0
29 30
30cases2 = TestLabel "yield_bt" $ TestList [ 31cases2 = TestLabel "yield_bt" $ TestList [
31 TestCase $ assertEqual "yield_bt1" (yield_bt (array (1,3) [(1,1),(2,2),(3,3)] ) 6) 32 TestCase $ assertEqual "yield_bt1"
32 [array (1,2) [(1,(+)),(2,(+))],array (1,2) [(1,(*)),(2,(*))]], 33 [array (1,2) [(1,(+)), (2,(+))],array (1,2) [(1,(*)), (2,(*))]]
33 TestCase $ assertEqual "yield_bt2" (yield_bt (array (1,3) [(1,1),(2,2),(3,3)] ) 4) [], 34 (yield_bt (array (1,3) [(1,1), (2,2), (3,3)] ) 6),
34 TestCase $ assertEqual "yield_bt3" (yield_bt (array (1,3) [(1,1),(2,2),(3,3)]) 0) 35 TestCase $ assertEqual "yield_bt2"
35 [(array (1,2) [(1,(+)),(2,(-))]),(array (1,2) [(1,(*)),(2,(./.))]),(array (1,2) [(1,(./.)),(2,(*))]),(array (1,2) [(1,(./.)),(2,(./.))])] 36 []
36 ] 37 (yield_bt (array (1,3) [(1,1), (2,2), (3,3)] ) 4),
37 38 TestCase $ assertEqual "yield_bt3"
39 [(array (1,2) [(1,(+)), (2,(-))]),(array (1,2) [(1,(*)), (2,(./.))]),
40 (array (1,2) [(1,(./.)), (2,(*))]),(array (1,2) [(1,(./.)), (2,(./.))])]
41 (yield_bt (array (1,3) [(1,1), (2,2), (3,3)]) 0),
42 TestCase $ assertEqual "yield_bt4"
43 [array (1,1) [(1,(+))], array (1,1) [(1,(-))]]
44 (yield_bt (array (1,2) [(1,1), (2,0)]) 1)
45 ]
38 46
39cases3 = TestLabel "yield_gtf" $ TestList [ 47cases3 = TestLabel "yield_gtf" $ TestList [
40 TestCase $ assertEqual "yield_gtf1" (yield_gtf (array (1,3) [(1,1),(2,2),(3,3)] ) 6) 48 TestCase $ assertEqual "yield_gtf1"
41 [array (1,2) [(1,(+)),(2,(+))],array (1,2) [(1,(*)),(2,(*))]], 49 [array (1,2) [(1,(+)), (2,(+))],array (1,2) [(1,(*)), (2,(*))]]
42 TestCase $ assertEqual "yield_gtf2" (yield_gtf (array (1,3) [(1,1),(2,2),(3,3)] ) 4) [], 50 (yield_gtf (array (1,3) [(1,1), (2,2), (3,3)] ) 6),
43 TestCase $ assertEqual "yield_gtf3" (yield_gtf (array (1,3) [(1,1),(2,2),(3,3)]) 0) 51 TestCase $ assertEqual "yield_gtf2"
44 [(array (1,2) [(1,(+)),(2,(-))]),(array (1,2) [(1,(*)),(2,(./.))]),(array (1,2) [(1,(./.)),(2,(*))]),(array (1,2) [(1,(./.)),(2,(./.))])] 52 []
45 ] 53 (yield_gtf (array (1,3) [(1,1), (2,2), (3,3)] ) 4),
54 TestCase $ assertEqual "yield_gtf3"
55 [(array (1,2) [(1,(+)), (2,(-))]),(array (1,2) [(1,(*)), (2,(./.))]),
56 (array (1,2) [(1,(./.)), (2,(*))]),(array (1,2) [(1,(./.)), (2,(./.))])]
57 (yield_gtf (array (1,3) [(1,1), (2,2), (3,3)]) 0),
58 TestCase $ assertEqual "yield_gtf4"
59 [array (1,1) [(1,(+))], array (1,1) [(1,(-))]]
60 (yield_gtf (array (1,2) [(1,1), (2,0)]) 1)
61 ]
62
63cases4 = TestLabel "yield" $ TestList [
64 TestCase $ assertEqual "yield"
65 [array (1,2) [(1,(+)), (2,(+))],array (1,2) [(1,(*)), (2,(*))]]
66 (yield (array (1,3) [(1,1), (2,2), (3,3)] ) 6),
67 TestCase $ assertEqual "yield"
68 []
69 (yield (array (1,3) [(1,1), (2,2), (3,3)] ) 4),
70 TestCase $ assertEqual "yield"
71 [(array (1,2) [(1,(+)), (2,(-))]),(array (1,2) [(1,(*)), (2,(./.))]),
72 (array (1,2) [(1,(./.)), (2,(*))]),(array (1,2) [(1,(./.)), (2,(./.))])]
73 (yield (array (1,3) [(1,1), (2,2), (3,3)]) 0),
74 TestCase $ assertEqual "yield"
75 [array (1,1) [(1,(+))], array (1,1) [(1,(-))]]
76 (yield (array (1,2) [(1,1), (2,0)]) 1)
77 ]
78
79--------------------------------------------------------------------------------
46 80
47tests :: [Test] 81tests :: [Test]
48tests = [cases1, cases2, cases3] 82tests = [cases1, cases2, cases3, cases4]
49 83
50main = do 84main = do
51 forM tests $ \test -> 85 forM tests $ \test ->