(defun flatten (x &optional y)
(declare (optimize (speed 3) (safety 0)))
(cond
((null x)
(cond
((null y) nil)
((listp (car y))
(flatten (car y) (cdr y)))
(t (cons (car y) (flatten (cdr y))))))
((listp (car x))
(flatten (car x) (if y (list (cdr x) y) (cdr x))))
(t (cons (car x) (flatten (cdr x) y)))))
(defun flatten-1 (l)
(declare (optimize (speed 3) (safety 0)))
(cond
((null l) nil)
((atom l) (list l))
(t (loop for a in l appending (flatten-1 a)))))
(defun flatten-2 (l)
(declare (optimize (speed 3) (safety 0)))
(when l
(if (atom l)
(list l)
(mapcan #'flatten-2 l))))
(defun flatten-3 (x)
(declare (optimize (speed 3) (safety 0)))
(do ((a x))
((null a))
(if (consp (car a))
(do ((b (car a) (cdr b))
(c a)
(d (cdr a)))
((null b)
(and (setf (cdr c) d) nil))
(setf (car c) (car b)
(cdr c) (cdr b)
c (or (cdr c) c)))
(setf a (cdr a)))) x)
(defun flatten-4 (l)
(declare (optimize (speed 3) (safety 0)))
(cond
((null l) nil)
((atom l) (list l))
(t (loop for a in l nconcing (flatten-4 a)))))
(defun flatten-5 (x &aux (res (list nil)))
(declare (optimize (speed 3) (safety 0)))
(do ((x x) (y nil) (r res))
(nil)
(cond
((null x)
(cond
((null y) (return-from flatten-5 (cdr res)))
((listp (car y))
(setq x (car y) y (cdr y)))
(t (rplacd r (list (car y)))
(setq r (cdr r)
x (cdr y)
y nil))))
((listp (car x))
(setq y (if y (list (cdr x) y) (cdr x))
x (car x)))
(t (rplacd r (list (car x)))
(setq r (cdr r)
x (cdr x))))))
(defun test-flatten (data)
(declare (optimize (speed 3) (safety 0)))
(let ((test (get-internal-real-time)))
(dotimes (i 1e6) (flatten data))
(print (- (get-internal-real-time) test))
(setf test (get-internal-real-time))
(dotimes (i 1e6) (flatten-1 data))
(print (- (get-internal-real-time) test))
(setf test (get-internal-real-time))
(dotimes (i 1e6) (flatten-2 data))
(print (- (get-internal-real-time) test))
(setf test (get-internal-real-time))
(dotimes (i 1e6)
(flatten-3 (copy-tree data)))
(print (- (get-internal-real-time) test))
(setf test (get-internal-real-time))
(dotimes (i 1e6) (flatten-4 data))
(print (- (get-internal-real-time) test))
(setf test (get-internal-real-time))
(dotimes (i 1e6) (flatten-5 data))
(print (- (get-internal-real-time) test))
(print "--------------------- finished")))
(let* ((data '(1 2 (3 4) (5 (6 (7 8) 9 a (10))) b (10.5 (1.6) (1.7)) 11))
(data-1 (do ((i 10 (1- i)) (x))
((zerop i) (return x))
(setf x (append x data))))
(data-2 (do ((i 10 (1- i)) (x))
((zerop i) (return x))
(setf x (append x data-1)))))
(format t "data: ~s~&data-1: ~s~& data-2: ~s~&"
data data-1 data-2)
(test-flatten data)
(test-flatten data-1)
(test-flatten data-2))
;; 890
;; 2806
;; 4735
;; 686
;; 811
;; 414
;; --------------------- finished
;; 3729
;; 12915
;; 21658
;; 6584
;; 7269
;; 3391
;; --------------------- finished
;; 50071
;; 133508
;; 215169
;; 73918
;; 70899
;; 33164
;; --------------------- finished