diff --git a/Lab1/src/FirstSteps.hs b/Lab1/src/FirstSteps.hs index 8b0a43b..0e1b863 100644 --- a/Lab1/src/FirstSteps.hs +++ b/Lab1/src/FirstSteps.hs @@ -8,7 +8,7 @@ import Data.Word (Word8) -- используйте сопоставление с образцом xor :: Bool -> Bool -> Bool -xor x y = error "todo" +xor x y = if x == y then False else True -- max3 x y z находит максимум из x, y и z -- max3 1 3 2 == 3 @@ -17,9 +17,11 @@ xor x y = error "todo" -- median3 1 3 2 == 2 -- median3 5 2 5 == 5 max3, median3 :: Integer -> Integer -> Integer -> Integer -max3 x y z = error "todo" - -median3 x y z = error "todo" +max3 x y z = max (max x y) z -- if z >= a then z else a where {a = x >= y then z else y} +median3 x y z | (min x z <= y) && (y <= max x z) = y --sum + | (min y z <= x) && (x <= max y z) = x + | (min x y <= z) && (z <= max x y) = z + | otherwise = error "the median has not been calculated" -- Типы данных, описывающие цвета в моделях -- RGB (https://ru.wikipedia.org/wiki/RGB), компоненты от 0 до 255 @@ -37,7 +39,17 @@ data CMYK = CMYK { cyan :: Double, magenta :: Double, yellow :: Double, black :: -- Заметьте, что (/) для Int не работает, и неявного преобразования Int в Double нет. -- Это преобразование производится с помощью функции fromIntegral. rbgToCmyk :: RGB -> CMYK -rbgToCmyk color = error "todo" +rbgToCmyk (RGB 0 0 0) = CMYK 0.0 0.0 0.0 1.0 +rbgToCmyk color = cmyk_color where + r = fromIntegral(red color) / 255.0 + g = fromIntegral(green color) / 255.0 + b = fromIntegral(blue color) / 255.0 + k = (min (min (1.0 - r) (1.0 - g)) (1.0 - b)) + c = (1.0 - r - k) / (1.0 - k) + m = (1.0 - g - k) / (1.0 - k) + y = (1.0 - b - k) / (1.0 - k) + cmyk_color = CMYK c m y k + -- geomProgression b q n находит n-й (считая с 0) член -- геометрической прогрессии, нулевой член которой -- b, @@ -47,7 +59,9 @@ rbgToCmyk color = error "todo" -- используйте рекурсию -- не забудьте случаи n < 0 и n == 0. geomProgression :: Double -> Double -> Integer -> Double -geomProgression b q n = error "todo" +geomProgression b q n | (n == 0) = b + | n < 0 = error "n must be a natural number: n >= 2" + | n > 0 = q * geomProgression b q (n - 1) -- coprime a b определяет, являются ли a и b взаимно простыми -- (определение: Целые числа называются взаимно простыми, @@ -63,5 +77,17 @@ geomProgression b q n = error "todo" -- (или div, mod, divMod в зависимости от того, как -- обрабатываете отрицательные числа) -- https://hackage.haskell.org/package/base-4.9.0.0/docs/Prelude.html +{- euclidAlgorithm :: Integer -> Integer -> Integer +euclidAlgorithm x 0 = x +euclidAlgorithm x y = euclidAlgorithm y (mod x y) -} + + coprime :: Integer -> Integer -> Bool -coprime a b = error "todo" +coprime a b = + let + euclidAlgorithm :: Integer -> Integer -> Integer + euclidAlgorithm x 0 = x + euclidAlgorithm x y = euclidAlgorithm y (mod x y) + in + if ((a * b) == 0) then error "ZeroException" else if euclidAlgorithm a b == 1 then True else False + diff --git a/Lab1/src/Lists.hs b/Lab1/src/Lists.hs index 75f8517..f9844eb 100644 --- a/Lab1/src/Lists.hs +++ b/Lab1/src/Lists.hs @@ -1,7 +1,9 @@ module Lists where -- вектор задаётся списком координат -newtype Point = Point [Double] deriving (Eq, Show, Read) +data Point = Point {coords :: [Double]} deriving (Eq, Show, Read) + +--{coords :: [Double]} -- distance x y находит расстояние между двумя точками в n-мерном -- пространстве. Если число координат точек разное, сообщите об ошибке. @@ -9,8 +11,15 @@ newtype Point = Point [Double] deriving (Eq, Show, Read) -- distance (Point [0.0, 0.0]) (Point [0.0, 1.0]) == 1.0 -- используйте рекурсию и сопоставление с образцом -distance :: Point -> Point -> Double -distance x y = error "todo" + +distance, abnormDistance :: Point -> Point -> Double + +abnormDistance p1 p2 + | not (length (coords p1) == length (coords p2)) = error "DifferentDimensionError" + | (null (coords p1) && null (coords p2)) = 0 + | otherwise = ((head (coords p2)) - (head (coords p1)))^2 + abnormDistance (Point(tail (coords p1))) (Point(tail (coords p2))) + +distance fstCoord sndCoords = sqrt $ (abnormDistance fstCoord sndCoords) -- intersect xs ys возвращает список, содержащий общие элементы двух списков. -- intersect [1, 2, 4, 6] [5, 4, 2, 5, 7] == [2, 4] (или [4, 2]!) @@ -18,16 +27,27 @@ distance x y = error "todo" -- используйте рекурсию и сопоставление с образцом intersect :: [Integer] -> [Integer] -> [Integer] -intersect xs ys = error "todo" +--intersect [] _ = [] +--intersect _ [] = [] +-- intersect xs ys = [x | x <- xs, any ((==) x) ys] +intersect xs ys | (null xs || null ys) = [] + | otherwise = [x | x <- xs, any ((==) x) ys] -- zipN принимает список списков и возвращает список, который состоит из -- списка их первых элементов, списка их вторых элементов, и так далее. -- zipN [[1, 2, 3], [4, 5, 6], [7, 8, 9]] == [[1, 4, 7], [2, 5, 8], [3, 6, 9]] --- zipN [[1, 2, 3], [4, 5], [6]] == [[1, 4, 6], [2, 5], [3]] -zipN :: [[a]] -> [[a]] -zipN xss = error "todo" --- Нижеперечисленные функции можно реализовать или рекурсивно, или с помощью +zipN :: (Num a) => [[a]] -> [[a]] +zipN ((x:xs):xss) = (x : zipN' xss) : zipN (helper xs xss) where + zipN' ((a:as):ass) = a : zipN' ass + zipN' _ = [] + helper [] ((b:bs):bss) = bs : helper [] bss + helper b_b ((b:bs):bss) = b_b : (bs : helper [] bss) + helper _ _ = [] +zipN _ = [] + + +-- Нижеперечисленные функции можно реализовать или рекурсивно, или с помощью -- стандартных функций для работы со списками (map, filter и т.д.) -- Попробуйте оба подхода! Хотя бы одну функцию реализуйте обоими способами. @@ -38,32 +58,65 @@ zipN xss = error "todo" -- findLast (> 0) [-1, 2, -3, 4] == Just 4 -- find (> 0) [-1, -2, -3] == Nothing find, findLast :: (a -> Bool) -> [a] -> Maybe a -find f xs = error "todo" -findLast f xs = error "todo" + +{- find f [] = Nothing +find f xs = Just (head (filter f xs)) -} + +find f [] = Nothing +find f xs + | (f (head xs)) = Just (head xs) + | not (f (head xs)) && (not (null (tail xs))) = find f (tail xs) + | null (tail xs) = Nothing + +findLast f x | (length (filter f x)) > 0 = Just $ last (filter f x) + | otherwise = Nothing -- mapFuncs принимает список функций fs и возвращает список результатов -- применения всех функций из fs к x. -- mapFuncs [\x -> x*x, (1 +), \x -> if even x then 1 else 0] 3 == [9, 4, 0] mapFuncs :: [a -> b] -> a -> [b] -mapFuncs fs x = error "todo" +mapFuncs [] _ = [] +mapFuncs fs x = [(f x) | f <- fs] --- satisfiesAll принимает список предикатов (функций, возвращающих Bool) preds --- и возвращает True, если все они выполняются (т.е. возвращают True) для x. --- Полезные стандартные функции: and, all. +-- satisfiesAll принимает список предикатов (функций, возвращающих Bool) preds +-- и возвращает True, если все они выполняются +-- (т.е. возвращают True) для x. Полезные стандартные функции: and, all. -- satisfiesAll [even, \x -> x rem 5 == 0] 10 == True --- satisfiesAll [] 4 == True (кстати, почему?) +-- satisfiesAll [] 4 == True (кстати, почему?). Потому что в пустом списке нет предикатов, возвращающих True, а значит ни один предикат не будет применён к аргументам satisfiesAll :: [a -> Bool] -> a -> Bool -satisfiesAll preds x = error "todo" +satisfiesAll [] _ = True +satisfiesAll preds x + | all (True ==) (mapFuncs preds x) = True + | any (False ==) (mapFuncs preds x) = False + | otherwise = False --- Непустой список состоит из первого элемента (головы) +-- непустой список состоит из первого элемента (головы) -- и обычного списка остальных элементов --- Например, NEL 1 [2, 3] соотвествует списку [1, 2, 3], а NEL 1 [] -- списку [1]. data NEL a = NEL a [a] deriving (Eq, Show, Read) --- Запишите правильный тип (т.е. такой, чтобы функция имела результат для любых аргументов --- без вызовов error) и реализуйте функции на NEL, аналогичные tail, last и zip +-- запишите правильный тип (т.е. такой, чтобы функция имела результат для любых аргументов) +-- и реализуйте функции на NEL, аналогичные tail, last и zip -- tailNel :: NEL a -> ??? -- lastNel :: NEL a -> ??? -- zipNel :: NEL a -> NEL b -> ??? -- listToNel :: [a] -> ??? -- nelToList :: NEL a -> ??? + +tailNel :: NEL a -> [a] +tailNel (NEL x xs) = xs + +lastNel :: NEL a -> a +lastNel (NEL x xs) + | null xs = x + | (not (null xs)) = last xs + +listToNel :: [a] -> NEL a +listToNel (x:xs) = NEL x xs + +nelToList :: NEL a -> [a] +nelToList (NEL x xs) = x : xs + + +zipNel :: NEL a -> NEL b -> NEL (a,b) +zipNel a b = listToNel $ zip (nelToList a) (nelToList b) + \ No newline at end of file diff --git a/Lab1/src/Luhn.hs b/Lab1/src/Luhn.hs index 1e336a3..7e21897 100644 --- a/Lab1/src/Luhn.hs +++ b/Lab1/src/Luhn.hs @@ -10,5 +10,17 @@ module Luhn where -- Не пытайтесь собрать всё в одну функцию, используйте вспомогательные. -- Например: разбить число на цифры (возможно, сразу в обратном порядке). -- Не забудьте добавить тесты, в том числе для вспомогательных функций! + +reverseNumber :: Int -> [Int] +reverseNumber n + | ((div n 10) == 0) = [n] + | otherwise = (mod n 10) : reverseNumber (div n 10) + +doublingEvenNumbers :: [Int] -> [Int] +doublingEvenNumbers [] = [] +doublingEvenNumbers [n] = [n] -- doublingEvenNumbers [n] = n : [] +doublingEvenNumbers (first:second:end) = first : (mod (2*second) 9) : doublingEvenNumbers end + + isLuhnValid :: Int -> Bool -isLuhnValid = error "todo" +isLuhnValid number = if (mod (foldr (+) 0 (doublingEvenNumbers (reverseNumber number))) 10) == 0 then True else False \ No newline at end of file diff --git a/Lab1/test/Spec.hs b/Lab1/test/Spec.hs index fb64b7d..9a467b8 100644 --- a/Lab1/test/Spec.hs +++ b/Lab1/test/Spec.hs @@ -2,6 +2,7 @@ import FirstSteps import Lists import Luhn import Test.Hspec +import Data.Bool (Bool(True)) main :: IO () main = hspec $ do @@ -15,20 +16,83 @@ main = hspec $ do it "max3" $ do max3 1 3 2 `shouldBe` 3 max3 5 2 5 `shouldBe` 5 - it "median3" pending - it "rbgToCmyk" pending - it "geomProgression" pending - it "coprime" pending + max3 (-10) 0 4 `shouldBe` 4 + max3 (-10) 0 (-4) `shouldBe` 0 + max3 5 5 5 `shouldBe` 5 + it "median3" $ do + median3 1 4 7 `shouldBe` 4 + median3 1 4 4 `shouldBe` 4 + median3 4 4 4 `shouldBe` 4 + median3 (-6) (-2) 4 `shouldBe` (-2) + it "rbgToCmyk" $ do + rbgToCmyk RGB {red = 255, green = 255, blue = 255} `shouldBe` CMYK {cyan = 0.0, magenta = 0.0, yellow = 0.0, black = 0.0} + rbgToCmyk RGB {red = 255, green = 0, blue = 0} `shouldBe` CMYK {cyan = 0.0, magenta = 1.0, yellow = 1.0, black = 0.0} + rbgToCmyk RGB {red = 0, green = 255, blue = 0} `shouldBe` CMYK {cyan = 1.0, magenta = 0.0, yellow = 1.0, black = 0.0} + rbgToCmyk RGB {red = 0, green = 0, blue = 255} `shouldBe` CMYK {cyan = 1.0, magenta = 1.0, yellow = 0.0, black = 0.0} + rbgToCmyk RGB {red = 255, green = 255, blue = 0} `shouldBe` CMYK {cyan = 0.0, magenta = 0.0, yellow = 1.0, black = 0.0} + rbgToCmyk RGB {red = 255, green = 0, blue = 255} `shouldBe` CMYK {cyan = 0.0, magenta = 1.0, yellow = 0.0, black = 0.0} + rbgToCmyk RGB {red = 0, green = 255, blue = 255} `shouldBe` CMYK {cyan = 1.0, magenta = 0.0, yellow = 0.0, black = 0.0} + rbgToCmyk RGB {red = 0, green = 0, blue = 0} `shouldBe` CMYK {cyan = 0.0, magenta = 0.0, yellow = 0.0, black = 1.0} + it "geomProgression" $ do + geomProgression 5.0 0.5 2 `shouldBe` 1.25 + geomProgression 5.0 2.0 3 `shouldBe` 40.0 + it "coprime" $ do + coprime 8 10 `shouldBe` False + coprime (-8) 10 `shouldBe` False + coprime 17 19 `shouldBe` True + coprime 14 27 `shouldBe` True + --coprime (-1) (-1) `shouldBe` True + coprime (-1) (-4) `shouldBe` True describe "lists" $ do - it "distance" pending - it "intersect" pending - it "zipN" pending - it "find" pending - it "findLast" pending - it "mapFuncs" pending - it "tailNel" pending - it "lastNel" pending - it "zipNel" pending - it "listToNel" pending - it "nelToList" pending - describe "luhn" $ it "" pending + it "distance" $ do + distance (Point [0.0, 0.0]) (Point [0.0, 1.0]) `shouldBe` 1.0 + distance (Point [0, 0, 0, 0]) (Point [1, 1, 1, 1]) `shouldBe` 2.0 + distance (Point []) (Point []) `shouldBe` 0.0 + it "intersect" $ do + intersect [0, 2, 3, 4, 6] [1, 3, 5, 7, 9] `shouldBe` [3] + intersect [3, 3, 3, 3] [3, 3, 3] `shouldBe` [3,3,3,3] + intersect [1, 2, 4, 6] [5, 4, 2, 5, 7] `shouldBe` [2, 4] + intersect [1, 3, 9] [] `shouldBe` [] + intersect [] [5, 7] `shouldBe` [] + intersect [] [] `shouldBe` [] + it "zipN" $ do + zipN [[1, 2, 3], [4, 5, 6], [7, 8, 9]] `shouldBe` [[1, 4, 7], [2, 5, 8], [3, 6, 9]] + zipN [[1, 2, 3], [4, 5], [6]] `shouldBe` [[1, 4, 6], [2, 5], [3]] + zipN [[]] `shouldBe` [] + it "find" $ do + find (> 0) [0 , 0, 0, 4] `shouldBe` Just 4 + find (even) [5, 1, -4, 5] `shouldBe` Just (-4) + find (< 0) [-1, 3, 7] `shouldBe` Just (-1) + it "findLast" $ do + findLast (> 0) [-1, 2, -3, 4] `shouldBe` Just 4 + findLast (< 0) [-1, 2, -3, 4] `shouldBe` Just (-3) + findLast (even) [-1, 1, -3, 5] `shouldBe` Nothing + it "mapFuncs" $ do + mapFuncs [\x -> x*x, (1 +), \x -> if even x then 1 else 0] 3 `shouldBe` [9, 4, 0] + mapFuncs [\x -> x*x, (1 +), \x -> if even x then 1 else 0] 3 `shouldBe` [9, 4, 0] + mapFuncs [\x -> sqrt (-x), abs] (-4) `shouldBe` [2.0,4.0] + it "satisfiesAll" $ do + satisfiesAll [] 8 `shouldBe` True + satisfiesAll [even, \x -> x `rem` 5 == 0] 10 `shouldBe` True + it "tailNel" $ do + tailNel (NEL 4 [3,9]) `shouldBe` [3, 9] + tailNel (NEL 1 [9]) `shouldBe` [9] + it "lastNel" $ do + lastNel (NEL 1 [2,3]) `shouldBe` 3 + lastNel (NEL 1 [2]) `shouldBe` 2 + it "zipNel" $ do + zipNel (NEL 1 [2,3]) (NEL 1 [2,3]) `shouldBe` NEL (1,1) [(2,2),(3,3)] + zipNel (NEL 9 [2]) (NEL 9 [5]) `shouldBe` NEL (9,9) [(2,5)] + zipNel (NEL 3 []) (NEL 5 []) `shouldBe` NEL (3,5) [] + it "listToNel" $ do + listToNel [1,2,3] `shouldBe` (NEL 1 [2,3]) + listToNel [1] `shouldBe` (NEL 1 []) + it "nelToList" $ do + nelToList (NEL 1 [2,3]) `shouldBe` [1, 2, 3] + nelToList (NEL 7 []) `shouldBe` [7] + describe "luhn" $ do + it "isLuhnValid" $ do + isLuhnValid 56372828181828 `shouldBe` False + isLuhnValid 1204496404322 `shouldBe` False + isLuhnValid 4026843483168683 `shouldBe` True + \ No newline at end of file diff --git a/Lab2/src/Poly.hs b/Lab2/src/Poly.hs index 1e261e3..2859097 100644 --- a/Lab2/src/Poly.hs +++ b/Lab2/src/Poly.hs @@ -2,6 +2,8 @@ module Poly where +import Data.List (intercalate) -- для п.4 + -- Многочлены -- a -- тип коэффициентов, список начинается со свободного члена. -- Бонус: при решении следующих заданий подумайте, какие стали бы проще или @@ -12,42 +14,81 @@ newtype Poly a = P [a] -- Определите многочлен $x$. x :: Num a => Poly a -x = undefined +x = P [0, 1] + -- Задание 2 ----------------------------------------- -- Функция, считающая значение многочлена в точке applyPoly :: Num a => Poly a -> a -> a -applyPoly = undefined +applyPoly (P []) _ = 0 +applyPoly (P lst) x = (head lst) + x * applyPoly (P (tail lst)) x + -- Задание 3 ---------------------------------------- -- Определите равенство многочленов -- Заметьте, что многочлены с разными списками коэффициентов --- могут быть равны! Подумайте, почему. +-- могут быть равны! Подумайте, почему - список можно дополнять нулями для членов полинома с большей степенью + instance (Num a, Eq a) => Eq (Poly a) where - (==) = undefined + (==) (P a) (P b) = checkNull a == checkNull b where + checkNull [] = [] + checkNull lst = if (last lst == 0) then checkNull (init lst) else lst + -- Задание 4 ----------------------------------------- -- Определите перевод многочлена в строку. -- Это должна быть стандартная математическая запись, -- например: show (3 * x * x + 1) == "3 * x^2 + 1"). --- (* и + для многочленов можно будет использовать после задания 6.) +-- (* и + для многочленов можно будет использовать после задания 6.) -- возникли трудности с решением (прим.) + +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) + + instance (Num a, Eq a, Show a) => Show (Poly a) where - show = undefined + show (P p) = showPoly p -- Задание 5 ----------------------------------------- -- Определите сложение многочленов + +listCalc :: Num a => [a] -> [a] -> [a]-- обработка списков +listCalc [] a = a +listCalc a [] = a +listCalc a b = head a + head b : listCalc (tail a) (tail b) -- рекурсивное сложение элементов + + plus :: Num a => Poly a -> Poly a -> Poly a -plus = undefined +plus (P a) (P b) = P (listCalc a b) + -- Задание 6 ----------------------------------------- -- Определите умножение многочленов + times :: Num a => Poly a -> Poly a -> Poly a -times = undefined +times (P a) (P b) = P (multLists a b) where + multLists [] _ = [0] + multLists _ [] = [0] + multLists lst1 lst2 = listCalc (multScalar (head lst1) lst2) (0 : multLists (tail lst1) lst2) + where + multScalar :: Num a => a -> [a] -> [a] + multScalar _ [] = [] + multScalar x lstV = x * (head lstV) : multScalar x (tail lstV) + -- Задание 7 ----------------------------------------- @@ -55,13 +96,14 @@ times = undefined instance Num a => Num (Poly a) where (+) = plus (*) = times - negate = undefined - fromInteger = undefined + negate (P coeffs) = P (map negate coeffs) + fromInteger a = P [fromInteger a] -- Эти функции оставить как undefined, поскольку для -- многочленов они не имеют математического смысла abs = undefined signum = undefined + -- Задание 8 ----------------------------------------- -- Реализуйте nderiv через deriv @@ -70,10 +112,20 @@ class Num a => Differentiable a where deriv :: a -> a -- взятие n-ной производной nderiv :: Int -> a -> a - nderiv = undefined + nderiv 0 a = a + nderiv n a = nderiv (n - 1) (deriv a) + -- Задание 9 ----------------------------------------- -- Определите экземпляр класса типов + +listDif :: Num a => [a] -> a -> [a] -- взятие первой производной от полинома +listDif [] _ = [] +listDif lst n = head lst * n : listDif (tail lst) (n + 1) + + + instance Num a => Differentiable (Poly a) where - deriv = undefined + deriv (P []) = P [] + deriv (P poly) = P (listDif (tail poly) 1) \ No newline at end of file diff --git a/Lab2/src/SimpleLang.hs b/Lab2/src/SimpleLang.hs index 7e20754..79df051 100644 --- a/Lab2/src/SimpleLang.hs +++ b/Lab2/src/SimpleLang.hs @@ -8,6 +8,7 @@ data Expression = | Op Expression Bop Expression -- Бинарные операции deriving (Show, Eq) + data Bop = Plus | Minus @@ -20,6 +21,7 @@ data Bop = | Eql -- == deriving (Show, Eq) + data Statement = -- присвоить переменной значение выражения Assign String Expression @@ -35,28 +37,48 @@ data Statement = | Skip deriving (Show, Eq) + -- примеры программ на этом языке в конце модуля -- по состоянию можно получить значение каждой переменной -- (в реальной программе скорее использовалось бы Data.Map.Map String Int) type State = String -> Int + -- Задание 1 ----------------------------------------- + -- в начальном состоянии все переменные имеют значение 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 = if v == var then newVal else state v + -- Задание 2 ----------------------------------------- + -- возвращает значение выражения expr при значениях переменных из state. eval :: State -> Expression -> Int -eval state expr = undefined +eval state (Var vr) = state vr +eval _ (Val vl) = vl +eval state (Op vl1 operation vl2) = case operation 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 vl1 + var2 = eval state vl2 -- Задание 3 ----------------------------------------- @@ -70,16 +92,41 @@ data DietStatement = DAssign String Expression | DSkip deriving (Show, Eq) + -- упрощает программу Simple desugar :: Statement -> DietStatement -desugar = undefined +-- If +desugar (If expr outTrue outFalse) = DIf expr (desugar outTrue) (desugar outFalse) +-- While +desugar (While expr state) = DWhile expr (desugar state) +-- Incr +desugar (Assign var expr) = DAssign var expr +desugar (Incr var) = DAssign var (Op (Var var) Plus (Val 1)) +-- SKip +desugar Skip = DSkip -- ???? +-- Block +desugar (Block []) = DSkip +desugar (Block (st : sts)) = DSequence (desugar st) (desugar (Block sts)) +-- For +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 @@ -87,7 +134,21 @@ runSimpler = undefined -- принимает начальное состояние и программу 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 stmt1 stmt2) = + if eval state cond /= 0 then run state stmt1 else run state stmt2 +run state (While cond stmt) = + let loop st = if eval st cond /= 0 then loop (run st stmt) else st + 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 stmts) = foldl run state stmts +run state Skip = state -- Программы ------------------------------------------- @@ -113,7 +174,12 @@ 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)) + ] {- Вычисление числа Фибоначчи @@ -135,4 +201,23 @@ 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") + ] + ) + ) + ) + ] diff --git a/Lab2/test/Spec.hs b/Lab2/test/Spec.hs index b2592c5..c99fb13 100644 --- a/Lab2/test/Spec.hs +++ b/Lab2/test/Spec.hs @@ -5,7 +5,39 @@ import Test.Hspec main :: IO () main = hspec $ do describe "poly" $ do - it "applyPoly" $ pending + it "applyPoly" $ do + applyPoly (P [0, 0, 0]) 10 `shouldBe` 0 + applyPoly (P [4, -4, 1 ]) 2 `shouldBe` 0 + it "+" $ do + (P [2, 0, 6]) + (P []) `shouldBe` (P [2, 0, 6]) + (P [4, 5]) + (P [1, 1, 1]) `shouldBe` (P [5, 6, 1]) + it "*" $ do + (P [1, 2, 3, 4, 5]) * (P [5, 4, 3, 2, 1]) `shouldBe` (P [5, 14, 26, 40, 55, 40, 26, 14, 5]) + it "negate" $ do + negate (P [0, 0, 0]) `shouldBe` P [0, 0, 0] + negate (P [5, -5, 3]) `shouldBe` P [-5, 5, -3] + it "(==)" $ do + ((P [4, 1, 7]) == (P [4, 1, 5])) `shouldBe` False + ((P [5, 3]) == (P [5, 3, 0, 0, 0])) `shouldBe` True + it "show" $ do + show (P [0 , 6, 3]) `shouldBe` "3 * x^2 + 6 * x" + it "nderiv" $ do + nderiv 2 (P [10, 5, 2, 1]) `shouldBe` (P [4, 6]) describe "simpleLang" $ do -- включите тесты на работу - it "desugar" $ pending + it "extend" $ do + extend empty "a" 1 "a" `shouldBe` 1 + it "eval" $ do + eval (extend empty "a" 4) (Op (Var "a") Plus (Val 1)) `shouldBe` 5 + eval (extend empty "a" 9) (Op (Var "a") Minus (Val 2)) `shouldBe` 7 + eval (extend empty "a" 6) (Op (Var "a") Divide (Val 2)) `shouldBe` 3 + eval (extend empty "a" 5) (Op (Var "a") Gt (Val 1)) `shouldBe` 1 + eval (extend empty "a" 5) (Op (Var "a") Ge (Val 5)) `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" 9) fibonacci) "Out") `shouldBe` 55 + ((SimpleLang.run (extend empty "A" 81) squareRoot) "B") `shouldBe` 9