#* [https://github.com/itanf/ITMO-Training-FunctionalProgramming/blob/master/ITMOPrelude/Primitive.hs Primitive.hs]
#* [https://github.com/itanf/ITMO-Training-FunctionalProgramming/blob/master/ITMOPrelude/List.hs List.hs]
==Натуральные числаPrimitive=====Nat=== data Nat = Zero | Succ Nat deriving (+.) (-.) (Show,Read*.) <font color=green divides :: Nat ->Nat -- Определение натуральных чисел</font>Bool natZero ===Rat== Zero <font color=green> data Rat (%+) (%-- 0<) (%*) (%/font>) natOne euler :: ? ==List== ===Угадайка===Дают тип, надо написать название функции из '''List.hs''' и реализовать её. === Succ Zero <font colorКомбинаторика=green== '''Тут можно использовать только набор заранее определённых функций листа( среди которых нет даже ''++'' )''' subsequences :: [a] ->[ [ a ] ] permutations :: [a] -- 1</font>[ [ a ] ] ==Algebra== class Monoid a
natCmp :: instance Monoid Nat -> Nat -> Tri <font color=green>-- Сравнивает два натуральных числа</font> natCmp Zero Zero = EQ natCmp Zero (Succ _) = LT natCmp (Succ _) Zero = GT natCmp (Succ n) (Succ m) = natCmp n m natEq :: Nat -> Nat -> Bool <font color=green>-- n совпадает с m</font> natEq Zero Zero = True natEq Zero (Succ _) = False natEq (Succ _) Zero = False natEq (Succ n) (Succ m) = natEq n m natLt :: Nat -> Nat -> Bool <font color=green>-- n меньше m</font> natLt Zero Zero = False natLt Zero (Succ m) = True natLt (Succ n) Zero = False natLt (Succ n) (Succ m) = natLt n m infixl 6 +. <font color=green>-- Сложение для натуральных чисел</font> (+.) :: Nat -> Nat -> Nat Zero +. m = m (Succ n) +. m = Succ (n +. m) infixl 6 -. <font color=green>-- Вычитание для натуральных чисел</font> (-.) :: Nat -> Nat -> Nat Zero -. _ = Zero n -. Zero = n (Succ n) -. (Succ m) = n -. m infixl 7 *. <font color=green>-- Умножение для натуральных чисел</font> (*.) :: Nat -> Nat -> Nat Zero *. m = Zero (Succ n) *. m = m +. (n *. m) natDivMod :: Nat -> Nat -> Pair Nat Nat <font color=green>-- Целое и остаток от деления n на m</font> natDivMod n m = if (n natLt m) then Pair Zero n else Pair (Succ div) mod where Pair div mod = ((n -. m) natDivMod m) natDiv n = fst . natDivMod n <font color=green>-- Целое</font> natMod n Categories= snd . natDivMod n <font color=green>-- Остаток</font>
==Целые числа== data Int = Plus Nat | Minus Nat deriving class (Show,ReadFunctor f) intZero = Plus Zero intOne = Plus (Succ Zero) intNegOne = Minus (Succ Zero) intNeg :: Int -> Int intNeg (Plus x) = Minus x intNeg (Minus x) = Plus x intCmp :: Int -> Int -> Tri intCmp (Plus Zero) (Minus Zero) = EQ intCmp (Minus Zero) (Plus Zero) = EQ intCmp (Plus Zero) (Minus (Succ x)) = GT intCmp (Minus Zero) (Plus (Succ x)) = LT intCmp (Plus (Succ x)) (Minus Zero) = GT intCmp (Minus (Succ x)) (Plus Zero) = LT intCmp (Plus x) (Plus y) = natCmp x y intCmp (Minus x) (Minus y) = natCmp y x intEq :: Int -> Int -> Bool intEq (Plus Zero) (Minus Zero) = True intEq (Minus Zero) (Plus Zero) = True intEq (Plus Zero) (Minus (Succ x)) = False intEq (Minus Zero) (Plus (Succ x)) = False intEq (Plus (Succ x)) (Minus Zero) = False intEq (Minus (Succ x)) (Plus Zero) = False intEq (Plus x) (Plus y) = natEq x y intEq (Minus x) (Minus y) = natEq x yApplicative f
intLt :: Int -> Int -> Bool intLt (Plus Zero) (Minus Zero) = False intLt (Minus Zero) (Plus Zero) = False intLt (Plus Zero) (Minus (Succ x)) = False intLt (Minus Zero) (Plus (Succ x)) = True intLt (Plus (Succ x)) (Minus Zero) = False intLt (Minus (Succ x)) (Plus Zero) = True intLt (Plus x) (Plus y) = natLt x y intLt (Minus x) (Minus y) = natLt y xMonad Join m
infixl 6 .+., .-. (.+.) :: Int -> Int -> Int (Plus m) .+. (Plus n) = Plus (m +. n) (Minus m) .+. (Minus n) = Minus (m +. n) (Plus (Succ m)) .+. (Minus (Succ n)) = (Plus m) .+. (Minus n) (Minus (Succ m)) .+. (Plus (Succ n)) = (Plus n) .+. (Minus m) x .+. (Plus Zero) = x x .+. (Minus Zero) = x (Plus Zero) .+. y = y (Minus Zero) .+. y = ydata Identity
(.-.) :: Int -> Int -> Int n .-. m = n .+. (intNeg m)instance Monad Identity
infixl 7 .*. (.*.) :: Int -> Int -> Int (Plus m) .*. (Plus n) = Plus (m *. n) (Minus m) .*. (Minus n) = Plus (m *. n) (Plus m) .*. (Minus n) = Minus (m *. n) (Minus m) .*. (Plus n) = Minus (m *. n) ==Рациональные числа== data Rat = Rat Int NatMaybe
ratNeg :: Rat -> Rat ratNeg (Rat x y) = Rat (intNeg x) yinstance Monad Maybe
ratInv :: Rat -> Rat ratInv (Rat (Plus x) y) = Rat (Plus y) x ratInv (Rat (Minus x) y) = Rat (Minus y) xinstance Monad []
ratCmp :: Rat -> Rat -> Tri ratCmp (Rat a b) (Rat c d) = intCmp (a .*. (Plus d)) (c .*. (Plus b))data State
ratEq :: Rat -> Rat -> Bool ratEq (Rat a b) (Rat c d) = intEq (a .*. (Plus d)) (c .*. (Plus b))instance Monad State
ratLt :: Rat -> Rat -> Bool ratLt (Rat a b) (Rat c d) = intEq (a .*. (Plus d)) (c .*. (Plus b))newtype CpsIdentity
internalRatPlus :: Rat -> Rat -> Rat internalRatPlus (Rat a b) (Rat c d) = Rat ((a .*. (Plus d)) .+. (c .*. (Plus b))) (b *. d)instance Monad CpsIdentity
internalRatShorten :: Rat -> Rat internalRatShorten (Rat (Plus a) b) = Rat (Plus (a /. (gcd a b))) (b /. (gcd a b)) internalRatShorten (Rat (Minus a) b) = Rat (Minus (a /. (gcd a b))) (b /. (gcd a b))newtype CpsMaybe
infixl 7 %+, %- (%+) :: Rat -> Rat -> Rat n %+ m = internalRatShorten (internalRatPlus n m)instance Monad CpsMaybe
(%-) :: Rat -> Rat -> Rat n %- m = n %+ (ratNeg m)newtype CpsState
infixl 7 %*, %/ (%*) :: Rat -> Rat -> Rat (Rat a b) %* (Rat c d) = Rat (a .*. c) (b *. d) (%/) :: Rat -> Rat -> Rat n %/ m = n %* (ratInv m) ==GCD== '''Тут я не уверен, можем ли использовать ''natMod'' или надо дополнительно реализовывать её.<br/>Ещё мы вроде бы не можем использовать дополнительные функции!''' gcd :: Nat -> Nat -> Nat gcd n Zero = n gcd n m = gcd m (natMod n m) ==Метод Ньютона====subsequences== subsequences :: List a -> List (List a) subsequences Nil = Cons Nil Nil subsequences (Cons x xs) = subsequences xs ++ (map (Cons x) $ subsequences xs) ==permutations== permutations :: List a -> List (List a) permutations Nil = Cons Nil Nil permutations (Cons x ab) = perm Nil x ab where perm left m Nil = map (Cons m) (permutations left) perm left m (Cons r rx) = (map (Cons m) $ permutations $ left ++ (Cons r rx)) ++ (perm (Cons m left) r rx) ==А так же==* Дают тип какого-нибудь foldr и просят написать какой-нибудь foldr.* Написать определения каких-нибудь тайпклассов.* Написать какие-нибудь инстансы.* Доказать эквивалетность каких-нибудь двух определений монады.* CPS-преобразовать какие-нибудь типы.* Написать монадные инстансы для CPS-преобразованных типов.instance Monad CpsState
=Кр4=
