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 ++++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 40 insertions(+), 20 deletions(-) (limited to 'AufgabeFFP6.hs') 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 -------------------------------------------------------------------------------- -- cgit v1.2.3