过滤一个很长的列表可能会让你陷入最大的回收错误（规格说高达一千万）而不是使用'（长度（过滤器...'使用折叠
(define (inversion L)
(let loop ((accumulator 0) (L L))
(if (null? L)
accumulator
(loop
(+ accumulator
(fold
(lambda (init next)
(if (> (car l) next)
(+ init 1)
init))
0
(cdr L)))
(cdr L)))))
第二，虽然这会更容易阅读，将折叠拉出到它自己的函数中
(define (inversions-from-car L)
(fold
(lambda (init next)
(if (> (car l) next)
(+ init 1)
init))
0
(cdr L)))
(define (inversion L)
(let loop ((accumulator 0) (L L))
(if (null? L)
accumulator
(loop
(+ accumulator
(inversions-from-car L)
(cdr L)))))
这看起来像是一个使用数据结构的好问题，因为按照书面形式，它的复杂度为 n^2。
我想你可以把它降低到 n(log n)
假设在与左侧节点数配对的值列表上创建一个排序树。
对于这个集合
'(2 3 8 6 1) -> '(1 2 3 6 8) ->
(*tree (*entry 3 2 2)
(*tree (*entry 2 1 1)
(*tree (*entry 1 0 1)
()
())
())
(*tree (*entry 8 1 1)
(*tree (*entry 6 0 1)
()
())
()))
*tree 和 *entry 只是类型标记
*tree 应该有一个入口，一个左和一个右
*entry 应该有一个值、#left 和数字）
首先在原始列表中查找具有零累加器的第一个
'(2 3 8 6 1)
如果 enrty 的值与 FIRST 匹配，则在累加器中添加#left
如果值为 entry 大于 FIRST，则在树的左分支上使用累加器进行递归
如果条目的值小于 FIRST ，则在右分支上递归，并将 #left 添加到累加器
如果是空树则抛出错误
然后你需要更新树。
如果条目的值等于 FIRST，则改变条目以将数字减一
如果值是条目大于 FIRST，则改变条目以将 #left 减一并在左分支上递归
如果条目的值小于 first ，则在右分支上递归
如果是空树则抛出错误
您可以将这些规则组合成一个遍历
另外添加规则，如果 #left 为 0 且 number 为 0，则如果右分支为空，则将此树变异为空树，否则为右分支。
这是一个粗略的（未经测试的想法）
(define (rev-sorted-list->count-list L) ;;sort should be resverse of
;; final desired order
(let loop ((value (car L)) (count 1) (L (cdr L)) (acc '()))
(cond ((null? L) '())
((= value (car l))
(loop value (+ 1 count) (cdr L) acc))
(else
(loop (car l) 1 (cdr L) (cons (cons value count) acc))))))
(define (make-tree count c-L)
(let* ((middle (ceiling (+ 1 count) 2))
(left-count (- middle 1))
(right-count (-count middle))
(left (if (= 0 left-count)
null-tree
(make-tree left-count c-L)))
(entry+right
(let loop ((index 1) (L c-L))
(if (= index middle)
L
(loop (+ 1 index) (cdr L)))))
(entry
(make-entry
(caar entry+right)
left-count
(cdar entry+right))))
(build-tree
entry
left
(if (= 0 right-count)
null-tree
(make-tree right-count (cdr entry+right))))))
;;form left branches from starting points
;;;form right from stopping points
;;never mutating c-L or copies
;;if count = 0 then null tree
(define (build-tree entry left right)
(list '*tree entry left right)
(define (entry tree)
(cadr tree)
(define (left-branch tree)
(caddr tree))
(define (right-branch tree)
(cadddr tree))
(define null-tree (list '*tree '()))
(define (null-tree? tree)
(null? (entry tree)))
(define (make-entry value Nleft count)
(let ((vec (make-vector 3)))
(begin (vector-set! vec 0 value)
(vector-set! vec 1 Nleft)
(vector-set! vec 2 count)
vec)))
;;might meessage passing function here
(define (entry-value entry)
(vector-ref entry 0))
(define (entry-Nleft entry)
(vector-ref entry 1))
(define (entry-Nleft-set! entry int)
(vector-set! entry 1 int))
(define (entry-count entry)
(vector-ref entry 2))
(define (entry-count-set! entry int)
(vector-set! entry 2 int))
(define (inversions! Test-List Search-Tree)
(let loop ((acc 0) (L Test-list) (T Search-tree))
(cond ((null? L) acc)
((null-tree? T) (error "null tree "
"in inner loop of inversion!"))
((= (car L) (entry-value (entry T)))
(entry-count-set! (entry T)
(- (entry-count (entry T)) 1))
(if (and (= 0 (entry-count (entry T)))
(= 0 (entry-Nleft (entry T))))
(set-cdr! T (right-branch T))
'skip)
(loop (+ acc (entry-Nleft (entry T)))
(cdr L)
Search-tree))
((< (car L) (entry-value (entry T)))
(entry-Nleft-set! (entry T)
(- (entry-Nleft (entry T)) 1))
(loop acc L (left-branch T)))
((> (car L) (entry-value (entry T)))
(loop (+ acc (entry-Nleft (entry T)))
L
(right-branch T))))))