labs Aleksei Pakhomov

Lab1/src/Lists.hs

@@ -69,7 +69,7 @@ mapFuncs (fs:fss) x = (fs x):(mapFuncs fss x)
 -- и возвращает True, если все они выполняются (т.е. возвращают True) для x.
 -- Полезные стандартные функции: and, all.
 -- satisfiesAll [even, \x -> x `rem` 5 == 0] 10 == True
--- satisfiesAll [] 4 == True (кстати, почему?)
+-- satisfiesAll [] 4 == True (кстати, почему?) -- потому что это нейтральный элемент, отсутствие условий не должно нарушать истинность результата, иначе бы не работала рекурсия
 satisfiesAll :: [a -> Bool] -> a -> Bool
 satisfiesAll [] x = True
 satisfiesAll (pred:preds) x = pred x && satisfiesAll preds x

Lab1/src/Luhn.hs

@@ -36,7 +36,7 @@ decreaseLarge x
 
 -- decreaseAllLarge [] == []
 -- decreaseAllLarge [1] == [1]
--- decreaseAllLarge [1, 9, 3] == [1, 2, 3]
+-- decreaseAllLarge [1, 18, 3] == [1, 9, 3]
 -- decreaseAllLarge [10, 2, 18] == [1, 2, 9]
 decreaseAllLarge :: [Int] -> [Int]
 decreaseAllLarge digs = map decreaseLarge digs

Lab2/src/Poly.hs

@@ -1,79 +1,115 @@
 -- Не забудьте добавить тесты.
 
 module Poly where
+import Data.List
 
 -- Многочлены
 -- a -- тип коэффициентов, список начинается со свободного члена.
 -- Бонус: при решении следующих заданий подумайте, какие стали бы проще или
 -- сложнее при обратном порядке коэффициентов (и добавьте комментарий).
-newtype Poly a = P [a]
+newtype Poly a = Poly [a]
 
 -- Задание 1 -----------------------------------------
 
 -- Определите многочлен $x$.
-x :: Num a => Poly a
-x = undefined
-
+xPows x = map (\n -> x**n) [0..]
+getCoefs (Poly p) = p
+discardZeroes [] = []
+discardZeroes p = if (last p /= 0) then p 
+                  else discardZeroes $ init p
+makePoly p x = sum $ zipWith (*) (getCoefs p) (xPows x)
+--x :: Num a => Poly a
+x p = Poly [0, 1]
 -- Задание 2 -----------------------------------------
 
 -- Функция, считающая значение многочлена в точке
-applyPoly :: Num a => Poly a -> a -> a
-applyPoly = undefined
+--applyPoly :: Num a => Poly a -> a -> a
+applyPoly p x = makePoly p x
 
 -- Задание 3 ----------------------------------------
 
 -- Определите равенство многочленов
 -- Заметьте, что многочлены с разными списками коэффициентов
 -- могут быть равны! Подумайте, почему.
+-- Ответ: при вычислении суммы или разности многочленов, коэффициенты, стоящие при некоторых степенях, могут оказаться равными нулю. Наличие  таких нулей не меняет сам многочлен, но допускает разные списки коэффициентов. В данном случае нулевые элементы в конце списка могут быть отброшены
 instance (Num a, Eq a) => Eq (Poly a) where
-    (==) = undefined
+    (Poly a) == (Poly b) = discardZeroes a == discardZeroes b
 
 -- Задание 4 -----------------------------------------
+showPoly [] = show 0 
+showPoly p =  let cOs = zip p [0..]
+                  nonZeroCOs = filter (\(c,_) -> c /= 0) cOs
+                  cShow c = if c == 1 then "" else show c ++ " *"
+                  nShow n = case n of 
+                              0 -> ""
+                              1 -> "x" 
+                              m -> "x^" ++ show m
+                  cnShow c n = if c == 1 && n == 0 then show 1 
+                               else intercalate " " $ filter (/="") [cShow c, nShow n]            
+                  terms = map (\(c,n) -> cnShow c n) nonZeroCOs
+              in intercalate " + " (reverse terms) 
 
 -- Определите перевод многочлена в строку. 
 -- Это должна быть стандартная математическая запись, 
 -- например: show (3 * x * x + 1) == "3 * x^2 + 1").
 -- (* и + для многочленов можно будет использовать после задания 6.)
+--instance (Num a, Eq a, Show a) => Show (Poly a) where
 instance (Num a, Eq a, Show a) => Show (Poly a) where
-    show = undefined
-
+    show (Poly []) = show 0
+    show (Poly p) = showPoly p
 -- Задание 5 -----------------------------------------
 
 -- Определите сложение многочленов
 plus :: Num a => Poly a -> Poly a -> Poly a
-plus = undefined
+plus p1 p2 = if (length (getCoefs p1) >= length (getCoefs p2)) then Poly $ zipWith (+) (getCoefs p1) ((getCoefs p2) ++ repeat 0)
+             else plus p2 p1
 
 -- Задание 6 -----------------------------------------
 
 -- Определите умножение многочленов
+multiplyBy a p1 = Poly (map (a*)(getCoefs p1))
+multiplyByX p = Poly (0:coefs)
+                where coefs = getCoefs p
 times :: Num a => Poly a -> Poly a -> Poly a
-times = undefined
+times (Poly []) p2 = Poly []
+times p1 p2 = let pTimesP2 = multiplyBy (head $ getCoefs p1) p2
+                  xTimesP1Timesp2 = multiplyByX $ times (Poly $ tail $ getCoefs p1) p2
+               in plus pTimesP2 xTimesP1Timesp2    
 
 -- Задание 7 -----------------------------------------
 
 -- Сделайте многочлены числовым типом
+negatePoly p = Poly $ map Prelude.negate (getCoefs p)
 instance Num a => Num (Poly a) where
     (+) = plus
     (*) = times
-    negate      = undefined
-    fromInteger = undefined
+    negate      = negatePoly
+    fromInteger a = Poly [fromIntegral a]
     -- Эти функции оставить как undefined, поскольку для 
     -- многочленов они не имеют математического смысла
     abs    = undefined
     signum = undefined
 
 -- Задание 8 -----------------------------------------
+--deriv (Poly []) = (Poly [])
+--deriv (Poly (_:ps)) = Poly $ zipWith (*) ps [1..]
+--nderiv n p | n == 0 = p
+--           | n == 1 = deriv p
+--           | otherwise = nderiv (n-1) (deriv p)
+
 
 -- Реализуйте nderiv через deriv
 class Num a => Differentiable a where
     -- взятие производной
     deriv  :: a -> a
     -- взятие n-ной производной
     nderiv :: Int -> a -> a
-    nderiv = undefined
+    nderiv n p | n == 0 = p
+	           | otherwise = nderiv (n - 1) (deriv p)
 
 -- Задание 9 -----------------------------------------
-
 -- Определите экземпляр класса типов
-instance Num a => Differentiable (Poly a) where
-    deriv = undefined
+deriv' (Poly []) = (Poly [])
+deriv' (Poly (_:ps)) = Poly $ zipWith (*) ps [1..]
+instance (Num a, Enum a) => Differentiable (Poly a) where
+    deriv (Poly p)= deriv' (Poly p)

Lab2/src/SimpleLang.hs

@@ -45,18 +45,33 @@ type State = String -> Int
 
 -- в начальном состоянии все переменные имеют значение 0
 empty :: State
-empty = undefined
+empty = const 0
 
 -- возвращает состояние, в котором переменная var имеет значение newVal, 
 -- все остальные -- то же, что в state
 extend :: State -> String -> Int -> State
-extend state var newVal = undefined
+extend state var newVal v | v == var = newVal
+                          | otherwise = state v
 
 -- Задание 2 -----------------------------------------
 
 -- возвращает значение выражения expr при значениях переменных из state.
 eval :: State -> Expression -> Int
-eval state expr = undefined
+eval state (Var var) = state var
+eval _ (Val val) = val
+eval state (Op val1 op val2) = case op of
+      Plus -> var1 + var2
+      Minus -> var1 - var2
+      Times -> var1 * var2
+      Divide -> var1 `div` var2
+      Gt -> if var1 > var2 then 1 else 0
+      Ge -> if var1 >= var2 then 1 else 0
+      Lt -> if var1 < var2 then 1 else 0
+      Le -> if var1 <= var2 then 1 else 0
+      Eql -> if var1 == var2 then 1 else 0
+      where
+        var1 = eval state val1
+        var2 = eval state val2
 
 -- Задание 3 -----------------------------------------
 
@@ -72,23 +87,61 @@ data DietStatement = DAssign String Expression
 
 -- упрощает программу Simple
 desugar :: Statement -> DietStatement
-desugar = undefined
+
+desugar (If expr outTrue outFalse) = DIf expr (desugar outTrue) (desugar outFalse) 
+
+desugar (While expr state) = DWhile expr (desugar state) 
+
+desugar (Assign var expr) = DAssign var expr 
+
+desugar (Incr var) = DAssign var (Op (Var var) Plus (Val 1))
+
+desugar Skip = DSkip
+
+desugar (Block []) = DSkip
+
+desugar (Block (st : sts)) = DSequence (desugar st) (desugar (Block sts))
+
+desugar (For state expr state1 state2) = DSequence (desugar state) (DWhile expr (DSequence (desugar state2) (desugar state1)))
 
 -- Задание 4 -----------------------------------------
 
 -- принимает начальное состояние и программу Simpler
 -- и возвращает состояние после работы программы
 runSimpler :: State -> DietStatement -> State
-runSimpler = undefined
 
+runSimpler state (DAssign var expr) = extend state var (eval state expr) 
+
+runSimpler state (DIf expr out1 out2) = if eval state expr == 1 then runSimpler state out1 
+                                        else runSimpler state out2
+
+runSimpler state (DWhile exp st) = if eval state exp == 1 then runSimpler (runSimpler state st) (DWhile exp st) 
+                                   else state
+
+runSimpler state (DSequence st1 st2) = runSimpler (runSimpler state st1) st2  
+
+runSimpler state DSkip = state
 -- 
 -- in s "A" ~?= 10
 
 -- принимает начальное состояние и программу Simple
 -- и возвращает состояние после работы программы
 run :: State -> Statement -> State
-run = undefined
-
+run state (Assign var expr) = extend state var (eval state expr) 
+run state (Incr var) = extend state var (state var + 1)  
+run state (If cond st1 st2) =
+    if eval state cond /= 0 then run state st1 else run state st2  
+run state (While cond stmt) =
+    let loop state = if eval state cond /= 0 then loop (run state stmt) else state
+    in loop state  
+run state (For initStmt cond incrStmt bodyStmt) =
+    let initState = run state initStmt
+        loop st = if eval st cond /= 0
+                 then loop (run st (Block [bodyStmt, incrStmt]))
+                 else st
+    in loop initState 
+run state (Block sts) = foldl run state sts  
+run state Skip = state 
 -- Программы -------------------------------------------
 
 {- Вычисление факториала
@@ -113,8 +166,10 @@ factorial = For (Assign "Out" (Val 1))
    B := B - 1
 -}
 squareRoot :: Statement
-squareRoot = undefined
-
+squareRoot = Block [ Assign "B" (Val 0), 
+  While (Op (Var "A") Ge (Op (Var "B") Times (Var "B"))) (Incr "B"), 
+  Assign "B" (Op (Var "B") Minus (Val 1))
+  ]
 {- Вычисление числа Фибоначчи
 
    F0 := 1;
@@ -135,4 +190,19 @@ squareRoot = undefined
    }
 -}
 fibonacci :: Statement
-fibonacci = undefined
+fibonacci = 
+  Block [
+    Assign "F0" (Val 1), Assign "F1" (Val 1),
+    If (Op (Var "In") Eql (Val 0))
+      (Assign "Out" (Val 1))
+      (If (Op (Var "In") Eql (Val 1))
+        (Assign "Out" (Var "F0"))
+        (For (Assign "C" (Val 2))
+          (Op (Var "C") Le (Var "In"))
+          (Incr "C")
+          (Block [ Assign "T" (Op (Var "F0") Plus (Var "F1")), Assign "F0" (Var "F1"), Assign "F1" (Var "T") , Assign "Out" (Var "T")
+            ]
+          )
+        )
+    )
+  ]

Lab2/test/Spec.hs

@@ -5,7 +5,45 @@ import Test.Hspec
 main :: IO ()
 main = hspec $ do
     describe "poly" $ do
-        it "applyPoly" $ pending
+        it "applyPoly" $ do
+            applyPoly (Poly []) 1 `shouldBe` 0
+            applyPoly (Poly [2]) 1 `shouldBe` 2
+            applyPoly (Poly [1, 2, 3]) 2 `shouldBe` 17.0
+        it "+" $ do 
+            (Poly [1, 2]) + (Poly []) `shouldBe` (Poly [1, 2])
+            (P [1, 2, 3]) + (P [1, 2]) `shouldBe` (P [2, 4, 3])
+        it "*" $ do
+            (P [1, 2, 3]) * (P []) `shouldBe` (P [0, 0, 0])
+            (P [1, 2, 3]) * (P [1, 2]) `shouldBe` (P [1, 4, 7, 6])
+        it "negate" $ do 
+            negate (P []) `shouldBe` P []
+            negate (P [1, -2, 3]) `shouldBe` P [-1, 2, -3]
+        it "(==)" $ do 
+            ((P [0, 1, 0]) == (P [0, 1])) `shouldBe` True
+            ((P [1, 2, 3]) == (P [1, 2])) `shouldBe` False
+			((P [1, 2, 3]) == (P [1, 2, 4])) `shouldBe` False
+        it "show" $ do 
+            show (P [1, 2, 3]) `shouldBe` "3 * x^2 + 2 * x + 1"
+        it "nderiv" $ do 
+            nderiv 0 (P [1, 2, 3]) `shouldBe` (P [1, 2, 3])
+            nderiv 1 (P [1, 2, 3]) `shouldBe` (P [2, 6])
+            nderiv 2 (P [1, 2, 3]) `shouldBe` (P [6])
+            nderiv 3 (P [1, 2, 3]) `shouldBe` (P []) 
     describe "simpleLang" $ do
         -- включите тесты на работу 
-        it "desugar" $ pending
+        it "extend" $ do  
+            extend empty "a" 1 "a" `shouldBe` 1
+        it "eval" $ do  
+            eval (extend empty "a" 1) (Op (Var "a") Plus (Val 1)) `shouldBe` 2
+            eval (extend empty "a" 2) (Op (Var "a") Minus (Val 1)) `shouldBe` 1
+            eval (extend empty "a" 6) (Op (Var "a") Divide (Val 3)) `shouldBe` 2
+            eval (extend empty "a" 2) (Op (Var "a") Gt (Val 1)) `shouldBe` 1
+            eval (extend empty "a" 2) (Op (Var "a") Ge (Val 2)) `shouldBe` 1
+            eval (extend empty "a" 2) (Op (Var "a") Lt (Val 1)) `shouldBe` 0
+            eval (extend empty "a" 2) (Op (Var "a") Le (Val 2)) `shouldBe` 1
+            eval (extend empty "a" 1) (Op (Var "a") Eql (Val 1)) `shouldBe` 1
+        it "desugar" $ do  
+            desugar (Incr "a") `shouldBe` DAssign "a" (Op (Var "a") Plus (Val 1))
+        it "programms" $ do  
+            ((SimpleLang.run (extend empty "In" 7) fibonacci) "Out") `shouldBe` 21
+            ((SimpleLang.run (extend empty "A" 49) squareRoot) "B") `shouldBe` 7