高阶函数 #

-- 接受函数参数
map :: (a -> b) -> [a] -> [b]

-- 返回函数
compose :: (b -> c) -> (a -> b) -> (a -> c)

-- 函数可以赋值给变量
addOne = (+1)

-- 函数可以作为参数
applyTwice :: (a -> a) -> a -> a
applyTwice f x = f (f x)

-- 函数可以作为返回值
makeMultiplier :: Int -> (Int -> Int)
makeMultiplier n = (*n)

-- 类型签名
map :: (a -> b) -> [a] -> [b]

-- 示例
map (*2) [1, 2, 3, 4, 5]      -- [2, 4, 6, 8, 10]
map (+1) [1, 2, 3]            -- [2, 3, 4]
map show [1, 2, 3]            -- ["1", "2", "3"]
map length ["hello", "world"] -- [5, 5]

-- map实现
map' :: (a -> b) -> [a] -> [b]
map' _ []     = []
map' f (x:xs) = f x : map' f xs

-- 映射复杂类型
map fst [(1, 'a'), (2, 'b'), (3, 'c')]  -- [1, 2, 3]

-- 链式映射
map (*2) (map (+1) [1, 2, 3])  -- [4, 6, 8]

-- 使用组合
map ((*2) . (+1)) [1, 2, 3]    -- [4, 6, 8]

-- 类型签名
filter :: (a -> Bool) -> [a] -> [a]

-- 示例
filter even [1..10]           -- [2, 4, 6, 8, 10]
filter (>5) [1..10]           -- [6, 7, 8, 9, 10]
filter (`elem` "aeiou") "hello world"  -- "eoo"

-- filter实现
filter' :: (a -> Bool) -> [a] -> [a]
filter' _ []     = []
filter' p (x:xs)
    | p x       = x : filter' p xs
    | otherwise = filter' p xs

-- 多条件过滤
filter (\x -> x > 3 && x < 8) [1..10]  -- [4, 5, 6, 7]

-- 过滤Maybe值
catMaybes :: [Maybe a] -> [a]
catMaybes = map fromJust . filter isJust
  where
    fromJust (Just x) = x
    isJust (Just _) = True
    isJust Nothing  = False

-- 过滤元组
filter (\(x, y) -> x > y) [(1, 2), (3, 1), (5, 5), (6, 2)]
-- [(3, 1), (6, 2)]

-- 类型签名
foldr :: (a -> b -> b) -> b -> [a] -> b

-- 示例
foldr (+) 0 [1, 2, 3, 4, 5]  -- 15
foldr (*) 1 [1, 2, 3, 4]     -- 24
foldr (:) [] [1, 2, 3]       -- [1, 2, 3]

-- 计算过程
-- foldr (+) 0 [1, 2, 3]
-- = 1 + (2 + (3 + 0))
-- = 1 + (2 + 3)
-- = 1 + 5
-- = 6

-- 类型签名
foldl :: (b -> a -> b) -> b -> [a] -> b

-- 示例
foldl (+) 0 [1, 2, 3, 4, 5]  -- 15
foldl (*) 1 [1, 2, 3, 4]     -- 24
foldl (flip (:)) [] [1, 2, 3] -- [3, 2, 1]

-- 计算过程
-- foldl (+) 0 [1, 2, 3]
-- = ((0 + 1) + 2) + 3
-- = (1 + 2) + 3
-- = 3 + 3
-- = 6

-- foldr实现
foldr' :: (a -> b -> b) -> b -> [a] -> b
foldr' _ z []     = z
foldr' f z (x:xs) = f x (foldr' f z xs)

-- foldl实现
foldl' :: (b -> a -> b) -> b -> [a] -> b
foldl' _ z []     = z
foldl' f z (x:xs) = foldl' f (f z x) xs

-- 求和
sum' :: Num a => [a] -> a
sum' = foldl (+) 0

-- 求积
product' :: Num a => [a] -> a
product' = foldl (*) 1

-- 长度
length' :: [a] -> Int
length' = foldl (\acc _ -> acc + 1) 0

-- 反转
reverse' :: [a] -> [a]
reverse' = foldl (flip (:)) []

-- 拼接
concat' :: [[a]] -> [a]
concat' = foldr (++) []

-- 类型签名
zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]

-- 示例
zipWith (+) [1, 2, 3] [4, 5, 6]      -- [5, 7, 9]
zipWith (*) [1, 2, 3] [4, 5, 6]      -- [4, 10, 18]
zipWith (,) [1, 2, 3] ['a', 'b', 'c'] -- [(1, 'a'), (2, 'b'), (3, 'c')]

-- zipWith实现
zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith' _ [] _        = []
zipWith' _ _ []        = []
zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys

-- 点积
dotProduct :: [Int] -> [Int] -> Int
dotProduct xs ys = sum (zipWith (*) xs ys)

-- 元素级操作
elementWiseMax :: [Int] -> [Int] -> [Int]
elementWiseMax = zipWith max

-- 列表相减
listSubtract :: [Int] -> [Int] -> [Int]
listSubtract = zipWith (-)

-- takeWhile：取满足条件的元素直到第一个不满足
takeWhile :: (a -> Bool) -> [a] -> [a]
takeWhile _ [] = []
takeWhile p (x:xs)
    | p x       = x : takeWhile p xs
    | otherwise = []

-- 示例
takeWhile (< 5) [1..10]  -- [1, 2, 3, 4]
takeWhile even [2, 4, 6, 7, 8]  -- [2, 4, 6]

-- dropWhile：丢弃满足条件的元素直到第一个不满足
dropWhile :: (a -> Bool) -> [a] -> [a]
dropWhile _ [] = []
dropWhile p (x:xs)
    | p x       = dropWhile p xs
    | otherwise = x:xs

-- 示例
dropWhile (< 5) [1..10]  -- [5, 6, 7, 8, 9, 10]

-- span：分割为满足和不满足两部分
span :: (a -> Bool) -> [a] -> ([a], [a])
span p xs = (takeWhile p xs, dropWhile p xs)

-- 示例
span (< 5) [1..10]  -- ([1, 2, 3, 4], [5, 6, 7, 8, 9, 10])

-- break：span的否定版本
break :: (a -> Bool) -> [a] -> ([a], [a])
break p = span (not . p)

-- 示例
break (> 5) [1..10]  -- ([1, 2, 3, 4, 5], [6, 7, 8, 9, 10])

-- partition：按条件分为两部分
partition :: (a -> Bool) -> [a] -> ([a], [a])
partition p xs = (filter p xs, filter (not . p) xs)

-- 示例
partition even [1..10]  -- ([2, 4, 6, 8, 10], [1, 3, 5, 7, 9])

-- scanl：类似foldl但保留中间结果
scanl :: (b -> a -> b) -> b -> [a] -> [b]
scanl f z xs = z : case xs of
    []   -> []
    x:xs -> scanl f (f z x) xs

-- 示例
scanl (+) 0 [1, 2, 3, 4]  -- [0, 1, 3, 6, 10]
scanl (*) 1 [1, 2, 3, 4]  -- [1, 1, 2, 6, 24]

-- scanr：类似foldr但保留中间结果
scanr :: (a -> b -> b) -> b -> [a] -> [b]
scanr _ z []     = [z]
scanr f z (x:xs) = f x (head ys) : ys
  where ys = scanr f z xs

-- 示例
scanr (+) 0 [1, 2, 3, 4]  -- [10, 9, 7, 4, 0]

-- 组合运算符
(.) :: (b -> c) -> (a -> b) -> (a -> c)
(f . g) x = f (g x)

-- 示例
doubleAndAddOne = (+1) . (*2)
doubleAndAddOne 5  -- 11

-- 多函数组合
pipeline = show . (*2) . (+1)
pipeline 5  -- "12"

-- 有参数形式
sumOfSquares xs = sum (map (^2) xs)

-- 无点形式
sumOfSquares' = sum . map (^2)

-- 另一个例子
-- 有参数
evenLength xs = even (length xs)

-- 无点
evenLength' = even . length

-- 长组合链
process :: [Int] -> String
process = show . sum . filter even . map (*2)

-- 等价于
process' xs = show (sum (filter even (map (*2) xs)))

-- 使用
process [1..10]  -- "60"

-- 处理学生成绩
type Student = (String, Int, Int)  -- (姓名, 数学, 英语)

-- 获取平均分高于80的学生姓名
topStudents :: [Student] -> [String]
topStudents = map getName . filter isTop
  where
    getName (name, _, _) = name
    isTop (_, math, eng) = (math + eng) `div` 2 > 80

-- 计算总分
totalScores :: [Student] -> [(String, Int)]
totalScores = map (\(name, m, e) -> (name, m + e))

import Data.Char

-- 统计单词
wordCount :: String -> Int
wordCount = length . words

-- 统计字母
letterCount :: String -> Int
letterCount = length . filter isLetter

-- 大写所有单词
capitalizeWords :: String -> String
capitalizeWords = unwords . map capitalize . words
  where
    capitalize (x:xs) = toUpper x : xs
    capitalize [] = []

-- 阶乘
factorial :: Integer -> Integer
factorial n = product [1..n]

-- 组合数 C(n, k)
combinations :: Integer -> Integer -> Integer
combinations n k = factorial n `div` (factorial k * factorial (n - k))

-- 斐波那契数列
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

-- 获取第n个斐波那契数
fib :: Int -> Integer
fib n = fibs !! n

-- 去重
nub :: Eq a => [a] -> [a]
nub = foldr (\x xs -> x : filter (/= x) xs) []

-- 排序并去重
uniqueSort :: Ord a => [a] -> [a]
uniqueSort = nub . sort

-- 分组
group :: Eq a => [a] -> [[a]]
group = foldr f []
  where
    f x [] = [[x]]
    f x (ys:yss)
        | x == head ys = (x:ys):yss
        | otherwise    = [x]:ys:yss

-- foldl可能产生空间泄漏
-- 使用严格的foldl'
import Data.List (foldl')

-- 严格版本
sumStrict :: [Int] -> Int
sumStrict = foldl' (+) 0

-- foldr可以处理无限列表
-- foldl不能
take 5 (foldr (:) [] [1..])  -- [1, 2, 3, 4, 5]
-- take 5 (foldl (flip (:)) [] [1..])  -- 无限循环

-- 多次遍历
process1 xs = sum (filter even (map (*2) xs))

-- 单次遍历（使用fold）
process2 xs = foldl' (\acc x -> if even (x*2) then acc + x*2 else acc) 0 xs