From 4df5a0cf24b811320f27e377dead9768aac54174 Mon Sep 17 00:00:00 2001 From: manuel Date: Tue, 15 May 2012 12:00:05 +0200 Subject: add div by zero protection + some indentions fixes --- AufgabeFFP6.hs | 60 +++++++++++++++++++++++++++-------------- 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 where import Data.Array +import Debug.Trace type F = Array Int Int type Op = Int -> Int -> Int @@ -33,11 +34,30 @@ yield = yield_bt -------------------------------------------------------------------------------- +instance Eq (Integer -> Integer -> Integer) where + (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0 +instance Eq (Int -> Int -> Int) where + (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0 + +check_divByZero :: F -> G -> Bool +check_divByZero f g = check_divByZero' (tail (elems f)) (elems g) + where + check_divByZero' _ [] = True + check_divByZero' [] _ = True + check_divByZero' (f:fs) (g:gs) + | f == 0 && g == (./.) = False + | otherwise = True && check_divByZero' fs gs + +-------------------------------------------------------------------------------- + type Node = ([Int], [Int], W, [Op]) goal_yield_bt :: Node -> Bool goal_yield_bt (_, _, _, []) = False -- no operators -goal_yield_bt (f, [], w, g) = eval (listArray (1, length f) f) (listArray (1, length g) g) == w +goal_yield_bt (f, [], w, g) = check_divByZero f' g' && eval f' g' == w + where + f' = listArray (1, length f) f + g' = listArray (1, length g) g goal_yield_bt (_, _, _, _) = False succ_yield_bt :: Node -> [Node] @@ -93,31 +113,31 @@ yield_gtf = filt . transform . generate -- produce [G] by using get_combinations generate :: F -> W -> (F, W, [G]) -generate f w = (f, w, [ array (1,n) entries | entries <- get_combinations n ] ) - where - n = (snd $ bounds f) - 1 +generate f w = (f, w, [ array (1,n) entries | entries <- get_combinations n ]) + where + n = (snd $ bounds f) - 1 --- provide all selections of length n, work recursively and attach index for level (convenient for creating arrays) +-- provide all selections of length n, work recursively and attach index for +-- level (convenient for creating arrays) get_combinations :: Int -> [[(Int, Op)]] -get_combinations 1 = [[(1,(+))], [(1, (-))], [(1, (*))], [(1,(./.))]] +get_combinations 1 = [[(1,(+))], [(1,(-))], [(1,(*))], [(1,(./.))]] get_combinations n = [ (up i) ++ entr | entr <- get_combinations (n-1), i <- get_combinations 1 ] - where - up = map (\(num, x) -> ((num+n-1), x)) + where + up = map (\(num, x) -> ((num + n - 1), x)) --- attaches a list of results -transform :: (W -> (F,W,[G])) -> W -> ((F, W, [G]), [W]) -transform fun w = ((f, w, g), map (eval f) g ) - where - (f, w, g) = fun w +-- attaches a list of results +transform :: (W -> (F, W, [G])) -> W -> ((F, W, [G]), [W]) +transform fun w = ((f, w, g'), map (eval f) g') + where + (f, w, g) = fun w + g' = filter (\g'' -> check_divByZero f g'') g --- take those, where the entry in the result list corresponds to -filt :: (W -> ((F,W,[G]),[W]) ) -> W -> [G] +-- take those, where the entry in the result list corresponds to +filt :: (W -> ((F, W, [G]), [W]) ) -> W -> [G] filt fun w = [ g!!i | i <- [0..n], res!!i == w ] - where - ( (f, _, g), res ) = fun w - n = (length g) - 1 - - + where + ( (f, _, g), res ) = fun w + n = (length g) - 1 -------------------------------------------------------------------------------- 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 [ TestCase $ assertEqual "eval3" (-3) (eval (array (1,3) [(1,1), (2,2), (3,3)]) (array (1,2) [(1,(-)), (2,(*))])), TestCase $ assertEqual "eval4" (-1) - (eval (array (1,6) [(1,3), (2,5), (3,2), (4,-2), (5,7), (6,0)]) (array (1,5) [(1,(+)), (2,(./.)), (3,(*)), (4,(+)), (5,(-))])), + (eval (array (1,6) [(1,3), (2,5), (3,2), (4,-2), (5,7), (6,0)]) + (array (1,5) [(1,(+)), (2,(./.)), (3,(*)), (4,(+)), (5,(-))])), TestCase $ assertEqual "eval5" (1) - (eval (array (1,6) [(1,3), (2,5), (3,2), (4,-2), (5,7), (6,0)]) (array (1,5) [(1,(*)), (2,(-)), (3,(+)), (4,(./.)), (5,(+))])), + (eval (array (1,6) [(1,3), (2,5), (3,2), (4,-2), (5,7), (6,0)]) + (array (1,5) [(1,(*)), (2,(-)), (3,(+)), (4,(./.)), (5,(+))])), TestCase $ assertEqual "eval6" (-5) - (eval (array (1,6) [(1,4), (2,2), (3,3), (4,-4), (5,5), (6,2)]) (array (1,5) [(1,(+)), (2,(./.)), (3,(*)), (4,(+)), (5,(-))])), + (eval (array (1,6) [(1,4), (2,2), (3,3), (4,-4), (5,5), (6,2)]) + (array (1,5) [(1,(+)), (2,(./.)), (3,(*)), (4,(+)), (5,(-))])), TestCase $ assertEqual "eval7" (2) - (eval (array (1,6) [(1,4), (2,2), (3,3), (4,-4), (5,5), (6,2)]) (array (1,5) [(1,(*)), (2,(-)), (3,(+)), (4,(./.)), (5,(+))])) + (eval (array (1,6) [(1,4), (2,2), (3,3), (4,-4), (5,5), (6,2)]) + (array (1,5) [(1,(*)), (2,(-)), (3,(+)), (4,(./.)), (5,(+))])) ] -instance Eq (Integer -> Integer -> Integer) where - (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0 -instance Eq (Int -> Int -> Int) where - (==) op1 op2 = ((op1 3 3) - (op2 3 3)) == 0 +-------------------------------------------------------------------------------- cases2 = TestLabel "yield_bt" $ TestList [ - TestCase $ assertEqual "yield_bt1" (yield_bt (array (1,3) [(1,1),(2,2),(3,3)] ) 6) - [array (1,2) [(1,(+)),(2,(+))],array (1,2) [(1,(*)),(2,(*))]], - TestCase $ assertEqual "yield_bt2" (yield_bt (array (1,3) [(1,1),(2,2),(3,3)] ) 4) [], - TestCase $ assertEqual "yield_bt3" (yield_bt (array (1,3) [(1,1),(2,2),(3,3)]) 0) - [(array (1,2) [(1,(+)),(2,(-))]),(array (1,2) [(1,(*)),(2,(./.))]),(array (1,2) [(1,(./.)),(2,(*))]),(array (1,2) [(1,(./.)),(2,(./.))])] - ] - + TestCase $ assertEqual "yield_bt1" + [array (1,2) [(1,(+)), (2,(+))],array (1,2) [(1,(*)), (2,(*))]] + (yield_bt (array (1,3) [(1,1), (2,2), (3,3)] ) 6), + TestCase $ assertEqual "yield_bt2" + [] + (yield_bt (array (1,3) [(1,1), (2,2), (3,3)] ) 4), + TestCase $ assertEqual "yield_bt3" + [(array (1,2) [(1,(+)), (2,(-))]),(array (1,2) [(1,(*)), (2,(./.))]), + (array (1,2) [(1,(./.)), (2,(*))]),(array (1,2) [(1,(./.)), (2,(./.))])] + (yield_bt (array (1,3) [(1,1), (2,2), (3,3)]) 0), + TestCase $ assertEqual "yield_bt4" + [array (1,1) [(1,(+))], array (1,1) [(1,(-))]] + (yield_bt (array (1,2) [(1,1), (2,0)]) 1) + ] cases3 = TestLabel "yield_gtf" $ TestList [ - TestCase $ assertEqual "yield_gtf1" (yield_gtf (array (1,3) [(1,1),(2,2),(3,3)] ) 6) - [array (1,2) [(1,(+)),(2,(+))],array (1,2) [(1,(*)),(2,(*))]], - TestCase $ assertEqual "yield_gtf2" (yield_gtf (array (1,3) [(1,1),(2,2),(3,3)] ) 4) [], - TestCase $ assertEqual "yield_gtf3" (yield_gtf (array (1,3) [(1,1),(2,2),(3,3)]) 0) - [(array (1,2) [(1,(+)),(2,(-))]),(array (1,2) [(1,(*)),(2,(./.))]),(array (1,2) [(1,(./.)),(2,(*))]),(array (1,2) [(1,(./.)),(2,(./.))])] - ] + TestCase $ assertEqual "yield_gtf1" + [array (1,2) [(1,(+)), (2,(+))],array (1,2) [(1,(*)), (2,(*))]] + (yield_gtf (array (1,3) [(1,1), (2,2), (3,3)] ) 6), + TestCase $ assertEqual "yield_gtf2" + [] + (yield_gtf (array (1,3) [(1,1), (2,2), (3,3)] ) 4), + TestCase $ assertEqual "yield_gtf3" + [(array (1,2) [(1,(+)), (2,(-))]),(array (1,2) [(1,(*)), (2,(./.))]), + (array (1,2) [(1,(./.)), (2,(*))]),(array (1,2) [(1,(./.)), (2,(./.))])] + (yield_gtf (array (1,3) [(1,1), (2,2), (3,3)]) 0), + TestCase $ assertEqual "yield_gtf4" + [array (1,1) [(1,(+))], array (1,1) [(1,(-))]] + (yield_gtf (array (1,2) [(1,1), (2,0)]) 1) + ] + +cases4 = TestLabel "yield" $ TestList [ + TestCase $ assertEqual "yield" + [array (1,2) [(1,(+)), (2,(+))],array (1,2) [(1,(*)), (2,(*))]] + (yield (array (1,3) [(1,1), (2,2), (3,3)] ) 6), + TestCase $ assertEqual "yield" + [] + (yield (array (1,3) [(1,1), (2,2), (3,3)] ) 4), + TestCase $ assertEqual "yield" + [(array (1,2) [(1,(+)), (2,(-))]),(array (1,2) [(1,(*)), (2,(./.))]), + (array (1,2) [(1,(./.)), (2,(*))]),(array (1,2) [(1,(./.)), (2,(./.))])] + (yield (array (1,3) [(1,1), (2,2), (3,3)]) 0), + TestCase $ assertEqual "yield" + [array (1,1) [(1,(+))], array (1,1) [(1,(-))]] + (yield (array (1,2) [(1,1), (2,0)]) 1) + ] + +-------------------------------------------------------------------------------- tests :: [Test] -tests = [cases1, cases2, cases3] +tests = [cases1, cases2, cases3, cases4] main = do forM tests $ \test -> -- cgit v1.2.3