Sort a list of lists

I have a large list that is a list of lists. The format is as follows:

(("C" "1" "xxx")("A" "1" "xxx")("B" "1" "xxx")...)

This list contains over 12,000 lists (compiled from a large database).
I wish to sort the lists without disturbing their contents, such as this:

(("A" "1" "xxx")("B" "1" "xxx")("C" "1" "xxx")...)

Sorting strings is a piece of cake, but I'm having trouble with sorting
lists.
Ideas?
Thanks.

Bruce

 

Try this code:

(defun pl:sort (func lst)
(mapcar (function (lambda (x) (nth x lst))) (vl-sort-i lst func))
)

(pl:sort (function (lambda (a b) (< (car a) (car b))))
'(("C" "1" "xxx") ("A" "1" "xxx") ("B" "1" "xxx"))
)

Best regards!

 

Hi Bruce,

Here is some excellent sorting routines I obtained on this forum from
the Herman Golden Company.

Once you load this LSP, you would call the function using the following
statement:


(setq SortedLst (l_ssort UnSortedLst 0 '<))

where,

0 - indicates the list index to sort in a nested list
< - indicates the sort function operator. This could be replaced by a
quoted function as well.

I hope this helps.

Regards
Rakesh

--
--
- Rakesh Rao [ rakesh.rao (at)4d-technologies.com ]
- Four Dimension Technologies
[www.4d-technologies.com]
- Get GeoTools, Work smarter: www.4d-technologies.com/geotools
- Free Lisp downloads @ TechCenter: www.4d-technologies.com/techcenter


;;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;;; * *
;;; * H E R M A N G O L D N E R C O M P A N Y *
;;; * *
;;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;;;
;;; File : hgsort.lsp
;;; Date : 8-6-96
;;; Purpose : Samples of power sorting in AutoLisp
;;;
;;; Author : T.J. DiTullio Herman Goldner Co. Inc.
;;; (70214,3131) E-Mail -
;;;
;;; Date : 3-23-95 (complied from earlier files 1992)
;;; : Revised 8-6-96 to add sorting "Method" and
;;; : and added (xysort) from seperate file
;;;
;;; Desciption : Here are five sorting functions that implement
;;; sorting with pointers (Yes in AutoLisp).
;;; There are two shell sorts and two bubble sorts.
;;; One of each for lists and one for list of lists
;;; and one two dimensional sort.
;;;
;;; After I developed these functions, I speed tested
;;; the shells against the bubbles. Since then I have not
;;; used the bubble sorts.
;;;
;;; All four functions use an integer list (ptr_lst) as
;;; pointers to the list to be sorted. One problem with
;;; sorting in AutoLisp is that the list to be sorted must
;;; be reconstructed each time a pair of items are swapped
;;; If the list (or list of lists) is very large, it can
;;; slow down the sort. By using a pointer list of type
;;; integer, this reconstruction will be much faster.
;;;
;;; At the start of each sort function, an integer list
;;; (ptr_lst) is constructed starting at 0 and ending at
;;; the number of items in list to be sorted (length lst).
;;; As items in the list to be sorted are compared, the
;;; pointer list is used to reference the list to be sorted.
;;; [ something like (nth (nth index ptr_lst) lst) ]
;;; [ meaning - The value of the list to be sorted is still
;;; in its original location. Used the integer
;;; (ptr_lst) value to determine where it is.
;;; ]
;;; Since the pointer list starts at 0, I used value of -1
;;; for the 1st (subst) call to avoid have duplicate values in
;;; the pointer list that would both be updated on the 2nd
;;; (subst) call. Then after the 2nd (subst) call, a 3rd call
;;; is made to replace the -1 value with the correct value.
;;; (setq t1 1st_item) - save 1st
;;; (setq t2 2nd_item) - save 2nd
;;; (subst -1 t1) - change t1 to -1
;;; (subst t1 t2) - change t2 to t1
;;; (subst t2 -1) - change -1 to t2
;;; - t1 and t2 are >= 0 always
;;;
;;; As items are swapped around, only the pointer list is
;;; modified. After the sorting is completed, the list to
;;; be sorted to rebuilt using the pointer list for the
;;; sorted location.
;;;
;;; This may seem like a lot of work to do some sorting. But
;;; the list of list that I sort get very large. (I use list
;;; of lists like an array of structures for anyone who knows
;;; the C language)
;;;
;;; Here is an example for a list of lists I might sort:
;;; ( ( "string" integer real integer real real "string"
;;; "string" real integer "string" real
;;; )
;;; ( "string" integer real integer real real "string"
;;; "string" real integer "string" real
;;; )
;;; etc ...
;;; )
;;;
;;; lisp call -> (setq mylist (l_ssort mylist 3 '>))
;;; lisp retn -> sorted list
;;; description -> sort mylist bases on the 4th item (an integer)
;;; in ascending order
;;;
;;;
;;; One thing I noticed when I wrote these sorts was that
;;; a shell sort is unable to sort completely if there are
;;; duplicate values. I could not find anything in writing
;;; to back this up. So I modified the algorithm to continue
;;; looping while the partition size is one until no swaps
;;; occurred.
;;;
;;; Sorry there are not a lot of comments!
;;;
;;; If you program in AutoLisp and are unfamiliar with these
;;; sorting methods, try looking at another language like
;;; Basic or C.
;;;
;;; Any comments or questions can be directed to me.
;;;
;;; *** Revision 8-6-96 ***
;;;
;;; All five sorting functions now except another parameter
;;; "method", a (quoted) function.
;;; Ex. (ssort some_list '>) - ascending order
;;; (ssort some_list '<) - descending order
;;;
;;; You can also use a function other than > or < for the
;;; sorting method. That function could expand the nested
;;; level even further the a list of lists.
;;;
;;; Ex. (defun sort_method (a b)
;;; (if (> (nth 0 a) (nth 0 b)
;;; T ;then return TRUE
;;; nil ;esle return FALSE
;;; )
;;; )
;;;
;;; (l_ssort list1 1 'sort_method)
;;;
;;; This SHOULD (I think, didn't test it) sort list1
;;; by the first element of the lists that are the second
;;; elements in the list of lists, OR SOMETHING, in
;;; ascending order.
;;;
;;; list1 = ( (1 (1 2 1) 1) (1 (2 1 1) 1) (2 (1 3 3) 3) )
;;; ^-- this is the "KEY" item
;;; first element of the list
;;; that is the second element of the bigger
;;; lists that make up "LIST1"
;;;
;;;
;;; WARNING: IF YOU ARE ALREADY USING THESE FUNCTIONS FROM AN EARLIER
;;; VERSIONS, YOU MUST EITHER RENAME THE NEW ONES OR EDIT
;;; ALL CALLS IN ANY EXISTING PROGRAMS TO INCLUDE THE NEW
;;; "method" PARAMETER.
;;;
;;;=======================================================================
;;;
;;; THIS CODE IS THE PROPERTY OF T.J. DITULLIO AND THE HERMAN GOLDNER CO INC
;;; PERMISSION IS GRANTED TO USE, COPY, MODIFY, AND DISTRIBUTE WITHOUT FEE
;;; PROVIDED THAT THIS NOTICE IS DISTRIBUTED.
;;;
;;;=======================================================================
;;; Sample Usage
;;;
;;; Command: !lst
;;; ((1 1 1) (2 2 2) (1 1 1) (3 3 3) (3 1 1) (0 0 0)
;;; (1 1 1) (2 2 2) (1 1 1) (3 3 3) (3 1 1) (0 0 0))
;;;
;;; Command: (l_ssort lst 0 '>)
;;; ((0 0 0) (0 0 0) (1 1 1) (1 1 1) (1 1 1) (1 1 1)
;;; (2 2 2) (2 2 2) (3 1 1) (3 3 3) (3 1 1) (3 3 3))
;;;
;;; Command: (l_ssort lst 0 '<)
;;; ((3 3 3) (3 1 1) (3 3 3) (3 1 1) (2 2 2) (2 2 2)
;;; (1 1 1) (1 1 1) (1 1 1) (1 1 1) (0 0 0) (0 0 0))
;;;
;;; Command: (l_bsort lst 1 '<)
;;; ((3 3 3) (3 3 3) (2 2 2) (2 2 2) (1 1 1) (1 1 1)
;;; (3 1 1) (1 1 1) (1 1 1) (3 1 1) (0 0 0) (0 0 0))
;;;
;;; Command: (l_bsort lst 1 '>)
;;; ((0 0 0) (0 0 0) (1 1 1) (1 1 1) (3 1 1) (1 1 1)
;;; (1 1 1) (3 1 1) (2 2 2) (2 2 2) (3 3 3) (3 3 3))
;;;
;;; Command: (xysort lst 0 1 '>)
;;; ((0 0 0) (0 0 0) (1 1 1) (1 1 1) (1 1 1) (1 1 1)
;;; (2 2 2) (2 2 2) (3 1 1) (3 1 1) (3 3 3) (3 3 3))
;;;
;;; Command: (xysort lst 0 2 '<)
;;; ((3 3 3) (3 3 3) (3 1 1) (3 1 1) (2 2 2) (2 2 2)
;;; (1 1 1) (1 1 1) (1 1 1) (1 1 1) (0 0 0) (0 0 0))
;;;
;;;
;;;* * * * * * * * * * * * * SORT FUNCTIONS * * * * * * * * * * * * * * *
;;;
;;; l_bsort
;;;
;;; Modified Bubble Sort of List of Lists
;;; Parameters llist -> list of lists
;;; key -> element in inner lists to sort by
;;; method -> '> for ascending or '< for descending
;;;
;;; Returns -> Sorted list of lists
;;;

(if (= #ProductName "LispLib") (vl-doc-export 'l_bsort))
(defun l_bsort ( llist key method / number_items count i
unsorted ptr_lst j
sorted_list t1 t2
)
(if (and llist key)
(progn
(setq i 1
number_items (length llist)
unsorted T
ptr_lst nil ;pointer list
count 0
)

(while (< count number_items)
(setq ptr_lst (append ptr_lst (list count)) ;built pointer list
count (1+ count)
)
) ;while

;-----------------------------------------------------------------------

(while (or unsorted (< i number_items))
(setq j 0
unsorted nil ;assume list is sorted
)

;loop thru and test (j) to (J+1) in pointer list

(while (< j (- number_items i))
(if ((eval method) (nth key (nth (nth j ptr_lst) llist))
(nth key (nth (nth (1+ j) ptr_lst) llist))
)

; swap items in pointer list
(setq t1 (nth j ptr_lst)
t2 (nth (1+ j) ptr_lst)
ptr_lst (subst t2 -1
(subst t1 t2
(subst -1 t1 ptr_lst)
)
)
unsorted T
) ;setq
) ;if

(setq j (1+ j))
) ;while j

(setq i (1+ i))
) ;while i

;-----------------------------------------------------------------------
;Build new list using sorted pointers

(setq count 0 sorted_list nil)
(while (< count number_items)
(setq sorted_list
(append sorted_list ;build updated list
(list
(nth
(nth count ptr_lst) ;pointer
llist
)
)
)
count (1+ count)
) ;setq
) ;while

sorted_list ;return sorted list
) ;progn

;else
nil
) ;if

) ;defun

;;;=======================================================================
;;;
;;; l_ssort
;;;
;;; Modified Shell Sort of List of Lists
;;; Parameters llist -> list of lists
;;; key -> element in inner lists to sort by
;;; method -> '> for ascending or '< for descending
;;;
;;; Returns -> Sorted list of lists
;;;
;;; Note: This custom shell sort algorithm will handle multiple
;;; occurrences of any items. The sort will continue looping
;;; when partition size is 1 until no swaps occur.
;;;

(if (= #ProductName "LispLib") (vl-doc-export 'l_ssort))
(defun l_ssort (llist key method /
number_items partition_size
number_partitions first_index
last_index unsorted
count ptr_lst
sorted_list i j
t1 t2
)

(if (and llist key)
(progn
(setq number_items (length llist)
partition_size number_items
ptr_lst nil ;pointer list
count 0
unsorted T ;assume list is not sorted
)

(if #Verbose (princ "\nBuilding point list..."))
(while (< count number_items)
(setq
ptr_lst (append ptr_lst (list count)) ;built pointer list
count (1+ count)
)
)
(if #Verbose (princ "done."))

;------------------------------------------------------------------

(while unsorted

(setq partition_size (fix (/ (1+ partition_size) 2))
number_partitions (fix (/ number_items partition_size))
)

(if #Verbose
(princ (strcat "\nNumber of partitions = " (itoa number_partitions) " \n"))
)

(if (= partition_size 1)
(setq unsorted nil) ;assume list is sorted
)

(if (/= (rem number_items partition_size) 0)
(setq number_partitions (1+ number_partitions))
)
(setq first_index 0
i 1
)
(while (< i number_partitions)
(if #Verbose
(princ (strcat "\r" (itoa i) " --> " (itoa number_partitions) " "))
)
(setq last_index (+ first_index partition_size))

(if (> last_index (- number_items partition_size))
(setq last_index (- number_items partition_size))
)

; loop thru and test (j) to (j+offset) in pointer list

(setq j first_index)
(while (< j last_index)
(if ((eval method) (nth key (nth (nth j ptr_lst) llist))
(nth key (nth
(nth (+ j partition_size) ptr_lst) llist)
)
)

; then swap items in pointer list
(setq t1 (nth j ptr_lst)
t2 (nth (+ j partition_size) ptr_lst)
ptr_lst (subst t2 -1
(subst t1 t2
(subst -1 t1 ptr_lst)
)
)
unsorted T
) ;setq
) ;if

(setq j (1+ j))

) ;while j

(setq first_index (+ first_index partition_size)
i (1+ i)
)

) ;while i


) ;while unsorted

;------------------------------------------------------------------
;Build new list using sorted pointers

(setq count 0 sorted_list nil)
(while (< count number_items)
(setq sorted_list
(append sorted_list ;build updated list
(list
(nth
(nth count ptr_lst) ;pointer
llist
)
)
)
count (1+ count)
) ;setq
) ;while

sorted_list ;return sorted list
) ;progn

;else
nil
) ;if

) ;defun

;;;=======================================================================
;;;
;;; bsort
;;;
;;; Modified Bubble Sort of List of values
;;; Parameters lst -> list of values
;;; method -> '> for ascending or '< for descending
;;;
;;; Returns -> Sorted list of values
;;;

(if (= #ProductName "LispLib") (vl-doc-export 'bsort))
(defun bsort ( lst method / number_items count i
unsorted ptr_lst j
sorted_list t1 t2
)
(if lst
(progn
(setq i 1
number_items (length lst)
unsorted T
ptr_lst nil ;pointer list
count 0
)

(while (< count number_items)
(setq ptr_lst (append ptr_lst (list count)) ;built pointer list
count (1+ count)
)
) ;while

;-----------------------------------------------------------------------

(while (or unsorted (< i number_items))
(setq j 0
unsorted nil ;assume list is sorted
)

;loop thru and test (j) to (J+1) in pointer list

(while (< j (- number_items i))
(if ((eval method) (nth (nth j ptr_lst) lst)
(nth (nth (1+ j) ptr_lst) lst)
)

; swap items in pointer list
(setq t1 (nth j ptr_lst)
t2 (nth (1+ j) ptr_lst)
ptr_lst (subst t2 -1
(subst t1 t2
(subst -1 t1 ptr_lst)
)
)
unsorted T
) ;setq
) ;if

(setq j (1+ j))
) ;while j

(setq i (1+ i))
) ;while i

;-----------------------------------------------------------------------
;Build new list using sorted pointers

(setq count 0 sorted_list nil)
(while (< count number_items)
(setq sorted_list
(append sorted_list ;build updated list
(list
(nth
(nth count ptr_lst) ;pointer
lst
)
)
)
count (1+ count)
) ;setq
) ;while

sorted_list ;return sorted list
) ;progn

;else
nil
) ;if

) ;defun

;;;=======================================================================
;;;
;;; ssort
;;;
;;; Modified Shell Sort of List of Values
;;; Parameters lst -> list of values
;;; method -> '> for ascending or '< for descending
;;;
;;; Returns -> Sorted list of values
;;;
;;; Note: This custom shell sort algorithm will handle multiple
;;; occurrences of any items. The sort will continue looping
;;; when partition size is 1 until no swaps occur.
;;;

(if (= #ProductName "LispLib") (vl-doc-export 'ssort))
(defun ssort (lst method /
number_items partition_size
number_partitions first_index
last_index unsorted
count ptr_lst
sorted_list i j
t1 t2
)

(if lst
(progn
(setq number_items (length lst)
partition_size number_items
ptr_lst nil ;pointer list
count 0
unsorted T ;assume list is not sorted
)

(while (< count number_items)
(setq ptr_lst (append ptr_lst (list count)) ;built pointer list
count (1+ count)
)
) ;while

;------------------------------------------------------------------

(while unsorted

(setq partition_size (fix (/ (1+ partition_size) 2))
number_partitions (fix (/ number_items partition_size))
)

(if (= partition_size 1)
(setq unsorted nil) ;assume list is sorted
)

(if (/= (rem number_items partition_size) 0)
(setq number_partitions (1+ number_partitions))
)
(setq first_index 0
i 1
)
(while (< i number_partitions)
(setq last_index (+ first_index partition_size))

(if (> last_index (- number_items partition_size))
(setq last_index (- number_items partition_size))
)

;loop thru and test (j) to (j+offset) in pointer list

(setq j first_index)
(while (< j last_index)
(if ((eval method) (nth (nth j ptr_lst) lst)
(nth (nth (+ j partition_size) ptr_lst) lst)
)

; then swap items in pointer list
(setq t1 (nth j ptr_lst)
t2 (nth (+ j partition_size) ptr_lst)
ptr_lst (subst t2 -1
(subst t1 t2
(subst -1 t1 ptr_lst)
)
)
unsorted T
) ;setq
) ;if

(setq j (1+ j))

) ;while j

(setq first_index (+ first_index partition_size)
i (1+ i)
)

) ;while i


) ;while unsorted

;------------------------------------------------------------------
;Build new list using sorted pointers

(setq count 0 sorted_list nil)
(while (< count number_items)
(setq sorted_list
(append sorted_list ;build updated list
(list
(nth
(nth count ptr_lst) ;pointer
lst
)
)
)
count (1+ count)
) ;setq
) ;while

sorted_list ;return sorted list
) ;progn

;else
nil
) ;if

) ;defun

;;;========================================================================
;;;
;;; xysort
;;;
;;; Two-dimensional sorting function
;;; Calls l_ssort
;;;
;;; Parameters llist -> list of values
;;; x -> primary key location
;;; y -> secondary key location
;;; method -> '> for ascending or '< for descending
;;;
;;; Returns -> Sorted list of values
;;;

(if (= #ProductName "LispLib") (vl-doc-export 'xysort))
(defun xysort (llist x y method
/ count1 llist_len sublist newlist key
)
(cond
( (= x y)
(princ "\nError: X and Y values are equal.")
(princ)
)
( (>= x (length (nth 0 llist)))
(princ "\nError: X value greater than list length.")
(princ)
)
( (>= y (length (nth 0 llist)))
(princ "\nError: Y value greater than list length.")
(princ)
)
( T
(setq llist (l_ssort llist x method) ;first sort by x
count1 0
llist_len (length llist)
sublist ()
newlist ()
)
(while (< count1 (1- llist_len))
(setq key (nth x (nth count1 llist))
count2 (1+ count1) ;next element after count1
sublist (append (list (nth count1 llist))) ;add first x
)

(while (and
(< count2 llist_len)
(= (nth x (nth count2 llist)) key) ;while x's are equal
)
(setq sublist (append sublist (list (nth count2 llist)))
count1 (1+ count1)
count2 (1+ count2)
)
) ;while =
(setq sublist (l_ssort sublist y method) ;sort by y
newlist (append newlist sublist)
count1 (1+ count1)
)
) ;while <
(if (< count1 llist_len)
(setq newlist (append newlist (list (nth count1 llist))))
)

newlist ;return x-y sorted list
) ;case T
) ;cond
) ;defun
;;;========================================================================

(princ)

 

Hi Bruce

Try this one (don't forget to initialize ActiveX support by 'vl-load-com'):

_$ (setq SrtLst '(("C" "1" "xxx") ("A" "1" "xxx") ("B" "1" "xxx")))
(("C" "1" "xxx") ("A" "1" "xxx") ("B" "1" "xxx"))
_$ (vl-sort SrtLst '(lambda (a b) (< (car a) (car b))))
(("A" "1" "xxx") ("B" "1" "xxx") ("C" "1" "xxx"))

Cheers

 

Forgot to say:
Duplicate elements may be eliminated from the list.

Cheers