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

> Fun problem++

Thanks! :) I was hoping that others would find it so; I did, even though I didn't manage to wrestle it to the ground myself.

Something's off with your solution, though: since the 'a's are supposed to be spread out as much as possible, the majority of the second list fails the test (e.g., 'babab' should have been 'abbba'.)

Replies are listed 'Best First'.
Re^3: Spreading out the elements
by BrowserUk (Patriarch) on Jul 05, 2007 at 02:11 UTC

    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

    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.
      interleave(1, 2); ABB # BAB and BBA are also fine
      [...] 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

      This should be more like

      print interleave(4, 5); abbabbaba print interleave(4, 7); abbbabbabba
      This version provides the maximum distance possible between all 'a's.

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

        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.