Haskell 以 Huffman coding 为例看函数式编程

frankking · 2016年05月02日 · 最后由 crazyphage 回复于 2016年06月01日 · 10904 次阅读
本帖已被管理员设置为精华贴

不同编程即为不同解决问题的思路

解决一个问题有很多思路,比如:

  1. 过程式 (C 语言):将解决问题的方式分解成若干步骤来控制数据。
  2. 面向对象式 (Java/Ruby):以对象为基本单位,定义其行为控制其内部状态,通过不同对象之间的协作解决问题。
  3. 函数式 (Lisp):一切皆为函数,用连贯的思维方式定义过程,常用递归。
  4. 组合式:将不同的解决方式组合起来,golang 经常会将面向对象与过程式组合起来。

示例:Huffman 编码

用 Lisp 的一个方言 Scheme 来实现:

输入 '((A 1) (B 3) (C 2)), A B C 为带编码字符,1 2 3 为出现次数。 输出 '((b 0) (a 0 1) c 1 1)

定义叶子节点

(define (make-leaf symbol weight)
  (list 'leaf symbol weight))

(define (leaf? object)
  (eq? (car object) 'leaf))

(define (symbol-leaf object)
  (cadr object))

(define (weight-leaf object)
  (caddr object))

如果没有接触过 lisp 的同学可能对上面的表示方式有点陌生,其实就是用括号代表方法调用,括号里的第一个位置是方法名称,后面的是调用该方法的参数。

上面的几行代码定义了叶子节点 leaf 及相关函数。

定义树节点
(define (make-code-tree left right)
  (list 
    left
    right
    (append (symbols left) (symbols right))
    (+ (weight left) (weight right))))

(define (left-branch tree) (car tree))

(define (right-branch tree) (cadr tree))

(define (symbols tree)
  (if (leaf? tree)
    (list (symbol-leaf tree))
    (caddr tree)))

(define (weight tree)
  (if (leaf? tree)
    (weight-leaf tree)
    (cadddr tree)))

同样的道理,定义了用于在构造 Huffman 树中非叶子的节点 tree 及其相关取值函数。

有序 list 构造方法
(define (adjoin-set x set)
  ;如果 set 为空,则返回以 x 作为唯一元素的 list
  (cond ((null? set) 
      (list x)) 
    ;如果 set 的第一个元素的 weight 大于 x 的 weight,则将 x 和 set 组合成一个新的 list 返回
    ((> (weight (car set)) (weight x))
      (cons x set)) 
    ; 否则将 set 的以第一个只取出,让后递归调用 `adjoin-set`
    (else (cons (car set) (adjoin-set x (cdr set)))))) 

adjoin-set 的功能就是 x 插入到有序 list set 中,保证插入后的 list 仍然有序。lisp 中的 cond 可理解为 其他语言中的 switch,而 cons 可理解为将两个元素结合成一个 list。乍一看这个所谓“插入”元素的方法有点奇怪,而且没有用任何临时变量。其思路将整个插入的过程用递归调用的方式表示:用过程(函数)代替了临时变量。举了例子:(adjoin-set 3 '(1 2)),执行顺序是:

(cons 1 (adjoin-set 3 '(2)))
(cons 1 (cons 2 (adjoin-set 3 '())))
(cons 1 (cons 2 (cons 3 '())))
(cons 1 (cons 2 '(3)))
(cons 1 '(2 3))
'(1 2 3)

可以看到在执行序列中,推迟 cons 的执行,用参数求值压栈从而省去了临时变量。在 make-leaf-set 中思路也一样:不断地从 paris 中取元素,交给 adjoin-set 插入到 list 中。整个编写过程中基本上用程序流畅地表达了我们的解题思路,代码如下:

(define (make-leaf-set pairs)
  (if (null? pairs)
    '()
    (let ((pair (car pairs)))
      (adjoin-set (make-leaf (car pair) (cadr pair))
        (make-leaf-set (cdr pairs))))))
Huffman 树构造方法

在插入元素这种简单的问题中函数式威力还远远没有体现出来,请看下面构造 Huffman 树 的函数实现:

(define (make-tree leaves)
  (cond ((or (null? (car leaves)) (null? (cadr leaves)))
      (error "leaves is not enough"))
    ((null? (cddr leaves))
      (make-code-tree (car leaves) (cadr leaves)))
    (else (make-tree (adjoin-set (make-code-tree (car leaves) (cadr leaves)) (cddr leaves))))))

几行代码就将构造 Huffman 树 的核心逻辑表达清楚了:将按 weight 升序 leaves 的前两个拿出来做成一个 tree node,adjoin-set 到剩下的 leaves 中,然后不断重复这个操作,直到 leaves 中只剩下两个元素,将这两个元素最为 最终 Huffman 树 的左右子树,然后返回。怎么样?一气呵成。

编码

对 Huffman 树 遍历编码的实现也是精炼得有种思维的美感: 先进行左子树遍历,直到找到叶子节点,构造成结果 list 中一个元素,然后回到上一层递归,进入右子树,不断重复直到遍历完所有节点。

(define (encode tree)
  (define (visit n bits)
    (if (leaf? n)
      ; 找到了一个叶子节点
      (cons (symbol-leaf n) bits)
      ; 用 cons 对 visit 的递归调用
      (cons (visit (left-branch n) (cons 0 bits))
        (visit (right-branch n) (cons 1 bits)))))
  (visit tree '()))

;测试
(define leaf-set (make-leaf-set '((A 1) (B 3) (C 2))))
(define tree (make-tree leaf-set))
(encode tree) ; outputs: ((b 0) (a 0 1) c 1 1)

详细代码请进 github

ps: 本篇用到部分《计算机程序的构造与解析》代码。强烈建议大家学习 MIT 的这门公开课。

mark 完全插不上话

SICP 里看过,不过这种递归的算法脑内建模大失败,就算学过用的时候还是要想很久。。

之前写过一篇基于 Python 的函数式编程,但对于 Lisp 嘛,完全插不上话。。。

有新的公开课吗?我只看过一个很老的,估计是 90 年代的课程。。

#4 楼 @numbcoder 没看到有新的,我看的就是老的,感觉蛮好的。

#3 楼 @debugtalk 其实 Lisp/Scheme 的语法和一些内置方法不算难,看 SICP 第一节公开课就可以写代码,只是我们早已习惯面向对象的高级语言一下不能适应 写程序像在解数学题或者证明数学公式

#6 楼 @frankking 嗯,函数式编程这块儿现在都还只是基于兴趣在了解,要用到实际工作中感觉还有很长一段路要走

lisp 神语言。

#4 楼 @numbcoder 课程的话建议 cs 61a 这门课就是从 SICP 演变过来的。但用的是 python,因为 berkeley 觉得用 lisp 讲不是很划算。

#9 楼 @yfractal 好的,谢谢啦!

#9 楼 @yfractal 那是因为 sussman 讲 SICP 讲了二十年,讲腻了

Ruby 实现更简单

class Node < Struct.new :nodes, :w
  def output r, code
    if nodes.is_a?(Array)
      fst, snd = nodes
      fst.output r, code + '0'
      snd.output r, code + '1'
    else
      r[nodes] = code
    end
  end
end

def huffman histogram
  nodes = histogram.map {|k, w| Node.new k, w }
  while nodes.size > 1
    fst, snd, *nodes = nodes.sort_by &:w
    nodes << Node.new([fst, snd], fst.w + snd.w)
  end
  r = {}
  nodes.first.output r, ''
  r
end

h = huffman a: 3, b: 4, c: 5, d: 6, e: 8
p h #=> {:c=>"00", :d=>"01", :a=>"100", :b=>"101", :e=>"11"}

#11 楼 @luikore 一部分吧。 毕竟 lisp 在语言里面是个特例,python 上手快,更普遍一些。可以更好关注要于要教的东西,而不是语言。

突然看到异端 2333

需要 登录 后方可回复, 如果你还没有账号请 注册新账号