laba3

-- Вариант 5
import Data.Char
import Data.List

-- 1
-- в строке есть символы - знаки пунктуации
hasPunсtuation :: [Char] -> Bool
hasPunсtuation s =
any isPunсtuation s
where
isPunсtuation x = elem x "!?,.:;'\"`"

-- все гласные в строке - прописные
isAllVowelUpper :: [Char] -> Bool
isAllVowelUpper s =
all (\x -> if isVowel x then isUpper x else True) s
where
isVowel x = elem x "АОЫУЭЫЯЁЮЕИAEIOUYаоуэыяёюеиaeiouy"

-- 2
-- из списка строк получить список
-- двух последних символов каждой строки
getTwoLast :: [[Char]] -> [[Char]]
getTwoLast list =
map (\str -> drop (length str - 2) str) list

-- в полученном списке удалить все элементы с начала,
-- в которых код первого символа меньше кода второго,
-- до первого неудовлетворяющего этому условию

getFiltered :: [[Char]] -> [[Char]]
getFiltered list =
dropWhile (\str -> ord (str!!0) < ord (str!!1)) list

-- 3
-- (c,c) (c,b) (b,b) (a,b) (c,a)
-- Найти P-1, P*P, P-1*P, np2(P-1*P) x np1(P*P)

-- заданное отображение
p :: a -> a -> a -> [(a, a)]
p a b c =
[(c,c), (c,b), (b,b), (a,b), (c,a)]
-- для отладки: [(c,a), (a,a), (b,c), (a,b)]

-- обратное отображение
pM1 :: [(a, a)] -> [(a, a)]
pM1 p =
map (\el -> (snd el, fst el)) p

-- композиция отображений
pComp :: Eq a => [(a, a)] -> [(a, a)] -> [(a, a)]
pComp p1 p2 =
nub [(a,d) | (a,b)<-p1, (c,d)<-p2, b == c]

-- проекция на первую ось
pr1 :: Eq a => [(a, b)] -> [a]
pr1 p =
nub (fst (unzip p))

-- проекция на вторую ось
pr2 :: Eq a1 => [(a2, a1)] -> [a1]
pr2 p =
nub (snd (unzip p))

-- декартово произведения
pDecart :: (Eq a, Eq b) => [a] -> [b] -> [(a, b)]
pDecart set1 set2 =
nub [(a,b) | a<-set1, b<-set2]

-- функции для вывода
pM1CompP :: Eq a => [(a, a)] -> [(a, a)]
pM1CompP p =
pComp (pM1 p) p

pr2pM1CompP :: Eq b => [(b, b)] -> [b]
pr2pM1CompP p =
pr2 (pComp (pM1 p) p)

pr1Comp :: Eq b => [(b, b)] -> [b]
pr1Comp p =
pr1 (pComp p p)

pr2pM1CompPDecartPr1Comp :: Eq b => [(b, b)] -> [(b, b)]
pr2pM1CompPDecartPr1Comp p =
pDecart (pr2pM1CompP p) (pr1Comp p)

-- 4
-- Написать функцию, имеющую аргументами эти два списка (предикаты и [(x,y)])
-- Возвращает список логических значений выражения (сущ)y (кажд)x P(x,y)
-- для каждого из предикатов
-- Р1(х,у)=”x+y – четное число”,
-- P2 (х,у)=”x>y”,
-- P3 (х,у)=”x и y имеют одинаковые остатки от деления на 4”,
-- P4 (х,у)=”x+2y<8”,
-- P5 (х,у)=”max{x,y} – нечетное число”,

p1 :: Integral a => a -> a -> Bool
p1 x y = even (x + y)
p2 :: Integral a => a -> a -> Bool
p2 x y = x > y
p3 :: Integral a => a -> a -> Bool
p3 x y = mod x 4 == mod y 4
p4 :: Integral a => a -> a -> Bool
p4 x y = x+2*y < 8
p5 :: Integral a => a -> a -> Bool
p5 x y = mod (max x y) 2 == 1

-- разбить на X и Y потом выводить
task4 :: Integral a => [a -> a -> Bool] -> [(a, a)] -> Bool
task4 preds xy =
any -- существует Y
(\y -> all -- каждый X
(\x -> checkAllPreds preds x y) -- все 5 предикатов выполняются
(getX xy))
(getY xy)
where
getX list =
nub (map fst list)

getY list =
nub (map snd list)

checkAllPreds preds x y =
all (\ f -> f x y) preds

-- 5
-- Написать функцию, возвращающую список значений,
-- получающийся при применении заданной функции, обрабатывающей список
-- (например, суммирование элементов), последовательно к списку,
-- затем к его хвосту, хвосту хвоста и т.д.
task5 :: ([a] -> a) -> [a] -> [a]
task5 _ [] = []
task5 f list = f list : task5 f (tail list)

-- 6
-- Найти все числа Лейланда (представимые в виде x^y+y^x), меньшие 1000.
task6 :: [Int]
task6 =
takeWhile (>0) [x^y + y^x | x<-[2..], y<-[2..], (x^y+y^x) < 1000]
-- takeWhile для преодоления переполнения Int