Lab 1

Lab1/src/FirstSteps.hs

@@ -1,14 +1,16 @@
 module FirstSteps 
 where
 import Data.Word (Word8)
+import GHC.Exts.Heap (GenClosure(key))
 
 -- xor x y находит "исключающее или" x и y
 -- xor True False == True
 -- xor True True == False
 
 -- используйте сопоставление с образцом
 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

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,22 +13,49 @@ 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]!)
 -- intersect [1, 2, 4, 6] [3, 5, 7] == []
 
 -- используйте рекурсию и сопоставление с образцом
 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,23 +67,33 @@ 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.
 -- Полезные стандартные функции: and, all.
 -- 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
+

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

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