Topic: Sort List by List

[Lee Mac]

This just came up over at CADTutor, and I was pretty dissatisfied with my solution, so I thought I'd post it as a bit of an exercise..

The task is to sort a list using another list as a reference, hence:

Code: [Select]

(setq CorrectOrder '("D" "B" "C" "A"))

(setq Lst '("A" "B" "C" "D"))

(SortByList Lst CorrectOrder)  ==>> ("D" "B" "C" "A")

This was the code that I hacked together:

Code: [Select]

(defun SortByList (lst ord)
  (mapcar
    (function
      (lambda (x)
        (nth x lst)))
    (mapcar
      (function
        (lambda (x)
          (vl-position x lst))) ord)))

Of course this errors out if there is an element in 'CorrectOrder' that doesn't appear in 'Lst'...

So I got around it by this:

Code: [Select]

(defun SortByList (lst ord)
  (setq ord (vl-remove-if-not
              (function
                (lambda (x) (vl-position x lst))) ord))
  (mapcar
    (function
      (lambda (x)
        (nth x lst)))
    (mapcar
      (function
        (lambda (x)
          (vl-position x lst))) ord)))

And then there is the situation when there is an element in 'Lst' that is not in 'CorrectOrder', causing it to be omitted from the result...

So I got around it like this:

Code: [Select]

(defun SortByList (lst ord / new)
  (setq ord (vl-remove-if-not
              (function
                (lambda (x) (vl-position x lst))) ord))
  (setq new (mapcar
              (function
                (lambda (x)
                  (nth x lst)))
              (mapcar
                (function
                  (lambda (x)
                    (vl-position x lst))) ord)))

  (append new (vl-remove-if
                (function
                  (lambda (x) (vl-position x new))) lst)))

But as I say, less than ideal...

So I leave it open to suggestions! 

Enjoy

[CAB]

My first thoughts.   and last cause I'm off to bed

Code: [Select]

(defun ReorderList (lst pattern / newlst)
  (foreach itm pattern
    (if (vl-position itm lst)
      (setq newlst (cons itm newlst))))
  (foreach itm lst
    (if (not (vl-position itm pattern))
      (setq newlst (cons itm newlst))))
  (reverse newlst)
)

(defun c:test()
  (print (ReorderList '("A" "B" "C" "D") '("D" "B" "C" "A")))
  (print (ReorderList '("A" "C" "D") '("D" "B" "C" "A")))
  (print (ReorderList '("K" "L" "A" "B" "P" "C" "D" "X" "Z") '("D" "B" "C" "A")))
  (print (ReorderList '("K" "L" "A" "P" "C" "D" "X" "Z") '("D" "B" "C" "A")))
  (princ)
)

[wizman]

Here's my try:

Code: [Select]

(defun sortlist (lst ord)
    (mapcar
        (function
            (lambda (x)
                (if (not (vl-position x ord))
                    (setq ord (append ord (list x)))
                )
            )
        )
        lst
    )
    (vl-sort lst
             (function
                 (lambda (e1 e2)
                     (< (vl-position e1 ord) (vl-position e2 ord))
                 )
             )
    )
)

[Lee Mac]

Nice Wizman! I like your solution 

[ElpanovEvgeniy]

my variant:

Code: [Select]

(defun Sort (a b)
 (mapcar
  (function (lambda (x) (nth x a)))
  (vl-remove nil
             (mapcar (function (lambda (x) (vl-position x a)))
                     (append b (vl-remove-if (function (lambda (a) (vl-position a b))) a))
             )
  )
 )
)

[Lee Mac]

my variant:

Code: [Select]

(defun Sort (a b)
 (mapcar
  (function (lambda (x) (nth x a)))
  (vl-remove nil
             (mapcar (function (lambda (x) (vl-position x a)))
                     (append b (vl-remove-if (function (lambda (a) (vl-position a b))) a))
             )
  )
 )
)

Nice one Evgeniy - a nice 'compacted' version of my code 

[ElpanovEvgeniy]

Nice one Evgeniy - a nice 'compacted' version of my code 

You like to see a new unique code?
It is difficult to imagine a more optimal approach...

ps. I will try to write a new algorithm.

[ElpanovEvgeniy]

new version:

Code: [Select]

(defun sort (a b)
 (cond ((not b) a)
       ((vl-position (car b) a) (cons (car b) (sort (vl-remove (car b) a) (cdr b))))
       ((sort a (cdr b)))
 )
)

[wizman]

Nice Wizman! I like your solution 

Thanks Lee, Good Solutions by EE & Cab too,

Code: [Select]

;;
;;
(defun sortlist (lst ord flag / func)
    ;; flag:  t - descending ; nil - ascending
    (setq func (if flag > <))
    (mapcar
        (function
            (lambda (x)
                (if (not (vl-position x ord))
                    (setq ord (if flag
                                  (append (list x) ord)
                                  (append ord (list x))
                              )
                    )
                )
            )
        )
        lst
    )
    (vl-sort lst
             (function
                 (lambda (e1 e2)
                     ((eval func)
                         (vl-position e1 ord)
                         (vl-position e2 ord)
                     )
                 )
             )
    )
)
;;
;; WIZ_01FEB10
;;
;;
(sortlist '("K" "L" "A" "P" "C" "D" "X" "Z") '("D" "B" "C" "A") nil)
;;=> ("D" "C" "A" "K" "L" "P" "X" "Z")
(sortlist '("K" "L" "A" "P" "C" "D" "X" "Z") '("D" "B" "C" "A") t)
;;=> ("A" "C" "D" "K" "L" "P" "X" "Z")
;;
;;

[VovKa]

Code: [Select]

(defun ReorderList (lst pattern /)
  (append (vl-remove-if-not
    (function (lambda (e) (vl-position e lst)))
    pat
  )
  (vl-remove-if
    (function (lambda (e) (vl-position e pat)))
    lst
  )
  )
)honestly, it's a tuned CAB's

[wizman]

(SortByList '("A" "B" "D" "C" "D") '("D" "A" "P" "B"));;=> ("D" "A" "B" "C")
(ReorderList '("A" "B" "D" "C" "D") '("D" "A" "P" "B"));;=> ("D" "A" "B" "C")
(sort '("A" "B" "D" "C" "D") '("D" "A" "P" "B") );;=> ("D" "A" "B" "C")
(sortlist '("A" "B" "D" "C" "D") '("D" "A" "P" "B") nil);;=> ("D" "D" "A" "B" "C")
(ReorderList '("A" "B" "D" "C" "D") '("D" "A" "P" "B"));;=> ("A" "B" "D" "C" "D")

[VovKa]

(ReorderList '("A" "B" "D" "C" "D") '("D" "A" "P" "B"));;=> ("A" "B" "D" "C" "D")

can someone else confirm?

[VovKa]

anyway...

Code: [Select]

(defun ReorderList3 (lst pattern / l)
  (setq l (length pattern))
  (vl-sort lst
   (function (lambda (e1 e2 /)
       (< (cond ((vl-position e1 pattern))
(l)
  )
  (cond ((vl-position e2 pattern))
(l)
  )
       )
     )
   )
  )
)it's slower than the previous one

[CAB]

OK, time to see who's is the fastest.

[MP]

Maybe I missed something but what's the design behavior when the length of the list to be sorted is greater than that of the sort index?

[Lee Mac]

Wow! A lot of interest, nice one everyone - I love that recursive solution Evgeniy!

Maybe I missed something but what's the design behavior when the length of the list to be sorted is greater than that of the sort index?

Michael,

The original request that spurred this on was to write a bunch of attribute tags to Excel in a particular order, that order was denoted by a 'reference list'.

But of course, if any tags are surplus to the list, these must be included too.

The attribute tag list would look something like:

Code: [Select]

((Category_Tag (Type_Tag . Value_Tag)) (Category_Tag (Type_Tag . Value_Tag)) ... )

Where the list would be sorted by referencing the "Category Tag" and the "Type_Tag" and "Value_Tag" are written under each category.

So, that is what spurred this on... 

[Lee Mac]

OK, time to see who's is the fastest.

Not me!  Too many loops in mine I think... 

[MP]

Ok ... as far as genericizing this .... is the intent to use the sort index associatively or positionally?

That is, given a raw list of '("C" "B" "A") should it sort using a sort index of '(2 1 3) as '("B" "C" "A") <positional sort> or since there's no association as it was, '("C" "B" "A")??

[Lee Mac]

Ok ... as far as genericizing this .... is the intent to use the sort index associatively or positionally?

That is, given a raw list of '("C" "B" "A") should it sort using a sort index of '(2 1 3) as '("B" "C" "A") <positional sort> or since there's no association as it was, '("C" "B" "A")??

Good point. In my original code, I sought out the position of the category in the 'reference list' and then moved the items accordingly, but this would have to be changed for whichever item was to be sort by.

So to make the code generic, I suppose a sort index would be the best option, becoming something like:

Code: [Select]

(defun SortByIndex (lst ind)
  (mapcar
    (function
      (lambda (x) (nth x lst))) ind))

Or allowing for missing elements...

Code: [Select]

(defun SortByIndex (lst ind / new)
  (setq new
    (mapcar
      (function
        (lambda (x) (nth x lst))) ind))

  (append new (vl-remove-if
                (function (lambda (x) (vl-position x new))) lst)))

[ElpanovEvgeniy]

(SortByList '("A" "B" "D" "C" "D") '("D" "A" "P" "B"));;=> ("D" "A" "B" "C")
(ReorderList '("A" "B" "D" "C" "D") '("D" "A" "P" "B"));;=> ("D" "A" "B" "C")
(sort '("A" "B" "D" "C" "D") '("D" "A" "P" "B") );;=> ("D" "A" "B" "C")
(sortlist '("A" "B" "D" "C" "D") '("D" "A" "P" "B") nil);;=> ("D" "D" "A" "B" "C")
(ReorderList '("A" "B" "D" "C" "D") '("D" "A" "P" "B"));;=> ("A" "B" "D" "C" "D")

corrected:

Code: [Select]

(defun rem-1 (a b)
 (cond ((not b) nil)
       ((= a (car b)) (cdr b))
       ((cons (car b) (rem-1 a (cdr b))))
 )
)
(defun sort (a b)
 (cond ((not b) a)
       ((member (car b) a) (cons (car b) (sort (rem-1 (car b) a) (cdr b))))
       ((sort a (cdr b)))
 )
)

(sort '("A" "B" "D" "C" "D") '("D" "D" "A" "P"))
;;=> ("D" "D" "A" "B" "C")

[MP]

Good point. In my original code, I sought out the position of the category in the 'reference list' and then moved the items accordingly, but this would have to be changed for whichever item was to be sort by.

One of the reasons I asked is that the posts seemed to be using an associative sort, kinda dicey when using strings -- is the intent to honor case etc? What happens if the data is numerical, nested lists, or worse, objects rather than strings? To continue, it appeared to me the intent that was positional, as said approach would work using the original data supplied. Please correct me if my assumptions are incorrect.

So to make the code generic, I suppose a sort index would be the best option, becoming something like:

Code: [Select]

(defun SortByIndex (lst ind)
  (mapcar
    (function
      (lambda (x) (nth x lst))) ind))
Or allowing for missing elements...

Code: [Select]

(defun SortByIndex (lst ind / new)
  (setq new
    (mapcar
      (function
        (lambda (x) (nth x lst))) ind))
  (append new (vl-remove-if
                (function (lambda (x) (vl-position x new))) lst)))

?? I don't see how either of those functions perform an actual a sort, what am I missing?

[Lee Mac]

?? I don't see how either of those functions perform an actual a sort, what am I missing?

The functions are designed so that given an index list, the items are sorted accordingly, hence;

Code: [Select]

(sortbyIndex '("A" "B" "C" "D") '(2 0 1 3))
("C" "A" "B" "D")

But perhaps its me who's losing it  - highly likely

[MP]

The functions are designed so that given an index list, the items are sorted accordingly, hence;

Code: [Select]

(sortbyIndex '("A" "B" "C" "D") '(2 0 1 3))
("C" "A" "B" "D")

A positional sort using that data should return ("B" "C" "A" "D"), no?

[Lee Mac]

The functions are designed so that given an index list, the items are sorted accordingly, hence;

Code: [Select]

(sortbyIndex '("A" "B" "C" "D") '(2 0 1 3))
("C" "A" "B" "D")

A positional sort using that data should return ("B" "C" "A" "D"), no?

We are still using Zero-based index right?

[MP]

yep

[Lee Mac]

yep

My mistake - you are right (as usual) 

[MP]

My mistake - you are right (as usual)  

Actually I'm not right.

It should be base indifferent, that is, I believe the behavior of the function should be such that this statement:

(_SortByKeys '("A" "B" "C") '(99 55 27))

would return:

("C" "B" "A")

But my expectation of said behavior (use of the sort keys) may deviate from the consensus here.