Re: One Zero variants_without_repetition

[grinder]

oooh, fun!

use strict;
use warnings;

my $zero = shift || 3;
my $one  = shift || 2;

my @array = ( (0) x $zero, (1) x $one );
# print "@array\n";
print join ('', @array), "\n";

while (1) {
    my $cand = $#array;
    while ($cand) {
        if ($array[$cand-1] == 0 and $array[$cand] == 1) {
            ($array[$cand-1], $array[$cand]) = ($array[$cand], $array[
+$cand-1]);
            if ($cand < $#array) {
                @array[$cand+1..$#array] = sort @array[$cand+1..$#arra
+y];
            }
            last;
        }
        --$cand;
    }
    last unless $cand;
    # print "@array\n";
    print join ('', @array), "\n";
}

Converting this to an iterator is left as an exercise to the reader (update:) remarkably trivial :)

sub iter {
    my $zero  = shift || 3;
    my $one   = shift || 2;
    my $init  = 0;
    my @array = ( (0) x $zero, (1) x $one );

    return sub {

        $init++ or return join('', @array);

        my $cand = $#array;
        while ($cand) {
            if ($array[$cand-1] == 0 and $array[$cand] == 1) {
                ($array[$cand-1], $array[$cand]) = ($array[$cand], $ar
+ray[$cand-1]);
                if ($cand < $#array) {
                    @array[$cand+1..$#array] = sort @array[$cand+1..$#
+array];
                }
                last;
            }
            --$cand;
        }
        return $cand ? join( '', @array) : undef;
    }
}

my $i = iter(@ARGV);

while (my $str = $i->()) {
    print "$str\n";
}

update: tye was right (of course!), the sort may be advantageously replaced by a reverse. Furthermore, there is no point in reversing (or sorting) a one-element array...

    $cand < $#array - 1 and
         @array[$cand+1..$#array] = reverse @array[$cand+1..$#array];

[tye]

This looks very similar to Permuting with duplicates and no memory, which makes me suspect that you can probably replace your sort with reverse, which is likely faster.</vague> (:

[thenetfreaker]

Extrordinaly nice, but whay does it do extra checks - crop some results ?
i simply added a counter($inC=0), in the beginning and told it to ++ before --$cand;, and at the end it printed 14 instead of 10, and only ehen i put the $inC++ before the print in the while() it printed 10.
i'm sorry to repeat that i work with hundreds of 1's and 0's, and every false checking costs.

All of your code are wonderful, but unfortunatly i like the second code i posted the most, it only needs to get fixed in the part where it gets the $Oc and $Zc; i would have replaces this while() to a foreach() of an array that contains all the distances between ones and zeroes sets(e.g, in the string 0010111 the distance's array should look like qw(2 1 1 3)), but for that i need to know all the distances variaties( without repetition) from @distances= ($ones, $zeroes) upto @distances= ($zeroes, $ones) when the @distances reach the array of $ones+$zeroes-1 times 1 ( if $ones=2 and $zeroes=3, when @distances=(1,1,1,1,1)) the rest of the @distances are the reverse of the previose sets in reverse:


11000 [2 3]
10100 [1 1 1 2]
10010 [1 2 1 1]
10001 [1 3 1]
10011 [1 2 2]
01010 [0 1 1 1 1]
01001 [0 1 2 1]
00110 [0 2 2 1]
00101 [0 2 1 1 1]
00011 [0 3 2]

[grinder]

Extrordinaly nice, but whay does it do extra checks - crop some results ?

What extra checks? It just hunts through the array, looking for a 0, 1 pair to swap to 1, 0. If it does so, it sorts the tail of the array that it has already walked past so that 0, 1, 1, 0 becomes 1, 0, 0, 1 (instead of 1, 0, 1, 0). The if check is just to avoid sorting empty length sub-arrays.

All of your code are wonderful, but unfortunatly i like the second code i posted the most

Yeah, but if it produces garbage, what's the point? There's no point in hanging onto code that doesn't work. Your problem interests me as an intellectual challenge, but I cannot summon the motivation to debug your code :)

I imagine my code would be very efficient up to several hundred elements. At some point it would become more efficient to examine the tail, count the 0s and 1s, and splice in a newly-constructed tail on the fly, thereby avoiding the sort:

    my ($zero, $one) = (0, 0);
    for my $element (@array[$cand+1..$#array]) {
        $element || ++$zero;
        $element && ++$one;
    }
    @array[$cand+1..$#array] = ((0) x $zero, (1) x $one);

The counting of 0s and 1s is a tad ugly, I admit, but it avoids creating a lexical scope that a classic if/else block would involve.