class-04.hs

{-
  Все задачи в этом задании должны решаться исключительно с помощью свёрток.
  Явная рекурсия не допускается. Если в решении в качестве вспомогательной
  требуется стандартная функция обработки списков (помимо fold*, scan*), она
  также должна реализовываться свёрткой.

  Каждое решение должно сопровождаться тремя различными тестовыми примерами, которые при запуске
  возвращают True, например:

  f = undefined -- решение 
  f_test1 = f undefined == undefined -- тест 1
  f_test2 = f undefined == undefined -- тест 2
  f_test3 = f undefined == undefined -- тест 3
-}


--1. Простейшие функции обработки списков
--a) Найти сумму чётных элементов списка с целочисленными элементами.
f1a :: [Integer] -> Integer
f1a = foldl (\s x -> s + if even x then x else 0) 0
f1a_test1 = f1a [1,2,3,4,5] == 6
f1a_test2 = f1a [-2,1,2,3,4] == 4
f1a_test3 = f1a [0,1,3,5] == 0


--b) Найти сумму и произведение элементов списка вещественных чисел.
f1b :: [Double] -> (Double, Double)
f1b = foldl (\(s,p) x -> (s+x, p*x)) (0, 1)
f1b_test1 = f1b [1,2,3,4,5] == (15.0,120.0)
f1b_test2 = f1b [-2,1,2,3,4] == (8.0,-48.0)
f1b_test3 = f1b [0,1,3,5] == (9.0,0.0)


{-
  с) Найти среднее арифметическое элементов списка вещественных чисел (функцией length пользоваться нельзя,
     решение должно выполняться в один проход).
-}
f1c :: [Double] -> Double
f1c = (\(x, y) -> x / y) . foldl (\(s,c) x -> (s+x, c+1)) (0, 0)
f1c_test1 = f1c [1,2,3,4,5] == 3.0
f1c_test2 = f1c [-2,1,2,3,4] == 1.6
f1c_test3 = f1c [0,1,3,5] == 2.25


--d) Найти минимальный элемент списка.
f1d :: (Ord a) => [a] -> a
f1d = foldl1 min
f1d_test1 = f1d [1,2,3,4,5] == 1
f1d_test2 = f1d [-2,1,2,3,4] == -2
f1d_test3 = f1d [0,1,3,5] == 0


{-
  e) Найти наименьший нечётный элемент списка с целочисленными значениями (дополнительным параметром
     функции должно быть значение, возвращаемое по умолчанию).
-}
f1e :: [Integer] -> Integer
f1e = snd . foldl (\(x, tmp) y -> if odd y then (if x == 0 then (1, y) else (if y < tmp then (x, y) else (x, tmp))) else (x, tmp)) (0, 0)
f1e_test1 = f1e [1,2,3,4,5] == 1
f1e_test2 = f1e [-1,1,2,3,4] == -1
f1e_test3 = f1e [2,4,6,8] == 0


--2. Свёртки, формирующие списки
--a) Сформировать список, содержащий каждый второй элемент исходного.
f2a :: [a] -> [a]
f2a = fst . foldl (\(acc, c) x -> if ((c > 0) && (mod c 2 /= 0)) then (acc ++ [x], c + 1) else (acc, c + 1)) ([], 0)
f2a_test1 = f2a [1,2,3,4,5] == [2,4]
f2a_test2 = f2a [-2,1,2,3,4] == [1,3]
f2a_test3 = f2a [0,1,3,5] == [1,5]


--b) Сформировать список, содержащий первые n элементов исходного.
--f2b :: (Num a, Ord a) => a -> [a1] -> [a1]
f2b n = fst . foldl (\(acc, c) x -> if c < n then (acc ++ [x], c + 1) else (acc, c + 1)) ([], 0)
f2b_test1 = f2b 3 [1,2,3,4,5] == [1,2,3]
f2b_test2 = f2b 2 [-2,1,2,3,4] == [-2,1]
f2b_test3 = f2b 1 [0,1,3,5] == [0]


--c) Сформировать список, содержащий последние n элементов исходного.
f2c :: (Num a, Ord a) => a -> [b] -> [b]
f2c n = foldl (flip (:)) [] . f2b n . foldl (flip (:)) []
f2c_test1 = f2c 3 [1,2,3,4,5] == [3,4,5]
f2c_test2 = f2c 2 [-2,1,2,3,4] == [3,4]
f2c_test3 = f2c 1 [0,1,3,5] == [5]


--d) Сформировать список, содержащий все элементы исходного списка, большие левого соседа.
f2d :: Ord a => [a] -> [a]
f2d [] = []
f2d (x:xs) = fst $ foldl (\(acc, tmp) x -> if (x > tmp) then (acc ++ [x], x) else (acc, x)) ([], x) xs
f2d_test1 = f2d [1,2,3,4,5] == [2,3,4,5]
f2d_test2 = f2d [-2,1,2,3,4] == [1,2,3,4]
f2d_test3 = f2d [0,1,3,5] == [1,3,5]


--e) Сформировать список, содержащий все локальные минимумы исходного списка.

{-
  f) Дана строка, содержащая слова, разделённые одним или несколькими пробелами. Сформировать
     список слов этой строки.
-}


--g) Разбить список на непересекающиеся подсписки длиной n элементов.
f2g :: (Eq a, Num a) => a -> [a1] -> [[a1]]
f2g n = (\(acc, x, tmp) -> acc ++ [x]) . foldl (\(acc, xs, tmp) x -> if (tmp /= 0) then (acc, xs ++ [x], tmp - 1) else (acc ++ [xs], [x], n - 1)) ([], [], n)
f2g_test1 = f2g 3 [1,2,3,4,5] == [[1,2,3],[4,5]]
f2g_test2 = f2g 2 [-2,1,2,3,4] == [[-2,1],[2,3],[4]]
f2g_test3 = f2g 1 [0,1,3,5] == [[0],[1],[3],[5]]


--h) Разбить список на подсписки длиной n элементов с перекрывающейся частью в k элементов (k < n).
f2h :: (Num a, Ord a) => a -> a -> [a1] -> [[a1]]
f2h n k = (\(acc, x, tmp) -> acc ++ [x]) . foldl (\(acc, xs, tmp) x -> if (tmp /= 0) then (acc, xs ++ [x], tmp - 1) else (acc ++ [xs], (f2c k xs) ++ [x], n - k - 1)) ([], [], n)
f2h_test1 = f2h 3 2 [1,2,3,4,5] == [[1,2,3],[2,3,4],[3,4,5]]
f2h_test2 = f2h 2 1 [-2,1,2,3,4] == [[-2,1],[1,2],[2,3],[3,4]]
f2h_test3 = f2h 3 1 [0,1,3,5] == [[0,1,3],[3,5]]


--k) Сформировать список, содержащий все начальные элементы списка, удовлетворяющие заданному предикату.
f2k :: (a -> Bool) -> [a] -> [a]
f2k f = fst . foldl (\(acc, flag) x -> if flag && f x then (acc ++ [x], True) else (acc, False)) ([], True)
f2k_test1 = f2k (> 0) [1,2,3,4,5] == [1,2,3,4,5]
f2k_test2 = f2k (< 3) [-2,1,2,3,4] == [-2,1,2]
f2k_test3 = f2k even [0,1,3,5] == [0]


--l) Повторить каждый элемент списка заданное количество раз.
replicate' n x = foldl (\a b -> a ++ [x]) [] [1..n]

f2l :: Int -> [a] -> [a]
f2l n = foldl (\acc x -> acc ++ replicate' n x) [] 
f2l_test1 = f2l 3 [1,2,3,4,5] == [1,1,1,2,2,2,3,3,3,4,4,4,5,5,5]
f2l_test2 = f2l 2 [-2,1,2,3,4] == [-2,-2,1,1,2,2,3,3,4,4]
f2l_test3 = f2l 1 [0,1,3,5] == [0,1,3,5]


--m) Удалить из списка повторяющиеся подряд идущие элементы.
f2m :: Eq a => [a] -> [a]
f2m [] = []
f2m (x:xs) = (\(acc, x) -> (acc ++ [x])) $ foldl (\(acc, tmp) x -> if x /= tmp then ((acc ++ [tmp]), x) else (acc, tmp)) ([], x) xs
f2m_test1 = f2m [1,1,2,3,4,5] == [1,2,3,4,5]
f2m_test2 = f2m [-2,1,1,2,3,4] == [-2,1,2,3,4]
f2m_test3 = f2m [0,1,3,5,5,5] == [0,1,3,5]


{-
  n) Даны два списка одинаковой длины. Сформировать список, состоящий из результатов применения
     заданной функции двух аргументов к соответствующим элементам исходных списков.
-}
zipWith' :: (t -> b -> a) -> [t] -> [b] -> [a]
zipWith' f xs ys = fst $ foldl (\(acc, (z:zs)) tmp -> (acc ++ [f z tmp], zs)) ([], xs) ys
zipWith'_test1 = zipWith' (+) [1,2,3,4,5] [-5,-4,-3,-2,-1] == [-4,-2,0,2,4]
zipWith'_test2 = zipWith' (*) [-2,1,2,3,4] [0,7,5,3,1] == [0,7,10,9,4]
zipWith'_test3 = zipWith' (-) [0,1,3,5] [1,1,1,1] == [-1,0,2,4]


--3. Использование свёртки как носителя рекурсии (для запуска свёртки можно использовать список типа [1..n]).
--a) Найти сумму чисел от a до b.
f3a :: (Enum a, Num a) => a -> a -> a
f3a a b = foldl1 (+) [a..b]
f3a_test1 = f3a 1 5 == 15
f3a_test2 = f3a (-2) 4 == 7
f3a_test3 = f3a 0 5 == 15


--b) Найти сумму факториалов чисел от a до b (повторные вычисления факториалов не допускаются).
f3b :: (Enum a, Num a, Ord a) => a -> a -> a
f3b a b = foldl (\s x -> s + if x > 0 then (foldl1 (*) [1..x]) else 0) 0 [a..b]
f3b_test1 = f3b 1 5 == 153
f3b_test2 = f3b (-2) 4 == 33
f3b_test3 = f3b 0 5 == 153

--другой способ:
--f3b2 a b = foldl1 (+) $ foldr (\x acc -> (if x > 0 then (foldl1 (*) [1..x]) else 0) : acc) [] [a..b]


--с) Сформировать список из первых n чисел Фибоначчи.
f3c :: (Enum b, Num a, Num b) => b -> [a]
f3c n = fst $ foldl (\(acc, (x1, x2)) x -> (acc ++ [x1], (x2, x1 + x2))) ([], (0, 1)) [1..n]
f3c_test1 = f3c 5 == [0,1,1,2,3]
f3c_test2 = f3c (-1) == []
f3c_test3 = f3c 7 == [0,1,1,2,3,5,8]


{-
d) Пользуясь рядом Тейлора, вычислить значение синуса заданного числа x (использовать
     n слагаемых).
-}


--e) Проверить, является ли заданное целое число простым.


{-
 4. Решить задачу о поиске пути с максимальной суммой в треугольнике (см. лекцию 3) при условии,
   что необходимо дополнительно найти сам путь (к примеру, в виде закодированных направлений спуска:
   0 - влево, 1 - вправо). В решении допускается использование любых стандартных функций.
-}
max' :: (Int, [Char]) -> (Int, [Char]) -> (Int, [Char])
max' (left, leftdir) (right, rightdir) = if (left > right) then (left, leftdir ++ "0 ") else (right, rightdir ++ "1 ")

plus :: Int -> (Int, [Char]) -> (Int, [Char])
plus x (y, dir) = (x + y, dir)

downstep :: [(Int, [Char])] -> [Int] -> [(Int, [Char])]
downstep upper lower = zipWith plus lower $ zipWith max' ((0, ""):upper) (upper ++ [(0, "")])

answer :: [[Int]] -> (Int, [Char])
answer = (\(x, y:ys) -> (x, ys)) . foldl1 (\(x, xs) (y, ys) -> if (x > y) then (x, xs) else (y, ys)) . foldl downstep [(0, [])]
f4_test = answer [[3],[7,4],[2,4,6],[8,5,9,3]] == (23," 1 0 0 ")


--5. Пусть числовые матрицы представлены списками строк. Реализовать следующие функции:
--1) транспонирование матрицы;


--2) сумма двух матриц;
matrixSum :: [[Double]] -> [[Double]] -> [[Double]]
matrixSum = zipWith' $ zipWith' (+)

matrixSum_test1 = matrixSum [[1,2,3,4,5],[(-1),(-2),(-3),(-4),(-5)]] [[(-1),(-2),(-3),(-4),(-5)],[1,2,3,4,5]] == [[0,0,0,0,0],[0,0,0,0,0]]
matrixSum_test2 = matrixSum [[-2,1,2],[3,4,5],[6,7,8]] [[9,10,11],[12,13,14],[(-13),(-14),(-15)]] == [[7,11,13],[15,17,19],[-7,-7,-7]]
matrixSum_test3 = matrixSum [[0.0],[1.0],[3.0],[5.0]] [[5.0],[3.0],[1.0],[0.0]] == [[5.0],[4.0],[4.0],[5.0]]


--3) произведение двух матриц.


{-
 6. Реализовать левую свёртку, пользуясь правой. Проанализировать поведение собственной реализации
  на бесконечных списках и сравнить его с поведением оригинальной foldl.
-}