P28 (**) Sorting a list of lists according to length of sublists.

问题描述

a) We suppose that a list contains elements that are lists themselves. The objective is to sort the elements of this list according to their length. E.g. short lists first, longer lists later, or vice versa.

sash> (lsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
   -> ((o) (d e) (d e) (m n) (a b c) (f g h) (i j k l))

b) Again, we suppose that a list contains elements that are lists themselves. But this time the objective is to sort the elements of this list according to their length frequency; i.e., in the default, where sorting is done ascendingly, lists with rare lengths are placed first, others with a more frequent length come later.

sash> (lfsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
   -> ((i j k l) (o) (a b c) (f g h) (d e) (d e) (m n))

Note that in the above example, the first two lists in the result have length 4 and 1, both lengths appear just once. The third and forth list have length 3 which appears twice (there are two list of this length). And finally, the last three lists have length 2. This is the most frequent length.

解法

a) 因为Scheme没提供排序算法，这里我简单地用插入排序方法。
因为列表的length方法时间复杂度为O(n),在排序过程中会大量调用，所以这里先计算出每个子列表的长度。

(define lsort
    (lambda (ls)
      (let ([als (map (lambda (e) (cons (length e) e)) ls)])
        (map (lambda (e) (cdr e))
             (insertion-sort als <= car)))))

(define insertion-sort
  (lambda (ls less? key)
    (letrec ([insert (lambda (x ls) (cond [(null? ls) (cons x ls)] [(less? (key x) (key (car ls))) (cons x ls)] [else (cons (car ls) (insert x (cdr ls)))]))])
      (let f ([s ls])
        (if (null? s) s (insert (car s) (f (cdr s))))))))

b) 一开始的想法是：(1)按照子列表的长度排序；(2)合并相邻相同长度的子列表；(3)按照频率【相同长度子列表的个数】排序；最后按照题目要求得到最终结果。但得到的结果 (i j k l)在(o)之后，这是因为第一步排序的缘故。

我们假设题目要求排序算法是稳定的。上述(2)得到的等长子列表相对顺序应该不变。有很多方法可以得到：

1. 依次从第一个子列表查找与之等长的元素放在一起，并保证顺序；
2. 用一个数据结构保存等长的子列表，(srfi 69)提供了哈希表，并提供了方便的hash-table->alist；
3. 使用(srfi 1)的partition
4. …

使用高阶函数能更清晰的表达思路，这里用第三种方式解决。

(define lfsort
  (lambda (ls)
    (if (null? ls)
        ls
        (letrec ([als (map (lambda (e) (cons (length e) e)) ls)] [compose (lambda (als) (if (null? als) '() (let-values ([(h t) (partition (lambda (x) (= (car x) (caar als))) als)]) (cons (cons (length h) h) (compose t)))))])
          (let* ([s (insertion-sort (compose als) <= car)] [ss (fold-right (lambda (e a) (append (cdr e) a)) '() s)]) (map cdr ss))))))