Fusion

考虑计算List最大值的 max 函数. 利用 sort，我们可以给出一个简单的规约：

1
2
3
4
5

max = head . sort
    where sort = foldr insert []
          insert x [] = [x]
          insert x (y:ys) | x >= y    = x : y : ys
                          | otherwise = y : insert x ys

但是大家都知道这样太慢了，因为 sort 会对整个List进行排序，而我们只需要最大值. 这个问题归结到直接利用sort会带来太多不需要的中间结果. 为了解决这个问题，我们考虑把head整合进sort中. 这样我们引入一个新的概念：Fusion.

Fusion Law for foldr

在处理List上的问题时经常会用到foldr. 在这里，我们考虑把一个外围的函数f整合入foldr中，给出如下的Lemma:

1
2
3

f (a ⊕ r) = a ⊗ f r
------------------------------------
f · foldr (⊕) e = foldr (⊗) (f e)

在这里和以后的一些表示中，\(r\)意味着“recursive”，即foldr的递归部分.

因此我们需要的是通过程序演算找到合适的运算符⊗. 以max为例，可以对head (insert a r)做如下的演算：

• 对于 \(r = []\),

\[ \begin{align*} \text{head} \space ( \text{insert} \space a \space r) &= \text{head} \space ( \text{insert} \space a \space []) \\ &= \text{head} \space [a] \\ &= a \\ \end{align*} \]

• 对于 \(r = y:ys\),

\[ \begin{align*} & \text{head} \space (\text{insert} \space a \space (y : ys)) \\ =& \space \{ \space \text{def. of insert} \space \} \\ & \text{head} \space (\text{if} \space a \geqslant y \space \text{then} \space a : y : ys \space \text{else} \space y : \text{insert} \space a \space ys) \\ =& \space \{ \space \text{distribute head over if} \space \} \\ & \text{if} \space a \geqslant y \space \text{then} \space \text{head} \space (a : y : ys) \space \text{else} \space \text{head} \space (y : \text{insert} \space a \space ys) \\ =& \space \{ \space \text{def. of head} \space \} \\ & \text{if} \space a \geqslant y \space \text{then} \space a \space \text{else} \space y \\ =& \space \{ \space \text{assumption: } r=y:ys \space \} \\ & \text{if} \space a \geqslant \text{head} \space r \space \text{then} \space a \space \text{else} \space \text{head} \space r \\ \end{align*} \]

（以后的演算会适当省略一些推理依据，并按照Haskell的语法来书写）

最后我们得到了一个合适的运算符 \(\otimes = \text{if} \space a \geqslant \text{head} \space r \space \text{then} \space a \space \text{else} \space \text{head} \space r\)，因此我们可以得到：

1

head (insert a r) = a ⊗ (head r)

因此按照Fusion Law，我们可以得到：

1

max = head . foldr insert [] = foldr ⊗ (head []) = foldr ⊗ (-∞)

现在通过Fusion,我们的max已经是一个线性时间的算法了.

More Examples

以上关于max的推演还是比较显然的，但是仍然能展示出Fusion在消除中间结果、将两个函数合并成一个函数上的作用. 现在我们考虑一个更复杂的例子：在List上的reverse.

1
2

reverse = foldr snoc []
    where snoc x xs = xs ++ [x]

现在我们引入一个数组作为辅助，定义一个我们希望变得更快的函数fastrev.

1
2
3
4
5
6

helper xs ys = reverse xs ++ ys
-- 等价于
helper xs = (++) (reverse xs)
          = (++) (foldr snoc [] xs)

fastrev = helper xs []

考虑提升helper的效率，这可以通过将++ 和 snoc 合并成一个函数来实现.

1
2
3
4
5
6
7

  (++) (snoc a r)
= { η expansion }
  λ y -> ((r ++ [a]) ++ y)
= { associativity of ++ }
  λ y -> (r ++ ([a] ++ y))
= { }
  r ++ (λ y -> [a] ++ y)

在Fusion Law中取 f= λ x -> (++) x我们可以得到：

1
2

(++) (r ++ [a]) = a ⊗ ((++) r)
    where a ⊗ r' = λ y r' -> r' ([a] ++ y)

因此，helper可以被重写为：

1
2
3
4

helper xs = λ ys -> (++ ys) (foldr snoc [] xs)
          = foldr (⊗) (++ []) xs
          = foldr (⊗) id xs
    where a ⊗ r' = λ y r' -> r' ([a] ++ y)

我们通过Fusion的推理得到了一个线性时间的算法！

展开foldr,则fastrev可以被重写为：

1
2
3

fastrev xs = helper xs []
    where helper [] y = y
          helper (x:xs) y = helper xs (x:y)

这是我们常见的fastrev的样子. 通过以上的例子，我们可以看到Fusion Law的作用.

Exercises

利用Fusion Law证明以下等式：

1
2
3
4
5

1. foldr (⊕) e . map f = foldr (⊗) e
      where a ⊗ r = f a ⊕ r
2. map f . map g = map (f . g)
3. foldr (⊕) e . filter p = foldr (⊗) e
      where a ⊗ r = if p a then a ⊕ r else r

Solution

考虑map也可以利用foldr来实现：

1

map f = foldr ((:) . f) []

因此，我们便可以利用Fusion Law，将外围原有的foldr整合进map中. 记u = foldr (⊕) e，则：

1
2
3
4

u (((:) . f) a r) = u (f a : r)
                  = f a ⊕ u r
                  = a ⊗ u r
    where a ⊗ r = f a ⊕ r

由Fusion Law, 1是显然的.

考虑 2 中map f也可以写成foldr,这就回到了第一个问题，也是显然的.

类似地，3 中filter也可以利用foldr来实现：

1

filter p = foldr (λ a r -> if p a then a : r else r) []

至此，我们利用Fusion Law证明了以上三个等式.

To Be Continued...

Q $g(x)$ 是定义在 $ [0,1] $ 上的函数，满足 $ g(0)=1,g(1)=0 $，如果函数 $ g(x)+ \tan x $ 单调上升，证明：$ g(x) $可以取到 $ [0,1] $ 内任意的值.

Proof 考虑更一般的问题：

$ f(x) $ 是 $ [0,1] $ 上的连续函数， $g(x)$ 是定义在 $ [0,1] $ 上的函数，满足 $ g(0)>0,g(1)<0 $，如果函数 $ f(x) + g(x) $ 单调上升，证明：$ g(x) $ 有零点.

这类问题的一般解决方法：Lebesgue方法.

考虑构造集合 $ A={x \mid g(x) \geqslant 0} $，我们取 $ c=\sup A $ 并证明 $ c $ 就是 $ g(x) $ 的零点.

• $ t>c $ 时，
  $$ f(t)\geqslant f(t)+g(t)\geqslant f(c)+g(c) $$

这说明 $ g(c)\leqslant f(t)-f(c) $，

两边取 $ t\to c $ 的极限，由于 $ f(x) $ 连续， $ g(c)\leqslant 0 $.

• $ t<c $ 时，类似得到
  $$ f(t)\leqslant f(t)+g(t)\leqslant f(c)+g(c)$$

这说明 $ g(c)\geqslant f(t)-f(c) $，

两边取 $ t\to c $ 的极限，由于 $ f(x) $ 连续， $ g(c)\geqslant 0 $.

综上， $ g(c)=0 $，即 $ c $ 是 $ g(x) $ 的零点.

回到原问题，对于任意的 $\eta \in [0,1] $ 取 $ f(x)=\tan x $，$ h(x)=g(x)-\eta $，对于 $ f(x) $ 和 $ h(x) $ 应用上面的结论，我们知道 $ h(x) $ 有零点，即 $ g(x) $ 可以取到 $ [0,1] $ 内任意的值.

Monadic Parser

Parser

A parser is a function that takes a string as input, then parses the string, and gives back an output.

However, the process may fail as the input string may not be a valid input for the parser. To describe the result, here we use a list [a] to represent the result, where a is the type of the output, and when parsing fails, we get an empty list.

1

newtype Parser a = Parser { parse :: String -> [(a, String)] }

Now we begin with “atoms” of parser, which consumes the smallest possible input, i.e. a char:

1
2
3
4

item :: Parser Char
item = Parser $ \s -> case s of
    [] -> []
    (x:xs) -> [(x, xs)]

Here we want to compose parsers, so declaring Parser as a Functor, Applicative, and even Monad is necessary:

1
2
3
4
5
6
7
8
9
10
11
12
13

instance Functor Parser where
    -- fmap :: (a -> b) -> Parser a -> Parser b
    fmap f (Parser p) = Parser $ \s -> [(f a, s') | (a, s') <- p s]

instance Applicative Parser where
    pure a = Parser $ \s -> [(a, s)] -- keep the input string unchanged
    -- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
    pg <*> px = Parser $ \s -> [(g x, s'') | (g, s') <- parse pg s, (x, s'') <- parse px s']

instance Monad Parser where
    return = pure
    -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
    px >>= f = Parser $ \s -> concat [parse (f x) s' | (x, s') <- parse px s]

By virtue of the do notation, we can now compose parsers easily:

1
2
3
4
5
6
7
8

three = do 
            x <- item
            item
            z <- item
            return (x, z)

> parse three "abcdef"
[(('a','c'),"def")]

The remarkable thing is that the Monad instance of Parser allows what ,In contract, when a computation is lifted by Applicative, the type can’t be changed, so any middle operation cannot change the type of the computation.

Alternative

You may notice that we were just doing some linear parsing in the previous section. Now we want to make choices in parsing, so we need to define Alternative:

1
2
3
4

-- import Control.Applicative
instance Applicative Alternative where
    empty :: f a
    (<|>) :: f a -> f a -> f a

The class Alternative is a subclass of Applicative, and it is used to represent choice, by the operand <|>. To ensure what we implement really stands for making choices, we need to obey the following laws, which shows the essence of choice:

1
2
3

Associativity: x <|> (y <|> z) = (x <|> y) <|> z
Left Identity: empty <|> x = x
Right Identity: x <|> empty = x

Making many & some choices

The concept is a bit like while and do-while, we repeat the computation until it fails, and we get the result.

1
2
3
4
5
6
7

-- many : Zero or more.
many :: Alternative f => f a -> f [a]
many v = some v <|> pure []

-- some : One or more.
some :: Alternative f => f a -> f [a]
some v = (:) <$> v <*> many v

Their diffecence is that some must succeed at least once, while many may fail at the beginning. We use examples to clarify the difference:

1
2
3
4
5

> many Nothing
Just []

> some Nothing
Nothing

Then the Parser instance serves as a perfect example of Alternative:

1
2
3
4
5
6

instance Alternative Parser where
    empty = Parser $ \s -> []
    -- (<|>) :: Parser a -> Parser a -> Parser a
    p <|> q = Parser $ \s -> case parse p s of
        [] -> parse q s
        [(x, s')] -> [(x, s')]

Now we can use <|> to make choices in parsing:

1
2
3
4

> parse (item <|> return 'd') "abc"
[('a',"bc")]
> parse (empty <|> return 'd') "abc" -- fails
[('d',"abc")]

Get down to Parsers!

We often want to make judgments on the input string, so we need to define some predicates:

1
2
3
4

-- Whether the next chat satisfies the predicate.
sat :: (Char -> Bool) -> Parser Char
sat p = do  t <- item
            if p t then return t else empty

Then we can define some parsers that consume specific chars and strings:

1
2
3
4
5
6
7

char :: Char -> Parser Char
char c = sat (== c)

string :: String -> Parser String
string (x:xs) = do  char x
                    string xs
                    return (x:xs)

Using many, we also have something that consumes multiple spaces, processes natural numbers:

1
2
3
4
5
6
7

space :: Parser ()
space = do  many (sat isSpace)
            return ()

nat :: Parser Int
nat = do xs <- some digit
         return (read xs)

When using spaces to separate different parts of the string, we can use token to consume the spaces:

1
2
3
4
5
6
7
8
9
10
11
12

token :: Parser a -> Parser a
token p = do space
             v <- p
             space
             return v

-- Tokenized parsers
symbol :: String -> Parser String
symbol xs = token $ string xs

natural :: Parser Int
natural = token nat

Arithmetic Expressions

Now we can define a parser for arithmetic expressions. Given the properties of the operators, we can describe the wanted syntax as the following context free grammar:

1
2
3
4

expr ::= term '+' expr | term
term ::= factor '*' term | factor
factor ::= digit | '(' expr ')'
digit ::= '0' | '1' | ... | '9'

Once we have the grammar, we can easily translate it into Haskell code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

expr :: Parser Int
expr = do
        t <- term
        do
            symbol "+"
            e <- expr
            return (t + e)
            <|> do
                    symbol "-"
                    e <- expr
                    return (t - e)
            <|> return t

term :: Parser Int
term = do 
        f <- factor
        do
            symbol "*"
            t <- term
            return (f * t)
            <|> do
                    symbol "/"
                    t <- term
                    return (f `div` t)
            <|> return f

factor :: Parser Int
factor = do
            symbol "("
            e <- expr
            symbol ")"
            return e
            <|> natural

Finally it’s time to parse and evaluate the final value!

1
2

eval :: String -> Int
eval = fst . head . parse expr

Foldable and Friends

Foldable

The type class Foldable generally relies on Monoid, and it describes data structures that can be folded to a summary value, so the mappend(<>) defined on Monoid is needed to show that the containing data in Foldable can be combined:

1
2
3
4
5

class Foldable t where
    fold :: Monoid a => t a -> a
    foldMap :: Monoid b => (a -> b) -> t a -> b
    foldr :: (a -> b -> b) -> b -> t a -> b
    foldl :: (b -> a -> b) -> b -> t a -> b

Here is a foldMap example on lists:

1
2
3

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

The minimal definition is foldMap or foldr, and using one of these two we can define them all:

1
2
3

fold = foldMap id
foldMap f = foldr (mappend . f) mempty
toList = foldMap (\x -> [x]) -- Here, we use the monoid of lists, which is concatenation

However, the folding directions are not absolute. For example, we can define foldl in terms of foldr (even though it is not efficient enough, it still shows some type of homomorphism):

1
2

foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
foldl f z ys = foldr (\x g -> g . f x) id ys z

To understand the entire process, we first notice that if we want to reverse the computation order, we may leave the computation “undone”, and gradually fold other elements into the process.

So in this implementation of foldl, the type b is used as the “undone” computation, i.e. function a -> a (like (+) 1), and the initial value is the identity map. After iterations, we shall get:

1
2
3
4
5

id -- \x -> x
\x -> f x y0
\x -> f (f x y0) y1
...
\x -> f (... f  (f (f x y0) y1) ... yN)

When the folding process ends, we apply the “undone” computation to the initial value z, and we get the final result, in a reversed order.

In conclusion, “Folding” is the abstraction of sequential operations (or sequential recursion) on a data structure. Example:

1

map f = foldr ((:) . f) [] -- or foldMap (pure . f)

Traversable

Now let’s take a look at map.

1
2
3

map :: (a -> b) -> [a] -> [b]
map g [] = []
map g (x:xs) = g x : map g xs

We get the motivation of Traversable from the need of generalizing map to deal with effects brought by various functors.

1
2
3
4
5
6

class (Functor t, Foldable t) => Traversable t where
    traverse :: Applicative f => (a -> f b) -> t a -> f (t b)

instance Traversable [] where
    traverse g [] = pure []
    traverse g (x:xs) = pure (:) <*> g x <*> traverse g xs

In the default definition of Traversable, another function sequenceA is introduced. It folds a series of effects into a single effect:

1
2
3
4
5
6
7
8
9

sequenceA :: Applicative f => t (f a) -> f (t a)
sequenceA = traverse id

--- Examples:
> sequenceA [Just 1, Just 2, Just 3]
Just [1, 2, 3]

> sequenceA [Just 1, Nothing, Just 3]
Nothing

We can also define traverse in turn:

1

traverse g = sequenceA . fmap g