1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
{-# LANGUAGE FlexibleInstances #-}
module AufgabeFFP6
where
import Data.Array
type F = Array Int Int
type Op = Int -> Int -> Int
type G = Array Int (Op)
type W = Int
--------------------------------------------------------------------------------
(./.) :: Int -> Int -> Int
(./.) = div
myfoldl :: [(a -> b -> a)] -> a -> [b] -> a
myfoldl _ f1 [] = f1
myfoldl (g:gs) f1 (f2:fs) = myfoldl gs (g f1 f2) fs
myfoldl' :: [(a -> a -> a)] -> [a] -> a
myfoldl' g (f:fs) = myfoldl g f fs
eval :: F -> G -> W
eval f g = myfoldl' (elems g) (elems f)
--------------------------------------------------------------------------------
yield :: F -> W -> [G]
yield = yield_bt
--yield = yield_gtf
--------------------------------------------------------------------------------
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) = 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]
succ_yield_bt (_, [], _, _) = []
succ_yield_bt (f, f', w, g) = [(f_new, f'_new, w, g ++ [g_new]) | g_new <- ops]
where
f_new = f ++ [head f']
f'_new = tail f'
ops = [(+), (-), (*), (./.)]
data Stack a = EmptyStk
| Stk a (Stack a)
push :: a -> Stack a -> Stack a
push x s = Stk x s
pop :: Stack a -> Stack a
pop EmptyStk = error "pop from an empty stack"
pop (Stk _ s) = s
top :: Stack a -> a
top EmptyStk = error "top from an empty stack"
top (Stk x _) = x
emptyStack :: Stack a
emptyStack = EmptyStk
stackEmpty :: Stack a -> Bool
stackEmpty EmptyStk = True
stackEmpty _ = False
searchDfs :: (node -> [node]) -> (node -> Bool) -> node -> [node]
searchDfs succ goal x = search' (push x emptyStack)
where
search' s
| stackEmpty s = []
| goal (top s) = top s : search' (pop s)
| otherwise =
let x = top s
in search' (foldr push (pop s) (succ x))
yield_bt :: F -> W -> [G]
yield_bt f w = map (\(_, _, _, g) -> listArray (1, length g) g) nodes
where
f_elem1 = head (elems f)
f_tail = tail (elems f)
nodes = searchDfs succ_yield_bt goal_yield_bt ([f_elem1], f_tail, w, [])
--------------------------------------------------------------------------------
yield_gtf :: F -> W -> [G]
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
-- 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 n = [ (up i) ++ entr | entr <- get_combinations (n-1), i <- get_combinations 1 ]
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
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]
filt fun w = [ g!!i | i <- [0..n], res!!i == w ]
where
( (f, _, g), res ) = fun w
n = (length g) - 1
--------------------------------------------------------------------------------
instance Show (Integer -> Integer -> Integer) where
show op = case (3 `op` 3) of
6 -> "plus"
0 -> "minus"
9 -> "times"
1 -> "div"
_ -> "unknown"
instance Show (Int -> Int -> Int) where
show op = case (3 `op` 3) of
6 -> "plus"
0 -> "minus"
9 -> "times"
1 -> "div"
_ -> "unknown"
|
