2

I need assistance sorting by two attributes in common lisp.

Say I had a list: (1 x)(2 y)(1 x)(2 x)(3 y)(2 y) I am trying to sort by both string and integer. So the result would be (1 x)(1 x)(2 x)(2 y)(2 y)(3 y).

Currently I can sort by either variable or number but not both. If I enter (2 x)(1 x)(1 y)(2 x)(1 y) I get (1 Y)(1 Y)(2 X)(1 X)(2 X) returned not (1 Y)(1 Y)(1 X)(2 X)(2 X)

The code I am using is:

(defun get-number (term)
  (destructuring-bind (number variable) term
    (declare (ignore variable))
    number))

(defun get-variable (term)
  (destructuring-bind (number variable) term
    (declare (ignore number))
    variable))

(defun varsort (p1)
    (sort (copy-list p1) 'string> :key 'get-variable))

My question is how could I sort by the term as a whole so (1 X) not just 1 or X.

Josh Horton
  • 77
  • 1
  • 1
  • 7
  • 1
    Contributions to Stack Overflow are licensed under terms that allows copying and reproduction. It's fine to copy and reuse things, but attribution is required. While you've changed the actual names of the functions, it appears that your accessors **get-number** and **get-variable**, as well as the body of your **varsort** are pretty much copied from [my answer to your earlier question](http://stackoverflow.com/a/34043773/1281433). It's fine to reproduce them like that, but you should probably include a link to your earlier question here. – Joshua Taylor Dec 06 '15 at 20:06

2 Answers2

4

You can do this by composing predicates. If you have a predicate that can compare variables, and a predicate that can compare coefficients, then you can easily create a new predicate that checks with one, returning a definite answer if the first predicate provides a definite answer, or deferring to the second predicate, in the case that it doesn't. This will be reusable for other applications, too:

(defun and-then (original-predicate next-predicate)
  "Returns a new predicate constructed from ORIGINAL-PREDICATE and
NEXT-PREDICATE.  The new predicate compares two elements, x and y, by
checking first with ORIGINAL-PREDICATE.  If x is less than y under
ORIGINAL-PREDICATE, then the new predicate returns true.  If y is less
than x under ORIGINAL-PREDICATE, then the new predicate returns false.
Otherwise, the new predicate compares x and y using NEXT-PREDICATE."
  (lambda (x y)
    (cond
      ((funcall original-predicate x y) t)
      ((funcall original-predicate y x) nil)
      (t (funcall next-predicate x y)))))

Then it's easy enough to make a call to (and-then 'variable< 'coefficient<). First, some accessors and predicates:

(defun term-coefficient (term)
  (first term))

(defun coefficient< (term1 term2)
  (< (term-coefficient term1)
     (term-coefficient term2)))

(defun term-variable (term)
  (second term))

(defun variable< (term1 term2)
  (string< (term-variable term1)
           (term-variable term2)))

Now the test:

(defparameter *sample*
  '((1 x)(2 y)(1 x)(2 x)(3 y)(2 y)))
CL-USER> (sort (copy-list *sample*) 'coefficient<)
((1 X) (1 X) (2 Y) (2 X) (2 Y) (3 Y))

CL-USER> (sort (copy-list *sample*) 'variable<)
((1 X) (1 X) (2 X) (2 Y) (3 Y) (2 Y))

CL-USER> (sort (copy-list *sample*) (and-then 'variable< 'coefficient<))
((1 X) (1 X) (2 X) (2 Y) (2 Y) (3 Y))

You could define a compare-by function to create some of these predicate functions, which could make their definitions a bit simpler, or possibly removable altogether.

(defun compare-by (predicate key)
  "Returns a function that uses PREDICATE to compare values extracted
by KEY from the objects to compare."
  (lambda (x y)
    (funcall predicate
             (funcall key x)
             (funcall key y))))

You could simply the predicate definitions:

(defun coefficient< (term1 term2)
  (funcall (compare-by '< 'term-coefficient) term1 term2))

(defun variable< (term1 term2)
  (funcall (compare-by 'string< 'term-variable) term1 term2))

or get rid of them altogether:

(defun varsort (p1)
  (sort (copy-list p1)
        (and-then (compare-by '<       'term-coefficient)
                  (compare-by 'string< 'term-variable))))
Joshua Taylor
  • 84,998
  • 9
  • 154
  • 353
  • Thank you! I use `ace-window` in Emacs to switch windows, but I wanted the windows to be numbered by frames (top, left first) and within a frame like you'd read in a book (start at top, left, number left-to-right, then go down and number left-to-right, etc). With your `and-then` and `compare-by`, I added `(defun make-composed-comparators (l) (seq-reduce (lambda (old new) (and-then old (compare-by #'< new))) (cdr l) (compare-by #'< (car l))))` When I call that with `'(window-frame-left window-frame-top window-frame-integer-window-id window-top-edge window-left-edge)`, it's great! – Colin Fraizer Jan 27 '20 at 23:04
2

Two options:

  • stable-sort the result of varsort according to the get-number
  • define a custom comparison function to use within sort :

    ;; choose a better name
    (compare-by-string-and-number (x y)
      (let ((vx (get-variable x))
            (vy (get-variable y)))
        (or (string> vx vy)
            (and (string= vx vy)
                 (> (get-number x)
                    (get-number y))))))
    

Joshua's answer is good way to write a generic comparison functions. And since you are manipulating tuples, you can be a little more specific and write the following:

(defun tuple-compare (comparison-functions)
  (lambda (left right)
    (loop for fn in comparison-functions
          for x in left
          for y in right
          thereis (funcall fn x y)
          until (funcall fn y x))))

For example:

(sort (copy-seq #((1 2) (2 3) (1 3) (2 1)))
      (tuple-compare (list #'< #'<)))

=> #((1 2) (1 3) (2 1) (2 3))

You can take advantage of having different lengths for the lists involved: for example, you could only sort according to the first argument by giving a single comparison function. You can also create a circular list if you want to compare all available pairs of elements with the same comparison function.

(stable-sort (copy-seq #((1 2 4)  (1 3 6) (1 2 6) (2 3 4) (1 3) (2 1)))
             (tuple-compare (list* #'> (circular-list #'<))))

=> #((2 1) (2 3 4) (1 2 4) (1 2 6) (1 3 6) (1 3))

(circular-list is available in alexandria)

A truyly lexicographic sort would ensure that shorter lists would be sorted before longer ones, provided they share a common prefix: for example, it would sort (1 3) before (1 3 6). A possible modification follows:

(defun tuple-compare (comparison-functions &optional lexicographic)
  (lambda (left right)
    (loop for fn in comparison-functions
          for (x . xr) on left
          for (y . yr) on right
          do (cond
               ((funcall fn x y) (return t))
               ((funcall fn y x) (return nil))
               ((and lexicographic yr (null xr)) (return t))))))
Community
  • 1
  • 1
coredump
  • 37,664
  • 5
  • 43
  • 77