Jump to content

vl-sort list of dotted pairs


Happy Hobbit

Recommended Posts

How can I vl-sort a list of dotted pairs by the first element of each [lowest first]

For simplicity my list is similar to:

(("1" . 1) ("A" . 1) ("C" . 2) ("3" . 1) ("B" . 5) ("D" . 2) ("2" . 3) ("E" . 5))

I've tried various

(mapcar '(lambda

functions but I cannot seem to get it right

 

Anybody got a solution please?

Link to comment
Share on other sites

  • Replies 26
  • Created
  • Last Reply

Top Posters In This Topic

  • pBe

    9

  • Happy Hobbit

    7

  • Tharwat

    5

  • Lee Mac

    2

*PING*

 

Easy when you know how, isn't it?

 

The variable holding my list is z

 

All I needed was:

 

(vl-sort z (function (lambda (a b) (< (car a) (car b)))))

 

Must be half asleep still :-p

 

Thank you for that pBe

Edited by Happy Hobbit
Forgot to thank
Link to comment
Share on other sites

Excellent, now lets make it more challenging interesting for you. sort Z and come up with this result

 

(("A" . 1) ("B" . 5) ("C" . 2) ("D" . 2) ("E" . 5)("1" . 1) ("2" . 3) ("3" . 1) )

Link to comment
Share on other sites

Oh Lord!

 

You nasty person you :-)

 

The only way I can think of is some sort of

 numberp 

comparison function, but I bet there's another way....?

Link to comment
Share on other sites

The only way I can think of is some sort of

 numberp 

comparison function,

 

Go for it :D

 

...but I bet there's another way....?

 

Pretty sure there is :)

Link to comment
Share on other sites

:surrender: :surrender:

 

I submit, c'mon tell me

 

You can do it, give it time, i honestly dont have the answer now :), using mobile device to reply to this thread, but i have ideas.

 

I bet there are others that has a solution at the ready. cmon guys pitch in :)

Link to comment
Share on other sites

Hi guys. :)

 

My method:

 

(setq lst '(("1" . 1) ("A" . 1) ("C" . 2) ("3" . 1) ("B" . 5) ("D" . 2) ("2" . 3) ("E" . 5)))

(setq z (vl-sort lst '(lambda (j k) (< (car j) (car k)))))
    (while z
         (if (numberp (read (caar z)))
           (setq b (append b (list (car z))))
           (setq a (append a (list (car z))))
           )
         (setq z (cdr z))
         )
(if (and a b) (append a b))

Link to comment
Share on other sites

Lee Mac, TharWat, David Bethnal, where art thou when I needeth you?

 

:lol: its the weekend after all.

 

if i were to guess, i may use numberp and ascii for this, that is if we're to continue using vl-sort.

Link to comment
Share on other sites

Another with mapcar & lambda functions and it is not that different than the one posted earlier by me with while function:

 

(setq lst '(("1" . 1) ("A" . 1) ("C" . 2) ("3" . 1) ("B" . 5) ("D" . 2) ("2" . 3) ("E" . 5)))

(setq z (vl-sort lst '(lambda (j k) (< (car j) (car k)))))
(mapcar '(lambda (x)
          (if (numberp (read (car x)))
            (setq b (append b (list x)))
            (setq a (append a (list x)))
            )
          )
       z
       )
(if (and a b) (append a b))

Link to comment
Share on other sites

I do not remember who wrote this but it is VERY old

 

 


;;******************************************************
;; ********************* SORTDPLST *********************
;;******************************************************
; (SORTDPLST <List_of_lists>)
; Sorts a list of lists (or dotted pairs) by the first element
; in ascending order. The first elements may be either all numeric or
; all strings.

(defun SortDpLst (dpl / len ctr start mcg rlen minimum)

(defun minimum (lst)
 (if (= (type (car lst)) 'STR)
   (car (acad_strlsort lst))
   (apply 'min lst)
 )
)

 (setq len (length dpl)
       ctr 0
       start nil)
 (cond ((> len 2)
   (setq mcg (minimum (mapcar 'car dpl))) ; get smallest value
   (setq mcg (assoc mcg dpl))
   (setq rlen (- len (length (member mcg dpl)))) ; get position in list
   (while (< ctr rlen)  ; remove minimum from list
     (setq start (cons (nth ctr dpl) start))
     (setq ctr (1+ ctr))
   )
   (setq dpl (cons mcg (sortdplst (append (reverse start) ; reconstruct list
                                  (cdr (member mcg dpl))))))
 )
 ((= len 2)
   (if (/= (minimum (mapcar 'car dpl)) (caar dpl))
     (setq dpl (reverse dpl))
   )
 ))
 dpl
)

 

 

https://www.theswamp.org/index.php?topic=29333.0

Link to comment
Share on other sites

I think it would be nice to write my name correctly, right?

 

My mistake my friend :) [ fixed name at post 13 ]

 

As for Happy Hobbit's lesson for the day (without stepping out of vl-sort)

 

(vl-sort lst
 '(lambda (a b)
    (setq c (mapcar '(lambda (d)
		       (if (> (Setq e (Ascii d)) 57)
			 (- e 50)
			 e
		       )
		     )
		    (mapcar 'car (list a b))
	    )
    )
    (< (Car c) (cadr c))
  )
)

 

NOTE TO SELF: (NTS)

Needs to out put more thought on the code if the conditions are different than the one posted by the OP

Link to comment
Share on other sites

Here is another method :D

 

(mapcar '(lambda (x)
          (setq order (append order (list (assoc (chr (if (< x 48)
                                                (+ x 33)
                                                x))
                                         lst)))
                )
          )
       (vl-sort (mapcar '(lambda (x)
                           (if (<= 48 (setq v (ascii (car x))) 57)
                             v
                             (- v 33)))
                        lst)
                '<)
       )

 

The output would be in variable 'order'

Link to comment
Share on other sites

(setq lst '(("1" . 1) ("A" . 1) ("C" . 2) ("3" . 1) ("B" . 5) ("D" . 2) ("2" . 3) ("E" . 5)))

(setq z (vl-sort lst '(lambda (j k) (< (car j) (car k)))))
    (while z
         (if (numberp (read (caar z)))
           (setq b (append b (list (car z))))
           (setq a (append a (list (car z))))
           )
         (setq z (cdr z))
         )
(if (and a b) (append a b))

(setq lst '(("1" . 1) ("A" . 1) ("C" . 2) ("3" . 1) ("B" . 5) ("D" . 2) ("2" . 3) ("E" . 5)))

(setq z (vl-sort lst '(lambda (j k) (< (car j) (car k)))))
(mapcar '(lambda (x)
          (if (numberp (read (car x)))
            (setq b (append b (list x)))
            (setq a (append a (list x)))
            )
          )
       z
       )
(if (and a b) (append a b))

(vl-sort lst
    '(lambda (a b)
       (setq c (mapcar '(lambda (d)
                  (if (> (Setq e (Ascii d)) 57)
                (- e 50)
                e
                  )
                )
               (mapcar 'car (list a b))
           )
       )
       (< (Car c) (cadr c))
     )
)

(mapcar '(lambda (x)
          (setq order (append order (list (assoc (chr (if (< x 48)
                                                (+ x 33)
                                                x))
                                         lst)))
                )
          )
       (vl-sort (mapcar '(lambda (x)
                           (if (<= 48 (setq v (ascii (car x))) 57)
                             v
                             (- v 33)))
                        lst)
                '<)
       )

 

Try these lists:

(setq lst '(("10" . 3) ("A" . 1) ("3" . 1) ("1" . 3) ("2" . 3)))
(setq lst '(("10" . 3) ("A" . 1) ("3" . 1) ("1" . 3) ("1" . 4) ("1" . 5) ("2" . 3)))
(setq lst '(("10" . 3) ("3" . 1) ("1" . 3) ("2" . 3)))

 

;)

 

Here is another:

(defun foo ( l )
   (vl-sort l
      '(lambda ( a b / x y )
           (setq x (read (car a)) y (read (car b)))
           (cond
               (   (and (numberp x) (numberp y)) (< x y))
               (   (numberp y))
               (   (numberp x) nil)
               (   (< (car a) (car b)))
           )
       )
   )
)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...