1
2
3
4
5
6
7
8

  (defun partition-upto (pivot a &optional less more)
      (cond
        ((eql (car a) pivot)
         (values less (nreverse more) (cdr a)))
        ((> (car a) pivot)
         (partition-upto pivot (cdr a) less (cons (car a) more)))
        ((< (car a) pivot)
         (partition-upto pivot (cdr a) (cons (car a) less) more))))

1
2
3

 (defun partition-upto (pivot a)
       (values (remove-if (lambda (x) (> x pivot)))
               (remove-if (lambda (x) (< x pivot))))) 

1
2
3
4
5
6
7
8
9
10
11

  (defun first-down (a)
    (loop for fst in a 
          for scd in (cdr a)
          when (> fst scd) return scd))

  (defun partition-upto (pivot a)
      (loop for e in a
            for r in a
            when (> e pivot) collect e into more
            when (< e pivot) collect e into less
            when (eql e pivot) return (values (cdr r) (nreverse less) more)))

1
2
3
4
5
6

 (defun partition-upto (pivot a)
      (loop for e in a
            for r on a
            when (> e pivot) collect e into more
            when (< e pivot) collect e into less
            when (eql e pivot) return (values (cdr r) (nreverse less) more)))

1
2
3
4
5
6
7

  (defun next-lex (a)
    (with var r = (reverse a)
          var pivor = (first-down r)
          vars (less-pivot greater-pivot before-pivot) = (partition-upto pivot r)
        in 
        (nreverse (append (cdr greater-pivot) (list pivot) less-pivot
              (list (car greater-pivot)) before-pivot))))

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

(require-extension miscmacros srfi-1)

(define (next-lex nums)
  (if (apply >= nums)
      #f ; already highest
      (if* (next-lex (cdr nums))
	   (cons (car nums) it)
	   (let ((n (next-highest (car nums) (cdr nums))))
	     (cons n (sort (remove-one n nums) <))))))

(define (remove-one a list)
  (let ((nl (remove (cut eqv? a <>) list)))
    (append! nl (make-list (- (length list) (length nl) 1) a))))

(define (next-highest a list)
  (apply min (filter (cut > <> a) list)))

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

;;; LIS is a list of (possibly repeated) elements
;;; COMPARE is a boolean function of two elements, such as > (which is the default)
;;; This returns the next lexicographically larger (via COMPARE) list of those same elements
;;; As an example, if lis = (1 5 10 10 12 12 11 11 10 9 9 8)
;;;           the result is (1 5 10 11 8 9 9 10 10 11 12 12) 
;;; It is O(4n)  more or less.  
;;; If lis were a vector, it seems we could save O(2n), but to convert a list to a vector and back will cost O(2n).
;;; Note that the order of "equal" elements is not guaranteed.
;;; (next-lex '("a" "e" "j" "j" "l" "l" "k" "k" "J" "j" "i" "i" "h") :compare #'string-greaterp)
;;; could return 
;;;     ("a" "e" "j" "k" "h" "i" "i" "j" "j" "J" "k" "l" "l")  Note the the upper and lower cases of J.
;;; or  ("a" "e" "j" "k" "h" "i" "i" "J" "j" "j" "k" "l" "l") 
;;; or  ("a" "e" "j" "k" "h" "i" "i" "j" "J" "j" "k" "l" "l") 
(defun next-lex (lis &key (compare '>))
  (let ((revlis (reverse lis)))         ;revlis = ( 8 9 9 10 11 11 12 12 10 10 5 1)   ;O(n)
    (loop with post-pivot = nil
        for (n1 pivot . rev-pre-pivot) on revlis ; O(0.5n)
        while pivot
        do (push n1 post-pivot)
           (when (funcall compare n1 pivot)
             ;;(format t "n1 = ~d, pivot = ~d, post-pivot = ~d, rev-pre-pivot = ~d~%" n1 pivot post-pivot rev-pre-pivot) ; Debug
             ;; at this point, n1 = 12, pivot = 10, post-pivot = (12 12 11 11 10 9 9 8), rev-pre-pivot = (10 5 1)
             (return (append 
                      ;; First is the part before the pivot that doesn't change.
                      (reverse rev-pre-pivot) ; O(0.5n)
                      ;; We know the numbers in post-pivot are monotonically decreasing
                      ;; In the post-pivot set, we will pick out the numbers that are bigger than the pivot, those equal to it, and the ones less than it.
                      ;; We move the smallest of the greater set to where the pivot was,
                      ;; Then put all those less than the pivot  (in monotonically increasing order),
                      ;; Then the pivot and all those equal to it
                      ;; Then the rest of those greater than the pivot (in monotonically increasing order)
                      (loop for (pp . pprest) on post-pivot ; O(0.5n)
                                                 ;; Remember, post-pivot is monotonically decreasing
                          with greater = nil
                          with equal = nil
                          do ;;(when (funcall compare pivot pp) (format t "pp = ~d, pprest = ~d, equal = ~d, greater = ~d~%" pp pprest equal greater)) ; Debug
                            (if (funcall compare pivot pp)
                                ;; At this point, pp = 9, pprest = (9 8), equal = (10), greater = (11 11 12 12)
                                ;; We can now finish up the resulte
                                (return (cons (first greater) ;The smallest of the greater set
                                              (append
                                               (reverse (cons pp pprest)) ; The lesser set, reversed to be increasing  ;O(2x0.25n) One for reverse, one for append
                                               (cons pivot
                                                     (append equal ; O[1]
                                                             (rest greater))))))
                              (if (funcall compare pp pivot)
                                  ;; If pp is greater than pivot, remember it
                                  (push pp greater) ; greater is monotonically increasing
                                ;; Note that we don't assume EQL or EQUAL for a comparison, but we use the COMPARE function in both directions.
                                (push pp equal))) 
                          finally
                            ;; If we haven't found something less than pivot, then we wind up here
                            ;;(prog2 (format t "No post-pivot < pivot.  equal = ~d, greater = ~d~%" equal greater) ;Debug
                            (return (cons (first greater) ; The smallest of the greater set
                                          (cons pivot
                                                (append equal ; O[1]
                                                        (rest greater)))))
                            ;;)         ;Debug
                            )))))))