And as such, has been implemented in Algorithm::Line::Bresenham. So there ya go!

Unfortunately, it turns out that the Bresenham algorithm isn't exactly the right thing - or I've misconscrewed something. Here's my implementation of it, with extra code to detect the crossings; it does a reasonable distribution of the two arrays, but doesn't quite follow the rules that I originally stated:

#!/usr/bin/perl -w
# Created by Ben Okopnik on Wed Jul  4 13:39:28 EDT 2007

# Modified and converted to code from Wikipedia entry for "Bresenham"
sub brezzie {
    my ($x1, $y1) = @_;
    ($x1, $y1) = ($y1, $x1) if $y1 > $x1;

    my ($deltax, $deltay) = ($x1, $y1);
    my $error = -$deltax / 2;

    my $y = 0;
    my ($last_a, $last_b) = (0, 0);

    for my $x (0 .. $x1){
        # print $steep ? "$y $x\n" : "$x $y\n";
        if ($y1 > $x1){ 
            ($b, $a) = ($x, $y);
        }
        else {
            ($a, $b) = ($y, $x);
        }

        print "A" if $a > $last_a;
        print "B" if $b > $last_b;

        ($last_a, $last_b) = ($a, $b);

        $error += $deltay;

        if ($error > 0){
            $y = $y + 1;
            $error -= $deltax;
        }
    }
}

brezzie(4, 14);
[download]

Running this results in 'BABBBBABBBABBBBABB' - and what I'm looking for is more like 'ABBBBBABBBBABBBBBA'. Max distance is not quite the same thing as a fair distribution.

I really appreciate the help that you've given me so far!

I think this is what merlyn means:

perl -MAlgorithm::Line::Bresenham=line -le'($A,$B)=@ARGV;@p=map{$_->[0
+]}line($A,1,1,$B);$l=$p[1];for(1..$B){if($p[$_]==$l){push@a,"A"}else{
+push@a,"B";$l=$p[$_]}}print$_ for@a' 10 40
[download]

Sorry, made it on the command line, can't be bothered to reformat it. The idea is to use ($A, 1) for the start point, (1, $B) for the end point, then pluck out the x values (projection of line onto x-axis, if that makes sense) from the list returned by line. The x values will sometimes stay the same, sometimes increase; you're interested in where it increases, that's where the Bs get plopped in.

I don't think that you'll generally have the exact right number of each element, just that you'll get a roughly even distribution of elements, given a certain ratio of A and B. Quickly experimenting about, I found that it breaks a little when the 1st number approaches the 2nd one (try 990 and 1000, for example, there will be 989 Bs instead of 990)

Assumes: two integer args on command line, the first would be your number of Bs, the second the total number of A + B.

It doesn't do things you wanted like endpoints always are A. For that, just subtract 2 from 2nd arg, and print out A at the beginning and end.

I'll go check out the code and see if I can figure out the 'how'. Thank you, Randal!

use strict;
use warnings;

use Test::More;
use POSIX;

my @TESTS
    = (
       [(0, 0)  => undef],
       [(0, 1)  => undef],
       [(1, 0)  => undef],
       [(1, 1)  => 'AB'],
       [(2, 1)  => 'ABA'],
       [(3, 1)  => { map {$_=>1} qw(ABAA AABA)}],
       [(4, 1)  => { map {$_=>1} qw(ABAAA AABAA AAABA)}],
       [(1, 2)  => { map {$_=>1} qw(ABB BBA BAB)}],
       [(2, 2)  => 'ABBA'],
       [(7, 6)  => 'ABABABABABABA'],
       [(3, 3)  => { map {$_=>1} qw(ABBABA ABABBA)}],
       [(4, 14) => { map {$_=>1} qw(
                                    ABBBBABBBBBABBBBBA
                                    ABBBBBABBBBABBBBBA
                                    ABBBBBABBBBBABBBBA
                                    )}],
       );
plan tests => scalar @TESTS;

for my $test (@TESTS) {

    my $skewer;
    my ($n_a, $n_b, $expected) = @$test;

    eval {
        $skewer = interleave( $n_a, $n_b );
    };
    if ($@) {
        ok(
           !defined( $expected ),
           "($n_a, $n_b) => undef"
           );
        next;
    }
    if (ref $expected) {
        ok(
           exists $expected->{ $skewer },
           "($n_a, $n_b) => $skewer"
           );
    }
    else {
        ok(
           $expected eq $skewer,
           "($n_a, $n_b) => $skewer"
           );
    }
}
exit( 0 );

##-------------------------------------------------------------------+
sub interleave {
    my ($n_a, $n_b) = @_;

    if ($n_a < 1 or $n_b < 1) {
        die "Bad args to interleave: ($n_a, $n_b)";
    }
    if ($n_a == 1) {
        return 'A' . 'B' x $n_b;
    }
    my $min_b = floor( $n_b / ($n_a - 1) );
    my $leftover_b = $n_b - $min_b * ($n_a - 1);
    ##warn "($n_a, $n_b) => min_b:$min_b, lefto:$leftover_b";

    my $skewer = 'A';
    for (1..$leftover_b) {
        $skewer .= 'B' x ($min_b + 1);
        $skewer .= 'A';
    }
    for ($leftover_b + 1 .. $n_a - 1) {
        $skewer .= 'B' x $min_b;
        $skewer .= 'A';
    }
    ##warn "returning ($n_a, $n_b) => $skewer";

    return $skewer;
}
[download]

1..12
ok 1 - (0, 0) => undef
ok 2 - (0, 1) => undef
ok 3 - (1, 0) => undef
ok 4 - (1, 1) => AB
ok 5 - (2, 1) => ABA
ok 6 - (3, 1) => ABAA
ok 7 - (4, 1) => ABAAA
ok 8 - (1, 2) => ABB
ok 9 - (2, 2) => ABBA
ok 10 - (7, 6) => ABABABABABABA
ok 11 - (3, 3) => ABBABA
ok 12 - (4, 14) => ABBBBBABBBBBABBBBA
[download]

1..12
ok 1 - (0, 0) => undef                # Growing up in Sweden
ok 2 - (0, 1) => undef
ok 3 - (1, 0) => undef
ok 4 - (1, 1) => AB                   # The early years
ok 5 - (2, 1) => ABA                  # still experimental
ok 6 - (3, 1) => ABAA
ok 7 - (4, 1) => ABAAA                # Eurovision
ok 8 - (1, 2) => ABB                  # Waterloo, Mama Mia 
ok 9 - (2, 2) => ABBA                 # Dancing Queen
ok 10 - (7, 6) => ABABABABABABA    
ok 11 - (3, 3) => ABBABA              # All falls apart 
ok 12 - (4, 14) => ABBBBBABBBBBABBBBA # Tribute bands abound
[download]

[applause]

Way too cool. :) Thank you!

Did you use some existing algorithm, or did you come up with this on your own? Kudos either way, but I'm really curious.

There isn't much of an algorithm, really. There are n_a-1 slots into which the B's will go. In the general case, some slots will have

floor( n_b / (n_a-1) )

B's and others will have one more. Still, it took me more than an hour from start to finish. Cheers.

interleave()

  choose a "pretty layout" method, e.g.

  More than one A?
  Y: remove two 'A' from pool
     return 'A' . interleave() . 'A'

  More than one B?
  Y: remove two 'B' from pool
     return 'B' . interleave() . 'B'

  one 'A'?
  Y: remove 'A' from pool
     return 'A'

  remove 'B' from pool
  return 'B'
[download]

...roboticus

I'm sorry, I seem to be missing your point. Are you saying something like this?

sub recurse {
  if (grep /A/, @a > 1){ my @c = splice @a, 0, 2; splice @c, 1, 0, (@a
+, @b); }
  if (grep /B/, @b > 1){ my @c = splice @b, 0, 2; splice @c, 1, 0, (@a
+, @b); }
  if (grep /A/, @a == 1){ shift @a; }
  if (grep /B/, @b == 1){ shift @b; }
}
[download]

If so, how would you call it and how would you terminate it?

Here's a simple implementation of the suggested recursive algorithm. Note that you don't really need the arrays, so I'm just using a count of how many of each letter are left:

#!/usr/bin/perl

use strict;

print_interleave(1,1);
print_interleave(2,1);
print_interleave(1,2);
print_interleave(2,2);
print_interleave(3,3);
print_interleave(4,14);
print_interleave(7,4);

sub print_interleave {
  my ($total_a, $total_b) = @_;
  print '(', $total_a, ', ', $total_b, ")\t";
  print interleave($total_a, $total_b), "\n";
}

sub interleave {
  my ($remaining_a, $remaining_b) = @_;
  if ($remaining_a > 1) {
    return 'A' . interleave($remaining_a - 2, $remaining_b) . 'A';
  } elsif ($remaining_b > 1) {
    return 'B' . interleave($remaining_a, $remaining_b - 2) . 'B';
  } elsif ($remaining_a == 1) {
    return 'A';
  } elsif ($remaining_b == 1) {
    return 'B';
  } else {
    return ''; # Just for completeness
  }
}
[download]

Unfortunately, it doesn't produce the correct results:

(1, 1)  A
(2, 1)  ABA
(1, 2)  BAB
(2, 2)  ABBA
(3, 3)  ABABA
(4, 14) AABBBBBBBBBBBBBBAA
(7, 4)  AAABBABBAAA
[download]

As for how to terminate it, every time interleave() calls itself, it reduces either $remaining_a or $remaining_b. One of them will eventually reach 0 and terminate that branch of the recursion. Since nothing in interleave() ever increases them, all branches will terminate.

UPDATE: Replacing the above interleave() with this interleave2()

sub interleave2 {
  my ($remaining_a, $remaining_b) = @_;
  if ($remaining_a > 1 && $remaining_b) {
    my $b_range = int($remaining_b/($remaining_a - 1));
    return 'A' . 'B' x $b_range . interleave2($remaining_a - 1, $remai
+ning_b - $b_range);
  } elsif ($remaining_a) {
    return 'A' . interleave2($remaining_a - 1, $remaining_b);
  } elsif ($remaining_b) {
    return 'B' . interleave2($remaining_a, $remaining_b - 1);
  } else {
    return ''; # Just for completeness
  }
}
[download]

appears to produce correct results:

(1, 1)  AB
(2, 1)  ABA
(1, 2)  ABB
(2, 2)  ABBA
(3, 3)  ABABBA
(4, 14) ABBBBABBBBBABBBBBA
(7, 4)  AAABABABABA
[download]

Fun problem++

Update: The original guard condition was a holdover.

Update2: Noticed that all 3 used of $bs (after the guard) were +1, so increment instead.

#! 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__
13a  4b: aaabaabaaabaabaaa
14a  4b: aaabaaabaabaaabaaa
15a  4b: aaabaaabaaabaaabaaa
16a  4b: aaabaaabaaaabaaabaaa
17a  4b: aaaabaaabaaabaaabaaaa
18a  4b: aaaabaaabaaaabaaabaaaa
19a  4b: aaaabaaaabaaabaaaabaaaa

-----------

 0a 11b: bbbbbbbbbbb
 3a 16b: bbbbabbbbabbbbabbbb
11a  9b: abababababaababababa
 7a 17b: bbabbabbabbabbbabbabbabb
16a 14b: abababababababaabababababababa
 3a 17b: bbbbabbbbabbbbbabbbb
14a 10b: aabababababaabababababaa
 6a  0b: aaaaaa
 1a  7b: bbbabbbb
 2a  3b: babab
19a  8b: aabaabaabaabaaabaabaabaabaa
 2a  0b: aa
 0a  7b: bbbbbbb
10a 11b: babababababababababab
12a 12b: ababababababbabababababa
 3a 13b: bbbabbbabbbbabbb
 9a  7b: ababababaabababa
 1a 12b: bbbbbbabbbbbb
15a 16b: bababababababababababababababab
10a  6b: aabababaabababaa
[download]

> 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'.)

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

It just struck me that this is (the same as) a fixed font text justification algorithm where the As are the words, and the Bs, the number of (extra) spaces to be distributed between the words to make up the line length.

Update: A crude example:

#! perl -slw
use strict;

our $WIDTH ||= 80;

my $buffer = '';
while( <DATA> ) {
    $buffer .= $_;
    $buffer =~ s[\s+][ ]g;
    $buffer =~ s[\. ][.  ]g;
    next unless eof( DATA ) or length( $buffer ) >= $WIDTH;
    while( length $buffer > $WIDTH ) {
        my $line = substr $buffer, 0, 1+rindex( $buffer, ' ', $WIDTH-1
+ )||-1,'';
        my $fill = $WIDTH - length $line;
        my $spaces = $line =~ m[(\s+)(?!$)]g;
        $fill = 0 unless $spaces;
        my $n = int $spaces / 2;
        while( $fill > 0 ) {
            $line =~ s[((?:\s+?\S+){$n})(?<=\S)(\s+)(?=\S)][
                $1 . $2 . ($fill-- > 0 ?  ' ' : '')
            ]ge;
            $n /= 2;
        }
        print $line;
#        printf "%-${WIDTH}s\t\t%d : %d\n", $line, length $line, lengt
+h( $buffer );
    }
}
print $buffer if length $buffer;;
#printf "%-${WIDTH}s\t\t%d : %d\n", $buffer, 0, length( $buffer );

__DATA__
Pickering is seated at the table, putting down some cards and a
tuning-fork which he has been using. Higgins is standing up near
him, closing two or three file drawers which are hanging out. He
appears in the morning light as a robust, vital, appetizing sort
of man of forty or thereabouts, dressed in a professional-looking
black frock-coat with a white linen collar and black silk tie. He
is of the energetic, scientific type, heartily, even violently
interested in everything that can be studied as a scientific
subject, and careless about himself and other people, including
their feelings. He is, in fact, but for his years and size,
rather like a very impetuous baby "taking notice" eagerly and
loudly, and requiring almost as much watching to keep him out of
unintended mischief. His manner varies from genial bullying when
he is in a good humor to stormy petulance when anything goes
wrong; but he is so entirely frank and void of malice that he
remains likeable even in his least reasonable moments.
[download]

C:\test>junk5 -WIDTH=80
Pickering  is  seated  at  the table, putting down some cards and a tu
+ning-fork
which he has been using.  Higgins is standing up near him, closing two
+ or three
file  drawers  which  are  hanging  out.   He appears in the morning l
+ight as a
robust,  vital,  appetizing  sort  of man of forty or thereabouts, dre
+ssed in a
professional-looking  black frock-coat with a white linen collar and b
+lack silk
tie.   He  is  of  the  energetic,  scientific  type,  heartily, even 
+violently
interested  in  everything  that  can  be  studied as a scientific sub
+ject, and
careless  about  himself and other people, including their feelings.  
+He is, in
fact,  but  for  his  years and size, rather like a very impetuous bab
+y "taking
notice"  eagerly  and loudly, and requiring almost as much watching to
+ keep him
out  of unintended mischief.  His manner varies from genial bullying w
+hen he is
in  a  good  humor  to  stormy petulance when anything goes wrong; but
+ he is so
entirely  frank  and  void of malice that he remains likeable even in 
+his least
reasonable moments.

C:\test>junk5 -WIDTH=60
Pickering  is  seated at the table, putting down some cards
and  a  tuning-fork  which  he  has been using.  Higgins is
standing  up  near  him,  closing two or three file drawers
which  are hanging out.  He appears in the morning light as
a  robust,  vital,  appetizing  sort  of  man  of  forty or
thereabouts,   dressed   in  a  professional-looking  black
frock-coat  with  a white linen collar and black silk tie.
He  is  of  the  energetic, scientific type, heartily, even
violently interested in everything that can be studied as a
scientific  subject,  and  careless about himself and other
people,  including their feelings.  He is, in fact, but for
his  years  and  size,  rather  like  a very impetuous baby
"taking notice" eagerly and loudly, and requiring almost as
much  watching to keep him out of unintended mischief.  His
manner  varies  from  genial  bullying when he is in a good
humor  to stormy petulance when anything goes wrong; but he
is  so  entirely  frank  and void of malice that he remains
likeable even in his least reasonable moments.

C:\test>junk5 -WIDTH=40
Pickering   is  seated  at  the  table,
putting   down   some   cards   and   a
tuning-fork  which  he has been using.
Higgins   is   standing  up  near  him,
closing two or three file drawers which
are  hanging  out.   He  appears in the
morning   light  as  a  robust,  vital,
appetizing  sort  of  man  of  forty or
thereabouts,      dressed      in     a
professional-looking  black  frock-coat
with  a  white  linen  collar and black
silk  tie.   He  is  of  the energetic,
scientific    type,    heartily,   even
violently interested in everything that
can be studied as a scientific subject,
and  careless  about  himself and other
people,  including  their feelings.  He
is,  in  fact,  but  for  his years and
size, rather like a very impetuous baby
"taking notice" eagerly and loudly, and
requiring  almost  as  much watching to
keep  him  out of unintended mischief.
His  manner varies from genial bullying
when  he  is  in a good humor to stormy
petulance when anything goes wrong; but
he  is  so  entirely  frank and void of
malice that he remains likeable even in
his least reasonable moments.
[download]

#!/usr/bin/perl

sub interleave {
    my @elems = sort { $$a[1] <=> $$b[1] or $$a[0] cmp $$b[0] }
        ( ["A", $_[0]], ["B", $_[1]] );
    $elems[0][1]-- if $elems[0][1] > 1;
    my $div = sprintf "%d", $elems[1][1] / $elems[0][1];
    my $mod = $elems[1][1] % $elems[0][1];
    if ($mod % 2 == 0) {
        $elems[1][1] -= $mod;
        $mod = $mod / 2;
    } else { $mod = 0 }
    print $elems[0][0] . $elems[1][0] x $mod;
    $elems[0][1]-- if $elems[0][1] == 1;
    until ($elems[0][1] <= 1) {
        print $elems[1][0] x $div . $elems[0][0];
        $elems[0][1]--;
        $elems[1][1] -= $div;
    }
    print $elems[1][0] x $elems[1][1] . $elems[1][0] x $mod .
        $elems[0][0] x $elems[0][1] . "\n";
}

interleave (@ARGV);
[download]

Or, to put it a different way - given a barbecue, a bunch of beef cubes, and a number of cherry tomatoes, how would you arrange the skewers in such a way that a) there's a beef chunk at the beginning and the end of every skewer, b) each skewer is arranged in as even a manner as possible, and c) you use up all the beef and all the tomatoes?

I can meet all of the requirements, without actually meeting the intent of the question -- put all of the tomatoes in the middle of the skewer, evenly divided across all of the skewers (within rounding tolerances).

(NO, that's *not* the real problem... :)

I would hope not. Cherry tomatoes and beef cubes have much different cooking issues -- the tomatoes will get all soft and fall off if you cook 'em too long. I much prefer assembling each skewer w/ a single ingredient, cooking them, then pulling 'em off onto a large platter and mixing it together. (and I'm not a fan of grilled tomatoes ... if you want, slice 'em up, a little salt, pepper and fresh basil, and they make a fine salad on the side)

> Cherry tomatoes and beef cubes have much different cooking issues -- the tomatoes will get all soft and fall off if you cook 'em too long.

I'm not sure how you're defining "too long", but - not in my experience. I didn't just come up with that example randomly: I stopped working on the problem to go to a party, where I explained what I was doing to a friend - and pointed out that she was using a similar algorithm at that very moment, since she was making up those skewers. They came out just fine, by the way - nothing fell off.

As to the side salad - that's how I prefer my tomatoes as well, although I'm likely to throw in some Romanian feta ("telemea"), add a little cumin, and chop up some fresh dill. And I certainly wouldn't use cherry tomatoes, either. :)

Oh, and I generally come up with completely charred tomatoes mixed in between a combination of tough-as-boiled-beaver and still-dripping-blood beef chunks. (And don't forget the burned onions and the bloody carrot chunks resulting from my pathetic skewering skills, from which I end up with more holes in my thumb than in the vegetables.)

I shouldn't be allowed near a grill.

sub interleave {
    my ($a, $b) = @_;

    return scalar("B" x $b) if $a < 1;
    return "A" . ("B" x $b) if $a < 2;

    my $groups = $a - 1;
    my $bchunk = int($b / $groups);
    my $big = $b % $groups;

    return ("A" . ("B" x $bchunk)) x ($groups - $big)
         . ("A" . ("B" x ($bchunk + 1))) x $big
         . "A";
}
[download]

> I shouldn't be allowed near a grill.

If they make one that's operable via Perl, you'll be quite the Grillmeister. :) Wow. This appears to do it all, in a tiny little chunk of code. Very, very nice.

I'm going to spend some time twisting my brain and figuring out how the heck this thing works (not Perl-wise; you're right, that's pretty obvious.) Thanks!