diff options
| -rw-r--r-- | AufgabeFFP6.hs | 60 | ||||
| -rw-r--r-- | TestAufgabeFFP6.hs | 78 |
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 | |||
| 4 | where | 4 | where |
| 5 | 5 | ||
| 6 | import Data.Array | 6 | import Data.Array |
| 7 | import Debug.Trace | ||
| 7 | 8 | ||
| 8 | type F = Array Int Int | 9 | type F = Array Int Int |
| 9 | type Op = Int -> Int -> Int | 10 | type Op = Int -> Int -> Int |
| @@ -33,11 +34,30 @@ yield = yield_bt | |||
| 33 | 34 | ||
| 34 | -------------------------------------------------------------------------------- | 35 | -------------------------------------------------------------------------------- |
| 35 | 36 | ||
| 37 | instance Eq (Integer -> Integer -> Integer) where | ||
| 38 | (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0 | ||
| 39 | instance Eq (Int -> Int -> Int) where | ||
| 40 | (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0 | ||
| 41 | |||
| 42 | check_divByZero :: F -> G -> Bool | ||
| 43 | check_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 | |||
| 36 | type Node = ([Int], [Int], W, [Op]) | 53 | type Node = ([Int], [Int], W, [Op]) |
| 37 | 54 | ||
| 38 | goal_yield_bt :: Node -> Bool | 55 | goal_yield_bt :: Node -> Bool |
| 39 | goal_yield_bt (_, _, _, []) = False -- no operators | 56 | goal_yield_bt (_, _, _, []) = False -- no operators |
| 40 | goal_yield_bt (f, [], w, g) = eval (listArray (1, length f) f) (listArray (1, length g) g) == w | 57 | goal_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 | ||
| 41 | goal_yield_bt (_, _, _, _) = False | 61 | goal_yield_bt (_, _, _, _) = False |
| 42 | 62 | ||
| 43 | succ_yield_bt :: Node -> [Node] | 63 | succ_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 |
| 95 | generate :: F -> W -> (F, W, [G]) | 115 | generate :: F -> W -> (F, W, [G]) |
| 96 | generate f w = (f, w, [ array (1,n) entries | entries <- get_combinations n ] ) | 116 | generate 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) | ||
| 101 | get_combinations :: Int -> [[(Int, Op)]] | 122 | get_combinations :: Int -> [[(Int, Op)]] |
| 102 | get_combinations 1 = [[(1,(+))], [(1, (-))], [(1, (*))], [(1,(./.))]] | 123 | get_combinations 1 = [[(1,(+))], [(1,(-))], [(1,(*))], [(1,(./.))]] |
| 103 | get_combinations n = [ (up i) ++ entr | entr <- get_combinations (n-1), i <- get_combinations 1 ] | 124 | get_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 |
| 108 | transform :: (W -> (F,W,[G])) -> W -> ((F, W, [G]), [W]) | 129 | transform :: (W -> (F, W, [G])) -> W -> ((F, W, [G]), [W]) |
| 109 | transform fun w = ((f, w, g), map (eval f) g ) | 130 | transform 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 |
| 114 | filt :: (W -> ((F,W,[G]),[W]) ) -> W -> [G] | 136 | filt :: (W -> ((F, W, [G]), [W]) ) -> W -> [G] |
| 115 | filt fun w = [ g!!i | i <- [0..n], res!!i == w ] | 137 | filt 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 | ||
| 25 | instance Eq (Integer -> Integer -> Integer) where | 29 | -------------------------------------------------------------------------------- |
| 26 | (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0 | ||
| 27 | instance Eq (Int -> Int -> Int) where | ||
| 28 | (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0 | ||
| 29 | 30 | ||
| 30 | cases2 = TestLabel "yield_bt" $ TestList [ | 31 | cases2 = 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 | ||
| 39 | cases3 = TestLabel "yield_gtf" $ TestList [ | 47 | cases3 = 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 | |||
| 63 | cases4 = 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 | ||
| 47 | tests :: [Test] | 81 | tests :: [Test] |
| 48 | tests = [cases1, cases2, cases3] | 82 | tests = [cases1, cases2, cases3, cases4] |
| 49 | 83 | ||
| 50 | main = do | 84 | main = do |
| 51 | forM tests $ \test -> | 85 | forM tests $ \test -> |
