不使用原始函数（car、cdr、cons）的方案插入排序

Question

我正在尝试编写带有和不带有原始函数的插入排序函数。

我的原始函数代码如下。

(define (insert n d)
  (cond ((null? n) d)
        ((null? d) n)
        (else (< (car n) (car d)) (cons (car n) (insert (cdr n) d)) (cons (car d) (insert (cdr d) n)))))

(define (sort n)
  (cond ((null? n) '())
        (else (insert (list (car n)) (sort (cdr n))))))

我应该如何修改 insert 和 sort 以不使用 car、cdr 和 cons？

编辑：我尝试编写插入函数。这就是我到目前为止所拥有的。

(define (insert n d)
  (let ((rest-digit (truncate (/ n 10))))
    (if (null? n) 0
        (+ rest-digit (insert (- n 1) d)))))

(insert '(3 2 1) '5)

编辑#2：我想我可以使用内置函数 expt。

Answer 1

最终您将使用原始函数。为了说明，让我向您展示一个实际使用 cons、car 和 cdr 的技巧：

(define (my-car lst)
  (apply (lambda (a . d) a) lst))

(define (my-cdr lst)
  (apply (lambda (a . d) d) lst))

(define (my-cons a d)
  (apply (lambda l l) a d))


(define test (my-cons 1 '(2 3)))
test          ; ==> (1 2 3)
(my-car test) ; ==> 1
(my-cdr test) ; ==> (2 3)

这滥用了apply 将列表作为最终参数，而其余参数按顺序被cons 编入列表的事实。 cons 不适用于所有配对：

(my-cons 1 2) ; ERROR: expected list?, got 1

您可以使cons、car 和cdr 遵守与原始cons 相同的规则，但它们根本不是由对组成的。 Barmar 建议关闭：

(define (ccons a d)
  (lambda (f) (f a d))

(define (ccar cc)
  (cc (lambda (a d) a)))

(define (ccdr cc)
  (cc (lambda (a d) d)))

(define test2 (ccons 1 2))
test2        ; ==> #<function...>
(ccar test2) ; ==> 1
(ccdr test2) ; ==> 2

这是有效的，因为a 和d 在返回的函数中被关闭，并且该函数传递了这些值，因此该函数充当具有两个属性的对象。挑战在于你不能只传递一个列表，因为只有使用ccons 制作的“列表”才能使用ccar 和ccdr。

一种不太经典的方法是使用向量：

(define vtag (make-vector 0))
(define (vcons a d)
  (let ((v (make-vector 3)))
    (vector-set! v 0 vtag)
    (vector-set! v 1 a)
    (vector-set! v 2 d)
    v))

(define (vcar vl)
  (vector-ref vl 1))

(define (vcdr vl)
  (vector-ref vl 2))

(define (vpair? vl)
  (eq? vtag (vector-ref vl 0)))

或者你可以使用records:

(define-record-type :rpair
  (rcons a d)
  rpair?
  (a rcar)
  (d rcdr))

(define test (rcons 1 2))
(rpair? test) ; ==> #t
(rcar test)   ; ==> 1
(rcdr test)   ; ==> 2

现在我认为记录只是语法糖和抽象，并且在引擎盖下您所做的与矢量版本完全相同，但代码更少，但这并不是一件坏事。

编辑

所以对于 cmets，如果唯一的限制是避免 car、cdr 和 cons，但对他们的姐妹没有限制，我们不妨与他们一起实施：

(define (sort lst)
  (define (insert e lst)
    (if (null? lst)
        (list e)
        (let ((a (first lst)))
          (if (>= a e)
              (list* e lst)
              (list* a (insert e (rest lst)))))))

  (foldl insert
         '()
         lst))

(sort '(1 5 3 8 5 0 2))
; ==> (0 1 2 3 5 5 8)

当然我的第一个建议可以代替它：

(define (sort lst)
  (define (my-car lst)
    (apply (lambda (a . d) a) lst))

  (define (my-cdr lst)
    (apply (lambda (a . d) d) lst))

  (define (my-cons a d)
    (apply (lambda l l) a d))

  (define (insert e lst)
    (if (null? lst)
        (my-cons e '())
        (let ((a (my-car lst)))
          (if (>= a e)
              (my-cons e lst)
              (my-cons a (insert e (my-cdr lst)))))))

  (foldl insert
         '()
         lst))

当然，使用替换规则你可以让它变得非常荒谬：

(define (sort lst)
  ;; insert element e into lst in order
  (define (insert e lst)
    (if (null? lst)
        ((lambda l l) e)
        (let ((a (apply (lambda (a . d) a) lst)))
          (if (>= a e)
              (apply (lambda l l) e lst)
              (apply (lambda l l)
                     a
                     (insert e (apply (lambda (a . d) d) lst)))))))

  ;; main loop of sort
  ;; insert every element into acc
  (let loop ((lst lst) (acc '()))
    (if (null? lst)
        acc
        (loop (apply (lambda (a . d) d) lst)
              (insert (apply (lambda (a . d) a) lst)
                      acc)))))