Guest User

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