SHARE
TWEET

Untitled

a guest Jan 22nd, 2020 60 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
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top