Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement