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
|
{-# 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
--------------------------------------------------------------------------------
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 (_, _, _, _) = 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
generate :: F -> W -> (F, W, [G])
--generate f w = (f, w, [ array (1,n) [ (i, j) | i<-[1..n], j<-[(+), (-), (*)] ] ] )
generate f w = (f, w, [ array (1,n) [(i, j) | i<-[1..n], j<-[(+)] ] ] )
where
n = snd $ bounds f
get_combinations :: Integer -> [[(Integer, 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))
--aget_combinations :: Integer -> [[Op]]
--aget_combinations 1 = [[(+)], [(-)], [(*)], [(./.)]]
--aget_combinations n = [ i ++ entr | entr <- aget_combinations (n-1), i <- aget_combinations 1 ]
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
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"
|
