in reply to Re^2: Spreading out the elements
in thread Spreading out the elements

S'funny, because I had that solution originally, but then I went back and looked closely at your spec. where I found:

interleave(1, 2);

ABB # BAB and BBA are also fine

And given that "BAB is also acceptable" decided that you might prefer the most diffuse spread possible regardless of whether that meant starting with an 'a' or a 'b'.

To restore the behaviour you are after, just comment out the third line of the sub. See the 2a/3b solution below to see that it works: 

#! perl -slw
use strict;

sub interleave {
    my( $a, $b ) = qw[ a b ];
    my( $as, $bs ) = @_;
#    ( $a, $as, $b, $bs ) = ( $b, $bs, $a, $as ) if $as < $bs;
    return $a x $as . $b x $bs unless $as and $bs;

    ++$bs;
    my $aPerB = int( $as / $bs );
    my $aRem = $as - $bs * $aPerB;
    my @as = ( $a x $aPerB ) x $bs;
    my $n = 0;
    $as[ $n ] .= $a, $as[ - ++$n ] .= $a, $aRem -= 2 while $aRem > 1;
    $as[ @as / 2 ] .= $a if $aRem > 0;
    return join $b, @as;
}

our $N ||= 10;
our $S ||= 0;
our $M ||= 10;
srand $S if $S;

for ( 13 .. 19 ) {
    my( $na, $nb ) = ( $_, 4 );
    my $s = interleave( $na, $nb );
    my( $as, $bs ) = ( $s =~ tr[a][], $s =~ tr[b][] );
    printf "%2da %2db: %s\n", $na, $nb, $s;
    die "$na != $as or $nb != $bs\n" unless $na == $as and $nb == $bs;
}

print "\n-----------\n";

for ( 1 .. $N ) {
    my( $na, $nb ) = map{ int rand $M } 1 .. 2;
    my $s = interleave( $na, $nb );
    my( $as, $bs ) = ( $s =~ tr[a][], $s =~ tr[b][] );
    printf "%2da %2db: %s\n", $na, $nb, $s;
    die "$na != $as or $nb != $bs\n" unless $na == $as and $nb == $bs;
}


__END__
C:\test>624887 -S=2 -N=20
13a  4b: aaabaabaaabaabaaa
14a  4b: aaabaaabaabaaabaaa
15a  4b: aaabaaabaaabaaabaaa
16a  4b: aaabaaabaaaabaaabaaa
17a  4b: aaaabaaabaaabaaabaaaa
18a  4b: aaaabaaabaaaabaaabaaaa
19a  4b: aaaabaaaabaaabaaaabaaaa

-----------

 0a  8b: bbbbbbbb
 7a  5b: abababaababa
 8a  5b: aabababababaa
 4a  8b: ababbbbbbaba
 3a  5b: abbbabba
 1a  8b: bbbbabbbb
 3a  0b: aaa
 9a  5b: aabababaababaa
 9a  9b: ababababbababababa
 2a  8b: abbbbbbbba
 3a  9b: abbbbbabbbba
 5a  2b: aababaa
 4a  7b: ababbbbbaba
 1a  0b: a
 9a  2b: aaabaaabaaa
 2a  3b: abbba
 8a  1b: aaaabaaaa
 5a  5b: ababbababa
 8a  2b: aaabaabaaa
 6a  5b: abababababa

[download]

You could also substitute 'a' for $a and 'b' for $b in the sub and remove the first line.

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.
"Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."

Replies are listed 'Best First'.
Re^4: Spreading out the elements
by oko1 (Deacon) on Jul 05, 2007 at 03:28 UTC 
        interleave(1, 2);

    ABB # BAB and BBA are also fine

    [download]
    [...] given that "BAB is also acceptable" decided that you might prefer the most diffuse spread possible regardless of whether that meant starting with an 'a' or a 'b'.

    My fault; I should have made it clear that it was an edge case. However... even with the changes you've suggested, I get this: 

    print interleave(4, 5);
ababbbaba
print interleave(4, 7);
ababbbbbaba

    [download]

    This should be more like 

    print interleave(4, 5);
abbabbaba
print interleave(4, 7);
abbbabbabba

    [download]
    This version provides the maximum distance possible between all 'a's.
[reply]
[d/l]
[select]

      Ah, shame! That destroys the symmetry I was exploiting and so requires two lots of not quite identical code :( 

      sub interleave {
    my( $a, $b ) = qw[ a b ];
    my( $as, $bs ) = @_;
    return $a x $as . $b x $bs unless $as >1 and $bs;

    if( $as > $bs ) {
        ++$bs;
        my $aPerB = int( $as / $bs );
        my $aRem = $as - $bs * $aPerB;
        my @as = ( $a x $aPerB ) x $bs;
        my $n = 0;
        $as[ $n ] .= $a, $as[ - ++$n ] .= $a, $aRem -= 2 while $aRem >
+ 1;
        $as[ @as / 2 ] .= $a if $aRem > 0;
        return join $b, @as;
    }
    else {
        --$as;
        my $bPerA = int( $bs / $as );
        my $bRem = $bs - $as * $bPerA;
        my @bs = ( $b x $bPerA ) x $as;
        my $n = 0;
        $bs[ $n ] .= $b, $bs[ - ++$n ] .= $b, $bRem -= 2 while $bRem >
+ 1;
        $bs[ @bs / 2 ] .= $b if $bRem > 0;
        return $a . join( $a, @bs ) . $a;
    }
}
__END__
C:\test>624887 -S=1 -N=50
 4a  5b: abbababba
 4a  7b: abbabbbabba

-----------

 4a 13b: abbbbabbbbbabbbba
 4a 14b: abbbbbabbbbabbbbba
 4a 15b: abbbbbabbbbbabbbbba
 4a 16b: abbbbbabbbbbbabbbbba
 4a 17b: abbbbbbabbbbbabbbbbba
 4a 18b: abbbbbbabbbbbbabbbbbba
 4a 19b: abbbbbbabbbbbbbabbbbbba

-----------

13a  4b: aaabaabaaabaabaaa
14a  4b: aaabaaabaabaaabaaa
15a  4b: aaabaaabaaabaaabaaa
16a  4b: aaabaaabaaaabaaabaaa
17a  4b: aaaabaaabaaabaaabaaaa
18a  4b: aaaabaaabaaaabaaabaaaa
19a  4b: aaaabaaaabaaabaaaabaaaa

-----------

      [download]
      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]
        > Ah, shame! That destroys the symmetry I was exploiting and so requires two lots of not quite identical code :(

        Oh, but it's _beautiful_ in terms of function. :) I'm not going to put it up on my wall, but I'll certainly keep it around in my "nifty and useful Perl stuff" folder; I'm sure it'll come in handy in the future. Heck, I'm about to use it right now to sort a bunch of domains for "whois" queries - .orgs need a 20-second delay between checks (otherwise they get rate-limited), so I'm going to "spread" the .orgs among all the other types and reduce the wait. Thanks again!

[reply]

In Section Seekers of Perl Wisdom