MergeSort2

[wishbonesr]

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"))

Edited December 20, 2011 by wishbonesr
spelling