Guest User

Untitled

a guest
Nov 1st, 2011
142
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. -- Алгебраическая структура Кольцо
  2. class Ring a where
  3.     add :: a -> a -> a -- (+)
  4.     mul :: a -> a -> a -- (*)
  5.     neg :: a -> a     -- -x
  6.     idPlus :: () -> a -- (+) identity
  7.     idMul :: () -> a  -- (*) identity
  8.  
  9.     minus :: a -> a -> a
  10.     -- x - y = x + (-y)
  11.     minus x y = add x (neg y)
  12.  
  13. -- Задаём кольцо из целых чисел (underlying set = Z)
  14. -- С бинарными операциями + и *
  15. instance Ring Int where
  16.      add = (+)
  17.      mul = (*)
  18.      neg x = -x
  19.      idPlus () = 0
  20.      idMul () = 1
  21.  
  22. -- Аналогичное кольцо из рациональных чисел
  23. instance Ring Float where
  24.      add = (+)
  25.      mul = (*)
  26.      neg x = -x
  27.      idPlus () = 0.0
  28.      idMul () = 1.0
  29.  
  30. -- Матрица из элементов кольца
  31. -- Можно добавить | Zero и | One для умножения и сложения
  32. newtype Matrix a = Matrix [[a]]
  33.     deriving Show
  34.  
  35. linearize :: Matrix a -> [a]
  36. linearize (Matrix list) = foldl' (\ state elem -> state ++ elem) [] list
  37.  
  38. -- Выполнить операцию op над всеми элементами матриц попарно
  39. mPerformOp :: (Ring a) => (a -> a -> a) -> Matrix a -> Matrix a -> Matrix a
  40. mPerformOp op (Matrix a) (Matrix b) =
  41.    Matrix result
  42.    where
  43.        helper [] _ = []
  44.        helper _ [] = []
  45.        helper (x : xs) (y : ys) = (zipWith op x y) : (helper xs ys)
  46.        result = helper a b
  47.  
  48. -- Сложение матриц
  49. mAdd ::(Ring a) => Matrix a -> Matrix a -> Matrix a
  50. mAdd = mPerformOp add
  51.  
  52. -- Вычитание матриц
  53. mSub ::(Ring a) => Matrix a -> Matrix a -> Matrix a
  54. mSub = mPerformOp minus
  55.  
  56. -- Умножение на скаляр - матрица * скаляр
  57. mMulR :: (Ring a) => Matrix a -> a -> Matrix a
  58. mMulR (Matrix []) _ = Matrix []
  59. mMulR (Matrix m) scalar =
  60.    Matrix result
  61.    where
  62.        helper [] = []
  63.        helper (x:xs) =  map (\ elem -> mul elem scalar) x : helper xs
  64.        result = helper m
  65.  
  66. -- скаляр * матрицу
  67. mMulL :: (Ring a) => a -> Matrix a -> Matrix a
  68. mMulL _ (Matrix []) = Matrix []
  69. mMulL scalar (Matrix m) =
  70.    Matrix result
  71.    where
  72.        helper [] = []
  73.        helper (x:xs) =  map (\ elem -> mul scalar elem) x : helper xs
  74.        result = helper m
  75.  
  76. -- (- Матрица)
  77. mNeg :: (Ring a) => Matrix a -> Matrix a
  78. mNeg (Matrix []) = Matrix []
  79. mNeg (Matrix m) =
  80.    Matrix result
  81.    where
  82.        helper [] = []
  83.        helper (x:xs) =  map (\ elem -> neg elem) x : helper xs
  84.        result = helper m
  85.  
  86. -- Транспозиция
  87. mTranspose :: (Ring a) => Matrix a -> Matrix a
  88. mTranspose (Matrix m) = Matrix (transpose m)
  89.  
  90. summator :: (Ring a) => [a] -> a
  91. summator list = foldl' add (idPlus()) list
  92.  
  93. -- Умножение матриц
  94. mMul :: (Ring a) => Matrix a -> Matrix a -> Matrix a
  95. mMul (Matrix aM) (Matrix bM) =
  96.     Matrix [ [summator $ zipWith mul a b | b <- transpose bM ] | a <- aM ]
  97.  
  98. -- Нулевая матрица
  99. mZero :: (Ring a) => () -> Matrix a
  100. mZero () = Matrix [[ idPlus() ]]
  101.  
  102. -- Единичная матрица
  103. mOne :: (Ring a) => () -> Matrix a
  104. mOne () = Matrix [[ idMul() ]]
  105.  
  106. -- Матрицы тоже образуют кольцо
  107. instance Ring a => Ring (Matrix a) where
  108.     add = mAdd
  109.     mul = mMul
  110.     neg = mNeg
  111.     idPlus = mZero
  112.     idMul = mOne
  113.  
  114. -- Выражение в кольце
  115. data (Ring a) => Expression a =
  116.     Element a
  117.     | Plus (Expression a) (Expression a)
  118.     | Minus (Expression a) (Expression a)
  119.     | Negate (Expression a)
  120.     | Mul (Expression a) (Expression a)
  121.     | Zero
  122.     | One
  123.     deriving Show
  124.  
  125. -- Функция, вычисляющая значение выражения
  126. calc :: (Ring a) => Expression a -> a
  127. calc (Element x) = x
  128. calc (Plus e1 e2) = add (calc e1) (calc e2)
  129. calc (Minus e1 e2) = minus (calc e1) (calc e2)
  130. calc (Negate e1) = neg (calc e1)
  131. calc (Mul e1 e2) = mul (calc e1) (calc e2)
  132. calc Zero = idPlus ()
  133. calc One = idMul ()
  134.  
  135.  
  136. -- Тестовые данные
  137. a_m = Matrix [[1, 3], [2, 4], [0, 5]] :: Matrix Int
  138. b_m = Matrix [[1, 0], [2, 3]]
  139. i_m = Matrix [[1, 0, 0, 1], [0, 1, 0, 1]]
  140.  
  141. megaMatrix = Matrix [[ a_m, b_m, a_m], [i_m, a_m, b_m]]
  142.  
  143. test = mMul a_m b_m
  144. test2 = mMul test i_m
  145.  
  146. -- Выражения
  147. e = Negate (Mul (Element a_m) (Element b_m))
  148. e1 = Mul (Plus One (One :: Expression Float)) One
  149.  
  150.  
  151. main =
  152.     do
  153.         putStrLn $ show test
  154.         putStrLn $ show test2
  155.         putStrLn $ show $ megaMatrix
  156.         putStrLn $ show $ mMulR megaMatrix a_m
  157.         putStrLn $ show $ mNeg megaMatrix
  158.         putStrLn $ show $ calc e
  159.         putStrLn $ show $ calc e1
  160.  
RAW Paste Data