[cl-utilities-devel] split-sequence performance problem.

[Szymon]

Peter Scott wrote:

> [.....] If it's not an issue but just a glaring
> performance wart, it might be better to leave the code as it is,
> simply because it's well tested and debugged in its current state and
> stability is very important to me. [.....]

Leave the code as it is, I just wrote an utility for splitting lists
and it's ok for me.

Regards, Szymon.

ps. utility works like this:

CL-USER> (split-list-if #'zerop '(0 0))
NIL

CL-USER> (split-list-if #'zerop '(0 0) :preserve-delimiters t)
((0 0))

(split-list-if #'zerop '(0 0 0 x) :preserve-delimiters t)

CL-USER> (split-list-if #'null '(a nil b))
((A) (B))

CL-USER> (split-list-if #'null '(nil a nil nil b nil))
((A) (B))

CL-USER> (split-list-if #'null '(nil a nil nil b nil)
                        :preserve-delimiters t)
((NIL) (A) (NIL NIL) (B) (NIL))

CL-USER> (split-list-if #'null '(nil a nil nil b nil) :count 2)
((A) (B))

CL-USER> (split-list-if #'null '(nil a nil nil b nil)
                        :preserve-delimiters t
                        :count 2)
((NIL) (A))

CL-USER> (split-list-if #'numberp '(0 a 1 2 b 3 4 c d))
((A) (B) (C D))

CL-USER> (split-list-if #'numberp '(0 a 1 2 b 3 4 c d) :preserve-delimiters t)
((0) (A) (1 2) (B) (3 4) (C D))

CL-USER> (split-list-if #'symbolp '(0 a 1 2 b 3 4 c d) :preserve-delimiters t)
((0) (A) (1 2) (B) (3 4) (C D))

CL-USER> (split-list-if #'numberp
                        '(foo (0 1) bar (2 3) baz 4 mug 5)
                        :key (lambda (x) (if (consp x) (car x) x)))
((FOO) (BAR) (BAZ) (MUG))

CL-USER> (split-list-if #'numberp
                        '(foo (0 1) bar (2 3) baz 4 mug 5)
                        :key (lambda (x) (if (consp x) (car x) x))
                        :preserve-delimiters t)
((FOO) ((0 1)) (BAR) ((2 3)) (BAZ) (4) (MUG) (5))



CL-USER> (split-list-if #'numberp '(0 a 1 2 b 3 4 c d 0 0 x)
                        :preserve-delimiters t
                        :count 3
                        :from-end t)
((C D) (0 0) (X))

CL-USER> (split-list-if #'numberp '(0 a 1 2 b 3 4 c d 0 0 x)
                        :count 3
                        :from-end t)
((B) (C D) (X))

|#

(defun split-list-if (test list
                      &key preserve-delimiters key count from-end
                      &aux (ldiff/cons (if (and from-end count) #'cons #'ldiff)))
  (when (or (null list)
            (and count (zerop count)))
    (return-from split-list-if))
  (when (and from-end (not count))
    (setq from-end nil))
  (multiple-value-bind (member member-not)
      (values (lambda (list) (member-if test list :key key))
              (let ((test-not (complement test)))
                (lambda (list) (member-if test-not list :key key))))
    (let ((get-next
           (if preserve-delimiters
               (let ((f member))
                 (lambda ()
                   (let ((result-begin list)
                         (result-end (funcall f list)))
                     (setq f (if (eq f member) member-not member))
                     (setq list result-end)
                     (when result-begin (funcall ldiff/cons result-begin result-end)))))
             (lambda (&aux (start (funcall member-not list))
                           (tail (funcall member start)))
               (when start (funcall ldiff/cons start (setq list tail)))))))
      (let (result pointer next init-delims)
        (setq init-delims
              (let ((tail (funcall member-not list)))
                (cond ((and (null tail) (cdr list))
                       (prog1 (copy-list list) (setq list nil)))
                      (t
                       (prog1 (ldiff list tail) (setq list tail))))))
        (if preserve-delimiters
            (when (and init-delims
                       (or (and (not from-end) count (= count 1))
                           (null list)))
              (return-from split-list-if (list init-delims)))
          (unless list (return-from split-list-if)))
        (setq result (list (funcall get-next)) pointer result)
        (when (and init-delims preserve-delimiters)
          (setq result (nconc (list init-delims) result))
          (when count (decf count)))
        (if count
            (loop repeat (1- count)
                  while (setq next (funcall get-next))
                  do (setq pointer (cdr (rplacd pointer (list next)))))
          (loop while (setq next (funcall get-next))
                do (setq pointer (cdr (rplacd pointer (list next))))))
        (when (and count from-end)
          (when list
            (cond ((= count 1)
                   (loop for x = (funcall get-next) do (if x (setq next x) (return)))
                   (setq result (rplaca result next)))
                  (t (loop while (setq next (funcall get-next))
                           for cell = (prog1 result (setq result (cdr result)))
                           do (rplaca (setq pointer (cdr (rplacd pointer cell))) next))
                     (rplacd pointer nil))))
          (map-into result (lambda (cons) (ldiff (car cons) (cdr cons))) result))
        result))))