# cl-permutation / permutation-generation.lisp

 ``` 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 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93``` ```;;;; permutation-generation.lisp ;;;; Copyright (c) 2012 Robert Smith (in-package #:cl-permutation) (defun abs> (x y) (> (abs x) (abs y))) (defun mobilep (idx perm &optional (len (length perm))) (let ((val (aref perm idx))) (if (plusp val) ; Is the value a "left" ; directed value? ;; Left directed. (and (> idx 1) ; Check that the index ; is non-zero. (abs> val (aref perm (1- idx)))) ; Check the neighbor. ;; Right directed. (and (not (= len idx)) ; Check that the index ; is not maximal. (abs> val (aref perm (1+ idx))))))) ; Check the neighbor. (defun reverse-direction (idx perm) (setf (aref perm idx) (- (aref perm idx)))) (defun exists-mobile-p (perm len) (loop :for i :from 1 :to len :thereis (mobilep i perm len))) (defun next-perm (perm len) (let ((idx -1) (max-mob -1)) (when (exists-mobile-p perm len) ;; Find the largest mobile (loop :for i :from 1 :to len :for x := (aref perm i) :if (and (mobilep i perm len) (abs> x max-mob)) :do (setf idx i max-mob x) :finally (let ((adj-idx (- idx (sign max-mob)))) ;; Swap the largest mobile element with its ;; adjacent partner (rotatef (aref perm idx) (aref perm adj-idx)) ;; Reverse the direction of all larger ;; elements. (loop :for i :from 1 :to len :for x := (aref perm i) :when (abs> x max-mob) :do (reverse-direction i perm)))) perm))) (defun make-perm-generator (n) "Create a generator that generates permutations of size N." (assert (plusp n) (n) "Must provide a positive size for permutation generation. Given ~D." n) (let ((perm t)) (lambda () ;; Check if PERM is NIL (if the generator was exhausted). (when perm ;; We do this hackery to be able to emit the initial ;; (identity) perm. Initially PERM is just T -- not a vector. (if (not (vectorp perm)) (progn (setf perm (iota-vector (1+ n))) (%make-perm :spec perm)) (let ((next (next-perm perm n))) ;; If we are at the end, then set PERM to NIL. (if next (%make-perm :spec (map 'vector #'abs next)) (setf perm nil)))))))) (defmacro doperms ((x n &optional result) &body body) "Iterate over all permutations of size N, optionally returning RESULT." (let ((perm (gensym "PERM-")) (len (gensym "LEN-"))) `(let ((,len ,n)) (assert (plusp ,len) (,len) "Must provide a positive size for permutation generation. Given ~D." ,len) (loop :for ,perm := (iota-vector (1+,len)) :then (next-perm ,perm ,len) :while ,perm :do (let ((,x (%make-perm :spec (map 'vector 'abs ,perm)))) ,@body) :finally (return ,result))))) ```