I'm afraid my command of Maple does not stretch to anything not easily portable to other languages; in addition, it relies on ancient features which I understand are nowadays deprecated. [A recent attempt at improving this situation --- by providing type declarations for variables and parameters --- proved so mind-bogglingly counter-productive that I was obliged immediately to reverse it.]

As has already been observed above, there are a great many permutation generators around; though somehow or other, they never seem to do quite what one requires.

My own attempt appears below: it requires a sorted bag / multiset of integers. My excuse for posting it here is that a simple generator which employs adjacent transpositions where possible, in constant amortised time, does not appear to be readily available elsewhere. I have attempted to provide a (sparse) summary of the algorithm.  

Any suggestions for updating the style would be welcome: in particular, a more object-oriented recasting might avoid having to cart around the auxiliary arrays as parameters (shades of FORTRAN!).

[Incidentally, the previewer is displaying this message as source plaintext, rendering much of it barely readable --- if anybody requires a clean copy, please let me know.]

WFL

################################################################################

# Generate bag-permutations of m elements, ordered by nearly adjacent
# transposition; generator value = m+1 on termination;
# assumes 0 <= n <= m, m > 0; 4 sentinels; no pre-initialisation.
# Maple program, Fred Lunnon, Maynooth 01/07/08
# Version with type-checking time 7x slower than without under Maple 9
# --- commented out again!

# A "run" is defined to be a sequence of equally ranked elements in
# consecutive locations (and with consecutive identifiers), such that all
# but the righthand end (highest location) are drifting right (d = +1).
# The drift of the righthand element at j determines that of the entire run.
# A run is "blocked" when the element adjacent in its direction of drift at i
# has equal or lower rank. The element adjacent to a run at its lefthand end
# is of different rank; at its righthand end may be another of equal rank.
# Generator employs Steinhaus-Johnson-Trotter adjacent transposition strategy
# to exchange the earliest (by identifier) unblocked run at j with the single
# element at i. Individual elements within a run behave as though under the
# action of a combination generator by nearly-adjacent transpositions;
# all permutations of the user bag of ranks are transpositions, most of
# which are actually adjacent.
# Once an unblocked element is found, the attached run is shifted one place
# along direction d, the end elements transposed, and all but the rightmost
# drift set leftwards; the drift of all earlier elements is reversed.
# In order to avoid unnecesary and nested loops, reversal takes place during
# search, and the left end of a run is retained in l for future reference.
# Spatial blocking sentinels ranked lowest are installed at either end, and
# temporal termination sentinels ranked highest placed off the righthand end.

# Case m = 0 is excluded, since iterator signals immediate termination;
# could be fixed, at the cost of extra testing at its start.
# The generator is stable, in the sense that elements of the same rank remain
# always in the same order. For this reason it might be regarded as a
# permutation generator with restrictions on the ordering of specified subsets.
# Next move takes place in constant amortised time; always by transposition,
# which will be adjacent when possible (for large m, at least 82.7% of moves).

# Each element has unique identifier p, lower p drifting more frequently;
# R_[k] = rank (positive integer user symbol) of element at k;
# P_[k] = identifier p of element at k, 0 <= p < m+3;
# Q_[p] = location k of element p, 0 <= k < m+3;
# D_[k] = current drift direction d of element at k, -1 <= d <= +1.
# i,j,k,l locate elements in current permutation;
# d,e = direction of element at j,i; l holds left end of current run.
# Arrays are extended by sentinels indexed 0 at left, m+1,m+2,m+3 at right;
# list [...] subscripts run from 1 to op(list).

# Initialiser: Input list of m > 0 rank values (non-decreasing order);
# adjacency improves for increasing partition;
# output R_, P_, Q_, D_ 1-dim arrays of integer.
#initbagperm := proc (rank :: list(integer), R_, P_, Q_, D_) :: NULL;
# local m :: integer, j :: integer, r :: array(integer),
# r_1 :: integer, r_m :: integer;
initbagperm := proc (rank, R_, P_, Q_, D_)
local m, j, r, r_1, r_m;
m := nops(rank); r := sort(rank);
if m <= 0 then print(`bagperm: length <= 0`)
else r_1, r_m := r[1], r[m];
R_ := array(0..m+3, [r_1-1, seq(r[j], j = 1..m), r_1-1, r_m+1, r_m+2]);
P_ := array(0..m+3, [0, seq(j, j = 1..m), 0, m+1, m+2]); # permed identities
Q_ := array(0..m+3, [0, seq(j, j = 1..m), m+2, m+3, 0]); # inverse locations
D_ := array(0..m+3, [0, seq(+1, j = 1..m), 0, +1, +1]); # permed drifts
fi; NULL end;

# Iterator: Output permuted ranks in R_[1..m];
# result = location j of run drifted; on termination j = m+1.
#nextbagperm := proc (R_ :: array(integer), P_ :: array(integer),
# Q_ :: array(integer), D_ :: array(integer)) :: integer;
# local i :: integer, j :: integer, k :: integer, l :: integer,
# d :: integer, e :: integer, p :: integer;
nextbagperm := proc (R_, P_, Q_, D_)
local i, j, k, l, d, e, p;
# locate earliest unblocked element at j, starting at blocked element 0
j, i, d := 0, 0, 0;
while R_[j] >= R_[i] do
D_[j] := -d; # blocked at j; reverse drift d pre-emptively
j := Q_[P_[j]+1]; d := D_[j]; i := j+d; # next element at j, neighbour at i
if R_[j-1] <> R_[j] then l := j # save left end of run in l
elif d < 0 then i := l-1 fi od; # restore left end at head of run
# shift run of equal rank from i-d,i-2d,...,l to i,i-d,...,l+d
k := i; if d < 0 then l := j fi;
e := D_[i]; p := P_[i]; # save neighbour drift e and identifier p
while k <> l do
P_[k] := P_[k-d]; Q_[P_[k]] := k;
D_[k] := -1; k := k-d od; # reset drifts of run tail elements
R_[l], R_[i] := R_[i], R_[l]; # transpose user ranks
D_[l], D_[i] := e, d; # restore drifts of head and neighbour
P_[l], Q_[p] := p, l; # wrap neighbour around to other end
j end;

# Test bag-perms --- listing
parts := [2, 2, 2]; # chosen partition of set
l := nops(parts): m := add(parts[i], i = 1..l): # length and weight
symb := [seq(seq(i, j = 1..parts[i]), i = 1..l)]:
cardi := combinat[multinomial](m, op(parts)): # number of bag-perms
initbagperm(symb, R_,P_,Q_,D_):
l := 1: print(l, [seq(R_[i], i = 1..n)]);
while nextbagperm(R_,P_,Q_,D_) <= n and l < cardi + 2 do
l := l+1; print(l, [seq(R_[i], i = 1..n)]) od:
print(l, cardi); # equal

################################################################################