Re: [FWP] Unsort/disperse a list

[John Porter <jdporter@min.net>]

Tim Ayers wrote:
> I've written a function that evenly disperses a list.
> It doesn't work well
> when one of the groups has the majority of elements, 

=pod

Here's my whack at the problem.

It does handle well the case where one value has many more
occurrences than any others.

O.k., it's not a fun solution, but it was fun to write.

=cut

# takes a bag; returns the same bag but elements desorted.
sub unsort {
  my %h;
  for ( @_ ) { push @{$h{$_}}, $_; }
  my( $b, @bins ) = sort { @$a <=> @$b } values %h;
  my @result = @$b;
  for $b ( @bins ) { @result = intersperse( $b, \@result ); }
  @result
}

sub take_one {
  my( $counter_sr, $source_ar ) = @_;
  ${$counter_sr}++;
  shift @$source_ar
}

sub intersperse {
  my( $aa, $ab ) = @_; # two arrays, by ref.
  @$aa > @$ab and ( $aa, $ab ) = ( $ab, $aa );
  # so that @$aa is the shorter array,
  # and @$ab is the longer array.

  my $ratio = @$ab / @$aa;
  my @accum;
  my( $na, $nb ) = (0,0);

  # take one from each, to start with:
  push @accum, take_one( \$na, $aa );
  push @accum, take_one( \$nb, $ab );

  while ( @$aa and @$ab ) {
    push @accum, take_one(
      $nb / $na < $ratio
        ? ( \$nb, $ab )
        : ( \$na, $aa )
    );
  }

  ( @accum, @$ab, @$aa )
}


==== Want to unsubscribe from Fun With Perl?  Well, if you insist...
==== Send email to <fwp-request@technofile.org> with message _body_
====   unsubscribe