From 9824e04dce7670e5f2d8b234207660e8767b2adb Mon Sep 17 00:00:00 2001 From: ilyashlykov <90597190+ilyashlykov@users.noreply.github.com> Date: Thu, 11 Apr 2024 12:22:57 +0300 Subject: [PATCH 1/7] Update FirstSteps.hs --- Lab1/src/FirstSteps.hs | 38 +++++++++++++++++++++++++++++++------- 1 file changed, 31 insertions(+), 7 deletions(-) diff --git a/Lab1/src/FirstSteps.hs b/Lab1/src/FirstSteps.hs index 8b0a43b..b9446a9 100644 --- a/Lab1/src/FirstSteps.hs +++ b/Lab1/src/FirstSteps.hs @@ -1,6 +1,7 @@ module FirstSteps where import Data.Word (Word8) +import GHC.Exts.Heap (GenClosure(key)) -- xor x y находит "исключающее или" x и y -- xor True False == True @@ -8,7 +9,8 @@ import Data.Word (Word8) -- используйте сопоставление с образцом xor :: Bool -> Bool -> Bool -xor x y = error "todo" +xor x y | x && not y || not x && y = True + | otherwise = False -- max3 x y z находит максимум из x, y и z -- max3 1 3 2 == 3 @@ -17,9 +19,17 @@ 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" +max3 x y z | x >= y && x >= z = x + | y >= x && y >= z = y + | z >= y && z >= x = z -median3 x y z = error "todo" +median3 x y z | (x > y && x <= z) || (x > z && x <= y) = x + | (y > z && y <= x) || (y > x && y <= z) = y + | (z > y && z <= x) || (z > x && z <= y) = z + | x == y = max x z + | x == z = max x y + | otherwise = max x y + -- Типы данных, описывающие цвета в моделях -- RGB (https://ru.wikipedia.org/wiki/RGB), компоненты от 0 до 255 @@ -37,7 +47,14 @@ data CMYK = CMYK { cyan :: Double, magenta :: Double, yellow :: Double, black :: -- Заметьте, что (/) для Int не работает, и неявного преобразования Int в Double нет. -- Это преобразование производится с помощью функции fromIntegral. rbgToCmyk :: RGB -> CMYK -rbgToCmyk color = error "todo" +rbgToCmyk (RGB r g b) = CMYK c m y k + where + r' = fromIntegral r/255 + g' = fromIntegral g/255 + b' = fromIntegral b/255 + k = min(1-r') (min (1-g') (1-b')) + (c,m,y) | k == 1 = (0,0,0) + | otherwise = ((1 - r' - k)/(1-k), (1-g'-k)/(1-k), (1-b'-k)/(1-k)) -- geomProgression b q n находит n-й (считая с 0) член -- геометрической прогрессии, нулевой член которой -- b, @@ -47,11 +64,13 @@ 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 = 0.0 + | n == 0 = b + | n>0 = q * geomProgression b q (n-1) -- coprime a b определяет, являются ли a и b взаимно простыми -- (определение: Целые числа называются взаимно простыми, --- если они не имеют никаких общих делителей, кроме +/-1) +-- если они не имеют никаких общиsх делителей, кроме +/-1) -- coprime 10 15 == False -- coprime 12 35 == True @@ -64,4 +83,9 @@ geomProgression b q n = error "todo" -- обрабатываете отрицательные числа) -- https://hackage.haskell.org/package/base-4.9.0.0/docs/Prelude.html coprime :: Integer -> Integer -> Bool -coprime a b = error "todo" +nod :: Integer -> Integer -> Integer + +nod a b | a == 0 || b == 0 = a + b + | otherwise = if a > b then nod b (a `rem` b) else nod a (b `rem` a) + +coprime a b = nod a b == 1 || nod a b == -1 From 1b955777d9f4d4fe49cb3d3664a424144ba251f6 Mon Sep 17 00:00:00 2001 From: ilyashlykov <90597190+ilyashlykov@users.noreply.github.com> Date: Thu, 11 Apr 2024 12:24:48 +0300 Subject: [PATCH 2/7] Update Lists.hs --- Lab1/src/Lists.hs | 74 ++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 66 insertions(+), 8 deletions(-) diff --git a/Lab1/src/Lists.hs b/Lab1/src/Lists.hs index 75f8517..3bfd49f 100644 --- a/Lab1/src/Lists.hs +++ b/Lab1/src/Lists.hs @@ -1,5 +1,8 @@ +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} module Lists where +import Data.List (delete) +import Data.Bits (Bits(xor)) -- вектор задаётся списком координат newtype Point = Point [Double] deriving (Eq, Show, Read) @@ -10,7 +13,17 @@ newtype Point = Point [Double] deriving (Eq, Show, Read) -- используйте рекурсию и сопоставление с образцом distance :: Point -> Point -> Double -distance x y = error "todo" +-- distance (Point x) (Point y) | length x /= length y = error "Число компонент вектора должно быть одинаковым" +-- | otherwise = sqrt $ sum [(a-b)^2 |(a, b) <- zip x y] + +-- Вспомогательная функция для подсчета суммы квадратов +squareSum :: Point -> Point -> Double +squareSum (Point []) (Point []) = 0 +squareSum (Point [x]) (Point [y]) = (x - y)^2 +squareSum (Point (x:xs)) (Point (y:ys)) = (x-y)^2 + squareSum (Point xs) (Point ys) + +distance (Point x) (Point y) = if length x /= length y then error "Число компонент вектора должно быть одинаковым" + else sqrt $ squareSum (Point x) (Point y) -- intersect xs ys возвращает список, содержащий общие элементы двух списков. -- intersect [1, 2, 4, 6] [5, 4, 2, 5, 7] == [2, 4] (или [4, 2]!) @@ -18,14 +31,31 @@ distance x y = error "todo" -- используйте рекурсию и сопоставление с образцом intersect :: [Integer] -> [Integer] -> [Integer] -intersect xs ys = error "todo" +intersect [] _ = [] +intersect _ [] = [] +intersect (x:xs) ys + | x `elem` ys = x : intersect xs (delete x ys) + | otherwise = intersect xs 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]] + +firsts :: [[a]] -> [a] +firsts [] = [] +firsts ([]:xss) = [] +firsts ((x:xs):xss) = x : firsts xss + +rests :: [[a]] -> [[a]] +rests [] = [] +rests ([]:xss) = [] +rests ((x:xs):xss) = xs : rests xss + zipN :: [[a]] -> [[a]] -zipN xss = error "todo" +zipN [] = [] +zipN xss | all null xss = [] + | otherwise = firsts xss : zipN (rests xss) -- Нижеперечисленные функции можно реализовать или рекурсивно, или с помощью -- стандартных функций для работы со списками (map, filter и т.д.) @@ -37,15 +67,25 @@ zipN xss = error "todo" -- find (> 0) [-1, 2, -3, 4] == Just 2 -- 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,findLast :: (a -> Bool) -> [a] -> Maybe a +findFilter :: (a->Bool) -> [a] -> Maybe a +find _ [] = Nothing +find f (x:xs) + | f x = Just x + | otherwise = find f xs + +findLast f xs = find f (reverse xs) + +findFilter _ [] = Nothing +findFilter f xs = case filter f xs of + [] -> Nothing + (x:_) -> Just x -- 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 fs x = map (\ f -> f x) fs -- satisfiesAll принимает список предикатов (функций, возвращающих Bool) preds -- и возвращает True, если все они выполняются (т.е. возвращают True) для x. @@ -53,7 +93,7 @@ mapFuncs fs x = error "todo" -- satisfiesAll [even, \x -> x rem 5 == 0] 10 == True -- satisfiesAll [] 4 == True (кстати, почему?) satisfiesAll :: [a -> Bool] -> a -> Bool -satisfiesAll preds x = error "todo" +satisfiesAll preds x = all id (mapFuncs preds x) -- Непустой список состоит из первого элемента (головы) -- и обычного списка остальных элементов @@ -67,3 +107,21 @@ data NEL a = NEL a [a] deriving (Eq, Show, Read) -- zipNel :: NEL a -> NEL b -> ??? -- listToNel :: [a] -> ??? -- nelToList :: NEL a -> ??? + +tailNel :: NEL a -> [a] +tailNel (NEL _ xs) = xs + +lastNel :: NEL a -> a +lastNel (NEL x []) = x +lastNel (NEL a (x:xs)) = lastNel (NEL x xs) + +zipNel :: NEL a -> NEL b -> NEL (a,b) +zipNel (NEL x xs) (NEL y ys) = NEL (x,y) (zip xs ys) + +listToNel :: [a] -> Maybe (NEL a) +listToNel [] = Nothing +listToNel (x:xs) = Just (NEL x xs) + +nelToList :: NEL a -> [a] +nelToList (NEL a xs) = a:xs + From 8fef5667f7a19cf960029f362cc1ee28ca75d453 Mon Sep 17 00:00:00 2001 From: ilyashlykov <90597190+ilyashlykov@users.noreply.github.com> Date: Thu, 11 Apr 2024 12:25:07 +0300 Subject: [PATCH 3/7] Update Luhn.hs --- Lab1/src/Luhn.hs | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/Lab1/src/Luhn.hs b/Lab1/src/Luhn.hs index 1e336a3..a508f0e 100644 --- a/Lab1/src/Luhn.hs +++ b/Lab1/src/Luhn.hs @@ -10,5 +10,24 @@ module Luhn where -- Не пытайтесь собрать всё в одну функцию, используйте вспомогательные. -- Например: разбить число на цифры (возможно, сразу в обратном порядке). -- Не забудьте добавить тесты, в том числе для вспомогательных функций! + +-- Функция для разбиения числа на цифры в обратном порядке +digitsRev :: Int -> [Int] +digitsRev n + | n < 10 = [n] + | otherwise = n `mod` 10 : digitsRev (n `div` 10) + +-- Функция для удвоения и коррекции цифр на четных позициях +doubleEven :: [Int] -> [Int] +doubleEven [] = [] +doubleEven [x] = [x] +doubleEven (x:y:zs) = x : (if y * 2 > 9 then y * 2 - 9 else y * 2) : doubleEven zs + +-- Функция для суммирования цифр +sumDigits :: [Int] -> Int +sumDigits [] = 0 +sumDigits (x:xs) = x + sumDigits xs + +-- Функция для проверки корректности номера по алгоритму Луна isLuhnValid :: Int -> Bool -isLuhnValid = error "todo" +isLuhnValid n = sumDigits (doubleEven (digitsRev n)) `mod` 10 == 0 From 62d87aacfe3392eb71365f05e80ce0b251d4e5dd Mon Sep 17 00:00:00 2001 From: ilyashlykov <90597190+ilyashlykov@users.noreply.github.com> Date: Thu, 11 Apr 2024 12:25:44 +0300 Subject: [PATCH 4/7] Update Spec.hs --- Lab1/test/Spec.hs | 66 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 50 insertions(+), 16 deletions(-) diff --git a/Lab1/test/Spec.hs b/Lab1/test/Spec.hs index fb64b7d..8900fe8 100644 --- a/Lab1/test/Spec.hs +++ b/Lab1/test/Spec.hs @@ -1,7 +1,9 @@ +{-# OPTIONS_GHC -Wno-type-defaults #-} import FirstSteps import Lists import Luhn import Test.Hspec +import Control.Exception.Base (tryJust) main :: IO () main = hspec $ do @@ -15,20 +17,52 @@ 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 + it "median3" $ do + median3 1 3 2 `shouldBe` 2 + median3 5 2 5 `shouldBe` 5 + it "rbgToCmyk" $ do + let cmyk = rbgToCmyk (RGB 10 20 30) + cmyk `shouldBe` CMYK { cyan = 0.666666666666667, magenta = 0.333333333333334, yellow = 0.0, black = 0.8823529411764706 } + it "geomProgression" $ do + geomProgression 3.0 2.0 2 `shouldBe` 12.0 + it "coprime" $ do + coprime 10 24 `shouldBe` False + coprime 17 3 `shouldBe` True + coprime 1 142 `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 [1,0,1,0,1,1]) (Point [0,1,0,0,1,0]) `shouldBe` 2 + distance (Point [3,4,0]) (Point [0,0,sqrt 11]) `shouldBe` 6 + distance (Point [3,0]) (Point [2,sqrt 8]) `shouldBe` 3.0000000000000004 + it "intersect" $ do + intersect [1,2,3,4] [1,2,5,11,21] `shouldBe` [1,2] + intersect [1,1,1] [1,2,1,5,6] `shouldBe` [1,1] + it "zipN" $ do + zipN [[1,2,3],[4,5],[10]] `shouldBe` [[1,4,10],[2,5],[3]] + zipN [[1,2,3],[9],[]] `shouldBe` [[1,9],[2],[3]] + it "find" $ do + find (<0) [1,2,10,-1,41] `shouldBe` Just (-1) + it "findFilter" $ do + findFilter (<0) [1,2,10,-1,41] `shouldBe` Just (-1) + it "findLast" $ do + findLast (<0) [1,2,-1,-2,-3] `shouldBe` Just (-3) + findLast (>0) [-1,-10] `shouldBe` Nothing + it "mapFuncs" $ do + mapFuncs [\x -> x*x, \x -> x - 2, \x -> if even x then 1 else 0] 11 `shouldBe` [121, 9, 0] + it "satisfiesAll" $ do + satisfiesAll [even, \x -> x `rem` 5 == 0, (>10)] 12 `shouldBe` False + satisfiesAll [even, \x -> x `rem` 5 == 0, (>10)] 20 `shouldBe` True + satisfiesAll [] 12 `shouldBe` True + it "tailNel" $ do + tailNel (NEL 1 [1,2,3,4]) `shouldBe` [1,2,3,4] + it "lastNel" $ do + lastNel (NEL 10 [4,2,1,2]) `shouldBe` 2 + it "zipNel" $ do + zipNel (NEL 1 [1,2,3]) (NEL 11 [41,2,11]) `shouldBe` NEL (1,11) [(1,41),(2,2),(3,11)] + it "listToNel" $ do + listToNel [1,2,3,4,5] `shouldBe` Just (NEL 1 [2,3,4,5]) + it "nelToList" $ do + nelToList (NEL 1 [2,3,4,5]) `shouldBe` [1,2,3,4,5] + describe "luhn" $ it "luhn" $ do + isLuhnValid 4276610017565479 `shouldBe` True + isLuhnValid 4377727816025071 `shouldBe` True From 6cb4027f9f12b6d80bbcbcb99998ba572b3e516a Mon Sep 17 00:00:00 2001 From: ilyashlykov <90597190+ilyashlykov@users.noreply.github.com> Date: Tue, 16 Apr 2024 22:23:21 +0300 Subject: [PATCH 5/7] Update Spec.hs --- Lab2/test/Spec.hs | 117 ++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 112 insertions(+), 5 deletions(-) diff --git a/Lab2/test/Spec.hs b/Lab2/test/Spec.hs index b2592c5..0b356c3 100644 --- a/Lab2/test/Spec.hs +++ b/Lab2/test/Spec.hs @@ -4,8 +4,115 @@ import Test.Hspec main :: IO () main = hspec $ do - describe "poly" $ do - it "applyPoly" $ pending - describe "simpleLang" $ do - -- включите тесты на работу - it "desugar" $ pending + describe "applyPoly" $ do + it "applyPoly_1" $ + applyPoly x 2 `shouldBe` 2 + it "applyPoly_2" $ + applyPoly (P [1, 2, 3]) 3 `shouldBe` 34 + describe "Poly equality" $ do + it "equality_1" $ + P [1, 2, 3] `shouldBe` P [1, 2, 3, 0] + it "equality_2" $ + P [0, 1, 2] `shouldBe` P [0, 1, 2, 0, 0] + it "equality_3" $ + P [0, 1, 2] `shouldNotBe` P [0, 1, 3] + describe "showPoly" $ do + it "show_1" $ + show (P [1, 2, 3, 0, 0]) `shouldBe` "3x^2 + 2x + 1" + it "show_2" $ + show (P [-1, 2, 3]) `shouldBe` "3x^2 + 2x - 1" + it "show_3" $ + show (P [0]) `shouldBe` "" + describe "plus" $ do + it "plus_1" $ + plus (P [1, 2, 3, 0]) (P [4, 5, 1, 21]) `shouldBe` P [5, 7, 4, 21] + it "plus_2" $ do + plus (P [1, 2, 3, 0]) (P []) `shouldBe` P [1, 2, 3, 0] + it "plus_3" $ do + plus (P [1, 2, 3, 0]) (P [4, 5]) `shouldBe` P [5, 7, 3, 0] + describe "times" $ do + it "times_1" $ + times (P [1, 2, 3]) (P [4, 5, 6]) `shouldBe` P [4, 13, 28, 27, 18] + it "times_2" $ + times (P []) (P [4, 5, 6]) `shouldBe` P [] + it "times_3" $ + times (P [1, 2, 3]) (P []) `shouldBe` P [] + it "times_4" $ + times (P [1]) (P [4, 5, 6]) `shouldBe` P [4, 5, 6] + it "times_5" $ + times (P [2, 5, 1]) (P [3, 1]) `shouldBe` P [6, 17, 8, 1] + it "times_6" $ + times (P [4, 2, 1]) (P [1, 7, 1]) `shouldBe` P [4, 30, 19, 9, 1] + describe "deriv" $ do + it "deriv_1" $ + deriv (P [1]) `shouldBe` P [0] + it "deriv_2" $ + deriv (P [1, 10]) `shouldBe` P [10] + it "deriv_3" $ + deriv (P [1, 2, 3, 4]) `shouldBe` P [2, 6, 12] + describe "nderiv" $ do + it "nderiv_1" $ + nderiv 4 (P [1, 2, 3, 4, 5]) `shouldBe` P [120] + it "nderiv_2" $ + nderiv 5 (P [1, 2, 3, 4, 5]) `shouldBe` P [0] + it "nderiv_3" $ + nderiv 3 (P [1, 2, 5, 1, 1, 1]) `shouldBe` P [6, 24, 60] + describe "simpleLang" $ do + it "eval_1" $ do + eval (extend empty "a" 2) (Op (Val 3) Plus (Var "a")) `shouldBe` 5 + it "eval_2" $ do + eval (extend empty "a" 5) (Op (Val 3) Minus (Var "a")) `shouldBe` -2 + it "eval_3" $ do + eval (extend empty "a" 10) (Op (Val 5) Times (Var "a")) `shouldBe` 50 + it "eval_4" $ do + eval (extend empty "a" 4) (Op (Val 2) Divide (Var "a")) `shouldBe` 0 + it "eval_5" $ do + eval (extend empty "a" 4) (Op (Val 5) Divide (Var "a")) `shouldBe` 1 + it "eval_6" $ do + eval (extend empty "a" 5) (Op (Val 5) Gt (Var "a")) `shouldBe` 0 + it "eval_7" $ do + eval (extend empty "a" 5) (Op (Val 5) Ge (Var "a")) `shouldBe` 1 + it "eval_8" $ do + eval (extend empty "a" 5) (Op (Val 12) Lt (Var "a")) `shouldBe` 0 + it "eval_9" $ do + eval (extend empty "a" 13) (Op (Val 12) Le (Var "a")) `shouldBe` 1 + it "eval_10" $ do + eval (extend empty "a" 5) (Op (Val 5) Eql (Var "a")) `shouldBe` 1 + it "eval_11" $ do + eval (extend empty "a" 5) (Op (Val 12) Eql (Var "a")) `shouldBe` 0 + it "desugar_1" $ do + desugar (Assign "x" (Val 5)) `shouldBe` DAssign "x" (Val 5) + it "desugar_2" $ do + desugar (Incr "x") `shouldBe` DAssign "x" (Op (Var "x") Plus (Val 1)) + it "runSimpler" $ do + runSimpler empty (DAssign "x" (Val 5)) "x" `shouldBe` 5 + it "run" $ do + run empty (Incr "A") "A" `shouldBe` 1 + run + (extend empty "q" 2) + ( For + (Assign "Out" (Val 1)) + (Op (Var "In") Lt (Val 10)) + (Incr "In") + (Assign "Out" (Op (Var "q") Times (Var "Out"))) + ) + "Out" + `shouldBe` 1024 + run + (extend empty "A" 2500) + ( While + (Op (Var "A") Ge (Val 3)) + ( Block + [ Assign "A" (Op (Var "A") Divide (Val 3)), + Incr "Out" + ] + ) + ) + "Out" + `shouldBe` 7 + it "state" $ do + empty "x" `shouldBe` 0 + it "squareRoot" $ do + run (extend empty "A" 122) squareRoot "B" `shouldBe` 11 + it "fibonacci" $ do + run (extend empty "In" 9) fibonacci "Out" `shouldBe` 55 From af7af0a299fa90625d36eb3742f31bec5172ac64 Mon Sep 17 00:00:00 2001 From: ilyashlykov <90597190+ilyashlykov@users.noreply.github.com> Date: Tue, 16 Apr 2024 22:23:44 +0300 Subject: [PATCH 6/7] Update Poly.hs --- Lab2/src/Poly.hs | 75 ++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 63 insertions(+), 12 deletions(-) diff --git a/Lab2/src/Poly.hs b/Lab2/src/Poly.hs index 1e261e3..742f1ac 100644 --- a/Lab2/src/Poly.hs +++ b/Lab2/src/Poly.hs @@ -1,6 +1,8 @@ -- Не забудьте добавить тесты. +{-# OPTIONS_GHC -Wno-redundant-constraints #-} module Poly where +import Data.List (dropWhileEnd, intercalate) -- Многочлены -- a -- тип коэффициентов, список начинается со свободного члена. @@ -12,42 +14,88 @@ 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 coef) value = sum $ zipWith (\coeffs power -> coeffs * (value ^ power)) coef [0..] -- Задание 3 ---------------------------------------- -- Определите равенство многочленов -- Заметьте, что многочлены с разными списками коэффициентов -- могут быть равны! Подумайте, почему. + +normalize :: (Num a, Eq a) => [a] -> [a] +normalize = dropWhileEnd (== 0) + instance (Num a, Eq a) => Eq (Poly a) where - (==) = undefined - + (==) (P xs) (P ys) = normalize xs == normalize ys + -- Задание 4 ----------------------------------------- -- Определите перевод многочлена в строку. -- Это должна быть стандартная математическая запись, -- например: show (3 * x * x + 1) == "3 * x^2 + 1"). -- (* и + для многочленов можно будет использовать после задания 6.) -instance (Num a, Eq a, Show a) => Show (Poly a) where - show = undefined +-- instance (Num a, Eq a, Show a, Ord a) => Show (Poly a) where +-- show (P coefs) = intercalate " " (zipWith showTerm (reverse coefs) (reverse [0..length coefs-1])) +-- where +-- showTerm :: (Num a, Eq a, Show a, Ord a) => a -> Int -> String +-- showTerm coeff power +-- | coeff == 0 = "" +-- | coeff == 1 && power > 0 = "x^" ++ show(power) ++ " " +-- | coeff == -1 && power > 0 = "-x^" ++ show(power) ++ " " +-- | power == 0 = show coeff +-- | power == 1 = show coeff ++ "x" ++ " " +-- | otherwise = if coeff > 0 then " + " ++ show coeff ++ "x^" ++ show(power) else " - " ++show (-1*coeff) ++ "x^" ++ show(power) + +instance (Num a, Eq a, Show a, Ord a) => Show (Poly a) where + show (P coeffs) = intercalate "" (filter (not . null) terms) + where + coeffss = normalize coeffs + terms = zipWith showTerm (reverse coeffss) (reverse [0..length coeffss - 1]) + showTerm :: (Num a, Eq a, Show a, Ord a) => a -> Int -> String + showTerm coeff power + | power == length coeffss - 1 = show (coeff) ++ termPower + | coeff == 0 = "" + | coeff < 0 = " - " ++ show (abs coeff) ++ termPower + | coeff == 1 && power > 0 = termPower + | otherwise = " + " ++ show coeff ++ termPower + where termPower + | power == 0 = "" + | power == 1 = "x" + | otherwise = "x^" ++ show (power) -- Задание 5 ----------------------------------------- -- Определите сложение многочленов +addLists :: Num a => [a] -> [a] -> [a] +addLists [] xs = xs +addLists xs [] = xs +addLists (c:cs) (y:ys) = c + y : addLists cs ys + plus :: Num a => Poly a -> Poly a -> Poly a -plus = undefined +plus (P a) (P b) = P (addLists a b) -- Задание 6 ----------------------------------------- -- Определите умножение многочленов times :: Num a => Poly a -> Poly a -> Poly a -times = undefined +times (P a) (P b) = P (multiplyPoly a b) + +-- Функция для умножения двух многочленов +multiplyPoly :: Num a => [a] -> [a] -> [a] +multiplyPoly [] _ = [0] +multiplyPoly _ [] = [0] +multiplyPoly (x:xs) ys = addLists (multiplyByConst x ys) (0 : multiplyPoly xs ys) + +-- Функция для умножения многочлена на константу +multiplyByConst :: Num a => a -> [a] -> [a] +multiplyByConst _ [] = [] +multiplyByConst c (y:ys) = c * y : multiplyByConst c ys -- Задание 7 ----------------------------------------- @@ -55,8 +103,8 @@ 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 @@ -70,10 +118,13 @@ class Num a => Differentiable a where deriv :: a -> a -- взятие n-ной производной nderiv :: Int -> a -> a - nderiv = undefined + nderiv 0 p = p + nderiv n p = nderiv (n - 1) (deriv p) -- Задание 9 ----------------------------------------- -- Определите экземпляр класса типов instance Num a => Differentiable (Poly a) where - deriv = undefined + deriv (P []) = P [] + deriv (P (_:xs)) = P $ zipWith (*) (map fromInteger [1..]) xs + From feb3f3a5036adde3f45b608ba4c693cf722ff8ff Mon Sep 17 00:00:00 2001 From: ilyashlykov <90597190+ilyashlykov@users.noreply.github.com> Date: Tue, 16 Apr 2024 22:23:58 +0300 Subject: [PATCH 7/7] Update SimpleLang.hs --- Lab2/src/SimpleLang.hs | 99 ++++++++++++++++++++++++++++++++++++------ 1 file changed, 85 insertions(+), 14 deletions(-) diff --git a/Lab2/src/SimpleLang.hs b/Lab2/src/SimpleLang.hs index 7e20754..d66a627 100644 --- a/Lab2/src/SimpleLang.hs +++ b/Lab2/src/SimpleLang.hs @@ -8,11 +8,11 @@ data Expression = | Op Expression Bop Expression -- Бинарные операции deriving (Show, Eq) -data Bop = - Plus - | Minus - | Times - | Divide +data Bop = + Plus + | Minus + | Times + | Divide | Gt -- > | Ge -- >= | Lt -- < @@ -45,18 +45,32 @@ 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 = if v == var then newVal else 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 expr1 op expr2) = + let x = eval state expr1 + y = eval state expr2 + in case op of + Plus -> x + y + Minus -> x - y + Times -> x*y + Divide -> x `div` y + Gt -> if x > y then 1 else 0 + Ge -> if x >= y then 1 else 0 + Lt -> if x < y then 1 else 0 + Le -> if x <= y then 1 else 0 + Eql -> if x == y then 1 else 0 -- Задание 3 ----------------------------------------- @@ -72,14 +86,30 @@ data DietStatement = DAssign String Expression -- упрощает программу Simple desugar :: Statement -> DietStatement -desugar = undefined +desugar (Assign var expr) = DAssign var expr +desugar (Incr var) = DAssign var (Op (Var var) Plus (Val 1)) +desugar (If cond stmt1 stmt2) = DIf cond (desugar stmt1) (desugar stmt2) +desugar (While cond stmt) = DWhile cond (desugar stmt) +desugar (For initStmt cond incrStmt bodyStmt) = + DSequence (desugar initStmt) $ + DWhile cond $ + DSequence (desugar bodyStmt) (desugar incrStmt) +desugar (Block stmts) = foldr (DSequence . desugar) DSkip stmts +desugar Skip = DSkip -- Задание 4 ----------------------------------------- -- принимает начальное состояние и программу Simpler -- и возвращает состояние после работы программы runSimpler :: State -> DietStatement -> State -runSimpler = undefined +runSimpler state (DAssign var expr) = extend state var (eval state expr) +runSimpler state (DIf cond stmt1 stmt2) = + if eval state cond /= 0 then runSimpler state stmt1 else runSimpler state stmt2 +runSimpler state (DWhile cond stmt) = + let loop st = if eval st cond /= 0 then loop (runSimpler st stmt) else st + in loop state +runSimpler state (DSequence stmt1 stmt2) = runSimpler (runSimpler state stmt1) stmt2 +runSimpler state DSkip = state -- -- in s "A" ~?= 10 @@ -87,7 +117,22 @@ 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 + -- Программы ------------------------------------------- @@ -112,9 +157,14 @@ factorial = For (Assign "Out" (Val 1)) }; B := B - 1 -} -squareRoot :: Statement -squareRoot = undefined +squareRoot :: Statement +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; @@ -134,5 +184,26 @@ 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") + ] + ) + ) + ) + ]