{-# LANGUAGE FlexibleInstances, TypeFamilies #-} import Data.Ratio -- рациональные числа import Data.Complex -- комплексные числа -- Класс абелевой группы class AbelGroup a where (^+^) :: a -> a -> a zero :: a negate' :: a -> a negate' a = zero ^-^ a (^-^) :: a -> a -> a (^-^) el1 el2 = el1 ^+^ negate' el2 --------------------------------------------- -- Класс линейного пространства над числовым полем типа Numeric a class AbelGroup a => LinearSpace a where type Numeric a :: * -- Numeric - тип числового поля (^*^) :: Numeric a -> a -> a --- Тип векторов data TVector = Vector { x::Double, y::Double } deriving(Eq,Ord) instance Show TVector where show (Vector x y) = "(" ++ show x ++ ";" ++ show y ++ ")" instance AbelGroup TVector where (Vector x1 y1) ^+^ (Vector x2 y2) = Vector (x1+x2) (y1+y2) zero = Vector 0 0 negate' (Vector x y) = Vector (-x) (-y) instance LinearSpace TVector where type Numeric TVector = Double a ^*^ v = Vector (a*x v) (a*y v) class LinearSpace a => HilbertSpace a where (%) :: a -> a -> Numeric a instance HilbertSpace TVector where (Vector x1 y1) % (Vector x2 y2) = (x1)*(x2) + (y1)*(y2) data TRealFunc = RealFunc (Double->Double) (^$^) :: TRealFunc -> Double -> Double (RealFunc f) ^$^ x = f x instance AbelGroup TRealFunc where (RealFunc f1) ^+^ (RealFunc f2) = RealFunc (\x -> f1 x + f2 x) zero = RealFunc (\_ -> 0) negate' (RealFunc f) = RealFunc (\x -> -f x) instance LinearSpace TRealFunc where type Numeric TRealFunc = Double a ^*^ (RealFunc f) = RealFunc (\x -> a*f x) instance HilbertSpace TRealFunc where (RealFunc f1) % (RealFunc f2) = sum $ map (\x -> (f1 x)*(f2 x)*(1/100)) [1/100,2/100..100/100] class MyMonoid a where (^**^) :: a -> a -> a neutral :: a instance MyMonoid [a] where l1 ^**^ l2 = l1 ++ l2 neutral = []