Advertisement
Guest User

Improved flatten test

a guest
May 9th, 2012
51
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (defun flatten (x &optional y)
  2.   (declare (optimize (speed 3) (safety 0)))
  3.   (cond
  4.     ((null x)
  5.      (cond
  6.        ((null y) nil)
  7.        ((listp (car y))
  8.         (flatten (car y) (cdr y)))
  9.        (t (cons (car y) (flatten (cdr y))))))
  10.     ((listp (car x))
  11.      (flatten (car x) (if y (list (cdr x) y) (cdr x))))
  12.     (t (cons (car x) (flatten (cdr x) y)))))
  13.  
  14. (defun flatten-1 (l)
  15.   (declare (optimize (speed 3) (safety 0)))
  16.   (cond
  17.     ((null l) nil)
  18.     ((atom l) (list l))
  19.     (t (loop for a in l appending (flatten-1 a)))))
  20.  
  21. (defun flatten-2 (l)
  22.   (declare (optimize (speed 3) (safety 0)))
  23.   (when l
  24.     (if (atom l)
  25.     (list l)
  26.     (mapcan #'flatten-2 l))))
  27.  
  28. (defun flatten-3 (x)
  29.   (declare (optimize (speed 3) (safety 0)))
  30.   (do ((a x))
  31.       ((null a))
  32.     (if (consp (car a))
  33.         (do ((b (car a) (cdr b))
  34.              (c a)
  35.              (d (cdr a)))
  36.             ((null b)
  37.              (and (setf (cdr c) d) nil))
  38.           (setf (car c) (car b)
  39.                 (cdr c) (cdr b)
  40.                 c (or (cdr c) c)))
  41.         (setf a (cdr a)))) x)
  42.  
  43. (defun flatten-4 (l)
  44.   (declare (optimize (speed 3) (safety 0)))
  45.   (cond
  46.     ((null l) nil)
  47.     ((atom l) (list l))
  48.     (t (loop for a in l nconcing (flatten-4 a)))))
  49.  
  50. (defun flatten-5 (x &aux (res (list nil)))
  51.   (declare (optimize (speed 3) (safety 0)))
  52.   (do ((x x) (y nil) (r res))
  53.       (nil)
  54.     (cond
  55.       ((null x)
  56.        (cond
  57.          ((null y) (return-from flatten-5 (cdr res)))
  58.          ((listp (car y))
  59.           (setq x (car y) y (cdr y)))
  60.          (t (rplacd r (list (car y)))
  61.             (setq r (cdr r)
  62.                   x (cdr y)
  63.                   y nil))))
  64.       ((listp (car x))
  65.        (setq y (if y (list (cdr x) y) (cdr x))
  66.              x (car x)))
  67.       (t (rplacd r (list (car x)))
  68.          (setq r (cdr r)
  69.                x (cdr x))))))
  70.  
  71. (defun test-flatten (data)
  72.   (declare (optimize (speed 3) (safety 0)))
  73.   (let ((test (get-internal-real-time)))
  74.     (dotimes (i 1e6) (flatten data))
  75.     (print (- (get-internal-real-time) test))
  76.     (setf test (get-internal-real-time))
  77.     (dotimes (i 1e6) (flatten-1 data))
  78.     (print (- (get-internal-real-time) test))
  79.     (setf test (get-internal-real-time))
  80.     (dotimes (i 1e6) (flatten-2 data))
  81.     (print (- (get-internal-real-time) test))
  82.     (setf test (get-internal-real-time))
  83.     (dotimes (i 1e6)
  84.       (flatten-3 (copy-tree data)))
  85.     (print (- (get-internal-real-time) test))
  86.     (setf test (get-internal-real-time))
  87.     (dotimes (i 1e6) (flatten-4 data))
  88.     (print (- (get-internal-real-time) test))
  89.     (setf test (get-internal-real-time))
  90.     (dotimes (i 1e6) (flatten-5 data))
  91.     (print (- (get-internal-real-time) test))
  92.     (print "--------------------- finished")))
  93.  
  94. (let* ((data '(1 2 (3 4) (5 (6 (7 8) 9 a (10))) b (10.5 (1.6) (1.7)) 11))
  95.        (data-1 (do ((i 10 (1- i)) (x))
  96.            ((zerop i) (return x))
  97.          (setf x (append x data))))
  98.        (data-2 (do ((i 10 (1- i)) (x))
  99.            ((zerop i) (return x))
  100.          (setf x (append x data-1)))))
  101.   (format t "data: ~s~&data-1: ~s~& data-2: ~s~&"
  102.       data data-1 data-2)
  103.   (test-flatten data)
  104.   (test-flatten data-1)
  105.   (test-flatten data-2))
  106.  
  107. ;; 890
  108. ;; 2806
  109. ;; 4735
  110. ;; 686
  111. ;; 811
  112. ;; 414
  113. ;; --------------------- finished
  114. ;; 3729
  115. ;; 12915
  116. ;; 21658
  117. ;; 6584
  118. ;; 7269
  119. ;; 3391
  120. ;; --------------------- finished
  121. ;; 50071
  122. ;; 133508
  123. ;; 215169
  124. ;; 73918
  125. ;; 70899
  126. ;; 33164
  127. ;; --------------------- finished
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement