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
|
{-# 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 (f, f', w, g)
| length g == 0 = False -- no operators
| length f' == 0 = eval (listArray (1, length f) f) (listArray (1, length g) g) == w
| otherwise = 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 :: Array Int Int -> Int -> [Array Int (Int -> Int -> Int)]
--------------------------------------------------------------------------------
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"
|
