Monoid 和 Foldable

又要工作了……

Monoid

Monoid 在 Haskell 中有很多应用，且和折叠操作比较相关，值得学习。

幺半群 Monoid，或者说半群 with 幺元，那首先得了解半群和幺元是什么玩意。

半群 Semigroup 是这样一种数学结构，对非空集合 S，对 S 上的二元运算·: S x S -> S，其满足结合律（即对集合 S 上的元素 a，b，c，有a · (b · c) = (a · b) · c），则二元组(S, ·)为半群；幺半群则在半群的基础上添加了一个幺元 identity element——任何元素对其作运算·仍旧得到它自身，这是说假如令幺元为 e，则对 S 上任意元素 a，有a · e = a = e · a，三元组(S, ·, e)为幺半群。

数学定义抽象且无聊，但幺半群的几个实例是非常明显的：

1. （Int，+, 0)是幺半群——结合律：1 + (2 + 3) = (1 + 2) + 3, 幺元：1 + 0 = 0 + 1 = 1
2. （Int，*, 1)是幺半群——结合律：1 * (2 * 3) = (1 * 2) * 3, 幺元：2 * 1 = 1 * 2 = 2
3. ([a], ++, [])是幺半群——结合律：[1,2] ++ ([3] ++ [4]) = ([1,2] ++ [3]) ++ [4]，幺元：[1,2] ++ [] = [] ++ [1,2] = [1,2]
4. （String，++, "")是幺半群，同上

结合律允许以任意顺序去执行这样的运算，这允许对其去并行计算。

Haskell 中定义了相应的 typeclass 用来表示幺半群：

-- | The class of monoids (types with an associative binary operation that
-- has an identity).  Instances should satisfy the following:
--
-- [Right identity] @x '<>' 'mempty' = x@
-- [Left identity]  @'mempty' '<>' x = x@
-- [Associativity]  @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ ('Semigroup' law)
-- [Concatenation]  @'mconcat' = 'foldr' ('<>') 'mempty'@
--
-- The method names refer to the monoid of lists under concatenation,
-- but there are many other instances.
--
-- Some types can be viewed as a monoid in more than one way,
-- e.g. both addition and multiplication on numbers.
-- In such cases we often define @newtype@s and make those instances
-- of 'Monoid', e.g. 'Data.Semigroup.Sum' and 'Data.Semigroup.Product'.
--
-- __NOTE__: 'Semigroup' is a superclass of 'Monoid' since /base-4.11.0.0/.
class Semigroup a => Monoid a where
        -- | Identity of 'mappend'
        --
        -- >>> "Hello world" <> mempty
        -- "Hello world"
        mempty  :: a

        -- | An associative operation
        --
        -- __NOTE__: This method is redundant and has the default
        -- implementation @'mappend' = ('<>')@ since /base-4.11.0.0/.
        -- Should it be implemented manually, since 'mappend' is a synonym for
        -- ('<>'), it is expected that the two functions are defined the same
        -- way. In a future GHC release 'mappend' will be removed from 'Monoid'.
        mappend :: a -> a -> a
        mappend = (<>)
        {-# INLINE mappend #-}

        -- | Fold a list using the monoid.
        --
        -- For most types, the default definition for 'mconcat' will be
        -- used, but the function is included in the class definition so
        -- that an optimized version can be provided for specific types.
        --
        -- >>> mconcat ["Hello", " ", "Haskell", "!"]
        -- "Hello Haskell!"
        mconcat :: [a] -> a
        mconcat = foldr mappend mempty
        {-# INLINE mconcat #-}
        -- INLINE in the hope of fusion with mconcat's argument (see !4890)

实现其只需要指定二元运算（在半群实例中）和幺元即可，下面定义数字加法幺半群：

newtype Plus = Plus Int

instance Semigroup Plus where
  (<>) :: Plus -> Plus -> Plus
  (Plus a) <> (Plus b) = Plus $ a + b

instance Monoid Plus where
  mempty :: Plus
  mempty = Plus 0

Monoid 的实例需要满足下面的定律：

(x <> y) <> z = x <> (y <> z) -- associativity
mempty <> x = x               -- left identity
x <> mempty = x               -- right identity

容易发现，(Bool, &&, True)和(Bool, ||, False)也是幺半群：

-- 在标准库中，这里的 And 名称为 All，Or 名称为 Any
newtype And = And Bool
instance Semigroup And where
  (<>) :: And -> And -> And
  (And a) <> (And b) = And $ a && b
instance Monoid And where
  mempty :: And
  mempty = And True

newtype Or = Or Bool
instance Semigroup Or where
  (<>) :: Or -> Or -> Or
  (Or a) <> (Or b) = Or $ a || b
instance Monoid Or where
  mempty :: Or
  mempty = Or False

应用

Monoid 的定义很简单，但其的使用的地方还是很多的，下面列一些可能常用的：

0. 列表是 Monoid。

1. Data.Text 是更高性能的字符串，其也是 Monoid 的实例，其无法像[Char]一样使用++去拼接，因此需要使用半群的<>去进行拼接：

str = ("Hello, " :: Text) <> "World!"

2. Data.Monoid 包下定义了 newtype First 和 Last，用于将Maybe m视为 Monoid，二元运算为取第一个或最后一个 Just 值，取不到则为 Nothing（Nothing 为幺元）；其特别适用于“取变量 x，如果 x 为 null，取变量 y”的需求（更抽象地说，对于变量 a,b,c,d,e…，从前往后或从后往前取第一个非 null 的变量）：

注意，Data.Semigroup 包下也定义了 First 和 Last，但其行为和 Data.Monoid 包下的同名 newtype 不同，Semigroup 包下的 First 和 Last 仅是半群且和 Maybe 无关，二元运算为取前者或后者！（坑啊！

First (Just 234) <> First (Just 123) = First (Just 234)
Last (Just 234) <> Last (Just 123) = Last (Just 123)
Last (Just 234) <> Last Nothing = Last (Just 234)

First 也可以直接用类型类Alternative中的<|>替代，这样更清晰些：

Just 234 <|> Just 123 = Just 234

顺便，对于Maybe m，若类型变量 m 是 Semigroup，则Maybe m为 Monoid，二元运算行为是将包含的值进行拼接，其中 Nothing 为幺元：

Nothing <> Just "Hello" = Just "Hello"
Just "Hello" <> Just ", World!" = Just "Hello, World!" 

3. Ordering 类型，即 compare 函数的返回值类型，也是 Monoid，其幺元是EQ，二元运算的行为类似 First，其非常适合这种需求——先比较 x，如果 x 相等，比较 y。比如这里写一个函数比较两个字符串的长度大小，其中规定若两个字符串等长，则比较两个字符串内容：

lengthCompare :: String -> String -> Ordering
lengthCompare a b = (length a `compare` length b) <> (a `compare` b)

同态

乘法有一个所谓的分配律，这是说对实数 a，b，c，有 a * (b + c) = a * b + a * c，定义f(x) = a * x，有f(b + c) = f(b) + f(c)，又能看到，f(0) = 0，这时称函数 f 是一个加法幺半群到加法幺半群上的同态 Homomorphism，抽象地说，对于 Monoid a 和 b，有：

f :: (Monoid a, Monoid b) => a -> b
f mempty   = mempty
f (x <> y) = f x <> f y

如，length 是([a], ++, [])到(Int, +, 0)的同伦映射：

length :: [a] -> Int
length [] = 0
length (xs ++ ys) = length xs + length ys -- 伪代码

这玩意有什么用呢？简单来说，若有变量 a，b 是一个幺半群的元素且二元运算为+，求f(a + b)的值，若 f 是同伦映射，就可以并行地计算f(a)和f(b)，然后使用对应二元运算得到结果。

但或许更有趣的地方是，Monoid 和折叠操作相关。

Foldable，但是 foldMap

Foldable 是列表的折叠操作的一般化，从而使任意类型具有折叠的能力。要实现 Foldable，需要实现 foldr 或者 foldMap，foldr 是老朋友了，foldMap 是何方神圣？

foldMap 的类型签名是foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m，这是说，对于可折叠类型 t，如果有将其中元素映射成为某 Monoid 类型 m 的映射，就能把 t 折叠成 m。how？

考虑foldr f z [a, b, c]，其可以表述为a `f` (b `f` (c `f` z))，若令f = (<>), z = mempty，就得到了a <> (b <> (c <> mempty))，这正好是 mconcat 的定义：

mconcat :: Monoid m => [m] -> m
mconcat xs = foldr (<>) mempty xs

可以看到，对于一个幺半群的列表，总是有一种方式去对它进行折叠操作，即是使用幺元作为初始值，使用二元运算作为操作符；将这泛化一步——若某列表中的元素能映射成为特定幺半群，则这个列表可以使用这个幺半群的方式去折叠，这就是 foldMap——先映射成为特定幺半群，再折叠：

foldMap :: Monoid m => (a -> m) -> [a] -> m
foldMap f xs = mconcat $ map f xs

foldMap 有一些非常有趣的玩法，比如定义 sum，product，all，any 等：

sum :: Num a => [a] -> a
sum = getSum . foldMap Sum

product :: Num a => [a] -> a
product = getProduct . foldMap Product

all :: [Bool] -> Bool
all = getAll . foldMap All

any :: [Bool] -> Bool
any = getAny . foldMap Any

因为 mconcat 可以由 foldr 定义（实际上对左折叠也行，因为半群的结合性，但二元运算可能需要flip一下——半群不要求二元运算满足交换律），所以 foldMap 可以由 foldr 定义。这是对折叠操作的一种新的视角——先把列表元素类型映射成幺半群，再用二元运算去 concat 成一个值。

这里去使用 foldMap 去实现一个 reverse，同时也给出 foldr 的版本：

reverseByFoldr :: Foldable t => t a -> [a]
reverseByFoldr = foldr (\x acc -> acc ++ [x]) [] -- 忘掉效率！

-- 使用 foldMap 去实现 reverse，重点就是要识别和创建出相应幺半群
-- 容易发现，这里需要这样一个列表的幺半群，它的幺元仍是空集，但二元操作为 flip (++)（应当测试几个用例证明该二元操作满足结合律）
newtype Reverse a = Reverse {getReverse :: [a]}
instance Semigroup (Reverse a) where
  (<>) :: Reverse a -> Reverse a -> Reverse a
  (Reverse a) <> (Reverse b) = Reverse $ b ++ a

instance Monoid (Reverse a) where
  mempty :: Reverse a
  mempty = Reverse []

-- 实际使用的时候，要把列表中的元素映射成为这个幺半群（即成为列表）
reverseByFoldMap :: [a] -> [a]
reverseByFoldMap xs = getReverse $ foldMap (Reverse . (:[])) xs

foldMap 的这种对折叠操作的看待方式相当有趣——每次进行列表或其它结构的折叠操作的时候，实际上都是定义了一个新的幺半群，将结构中的值映射到幺半群的类型，并使用幺半群的二元运算去做拼接。那么，是否有可能根据 foldMap 去定义折叠操作？

观察 foldr 的签名：

foldr :: (a -> b -> b) -> b -> [a] -> b

考虑折叠操作a -> b -> b，为返回值加上括号得到 a -> (b -> b)……唔姆唔姆，从这个角度上看 foldr，我们就是把列表中的元素 a 映射成为b -> b，然后将其不断地应用在初始值 b 上，得到最终结果，于是，如何处理列表b -> b和初始值 b？

好玩的地方来了：函数本身也是幺半群，幺元是 id，二元运算是函数组合，所以，我们可以先把b -> b列表折成一个b -> b，再应用它到初始值 b 上（也就是说，利用函数是幺半群这个性质先拼接一下），下面是定义：

-- 不知道为何 Haskell 没有识别出函数是幺半群，这里直接显式地定义一个幺半群 Endo：
newtype Endo b = Endo {appEndo :: b -> b}
instance Semigroup (Endo b) where
  (<>) :: Endo b -> Endo b -> Endo b
  (Endo g) <> (Endo f) = Endo $ g . f

instance Monoid (Endo b) where
  mempty :: Endo b
  mempty = Endo id

-- foldMap :: Monoid m => (a -> m) -> [a] -> m，替换 m 为 b -> b，替换结果为 Endo b
foldComposing :: (a -> (b -> b)) -> [a] -> Endo b
foldComposing f = foldMap (Endo . f)

-- 先把`b -> b`列表折成一个 Endo b（即 b -> b），再应用它到初始值 b
foldr :: (a -> (b -> b)) -> b -> [a] -> b
foldr f z xs = appEndo (foldComposing f xs) z

-- 如果 Haskell 能识别 b -> b 为幺半群的话，直接下面这样就行了
foldComposing :: (a -> (b -> b)) -> [a] -> (b -> b)
foldComposinng f = foldMap f

foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f z xs = foldComposing f xs z

这说明可以用 foldMap 去实现 foldr，前面又用 foldr 去实现 foldMap，它们可以互相实现；Haskell 中提供折叠操作的类型类是 Foldable，其允许仅定义 foldMap 或 foldr 去实例化它，这里给出列表的递归的 foldMap 实现：

foldMap :: (Monoid m) => (a -> m) -> [a] -> m
foldMap _ [] = mempty
foldMap f (x:xs) = f x <> foldMap f xs

Foldable 中还有许多有趣的玩意，比如用 foldr 去实现 foldl，foldr1 等，以及转换到列表，检查是否为空，获取容器长度，求最大最小值等：

-- Abridged definition, with just the method signatures.
class Foldable t where
    foldMap :: Monoid m => (a -> m) -> t a -> m
    foldr :: (a -> b -> b) -> b -> t a -> b

    -- All of the following have default implementations:
    fold :: Monoid m => t m -> m -- generalised mconcat
    foldr' :: (a -> b -> b) -> b -> t a -> b
    foldl :: (b -> a -> b) -> b -> t a -> b
    foldl' :: (b -> a -> b) -> b -> t a -> b
    foldr1 :: (a -> a -> a) -> t a -> a
    foldl1 :: (a -> a -> a) -> t a -> a
    toList :: t a -> [a]
    null :: t a -> Bool
    length :: t a -> Int
    elem :: Eq a => a -> t a -> Bool
    maximum :: Ord a => t a -> a
    minimum :: Ord a => t a -> a
    sum :: Num a => t a -> a
    product :: Num a => t a -> a

toList 非常有趣，其证明任何可折叠的类型都可以转换成为列表，这借用了列表是幺半群这个特性：

toList :: (Foldable t) => t a -> [a]
toList = foldMap (\x -> [x])

toList reflects the fact that lists are the free monoid for Haskell types. “Free” here means any value can be promoted to the monoid in a way which neither adds nor erases any information (we can convert values of type a to [a] lists with a single element and back through (\x->[x]) and head in a lossless way).

应用

所以，在什么情况下 foldMap 会比 foldr 更香？

考虑二叉树：

data BiTree a = BiTree a (Maybe (BiTree a)) (Maybe (BiTree a)) deriving (Show)

能对这个树做什么操作呢？比如，对每个子树都应用相同操作，比如获取它以及所有子树的和，获取它的最大深度……

-- 对所有元素进行相同操作，这显然是 Functor，类似列表：
instance Functor BiTree where
  fmap :: (a -> b) -> BiTree a -> BiTree b
  fmap f (BiTree v l r) = BiTree (f v) (fmap f <$> l) (fmap f <$> r) -- <$> 提升这个 fmap f 到 Maybe 上下文

-- 求所有子树的和
-- maybe 函数类似于 orElse
sumTree :: BiTree Int -> Int
sumTree (BiTree v l r) = maybe 0 sumTree l + maybe 0 sumTree r + v

-- 获取最大深度
maxDepth :: BiTree a -> Int
maxDepth (BiTree _ Nothing Nothing) = 1
maxDepth (BiTree _ l r) = maybe 0 maxDepth l `max` maybe 0 maxDepth r + 1

这两个操作显然都是折叠操作，所以，树是可以折叠的！那如何折叠呢？如果尝试去编写 foldr，那代码会显得比较（或者相当？）繁琐，但若使用 foldMap 的话，则会很容易：

-- 可以发现，这同时也是一个前序遍历，显然还能有中序遍历，后序遍历，还能有广度优先遍历
instance Foldable BiTree where
  foldMap :: Monoid m => (a -> m) -> BiTree a -> m
  foldMap f (BiTree v l r) = f v <> maybe mempty (foldMap f) l <> maybe mempty (foldMap f) r

定义了 Foldable 的实例后，定义 sumTree 就很简单了：

sumTree :: BiTree Int -> Int
sumTree = getSum . foldMap Sum

问题在于，maxDepth 无法使用这个 foldMap 去表述——从中无法抽象出合适的幺半群（是否真的如此？？）。为什么如此呢？天知道。解决方案是编写一种树专属的折叠函数，其对每个值先做一次映射，再对每个子树进行合并，参数带上根结点和左右子树的值：

treeFold :: b -> (a -> b) -> (b -> b -> b -> b) -> BiTree a -> b
-- z 为默认值，在子树为空的情况下填充，mapper 为映射，combiner 为合并函数
treeFold z mapper combiner (BiTree v l r) = combiner (mapper v) l' r'
  where l' = maybe z (treeFold z mapper combiner) l 
        r' = maybe z (treeFold z mapper combiner) r

maxDepth' :: (Num b, Ord b) => BiTree b -> b
maxDepth' = treeFold 0 (const 1) (\_ l r -> l `max` r + 1)

Bonus

下面在 typescript 里利用 foldMap 去实现了 sum 和 groupBy，使用了 type class 模式，比较有趣：

interface Monoid<T> {
  mempty() : T,
  mappend(a: T, b: T): T
}
// 将一个幺半群的序列用其上的二元操作进行拼接
function mconcat<T>(xs : T[], Monoid : Monoid<T>) {
  return xs.reduceRight(Monoid.mappend, Monoid.mempty())
}

function foldMap<T, A>(f: (t: A) => T, xs: A[], MonoidT: Monoid<T>) {
  return mconcat(xs.map(f), MonoidT)
}

function sum(xs: number[]): number {
  // 数字上的加法幺半群，幺元为 0，二元运算为加法
  const SumMonoid: Monoid<number> = {
    mempty() { return 0 }, mappend(a, b) { return a + b }
  }
  return foldMap(x => x, xs, SumMonoid) // 在这里等价于 mconcat(xs, SumMonoid)
}

function groupBy<T>(keyMapper: (x: T) => string, xs: T[]): Record<string, T[]> {
    // Record<string, T[]>上的幺半群，幺元为{}，二元运算为合并两个 Record，其中对同名的 key，拼接它们的值数组作为新的值
    const RecordMergeMonoid: Monoid<Record<string, T[]>> = {
      mempty() {
        return {} as Record<string, T[]>
      },
      mappend(a, b) {
        // 找到所有 key，对每个 key，合并两个 Record
        const result = {} as Record<string, T[]>
        const keys = [...new Set([...Object.keys(a), ...Object.keys(b)])]
        keys.forEach(key => {
          const arrA = a[key] ?? []
          const arrB = b[key] ?? []
          result[key] = [...arrA, ...arrB]
        })
        return result
      },
    }
    // 需要把元素 x 映射成 Record<string, T[]>
    return foldMap(x => ({[keyMapper(x)]: [x]}), xs, RecordMergeMonoid)
}
const objs = [{name: "Haruka", clazz: "765"}, {name: "Chihaya", clazz: "765"}, {name: "Miki", clazz: "961"}]
console.log(groupBy(obj => obj.clazz, objs))

参考资料

• Haskell/Monoids - Wikibooks
• Haskell/Foldable - Wikibooks
• 《Haskell 趣学指南》