This week only. Pastebin PRO Accounts Christmas Special! Don't miss out!Want more features on Pastebin? Sign Up, it's FREE!
Guest

Flatten list in a loop

By: a guest on May 8th, 2012  |  syntax: Lisp  |  size: 1.74 KB  |  views: 23  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
This paste has a previous version, view the difference. Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  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)))
clone this paste RAW Paste Data