SHARE
TWEET

Flatten list in a loop

a guest May 8th, 2012 25 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 (listp (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. ;; 353
  44. ;; 2056
  45. ;; 1230
  46. ;; 63
  47.  
  48. (let ((test (get-internal-real-time)))
  49.   (dotimes (i 1e6)
  50.     (flatten '(1 2 (3 4) (5 (6 (7 8) 9 a (10))) b (10.5 (1.6) (1.7)) 11)))
  51.   (print (- (get-internal-real-time) test))
  52.   (setf test (get-internal-real-time))
  53.   (dotimes (i 1e6)
  54.     (flatten-2 '(1 2 (3 4) (5 (6 (7 8) 9 a (10))) b (10.5 (1.6) (1.7)) 11)))
  55.   (print (- (get-internal-real-time) test))
  56.   (setf test (get-internal-real-time))
  57.   (dotimes (i 1e6)
  58.     (flatten-1 '(1 2 (3 4) (5 (6 (7 8) 9 a (10))) b (10.5 (1.6) (1.7)) 11)))
  59.   (print (- (get-internal-real-time) test))
  60.   (setf test (get-internal-real-time))
  61.   (dotimes (i 1e6)
  62.     (flatten-3 '(1 2 (3 4) (5 (6 (7 8) 9 a (10))) b (10.5 (1.6) (1.7)) 11)))
  63.   (print (- (get-internal-real-time) test)))
RAW Paste Data
Top