SHARE
TWEET

Flatten list in a loop

a guest May 8th, 2012 23 Never
  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