Range permutations, treating given runs of consecutive element as they were identical

Question

Given a positive integer $n$ and a list of disjoint intervals in the form $\{\{i_1,i_1+1,i_1+2,\ldots,i_1+n_1\},\{i_2,i_2+1,i_2+2,\ldots i_2+n_2\},\ldots\}$ all contained in $[1,n]$, I want to generate the permutations of $\{1\ldots n\}$ treating integers in the same given interval as they were equivalent, hence never changing their order. I should have $\frac{n!}{(n_1!n_2!...)}$ permutations.

This is my attempt:

myperm[n_, alike_] := Module[{perms, temp},
  perms = Flatten@{Delete[Range@n, Partition[Flatten@#, 1]], ConstantArray[First@#, Length@#] & /@ #} &@alike // Permutations;
  Do[temp = ConstantArray[0, n]; Do[temp[[perms[[i, j]]]]++; perms[[i, j]] += temp[[perms[[i, j]]]] - 1, {j, n}], {i, Length@perms}];
  perms
]

Are those nested Do[] and that local variable unavoidable?

Answer 1

ClearAll[myPerm]
myPerm[n_, alike_] := Module[{f, keys = First /@ alike,
    perms = Permutations @ 
      ReplaceAll[Alternatives @@ # -> First @ # & /@ alike] @ Range @ n}, 
  Do[f[First @ a] = a, {a, alike}];
  ReplaceAll[Table[With[{k = k}, k :> Last[f[k] = RotateLeft[f[k]]]], {k, keys}]]@perms]

This gives the same list of permutations as OP's myperm. For example,

myPerm[7, {{1, 2, 3}, {5, 6}}] == Sort @ myperm[7, {{1, 2, 3}, {5, 6}}]

True