in reply to combinations of given string

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]
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.

Replies are listed 'Best First'.
Re^2: combinations of given string
by Athanasius (Archbishop) on Oct 26, 2013 at 07:28 UTC
    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,

[reply]
[d/l]
[select]
      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.
[reply]
[d/l]
        If you're really bored, you might try to resolve the table at the end -- characters down; wildcards across -- to a formula.

        For c characters and w wildcards, the number of different combinations is (c + w)! / c! w!:

        Read more... (2 kB)

        Conclusion: apparently I was really bored. :-)

        Athanasius <°(((>< contra mundum Iustus alius egestas vitae, eros Piratica,

[reply]
[d/l]
[select]
Re^2: combinations of given string
by Anonymous Monk on Oct 26, 2013 at 06:12 UTC

    thanks for the code

    can you please add comments or give pseudo code

[reply]

      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.
[reply]
[d/l]

In Section Seekers of Perl Wisdom