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

  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
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136

#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 的可持久化数组。