Lab1 Rudnevskiy

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
+

Lab1/src/Lists.hs

@@ -1,33 +1,53 @@
 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-мерном
 -- пространстве. Если число координат точек разное, сообщите об ошибке.
 -- distance (Point [1.0, 0.0]) (Point [0.0, 1.0]) == sqrt 2.0
 -- 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]!)
 -- intersect [1, 2, 4, 6] [3, 5, 7] == []
 
 -- используйте рекурсию и сопоставление с образцом
 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) 
+

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 

Lab1/test/Spec.hs

@@ -15,20 +15,81 @@ 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
     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
+