# Untitled

a guest
Jan 22nd, 2020
73
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. module Fix where
2. import Prelude hiding   ( repeat
3.                         , map
4.                         , foldr
5.                         , foldl
6.                         , iterate
7.                         , zip
8.                         , zipWith
9.                         , cycle
10.                         )
11. import Data.Function
12. import Nat
13.
14. data BinTree a = Leaf a | Node ( BinTree a) ( BinTree a)
15.     deriving (Show, Eq, Ord)
16.
17. map :: (a -> b) -> [a] -> [b]
18. map f = fix \$ \m xs -> case xs of
19.     []   -> []
20.     y:ys -> f y : m ys
21.
22. -- правая свертка через fix
23. foldr :: (a -> b -> b) -> b -> [a] -> b
24. foldr f = fix \$ \fr ini xs -> case xs of
25.     []      -> ini
26.     y:ys    -> y `f` fr ini ys
27.
28. -- левая свертка через fix
29. foldl :: (b -> a -> b) -> b -> [a] -> b
30. foldl f = fix \$ \fl ini xs -> case xs of
31.     []      -> ini
32.     y:ys    -> f ini y `fl` ys
33.
34. -- zip'ы через fix
35. zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
36. zipWith f = fix \$ \z x y -> if null x || null y
37.     then []
38.     else f (head x) (head y) : z (tail x) (tail y)
39.
40. zip :: [a] -> [b] -> [(a, b)]
41. zip = zipWith (,)
42.
43. -- repeat через fix
44. repeat :: a -> [a]
45. repeat = fix . (:)
46.
47. --iterate через fix
48. iterate :: (a -> a) -> a -> [a]
49. iterate f = fix \$ \i x -> x : i (f x)
50.
51. cycle :: [a] -> [a]
52. cycle = fix . (++)
53.
54. instance Num a => Num (BinTree a) where
55.     (+) (Leaf _) x = x
56.     (+) (Node l r) x = Node (l + x) r
57.     (*) (Leaf a) (Leaf b) = Leaf (a*b)
58.     (*) (Node l r) (Node l1 r1) = Node(l*l1) (r*r1)
59.     (*) _ _ = error "oshibka"
60.
61. treeAdd :: Num a => BinTree a -> BinTree a -> BinTree a
62. treeAdd = fix \$ \m tl tr -> case (tl,tr) of
63.             ((Leaf _),x) -> x
64.             ((Node l r),x) -> Node (m l x) r
65.
66. testTree :: BinTree Integer
67. testTree = Node (Leaf 7) (Leaf 3)
68. testTree2 = Node (testTree) (testTree)
RAW Paste Data