Generate all permutations of a string containing repeated characters

Question

I was writing a program to print all the permutations of a string. I came up with the following:

void permute(string s,string r){
    if(s.length()==0){
        cout<<r<<endl;
        return;
    }
    for(int i=0;i<s.length();i++){
        permute(s.substr(0,i)+s.substr(i+1,s.length()-i-1),r+s[i]);
    }
}

However, this prints duplicates in case the string has repeated characters. Can anyone please help me figure out a way to avoid duplicates (not using a set, of course)?

Answer 1

We build the permutation from consecutive blocks of equal values.

The trick here is to group the output in blocks of repeated equal values and ensure that when a block is being followed by another the second block is certain to repeat a different value than the first one. This removes the ambiguity that would arise if the permutation were being built one item at a time.

This is the Perl code.

#! /usr/bin/perl -w
#

sub permute {
    my ($avail, $prev, $sofar, $pos, $n) = @_;

    if($pos == $n){
        print(join('-', @$sofar) . "\n");
        return;
    }

    my @possibles = keys %$avail;
    foreach my $item (@possibles){
        if(!($item eq $prev)){
            for(my $len = 1; $len <= $avail->{$item}; $len++){
                $avail->{$item} -= $len;
                delete $avail->{$item} if $avail->{$item} == 0;
                push @$sofar, ($item) x $len;

                permute($avail, $item, $sofar, $pos+$len, $n);

                splice @$sofar, $pos, $len;
                $avail->{$item} += $len;
            }
        }
    }
}

 MAIN: {
     my $str = shift || 'ABCD';
     my @chars = split //, $str;

     my %multiset;
     map { $multiset{$_}++ } @chars;

     permute(\%multiset, 'VOID', [], 
            0, scalar(@chars));
}

Here are some sample runs.

$ time ./permute.pl 1234
4-1-3-2
4-1-2-3
4-3-1-2
4-3-2-1
4-2-1-3
4-2-3-1
1-4-3-2
1-4-2-3
1-3-4-2
1-3-2-4
1-2-4-3
1-2-3-4
3-1-4-2
3-1-2-4
3-4-1-2
3-4-2-1
3-2-4-1
3-2-1-4
2-1-4-3
2-1-3-4
2-4-1-3
2-4-3-1
2-3-4-1
2-3-1-4

real    0m0.071s
user    0m0.015s
sys     0m0.031s

$ time ./permute.pl abab
a-b-a-b
a-b-b-a
a-a-b-b
b-a-b-a
b-a-a-b
b-b-a-a

real    0m0.061s
user    0m0.000s
sys     0m0.046s

$ time ./permute.pl xabab
a-b-a-b-x
a-b-a-x-b
a-b-x-a-b
a-b-x-b-a
a-b-b-a-x
a-b-b-x-a
a-x-a-b-b
a-x-b-a-b
a-x-b-b-a
a-a-b-x-b
a-a-b-b-x
a-a-x-b-b
b-a-b-a-x
b-a-b-x-a
b-a-x-a-b
b-a-x-b-a
b-a-a-b-x
b-a-a-x-b
b-x-a-b-a
b-x-a-a-b
b-x-b-a-a
b-b-a-x-a
b-b-a-a-x
b-b-x-a-a
x-a-b-a-b
x-a-b-b-a
x-a-a-b-b
x-b-a-b-a
x-b-a-a-b
x-b-b-a-a

real    0m0.063s
user    0m0.030s
sys     0m0.030s

$ time ./permute.pl xyxyxy
y-x-y-x-y-x
y-x-y-x-x-y
y-x-y-y-x-x
y-x-x-y-x-y
y-x-x-y-y-x
y-x-x-x-y-y
y-y-x-y-x-x
y-y-x-x-y-x
y-y-x-x-x-y
y-y-y-x-x-x
x-y-x-y-x-y
x-y-x-y-y-x
x-y-x-x-y-y
x-y-y-x-y-x
x-y-y-x-x-y
x-y-y-y-x-x
x-x-y-x-y-y
x-x-y-y-x-y
x-x-y-y-y-x
x-x-x-y-y-y

real    0m0.054s
user    0m0.000s
sys     0m0.061s

Addendum. I just realized that the OP probably does not admit this solution because it uses a multiset stored in a hash table. However the hash table can be removed and replaced with a sorted list being spliced to extract the blocks. That would seem to mean that the basic idea of the algorithm is sound.

Addendum II. Here is an implementation that only uses arrays and no hash tables, which is not as fast as the first one. This should be sufficient as a building block for a C implementation, one just needs to optimize that array splicing that takes place.

#! /usr/bin/perl -w
#

sub permute {
    my ($avail, $prev, $sofar, $pos, $n) = @_;

    if($pos == $n){
        print(join('-', @$sofar) . "\n");
        return;
    }

    my $avails = scalar(@$avail); my $ind = 0;
    while($ind < $avails){
        my $item = $avail->[$ind];

        my $run = 1;
        while($ind+$run < $avails &&
              $avail->[$ind+$run] eq $item){
            $run++;
        }


        if(!($item eq $prev)){
            for(my $len = 1; $len <= $run; $len++){
                push @$sofar, ($item) x $len;
                splice @$avail, $ind, $len;

                permute($avail, $item, $sofar, $pos+$len, $n);

                splice @$avail, $ind, 0, ($item) x $len;
                splice @$sofar, $pos, $len;
            }
        }

        $ind += $run;
    }
}

 MAIN: {
     my $str = shift || 'ABCD';
     my @chars = split //, $str;

     my @sorted = sort @chars;

     permute(\@sorted, 'VOID', [], 
            0, scalar(@chars));
}