如何在Lisp中對列表進行排序？

Question

我在Lisp中有一個這樣的列表：

(
    ((5 6) (2 7)) 
    ((5 4) (2 9)) 
    ((1 8) (7 7))
)

我想按所有這些條件對它進行排序：

1. 剛開始的時候是(5 6) ， (5 4) ， (1 8)

2. 在這些元素中，首先按x然后按y排序： (1 8) (5 4) (5 6)

最后，我想要一個列表，該列表按上述條件在第一個元素中排序，並且每個元素都有第二個元素：

(
    ((1 8) (7 7)) 
    ((5 4) (2 9))
    ((5 6) (2 7)) 
)

你能給我一個子程序來做嗎？

謝謝。

Answer 1

由於您在注釋中指出您正在使用Visual LISP，因此可以通過以下方式使用標准的vl-sort函數（實現了Quicksort算法）：

(setq l
  '(
       ((5 6) (2 7)) 
       ((5 4) (2 9)) 
       ((1 8) (7 7))
    )
)

(vl-sort l
   '(lambda ( a b )
        (if (= (caar  a) (caar  b))
            (< (cadar a) (cadar b))
            (< (caar  a) (caar  b))
        )
    )
)

在這里，lambda比較函數中的if語句測試每個項目的第一個子列表的第一個元素（ “ x坐標” ）是否相等，如果相等，則比較第二個元素（ “ y坐標” ）。

對於lambda函數中的給定項目對：

a = ((5 6) (2 7))

(car a)   = (5 6)
(caar a)  = 5
(cadar a) = 6

Answer 2

我找到了一種解決方法：

(defun Sort ()
  (setq li nil)
  (setq liso nil)
  (setq newptlist nil)
  (defun AS:Sort (lst / newptlist)
    (setq xvals (list))
    (foreach pt lst
      (if (not (vl-remove-if-not
         '(lambda (x) (equal (car (car pt)) x 0.0001))
         xvals
           )
      )
    (setq xvals (cons (car (car pt)) xvals))
      )
    )
    (setq xvals (vl-sort xvals '(lambda (x1 x2) (< x1 x2))))
    (foreach xval xvals
      (setq pts       (vl-remove-if-not
            '(lambda (x) (equal xval (car (car x)) 0.0001))
            lst
              )
        pts       (vl-sort
            pts
            '(lambda (pt1 pt2) (< (cadr (car pt1)) (cadr (car pt2))))
              )
        newptlist (append newptlist pts)
      )
    )
  )
  (setq li (list (list '(5 6) '(2 7))
         (list '(5 4) '(2 9))
         (list '(1 8) '(7 7))
       )
  )
  (setq liso (AS:Sort li1))
;;;  PRINT
  (print "li= ")
  (print li)
  (print "liso= ")
  (print liso)
  (princ)
)

Answer 3

我忍不住要回答這個問題，因為我試圖考慮是否存在一種在Lisp中非常容易編寫但又很糟糕的排序算法，而我得出了這一點（請參閱注釋：該算法必須是眾所周知的，但是我不知道它的名字是什么。

請注意，這里有很多有目的的重塑方法：代碼不是有意的不透明，而是有意地很難將其作為作業答案提交。

它在球拍中，可能不是您所說的“ lisp”。

#lang racket

(define (remove/one e l #:test (equivalent? eqv?))
  ;; remove the first occurence of e from l using equivalent?
  ;; as the equivalence predicate.
  (let loop ([lt l] [a '()])
    (cond
      [(null? lt)
       l]
      [(equivalent? e (first lt))
       (append (reverse a) (rest lt))]
      [else
       (loop (rest lt) (cons (first lt) a))])))

(define (extremum l <?)
  ;; find the extremum of l under <?
  (if (null? l)
      l
      (let loop ([lt (rest l)] [candidate (first l)])
        (cond
          [(null? lt)
           candidate]
          [(<? (first lt) candidate)
           (loop (rest lt) (first lt))]
          [else
           (loop (rest lt) candidate)]))))

(define (terrible-sort l less-than?
                       #:key (key identity))
  ;; A terrible sort function.  This works by repeatedly finding the extremum
  ;; of l & then recursing on l with the extremum removed.
  ;; less-than? is assumed to provide a partial order on the elements of l:
  ;; equivalence is defined by less-than?.  key is a key extractor in the
  ;; usual way: there is no Schwartzian transform though.
  ;;
  ;; I haven't stopped to think about the complexity of this but it's at least
  ;; quadratic (and I think it probably is quadratic?).  It's also very consy.
  ;;
  ;; This algorithm must have a name.
  ;;
  (define (>? a b)
    (less-than? (key b) (key a)))
  (define (=? a b)
    (let ([av (key a)]
          [bv (key b)])
      (and (not (less-than? av bv))
           (not (less-than? bv av)))))
  (let loop ([lt l] [sorted '()])
    (if (null? lt)
        sorted
        (let ([smallest (extremum lt >?)])
          (loop (remove/one smallest lt #:test =?)
                (cons smallest sorted))))))

(define (answer l)
  (terrible-sort l (λ (a b)
                     ;; compare two lists of numbers
                     (let loop ([at a] [bt b])
                       (if (null? at)
                           (if (null? bt)
                               #f
                               (error "unequal lengths"))
                           (match-let ([(cons ath att) at]
                                       [(cons bth btt) bt])
                             (cond
                               [(< ath bth) #t]
                               [(> ath bth) #f]
                               [else (loop att btt)])))))
                 #:key first))

(define data '(((5 6) (2 7)) 
               ((5 4) (2 9)) 
               ((1 8) (7 7))))