[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/Y8uDXfrX    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Feb 27:
; lexicographic permutations

(define (next-perm lt? zs)
  (if (null? zs) zs
    (let next ((xlist (list (car zs))) (ys (cdr zs)))
      (cond ((null? ys) (reverse zs))
            ((not (lt? (car ys) (car xlist)))
              (next (cons (car ys) xlist) (cdr ys)))
            (else
              (letrec ((swap
                        (lambda (xs)
                          (cond ((null? (cdr xs))
                                  (cons (car ys) (cons (car xs) (cdr ys))))
                                ((lt? (car ys) (cadr xs))
                                  (cons (car xs) (swap (cdr xs))))
                                (else (append (cons (car ys) (cons (cadr xs) (cddr xs)))
                                              (cons (car xs) (cdr ys))))))))
                (swap xlist)))))))

(define (perms lt? xs)
  (define (fact n) (if (<= n 1) 1 (* n (fact (- n 1)))))
  (let loop ((n (fact (length xs))) (xs xs) (xss '()))
    (if (zero? n) xss
      (loop (- n 1) (next-perm lt? xs) (cons xs xss)))))

(display (perms < '())) (newline)
(display (perms < '(1))) (newline)
(display (perms < '(1 1))) (newline)
(display (perms < '(4 3 2 1))) (newline)


Output:
1
2
3
4
(())
((1))
((1 1) (1 1))
((1 2 3 4) (2 1 3 4) (1 3 2 4) (3 1 2 4) (2 3 1 4) (3 2 1 4) (1 2 4 3) (2 1 4 3) (1 4 2 3) (4 1 2 3) (2 4 1 3) (4 2 1 3) (1 3 4 2) (3 1 4 2) (1 4 3 2) (4 1 3 2) (3 4 1 2) (4 3 1 2) (2 3 4 1) (3 2 4 1) (2 4 3 1) (4 2 3 1) (3 4 2 1) (4 3 2 1))


Create a new paste based on this one


Comments: