{-# LANGUAGE FlexibleInstances #-}

module Main (
    main
) where

import Data.List

-- Алгебраическая структура Кольцо
class Ring a where
    add ∷ a → a → a -- (+)
    mul ∷ a → a → a -- (*)
    neg ∷ a → a     -- -x
    idPlus ∷ () → a -- (+) identity
    idMul ∷ () → a  -- (*) identity

    minus ∷ a → a → a
    -- x - y = x + (-y)
    minus x y = add x (neg y)

-- Задаём кольцо из целых чисел (underlying set = Z)
-- С бинарными операциями + и *
instance Ring Int where
     add = (+)
     mul = (*)
     neg x = -x
     idPlus () = 0
     idMul () = 1

-- Аналогичное кольцо из рациональных чисел
instance Ring Float where
     add = (+)
     mul = (*)
     neg x = -x
     idPlus () = 0.0
     idMul () = 1.0

-- Матрица из элементов кольца
-- Можно добавить | Zero и | One для умножения и сложения
newtype Matrix a = Matrix [[a]]
    deriving Show

linearize ∷ Matrix a → [a]
linearize (Matrix list) = foldl' (λ state elem → state ⊕ elem) [] list

-- Выполнить операцию op над всеми элементами матриц попарно
mPerformOp ∷ (Ring a) ⇒ (a → a → a) → Matrix a → Matrix a → Matrix a
mPerformOp op (Matrix a) (Matrix b) =
    Matrix result
    where
        helper [] _ = []
        helper _ [] = []
        helper (x : xs) (y : ys) = (zipWith op x y) : (helper xs ys)
        result = helper a b

-- Сложение матриц
mAdd ∷(Ring a) ⇒ Matrix a → Matrix a → Matrix a
mAdd = mPerformOp add

-- Вычитание матриц
mSub ∷(Ring a) ⇒ Matrix a → Matrix a → Matrix a
mSub = mPerformOp minus

-- Умножение на скаляр - матрица * скаляр
mMulR ∷ (Ring a) ⇒ Matrix a → a → Matrix a
mMulR (Matrix []) _ = Matrix []
mMulR (Matrix m) scalar =
    Matrix result
    where
        helper [] = []
        helper (x:xs) =  map (λ elem → mul elem scalar) x : helper xs
        result = helper m

-- скаляр * матрицу
mMulL ∷ (Ring a) ⇒ a → Matrix a → Matrix a
mMulL _ (Matrix []) = Matrix []
mMulL scalar (Matrix m) =
    Matrix result
    where
        helper [] = []
        helper (x:xs) =  map (λ elem → mul scalar elem) x : helper xs
        result = helper m

-- (- Матрица)
mNeg ∷ (Ring a) ⇒ Matrix a → Matrix a
mNeg (Matrix []) = Matrix []
mNeg (Matrix m) =
    Matrix result
    where
        helper [] = []
        helper (x:xs) =  map (λ elem → neg elem) x : helper xs
        result = helper m

-- Транспозиция
mTranspose ∷  (Ring a) ⇒ Matrix a → Matrix a
mTranspose (Matrix m) = Matrix (transpose m)

summator ∷ (Ring a) ⇒ [a] → a
summator list = foldl' add (idPlus()) list

-- Умножение матриц
mMul ∷ (Ring a) ⇒ Matrix a → Matrix a → Matrix a
mMul (Matrix aM) (Matrix bM) =
    Matrix [ [summator $ zipWith mul a b | b ← transpose bM ] | a ← aM ]

-- Нулевая матрица
mZero ∷ (Ring a) ⇒ () → Matrix a
mZero () = Matrix [[ idPlus() ]]

-- Единичная матрица
mOne ∷ (Ring a) ⇒ () → Matrix a
mOne () = Matrix [[ idMul() ]]


-- Матрицы тоже образуют кольцо
instance Ring a ⇒ Ring (Matrix a) where
    add = mAdd
    mul = mMul
    neg = mNeg
    idPlus = mZero
    idMul = mOne

-- Выражение в кольце
data (Ring a) ⇒ Expression a =
    Element a
    | Plus (Expression a) (Expression a)
    | Minus (Expression a) (Expression a)
    | Negate (Expression a)
    | Mul (Expression a) (Expression a)
    | Zero
    | One
    deriving Show

-- Функция, вычисляющая значение выражения
calc ∷ (Ring a) ⇒ Expression a → a
calc (Element x) = x
calc (Plus e1 e2) = add (calc e1) (calc e2)
calc (Minus e1 e2) = minus (calc e1) (calc e2)
calc (Negate e1) = neg (calc e1)
calc (Mul e1 e2) = mul (calc e1) (calc e2)
calc Zero = idPlus ()
calc One = idMul ()


-- Тестовые данные
a_m = Matrix [[1, 3], [2, 4], [0, 5]] ∷ Matrix Int
b_m = Matrix [[1, 0], [2, 3]]
i_m = Matrix [[1, 0, 0, 1], [0, 1, 0, 1]]

megaMatrix = Matrix [[ a_m, b_m, a_m], [i_m, a_m, b_m]]

test = mMul a_m b_m
test2 = mMul test i_m

-- Выражения
e = Negate (Mul (Element a_m) (Element b_m))
e1 = Mul (Plus One (One ∷ Expression Float)) One

main =
    do
        putStrLn "Hello World!"
        putStrLn $ show test
        putStrLn $ show test2
        putStrLn $ show $ megaMatrix
        putStrLn $ show $ mMulR megaMatrix a_m
        putStrLn $ show $ mNeg megaMatrix
        putStrLn $ show $ calc e
        putStrLn $ show $ calc e1