函数式随机访问列表

· · 算法·理论

如题，一种 lisp 列表的增强版，支持 O(\log n) 级别的随机访问和修改，并且无缝可持久化。

#lang racket/base

(define (length-geq? l n)
  (let loop ([cur l]
             [len 0])

    (cond
      [(>= len n) #t]
      [(null? cur) #f]
      [else (loop (cdr cur) (add1 len))])))

(struct alist (roots) #:transparent)
(struct single-tree (root size) #:transparent)
(struct tree-node (val l r) #:transparent)

(define (alist-cons head l)
  (let ([rt (alist-roots l)])
    (if (length-geq? rt 2)
        (let ([a (car rt)]
              [b (cadr rt)]
              [rest (cddr rt)])

          (if (= (single-tree-size a) (single-tree-size b))
              (alist
               (cons (single-tree
                      (tree-node head (single-tree-root a) (single-tree-root b))
                      (add1 (* 2 (single-tree-size b))))
                     rest))

              (alist (cons (single-tree (tree-node head #f #f) 1) rt))))

        (alist (cons (single-tree (tree-node head #f #f) 1) rt)))))

(define (alist-car l)
  (let ([head (car (alist-roots l))])
    (tree-node-val
     (single-tree-root head))))

(define (alist-cdr l)
  (let ([head (car (alist-roots l))]
        [rest (cdr (alist-roots l))])

    (if (= (single-tree-size head) 1)
        (alist rest)
        (let* ([root (single-tree-root head)]
               [lson (tree-node-l root)]
               [rson (tree-node-r root)]
               [size (arithmetic-shift (single-tree-size head) -1)])

          (alist (cons (single-tree lson size) (cons (single-tree rson size) rest)))))))

(define (get-binary x)
  (define width (integer-length x))
  (define res (make-vector width #f))

  (let loop ([i (sub1 width)])
    (when (>= i 0)
      (when (not (zero? (bitwise-and 1 (arithmetic-shift x (- i)))))
        (vector-set! res i #t))

      (loop (sub1 i))))

  res)

(define (access-in-single-tree p idx)
  (define width (integer-length idx))
  (define bin (get-binary idx))

  (let loop ([i (- width 2)]
             [cur p])
    (if (>= i 0)
        (if (vector-ref bin i)
            (loop (sub1 i) (tree-node-r cur))
            (loop (sub1 i) (tree-node-l cur)))
        (tree-node-val cur))))

(define (random-access l pos)
  (set! pos (add1 pos)) ;; 0-base => 1-base

  (let ([roots (alist-roots l)])
    (let loop ([cur roots]
               [i pos])

      (let ([rt (car cur)])
        (if (> i (single-tree-size rt))
            (loop (cdr cur) (- i (single-tree-size rt)))
            (access-in-single-tree (single-tree-root rt) i))))))

(define (set-in-single-tree p idx v)
  (define width (integer-length idx))
  (define bin (get-binary idx))

  (let loop ([i (- width 2)]
             [cur p])

    (let ([org (tree-node-val cur)]
          [lson (tree-node-l cur)]
          [rson (tree-node-r cur)])

      (if (< i 0)
          (tree-node v lson rson)
          (if (vector-ref bin i)
              (tree-node org lson (loop (sub1 i) rson))
              (tree-node org (loop (sub1 i) lson) rson))))))

(define (random-set l pos v)
  (set! pos (add1 pos))

  (define res
    (let ([roots (alist-roots l)])
      (let loop ([cur roots]
                 [i pos])

        (let ([rt (car cur)])
          (if (> i (single-tree-size rt))
              (cons rt (loop (cdr cur) (- i (single-tree-size rt))))
              (cons (single-tree (set-in-single-tree (single-tree-root rt) i v) (single-tree-size rt)) (cdr cur)))))))
  (alist res))

;; tests

(define a (alist '()))
(set! a (alist-cons 3 a))
(set! a (alist-cons 5 a))

(displayln (random-access a 0))

(set! a (alist-cons 7 a))
(set! a (alist-cons 9 a))

(displayln (random-access a 2))

(set! a (random-set a 2 'a))

(displayln (random-access a 2))
(displayln (random-access (alist-cdr a) 1))

概述

一种基于完美二叉树以及斜二进制分解的结构。lisp 列表的上位替代，支持 O(1) 的 car/cdr/cons，O(\log n) 的随机访问修改。完全可持久化，支持不可变性和结构共享。

后面的几点才是真正的优势。如果只是要常数级别头部添加以及高效随机访问，vector 快得多（类似 C++ std::vector 的结构，但是反转过来）。然而我们使用列表时常用的是结构共享和可持久化的功能，也要求不可变性，vector 就无法胜任。

权值线段树不支持 cons/cdr，而平衡树不支持 O(1) car/cdr/cons。

原理

维护一组完美二叉树组成的列表。

我们将列表中的元素存储在这些树中，靠前的树中任意元素的下标小于靠后的树中元素的下标（形式化的，对于任意 i, j 满足 i<j，第 i 棵树中的任意元素的下标小于第 j 棵树中的任意元素的下标。）

对于一棵树内部，下标最小的元素占据根节点，它的左儿子是下标第二小的，右儿子是第三小的。下标第 k 小的元素的左右儿子分别是下标第 2k 小和第 2k+1 小的节点。（类似于线段树的堆式存储）

这些二叉树的大小从前往后单调不降，并且除了第一二个可能相等外其余的树大小严格递增。

不难发现，由于每多一棵树节点总数翻倍，树的总数是 O(\log n) 量级的。

cons

如果原来的前两棵树大小相等，就将这两棵树分别作为新节点的左右儿子组合成一棵更大的树。

否则造一棵新的大小为 1 的树，插进列表最前面。

car

取第一棵树的根节点。

cdr

cons 的逆过程，如果第一棵树大小为 1，直接删掉。否则删去它的根节点，将它分裂成两棵大小相同的树。

access

在列表中顺序查找到访问下标所处的树，然后在树中进行访问。

假设这棵树的根节点的下标是 i，你要访问 x，那么设 idx=x-i+1，将它转为二进制位序列（高位在前，从最高有效位开始。比如 10 对应的序列是 1010）。

这个序列就是寻找到目标节点的操作步骤指示。假如说你现在在深度为 d 的节点（一开始你在根节点，深度为 0），那么这个序列的第 d+1（0-based）位为 0 代表你应该去当前节点的左儿子，为 1 说明你应该去右儿子。

而如果 d+1 已经等于序列长度了（也就是说操作全部做完了），你就到达目标节点了。

复杂度 O(\log n)+O(\log n)=O(\log n)。

set

同样的，在列表中顺序查找到访问下标所处的树，然后对它进行可持久化修改即可。返回新的列表，共用其他没有被修改的树，中间 cons 上修改后返回的新树。

可持久化修改也很简单：找到你要修改的节点（方法和 access 是一样的），把它换成一个新的节点，上面存的值是你修改后的新值，但是两个儿子和之前一样。

对于它的所有祖先节点，都重造一个新的节点，存的值以及指向没有被修改的那个子树的指针不变，但指向被修改了的子树的指针指向修改后的新子树节点。

具体都可以见代码。

应用场景

没什么应用场景。如果你发现你需要用到大量的 list-ref，可以考虑这个。或者如果你需要一个能够 push_back 的可持久化数组。