Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

labs Aleksei Pakhomov #5

Open
wants to merge 5 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
39 changes: 32 additions & 7 deletions Lab1/src/FirstSteps.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -17,9 +17,9 @@ 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 = if max x y >= z then max x y else z

median3 x y z = error "todo"
median3 x y z = if max x y >= z then (if x >= y then max y z else max x z) else max x y

-- Типы данных, описывающие цвета в моделях
-- RGB (https://ru.wikipedia.org/wiki/RGB), компоненты от 0 до 255
Expand All @@ -36,8 +36,24 @@ data CMYK = CMYK { cyan :: Double, magenta :: Double, yellow :: Double, black ::

-- Заметьте, что (/) для Int не работает, и неявного преобразования Int в Double нет.
-- Это преобразование производится с помощью функции fromIntegral.
rbgToCmyk :: RGB -> CMYK
rbgToCmyk color = error "todo"
minim [] = 0
minim [x] = x
minim (x:xs) = min x (minim xs)

rgbToCmyk :: RGB -> CMYK
rbgToCmyk (RGB 0 0 0) = CMYK 0.0 0.0 0.0 1.0
rgbToCmyk color = CMYK { black = toBlack
, magenta = toMagenta
, yellow = toYellow
, cyan = toCyan
}
where toBlack = minim [1 - fromIntegral (red color) / 255.0, 1 - fromIntegral (green color) / 255.0, 1 - fromIntegral (blue color) / 255.0]
toMagenta = (1 - fromIntegral (green color) / 255.0 - toBlack) / (1 - toBlack)
toYellow = (1 - fromIntegral (blue color) / 255.0 - toBlack) / (1 - toBlack)
toCyan = (1 - fromIntegral (red color) / 255.0 - toBlack) / (1 - toBlack)




-- geomProgression b q n находит n-й (считая с 0) член
-- геометрической прогрессии, нулевой член которой -- b,
Expand All @@ -47,7 +63,10 @@ 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 = error "n must be non-negative"
| n == 0 = b
| otherwise = q * geomProgression b q (n-1)

-- coprime a b определяет, являются ли a и b взаимно простыми
-- (определение: Целые числа называются взаимно простыми,
Expand All @@ -64,4 +83,10 @@ 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"
coprime a b
| c == 0 || d == 0 = False
| c == 1 || d == 1 = True
| c > d = coprime (c - d) d
| otherwise = coprime (d - c) c
where c = abs a
d = abs b
66 changes: 52 additions & 14 deletions Lab1/src/Lists.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
module Lists where
import Data.List (transpose)

-- вектор задаётся списком координат
newtype Point = Point [Double] deriving (Eq, Show, Read)
Expand All @@ -10,22 +11,32 @@ newtype Point = Point [Double] deriving (Eq, Show, Read)

-- используйте рекурсию и сопоставление с образцом
distance :: Point -> Point -> Double
distance x y = error "todo"
distance (Point []) (Point []) = 0
distance (Point _) (Point []) = error "dims must match"
distance (Point []) (Point _) = error "dims must match"
distance (Point (x:xs)) (Point (y:ys)) = sqrt (x^2 + y^2 + distance (Point xs) (Point ys))

-- 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) (y:ys)
| x == y = [x] ++ intersect xs ys
| otherwise = intersect xs ys
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Я не вижу, как у вас проходит тест

intersect [1, 2, 3] [3, 4, 5] `shouldBe` [3]

У меня там получается пустой список с такой реализацией. Первый пример в задании тоже не должен работать.


-- 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"
zipWith' :: ([a] -> b) -> [[a]] -> [b]
zipWith' _ [] = []
zipWith' f xss = map f . transpose $ xss
zipN = zipWith' id

-- Нижеперечисленные функции можно реализовать или рекурсивно, или с помощью
-- стандартных функций для работы со списками (map, filter и т.д.)
Expand All @@ -38,22 +49,30 @@ 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 (x:xs)
| f x = Just x
| otherwise = find f xs
findLast f xs
| null filtered = Nothing
| otherwise = Just (last (filtered))
where filtered = filter f xs

-- 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 [] x = []
mapFuncs (fs:fss) x = (fs x):(mapFuncs fss x)

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

-- Непустой список состоит из первого элемента (головы)
-- и обычного списка остальных элементов
Expand All @@ -62,8 +81,27 @@ data NEL a = NEL a [a] deriving (Eq, Show, Read)

-- Запишите правильный тип (т.е. такой, чтобы функция имела результат для любых аргументов
-- без вызовов error) и реализуйте функции на 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 []) = x
lastNel (NEL x xs) = lastNel (NEL xs' xss)
where
xs' = head xs
xss = tail xs

zipNel :: NEL a -> NEL b -> [(a, b)]
zipNEL (NEL x []) (NEL y []) = [(x, y)]
zipNel (NEL x xs) (NEL y ys) = [(x, y)] ++ zipNel (NEL xs' xss) (NEL ys' yss)
where
xs' = head xs
xss = tail xs
ys' = head ys
yss = tail ys

listToNel :: [a] -> NEL a
listToNel (a:as) = NEL a as

nelToList :: NEL a -> [a]
nelToList (NEL a as) = a:as
43 changes: 42 additions & 1 deletion Lab1/src/Luhn.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,5 +10,46 @@ module Luhn where
-- Не пытайтесь собрать всё в одну функцию, используйте вспомогательные.
-- Например: разбить число на цифры (возможно, сразу в обратном порядке).
-- Не забудьте добавить тесты, в том числе для вспомогательных функций!
-- intToList 0 == []
-- intToList 1 == [1]
-- intToList 123 == [321] (returns reversed list)
intToList :: Int -> [Int]
intToList 0 = []
intToList x = [x `mod` 10] ++ intToList (x `div` 10)


-- processEven [] == []
-- processEven [1] == [1]
-- processEven [1, 1] == [1, 2]
-- processEven [1, 1, 1] == [1, 2, 1]
processEven :: [Int] -> [Int]
processEven digs = [(digs !! i) * (2 ^ (i `mod` 2))| i <- [0..(length digs) - 1]]

-- decreaseLarge 1 == 1
-- decreaseLarge 9 == 9
-- decreaseLarge 10 == 1
-- decreaseLarge 18 == 9
decreaseLarge :: Int -> Int
decreaseLarge x
| x > 9 = x - 9
| otherwise = x

-- decreaseAllLarge [] == []
-- decreaseAllLarge [1] == [1]
-- decreaseAllLarge [1, 18, 3] == [1, 9, 3]
-- decreaseAllLarge [10, 2, 18] == [1, 2, 9]
decreaseAllLarge :: [Int] -> [Int]
decreaseAllLarge digs = map decreaseLarge digs

isSumDivisible :: [Int] -> Bool
isSumDivisible [] = False
isSumDivisible digs = ((sum digs) `mod` 10) == 0

-- isLuhnValid 0 == False
-- isLuhnValid 1241235125 == False
-- isLuhnValid 4140834708961565 == True (generated with https://randommer.io/Card)
isLuhnValid :: Int -> Bool
isLuhnValid = error "todo"
isLuhnValid x = isSumDivisible digs1
where digs1 = decreaseAllLarge digs2
where digs2 = processEven digs3
where digs3 = intToList x
102 changes: 86 additions & 16 deletions Lab1/test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,20 +15,90 @@ 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 2 3 `shouldBe` 2
median3 1 2 2 `shouldBe` 2
median3 2 2 2 `shouldBe` 2
median3 3 2 1 `shouldBe` 2
median3 5 3 4 `shouldBe` 4
median3 4 3 5 `shouldBe` 4
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 1.0 0.5 2 `shouldBe` 0.25
geomProgression 1.0 2.0 3 `shouldBe` 8.0
it "coprime" $ do
coprime 2 7 `shouldBe` True
coprime (-2) 7 `shouldBe` True
coprime 2 4 `shouldBe` False
coprime (-2) 4 `shouldBe` False
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 [1, 2, 3] [1, 2, 3] `shouldBe` [1, 2, 3]
intersect [1, 2, 3] [3, 4, 5] `shouldBe` [3]
intersect [1, 2] [3, 4] `shouldBe` []
intersect [1, 2] [] `shouldBe` []
intersect [] [1, 2] `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, 1] `shouldBe` Just 1
find (even) [1, 2, 3, 4] `shouldBe` Just 2
find (< 0) [-1, 0] `shouldBe` Just (-1)
it "findLast" $ do
findLast (> 0) [-1, 0, 1] `shouldBe` Just 1
findLast (< 0) [-1, -2, -3, -4] `shouldBe` Just (-4)
findLast (even) [-1, 1, -3, 3] `shouldBe` Nothing
it "mapFuncs" $ do
mapFuncs [\x -> x*x, \x -> x - 1] 2 `shouldBe` [4, 1]
mapFuncs [abs] (-9) `shouldBe` [9.0]
it "satisfiesAll" $ do
satisfiesAll [] 1 `shouldBe` True
satisfiesAll [even, \x -> x rem 5 == 0] 10 `shouldBe` True
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 1 [2]) (NEL 3 [4]) `shouldBe` NEL (1,3) [(2,4)]
zipNel (NEL 1 []) (NEL 2 []) `shouldBe` NEL (1,2) []
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 1 []) `shouldBe` [1]
describe "luhn" $ do
it "intToList" $ do
intToList 1 `shouldBe` [1]
intToList 123 `shouldBe` [321]
it "processEven" $ do
processEven [] `shouldBe` []
processEven [1] `shouldBe` [1]
processEven [1, 1] `shouldBe` [1, 2]
processEven [1, 1, 1] `shouldBe` [1, 2, 1]
it "decreaseLarge" $ do
decreaseLarge 1 `shouldBe` 1
decreaseLarge 18 `shouldBe` 9
it "decreaseAllLarge" $ do
decreaseAllLarge [] `shouldBe` []
decreaseAllLarge [1] `shouldBe` [1]
decreaseAllLarge [1, 18, 3] `shouldBe` [1, 9, 3]
it "isLuhnValid" $ do
isLuhnValid 0 `shouldBe` False
isLuhnValid 1241235125 `shouldBe` False
isLuhnValid 4140834708961565 `shouldBe` True
Loading