-
Notifications
You must be signed in to change notification settings - Fork 1
/
list.hs
105 lines (69 loc) · 2.66 KB
/
list.hs
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
module WhyFP where
data List' a = Nil | Cons a (List' a) deriving Show
sum' :: List' Int -> Int
sum' Nil = 0
sum' (Cons num list) = num + sum' list
reduce' :: (a -> b -> b) -> b -> List' a -> b
reduce' f x Nil = x
reduce' f x (Cons i l) = f i $ reduce' f x l
sum'' :: List' Int -> Int
sum'' = reduce' (+) 0
product' :: List' Int -> Int
product' = reduce' (*) 1
anytrue :: List' Bool -> Bool
anytrue = reduce' (||) False
alltrue :: List' Bool -> Bool
alltrue = reduce' (&&) True
append :: List' a -> List' a -> List' a
append a b = reduce' Cons b a
doubleall :: List' Int -> List' Int
doubleall = reduce' doubleandcons Nil
where doubleandcons num list = Cons (2 * num) list
doubleall' :: List' Int -> List' Int
doubleall' = reduce' doubleandcons Nil
where doubleandcons = fandcons double
double n = 2 * n
fandcons f el list = Cons (f el) list
doubleall'' :: List' Int -> List' Int
doubleall'' = reduce' doubleandcons Nil
where doubleandcons = fandcons double
double n = 2 * n
fandcons f = Cons . f
doubleall''' :: List' Int -> List' Int
doubleall''' = reduce' (Cons . (*2)) Nil
map' :: (a -> b) -> List' a -> List' b
map' f = reduce' (Cons . f) Nil
doubleall'''' :: List' Int -> List' Int
doubleall'''' = map' (*2)
summatrix :: List' (List' Int) -> Int
summatrix = sum' . map' sum'
data Tree' a = Node a (List' (Tree' a)) deriving Show
redtree :: (a -> b -> b) -> (b -> b -> b) -> b -> Tree' a -> b
redtree f g x (Node label subtrees) = f label (redtree' f g x subtrees)
redtree':: (a -> b -> b) -> (b -> b -> b) -> b -> List' (Tree' a) -> b
redtree' f g x (Cons subtree rest) = g (redtree f g x subtree) (redtree' f g x rest)
redtree' f g x Nil = x
sumtree :: Tree' Int -> Int
sumtree = redtree (+) (+) 0
labels :: Tree' a -> List' a
labels = redtree Cons append Nil
--maptree :: (a -> b) -> Tree' a -> Tree' b
--maptree f = redtree (Node . f) Cons Nil
repeat' :: (a -> a) -> a -> List' a
repeat' f x = Cons x (repeat' f (f x))
next :: (Fractional a) => a -> a -> a
next n x = (x + n/x) / 2
approx' :: (Fractional a) => a -> a -> List' a
approx' num init = repeat' (next num) init
within :: (Fractional a, Ord a) => a -> List' a -> a
within eps (Cons x (Cons y rest))
| abs(x-y) <= eps = y
| otherwise = within eps (Cons y rest)
sqrt' :: (Fractional a, Ord a) => a -> a -> a -> a
sqrt' init eps num = within eps $ repeat' (next num) init
relative :: (Fractional a, Ord a) => a -> List' a -> a
relative eps (Cons x (Cons y rest))
| abs(x-y) <= (eps * (abs y)) = y
| otherwise = relative eps (Cons y rest)
sqrt'' :: (Fractional a, Ord a) => a -> a -> a -> a
sqrt'' init eps num = relative eps $ repeat' (next num) init