Search the Community
Showing results for tags 'mergesort'.
Found 2 results
I've completed MergeSort algorithm implementation in Autolisp based on Ellis Dee's vb6 version here: http://www.vbforums.com/showpost.php?p=2909257&postcount=12 The problem is that I need to replace nth atom in the lisp array, and the only way I can currently accomplish this, is by iterating the entire list. This takes, what would be a spectacular sorting algorithm, and destroys it's efficiency by iterating the list nth(log) times. I'm going to try not to muddy the water too much, but here is my nth-replace function based on Michels nth-remove function... (defun nth-replace (n_atom f_list f_n / ) ;replaced the nth element of a list ;n_atom is new atom ;f_list is list to be operated on ;f_n is the index that will be replaced (if (and (numberp f_n) (listp f_list)) (if (and (>= f_n 0) (< f_n (length f_list)) n_atom) (progn (repeat f_n (setq f_list (append (cdr f_list) (list (car f_list)))) ) (setq f_list (append (cdr f_list) (list n_atom))) (repeat (- (length f_list) f_n 1) (setq f_list (append (cdr f_list) (list (car f_list)))) ) ) ) ) f_list );defun I'm not completely new to autolisp, but I'm hoping there's a fundamental function I'm overlooking that can either replace an atom at a certain level, or can return a list up to a certain atom (nth instance), and then I can append my change, and then the latter half of the list.
For public consumption and comment... Below is a MergeSort algorithm implementation in Autolisp based on Ellis Dee's vb6 version here: http://www.vbforums.com/showpost.php?p=2909257&postcount=12 I'm looking to optimize further, but there are only a few places this can occur / after the recursive call in what kinda resembles an insertion sort. Specifically the (repeat (1+ (- mid L)) and (repeat (1+ (-upper R)). Let me know what you think.... Special Considerations: No byref, so currently uses global vars INDEX and SORTCLMN. You can nest this function with defined vars in the holding function, to keep private - so not completely global. Sorting is for nested lists, thus the name MergeSort2. This is for sorting the equivelant of a 2-dimensional array. See the inline example of the list construct. Don't think this will work with dotted pairs in current state. The code below includes everything necessary to build the current environment, and test (defun randnum (/ modulus multiplier increment random) (if (not seed) (setq seed (getvar "DATE")) ) (setq modulus 65536 multiplier 25173 increment 13849 seed (rem (+ (* multiplier seed) increment) modulus) random (/ seed modulus) ) ) (setq index nil) (repeat 1000 (setq index (append index (list (list (randnum))))) ) (setq sortclmn 0) ;use read and eval to make outside var dynamic ;currently locked to index (defun MergeSort2 (lsMirror lower upper ;require global vars: index sortclmn ;index is a two dimension array/list ;Ex. ( ; (1.2 4.1 0 <vla-obj> <ename>) ; (1 1 1 <vla-obj> <ename>) ; ) ;Ex. ( ; (5) ; (2) ; (6) ; ) ;Ex. 3d point list ; ( ; (21145.12 6546.01 0.0) ; (21165.0 6546.01 0.0) ; (20010.0 6500.0 1.0) ; ) / mid L R O Do swap ) ;(vl-load-com) (if (not upper) (setq upper (1- (length index)) ;if first run, get the bounds of the array lower 0 ;build an empty array to match the original lsMirror (repeat (length index) (setq lsmirror (append lsmirror (list 'nil)))))) (setq mid (- upper lower)) (cond ((= mid 0) );do nothing ((= mid 1) ;only one comparison in array (if (> (nth sortclmn (nth lower index)) (nth sortclmn (nth upper index))) (setq swap (nth lower index) index (nth-replace (nth upper index) index lower) index (nth-replace swap index upper)) );if ) ;else we have more than two entries ot work with (t (setq mid (+ lower (/ mid 2))) (MergeSort2 lsmirror lower mid) (MergeSort2 lsmirror (1+ mid) upper) (setq L lower R (1+ mid) O lower Do t) (while Do (if (< (nth sortclmn (nth R index)) (nth sortclmn (nth L index))) (progn (setq lsmirror (nth-replace (nth R index) lsmirror O)) (setq R (1+ R)) (if (> R upper) (progn (repeat (1+ (- mid L)) (setq O (1+ O)) (setq lsmirror (nth-replace (nth L index) lsmirror O)) (setq L (1+ L)) );repeat (setq Do nil) );progn );if );progn (progn ;else (setq lsmirror (nth-replace (nth L index) lsmirror O)) (setq L (1+ L)) (if (> L mid) (progn (repeat (1+ (- upper R)) (setq O (1+ O)) (setq lsmirror (nth-replace (nth R index) lsmirror O)) (setq R (1+ R)) );repeat (setq Do nil) );progn );if );progn );if (if do (setq O (1+ O))) );while (setq O lower) (repeat (1+ (- upper lower)) (setq index (nth-replace (nth O lsmirror) index O)) (setq O (1+ O)) );repeat );cond else );cond (princ) );defun mergeSort2 ;Provided by RenderMan... ;http://www.cadtutor.net/forum/showthread.php?65280-nth-replace-(mergesort-s-achilles-heel)&p=445816#post445816 (defun nth-replace ( newitem alist position / i ) (setq i -1) (mapcar '(lambda ( x ) (if (= position (setq i (1+ i))) newitem x)) alist) ) (defun get-utime () (* 86400 (getvar "tdusrtimer")) ) (setq ctime (get-utime)) (mergesort2 nil nil nil) (princ (strcat "\nTime: \n" (rtos (- (get-utime) ctime) 2 2) " seconds"))