Guest User

Untitled

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