(defun nbest-to-front (lst pred)
  (let ((best lst)
        (par nil))
    (do* ((prev lst (cdr prev))
          (chk (cdr prev) (cdr prev)))
         ((endp chk))
      (if (funcall pred (car chk) (car best))
          (setq best chk par prev)))
    (if par
        (setf (cdr par) (cdr best)))
    (setf lst (cons (car best) lst)))) ;; last line is redundant if
par = nil, but I'd like lst returned...

The alternative I thought of to that last line is:
(when par
      (setf (cdr par) (cdr best))
      (setf lst (cons (car best) lst)))
    lst))

(sort list pred)

(defun nmove-best-to-front2 (lst pred)
  (loop for i on lst do
       (if (funcall pred (car i) (car lst))
         (rotatef (car lst) (car i)))))

I'll have to remember this rotatef voodoo...

However... it's still doing swapping on each best find.  I'd imagine
it's markedly slower when using a list sorted reverse of the given
predicate (descending?).  It doesn't change the runtime O(n), but ah
what the heck, slime is open, I'll run it now:

scratch that - way to slow...

CL-USER> (time (test-nmove-best-to-front2 1000000))
Evaluation took:
  2.446 seconds of real time
  2.424151 seconds of total run time (2.396150 user, 0.028001 system)
  99.10% CPU
  3,827,875,897 processor cycles
  0 bytes consed
NIL
CL-USER> (time (test-nmove-best-to-front 1000000))
Evaluation took:
  0.048 seconds of real time
  0.040003 seconds of total run time (0.040003 user, 0.000000 system)
  83.33% CPU
  49,030,586 processor cycles
  0 bytes consed

How about this:

(defun nmove-best-to-front3 (lst pred)
  (let ((best (car lst))
        (best-lst lst))
    (loop for i on (cdr lst) do
         (if (funcall pred (car i) best)
             (setq best (car i) best-lst i)))
    (rotatef (car lst) (car best-lst))))

CL-USER> (time (test-nmove-best-to-front3 1000000))
Evaluation took:
  2.902 seconds of real time
  2.876180 seconds of total run time (2.856178 user, 0.020002 system)
  99.10% CPU
  3,792,683,484 processor cycles
  0 bytes consed
NIL

(defun nmove-best-to-front2 (lst pred)
  (loop for i on lst do
       (if (funcall pred (car i) (car lst))
         (rotatef (car lst) (car i)))))

I'll have to remember this rotatef voodoo...

However... it's still doing swapping on each best find.  I'd imagine
it's markedly slower when using a list sorted reverse of the given
predicate (descending?).  It doesn't change the runtime O(n), but ah
what the heck, slime is open, I'll run it now:

scratch that - way to slow...

CL-USER> (time (test-nmove-best-to-front2 1000000))
Evaluation took:
  2.446 seconds of real time
  2.424151 seconds of total run time (2.396150 user, 0.028001 system)
  99.10% CPU
  3,827,875,897 processor cycles
  0 bytes consed
NIL
CL-USER> (time (test-nmove-best-to-front 1000000))
Evaluation took:
  0.048 seconds of real time
  0.040003 seconds of total run time (0.040003 user, 0.000000 system)
  83.33% CPU
  49,030,586 processor cycles
  0 bytes consed

How about this:

(defun nmove-best-to-front3 (lst pred)
  (let ((best (car lst))
        (best-lst lst))
    (loop for i on (cdr lst) do
         (if (funcall pred (car i) best)
             (setq best (car i) best-lst i)))
    (rotatef (car lst) (car best-lst))))

CL-USER> (time (test-nmove-best-to-front3 1000000))
Evaluation took:
  2.902 seconds of real time
  2.876180 seconds of total run time (2.856178 user, 0.020002 system)
  99.10% CPU
  3,792,683,484 processor cycles
  0 bytes consed
NIL

(defun nmove-best-to-front (lst pred)
  (let ((best lst)
        (parent nil))
    (do* ((prev lst (cdr prev))
          (cur (cdr prev) (cdr prev)))
         ((endp cur))
      (if (funcall pred (car cur) (car best))
          (setf best cur parent prev)))
    (when parent
      (setf (cdr parent) (cdr best))
      (setf lst (cons (car best) lst)))
    lst))

(defun nmove-best-to-front2 (lst pred)
  (loop for i on (cdr lst) do
       (if (funcall pred (car i) (car lst))
           (rotatef (car lst) (car i)))))

(defun nmove-best-to-front3 (lst pred)
  (let ((best (car lst))
        (best-lst lst))
    (loop for i on (cdr lst) do
         (if (funcall pred (car i) best)
             (setq best (car i) best-lst i)))
    (rotatef (car lst) (car best-lst))))

(defun test-nmove-best-to-front3 (n)
  (dotimes (i n)
    (let ((lst '(50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33
32 31 30 29 28 27
 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2
1)))
      (nmove-best-to-front3 lst #'<))))

(defun test-nmove-best-to-front2 (n)
  (dotimes (i n)
    (let ((lst '(50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33
32 31 30 29 28 27
 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2
1)))
      (nmove-best-to-front2 lst #'<))))

(defun test-nmove-best-to-front (n)
  (dotimes (i n)
    (let ((lst '(50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33
32 31 30 29 28 27
 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2
1)))
      (nmove-best-to-front lst #'<))))

The last post didn't make any sense and I re-tested again (after
making sure EVERYTHING was compiled).  Luckily the universe makes
sense again and rotatef isn't too expensive (even when run all all the
elements of the list

OTKB:

(loop with best = lst
       for cm on (cdr lst)
       when (funcall pred (car cm) (car best))
       do (setf best cm)
       finally (rotatef (car lst) (car best)))

hth,kt

  (setf list (sort list pred))

The identity of the first cons of the list may change under sort,
so you must always retain the return value in place of the original
list.

Sorting the list in a function like this is probably silly.

If you are going to extract the ``best'' item regularly, you will
probably maintain the list in sorted order. The efficient way to do that
is an ordered insert.  A full sort will have to scan the whole list
once, even if it's optimized for the case when the list is nearly sorted.

(in-package :iterate) ; it is likely you'll have symbol clashes if you
use-package;
                      ; btw, use http://sourceforge.net/projects/iteratekeywords/
(defun test-best-to-front (n best-to-front)
  (dotimes (i n)
    (let ((lst (list 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35
34 33
32 31 30 29 28 27
 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2
1)))
      (funcall best-to-front lst #'<))))

(defun nbest-to-front-4 (lst pred)
        (iter (for i in lst)
              (for o on lst) (:for maybe-cut-point previous o initially nil)
              (with best-i = (car lst)) (:with cut-point = nil)
              (unless (first-time-p)
                (when (funcall pred best-i i)
                  (setf best-i i cut-point maybe-cut-point)))
              (finally
               (return
                 (cond ((null cut-point) lst) ((eq cut-point lst) lst)
                       (t (let ((new-lst (cdr cut-point))) (shiftf (cdr cut-point)
(cdr new-l) lst)))
                       )))
              ))

(compile 'nbest-to-front-4)

(defun nbest-to-front-5 (lst pred) (loop with best = lst
       for cm on (cdr lst)
       when (funcall pred (car cm) (car best))
       do (setf best cm)
       finally (rotatef (car lst) (car best))))

(compile 'nbest-to-front-5)

ITER> (time (test-best-to-front 1000000 'nbest-to-front-4))
Evaluation took:
  5.239 seconds of real time
  5.212325 seconds of total run time (5.124320 user, 0.088005 system)
  [ Run times consist of 0.196 seconds GC time, and 5.017 seconds non-
GC time. ]
  99.48% CPU
  7,833,665,384 processor cycles
  400,698,840 bytes consed

NIL
ITER> (time (test-best-to-front 1000000 'nbest-to-front-5))
Evaluation took:
  5.164 seconds of real time
  5.152323 seconds of total run time (5.048316 user, 0.104007 system)
  [ Run times consist of 0.224 seconds GC time, and 4.929 seconds non-
GC time. ]
  99.77% CPU
  7,720,695,931 processor cycles
  400,698,904 bytes consed

http://paste.lisp.org/display/71851#1

(defun test-best-to-front (n best-to-front) "n should be even!"
    (let ((lst (list 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35
34 33
32 31 30 29 28 27
 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2
1)))
    (dotimes (i (/ n 2))
      (setf lst (funcall best-to-front lst #'<))
      (setf lst (funcall best-to-front lst #'>))
) (print lst)))

I noticed I pasted a wrong version of nbest-to-front-4 here. Here is a
fix:

(defun nbest-to-front-4 (lst pred)
        (iter (for i in lst)
              (for o on lst) (for maybe-cut-point previous o initially
nil)
              (with best-i = (car lst)) (with cut-point = nil)
              (unless (first-time-p)
                (when (funcall pred best-i i)
                  (setf best-i i cut-point maybe-cut-point)))
              (finally
               (return
                 (cond ((null cut-point) lst) ((eq cut-point lst) lst)
                       (t (let ((new-lst (cdr cut-point)))
                             (shiftf (cdr cut-point) (cdr new-lst)
lst)))
                       )))
              ))

Now:
(defun nbest-to-front-5 (lst pred) (loop with best = lst
       for cm on (cdr lst)
       when (funcall pred (car cm) (car best))
       do (setf best cm)
       finally (rotatef (car lst) (car best)))
       lst)

ITER> (time (test-best-to-front 4000000 'nbest-to-front-4))

(1 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29
28 27
 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2)
Evaluation took:
  16.835 seconds of real time
  16.729045 seconds of total run time (16.693043 user, 0.036002
system)
  [ Run times consist of 0.020 seconds GC time, and 16.710 seconds non-
GC time. ]
  99.37% CPU
  25,172,015,038 processor cycles
  2,405,008 bytes consed

(1 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29
28 27 26
 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2)
ITER> (time (test-best-to-front 4000000 'nbest-to-front-5))

(50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28
27
 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2
1)
Evaluation took:
  16.331 seconds of real time
  16.317020 seconds of total run time (16.317020 user, 0.000000
system)
  99.91% CPU
  24,419,120,812 processor cycles
  2,346,928 bytes consed