• API
• FAQ
• Tools
• Trends
• Archive
daily pastebin goal
87%
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