Problem with permutations

Question

For a given binary array like {0, 1, 1, 0,..}, I need to find the shortest permutation, sorting it in standard order {0,0,...,1,1,..}.
There is a warning in documentations for FindPermutation:

For expressions containing repeated parts, the permutation is not uniquely defined

And it's easily to find the next example:

  data = {1, 1, 0};
  FindPermutation[data, Sort@data]
  (*Don't confuse it with FindPermutation@data,
  it's not the same!*)
 Output: Cycles[{{1, 2, 3}}]
(*Also:*)
PermutationCycles@Ordering@data
Output: Cycles[{{1, 3, 2}}]

But:

 Permute[data, Cycles[{{1, 3}}]]
    Output: {0, 1, 1}

So FindPermutation produces not shortest result. And how to find shortest not manually?
Is it possible to find all that produce the same result?

Answer 1

The only direct method that I've found is (without useless FindPermutation) :

data = {0, 1, 1, 1, 0, 0};
perms = Permutations@Range@Length@data;
res = MinimalBy[Select[perms, data[[#]] == Sort@data &], 
  PermutationOrder]

Output: {{1, 5, 6, 4, 2, 3}, {1, 6, 5, 4, 3, 2}}

This code guarantees shortest length of permutations that produce sorted data.
Shorter and smarter result is very welcome!