Perhaps the following will be helpful:

use strict;
use warnings;

my $chars = 'ABC---';

my %seen;
my @letters = grep /[a-z]/i, split '', $chars;
my $regex = join '.*', @letters;
my $string = ( '{' . ( join ',', split '', $chars ) . '}' ) x length $
+chars;

print "$_\n"
  for grep { /$regex/ and !$seen{$_}++ and @{ [/[a-z]/ig] } == @letter
+s }
  glob $string;
[download]

Output:

ABC---
AB-C--
AB--C-
AB---C
A-BC--
A-B-C-
A-B--C
A--BC-
A--B-C
A---BC
-ABC--
-AB-C-
-AB--C
-A-BC-
-A-B-C
-A--BC
--ABC-
--AB-C
--A-BC
---ABC
[download]

This 'brute force' approach uses glob to generate all possible combinations of the characters. Each combination is grepped for the order of characters (/$regex/), whether it's already been seen (!$seen{$_}++) and for the correct number of letters (@{ [/[a-z]/ig] } == @letters).

I can't (yet) work out how to code _next() in Perl.

#! perl -slw
use strict; 
use Inline C => Config => BUILD_NOISY => 1;
use Inline C => <<'END_C',  NAME => '_1059792', CLEAN_AFTER_BUILD =>0;

unsigned int _next( unsigned int v ) {
    unsigned int t = (v | (v - 1)) + 1;
    unsigned int w = t | ((((t & -t) / (v & -v)) >> 1) - 1);
    return w;
}

END_C

sub permIt {
    my $l = @_;
    my @chars = grep $_ ne '-', @_;
    my $n = my $s = ( 1 << @chars ) -1;
    do {
        my $bits = pack 'V', $n;
        my @copy = @chars;
        my $str = join '', map{
            vec( $bits, $_, 1 ) ? shift( @copy ) : '-'
        } 0 .. $l-1;
        print $str;
        $n = _next( $n );
    } until( $n > ( $s << ( $l - @chars ) ) );
}

permIt( split '', 'ABC---' );;

__END__
ABC---
AB-C--
A-BC--
-ABC--
AB--C-
A-B-C-
-AB-C-
A--BC-
-A-BC-
--ABC-
AB---C
A-B--C
-AB--C
A--B-C
-A-B-C
--AB-C
A---BC
-A--BC
--A-BC
---ABC
[download]

I can't (yet) work out how to code _next() in Perl.

I like a challenge, but my first try — a one-for-one translation from C into Perl — seems to work fine:

Read more... (1475 Bytes)

What am I missing?

Athanasius <°(((>< contra mundum

Iustus alius egestas vitae, eros Piratica,

What am I missing?

Nothing it seems.

I had two attempts at converting that C to Perl -- actually a couple of weeks back for one of my 6 attempts at Challenge: 8 Letters, Most Words -- and they both failed to produce the correct results. I assumed at the time that it was because Perl doesn't allow me to type the numbers as unsigned and thus perl was transitioning the bit patterns through some signed/unsigned conversions somewhere and that was the cause of the failure. I didn't investigate further.

Seems I was wrong and must have coded something incorrectly -- perhaps I didn't include enough parens and fell foul of a precedence error or some such. I didn't keep the code so I don't know for sure.

Anywho, your conversion works perfectly and still allows this to process 26 chars with 6 wildcards (nearly 1 million iterations) in ~20 seconds and 1.6 MB of ram:

#! perl -slw
use strict;
sub _next {
    my ($v) =  @_;
    my  $t  = ($v | ($v - 1)) + 1;
    return ($t | (((($t & -$t) / ($v & -$v)) >> 1) - 1));
}

sub permIt {
    my $l = @_;
    my @chars = grep $_ ne '-', @_;
    my $n = my $s = ( 1 << @chars ) -1;
    return sub {
        return undef if $n > ( $s << ( $l - @chars ) );
        my $bits = pack 'Q', $n;
        my @copy = @chars;
        my $str = join '', map{
            vec( $bits, $_, 1 ) ? shift( @copy ) : '-'
        } 0 .. $l-1;
        $n = _next( $n );
        return $str;
    };
}

my $iter = permIt( split '', $ARGV[0] );
#print $_  while defined( $_ = $iter->() );
#__END__
my $n = 0;
printf "\r%d\t", ++$n while defined( $_ = $iter->() );
print $n;

__END__
C:\test>1059792 ABCDEFGHIJKLMNOPQRSTUVWXYZ------
906192  906192


  | 1| 2|  3|   4|   5|   6|    7|    8|    9|
 -+--+--+---+----+----+----+-----+-----+-----+
 1| 2| 3|  4|   5|   6|   7|    8|    9|   10|
 2| 3| 6| 10|  15|  21|  28|   36|   45|   55|
 3| 4|10| 20|  35|  56|  84|  120|  165|  220|
 4| 5|15| 35|  70| 126| 210|  330|  495|  715|
 5| 6|21| 56| 126| 252| 462|  792| 1281| 2002|
 6| 7|28| 84| 210| 462| 929| 1716| 3003| 5005|
 7| 8|36|120| 330| 792|1716| 3432| 6435|11440|
 8| 9|45|165| 495|1287|3003| 6435|12870|24310|
 9|10|55|220| 715|2002|5005|11440|24310|48620|
10|11|66|286|1001|3003|8008|19448|43758|92378|
[download]

If you're really bored, you might try to resolve the table at the end -- characters down; wildcards across -- to a formula.

It looks related to Fibonacci; but its eluding my grey matter at the moment.

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

thanks for the code

can you please add comments or give pseudo code

Given a bit pattern with n-bits set (eg. 0x7 == 0b111000), _next() produces the next number that contains that same number of bits sets. (eg. 0b110100 ). And when you pass that value in it produces the next (eg. 0b101100 ); and so on.

[0] Perl> $n = 0x7; print unpack 'b6', pack 'V', $n while ( $n = _next
+( $n ) ) < ( 0x7 << 3 );;
110100
101100
011100
110010
101010
011010
100110
010110
001110
110001
101001
011001
100101
010101
001101
100011
010011
001011
[download]

Thus, replacing 1s with successive characters from the input charset, and 0s with '-', results in the required output.

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

You also need a recursive solution that creates all combinations directly without the need of filtering duplicates:

use strict;
use warnings;

my $input  = 'ABC---';

sub insert {
  my( $sofar, $chars, $dashes ) = @_;
  print "$sofar\n" and return unless @$chars or @$dashes;
  insert( $sofar . $$chars[0],  [ @$chars[ 1..@$chars-1] ],   [ @$dash
+es ] ) if @$chars;
  insert( $sofar . $$dashes[0], [ @$chars ], [ @$dashes[ 1..@$dashes-1
+ ] ] ) if @$dashes;
}

insert( '', [ $input =~ /[^-]/g ], [ $input =~ /-/g ] );
[download]

UPDATE: operating on strings rather than arrays is even simpler:

use strict;
use warnings;

my $input  = 'ABC---';

sub insert {
  my( $sofar, $chars, $dashes ) = @_;
  print "$sofar\n" and return unless $chars or $dashes;
  insert( $sofar . substr( $chars, 0, 1),  substr( $chars, 1 ), $dashe
+s ) if $chars;
  insert( $sofar . substr( $dashes, 0, 1), $chars, substr( $dashes, 1)
+  ) if $dashes;
}

insert( '', $1, $2 ) if $input =~ /^([^-]+)(-+)$/;
[download]

update

simplified code

update

Formula: be s_1,s_2,...s_n the size of n sets in @sets, the number of combinations is then

 fac( sum( s_i)  )
-------------------
 prod ( fac (s_i) )
[download]

or

( Σ si ) ! 
---------- 
  Π (si!)

Another approach:

my $str = 'ABC---';
my $dash = $str =~ tr/-//d;
my %combo = ($str => 1);

%combo = map {
    my $x = $_;
    map {$x =~ s/.{$_}\K/-/r, 1} 0..length;
} keys %combo for 1..$dash;

say for reverse sort keys %combo;

__END__
ABC---
AB-C--
AB--C-
AB---C
A-BC--
A-B-C-
A-B--C
A--BC-
A--B-C
A---BC
-ABC--
-AB-C-
-AB--C
-A-BC-
-A-B-C
-A--BC
--ABC-
--AB-C
--A-BC
---ABC
[download]

#!/usr/bin/perl
use strict;
use warnings;
use Algorithm::Combinatorics qw/combinations/;

my $input  = 'ABC---';

my $dashes = $input =~ tr/-//;
my @letters = $input =~ /[A-Z]/g;

my @positions = 0 .. ($dashes + @letters)-1;
my @idx = combinations(\@positions, scalar @letters);

for my $indices (@idx) {
    my @comb = ('-') x ($dashes + @letters);
    @comb[@$indices] = @letters;
    print @comb, "\n";
}
[download]