RE: [FWP] Unsort/disperse a list

[Eli Evans <eevans@libronix.com>]

: Tim Ayers [mailto:tayers@bridge.com] said:
: I've written a function that evenly disperses a list. For example, a
: list like (A A B B C C) comes out as (A B C A B C). While the
: functionality is not commonly useful, I thought I would pass it along
: for critiques, suggestions, and improvements. It doesn't work well
: when one of the groups has the majority of elements, e.g. (A B C C C C
: C C C D), but otherwise it seems to do pretty well.
: 
: Before I wrote this I searched around and couldn't find anything
: similar; only shuffle algorithms. I'm probably just using the wrong
: terminology. Are there well-known algorithms to do this?
: 
: Hope you have a very nice day, :-)
: Tim Ayers
: 
: P.S. It's not an entirely stable unsort.

*snip lots of code*

How 'bout the code below? It does handle lists where each group has
different numbers of elements. Of course, I'm not sure what the desired
behavior you wanted was in these situations; mine gives different output
than yours, but it does "disperse" the elements. For example, you give:

   HA H2 H3 H4 H5 H6 H7 H8 H9 HJ HQ HK SA S2 S3 S4 S5 S6 S7 S8
   HA SA H2 H3 S2 H4 H5 S3 H6 H7 S4 H8 H9 S5 HJ HQ S6 HK S7 S8

But I give:

   HA H2 H3 H4 H5 H6 H7 H8 H9 HJ HQ HK SA S2 S3 S4 S5 S6 S7 S8
   H2 S2 H3 S3 H4 S4 H5 S5 H6 S6 H7 S7 H8 S8 H9 SA HA HJ HK HQ

Is that more what you were thinking? Or what ...

Peace,
Eli

-----------------------------------------------------------------------

#!/usr/bin/perl -w
use strict;

$, = ' ';

while(<DATA>)
    {
    print "ORIG: $_";
    print "DISP:", disperse([split/\s+/], sub{substr($_[0],0,1)}), "\n\n";
    }

sub disperse
    {
    my($listref, $keysub) = @_;
    
    my %count = my %items = ();

    # Get counts for all the normalized items in the list
    $count{$_}++ for(map &$keysub($_), @$listref);

    # %items is normalized keys => [ all un-normalized items ]
    push(@{$items{&$keysub($_)}}, $_) for(@$listref);
    
    # Sort the item lists in %items
    # (otherwise, it's in "first seen on the line" order
    @{$items{$_}} = sort @{$items{$_}} for(keys %items);
    
    my @newlist = ();

    while(%count)
        {
        foreach(sort keys %count)
            {
            push @newlist, shift @{$items{$_}};
            $count{$_}--;
            delete $count{$_} unless $count{$_};
            }
        }

    return @newlist;
    }

__DATA__
A1 A2 A3 B1 B2 B3 C1 C2 C3 D1 D2 D3
A1 A2 A3 B1 C1 C2 C3 C4 C5 C6 C7 C8 D1 D2
HA H2 H3 H4 H5 H6 H7 H8 H9 HJ HQ HK SA S2 S3 S4 S5 S6 S7 S8 
S9 SJ SQ SK DA D2 D3 D4 D5 D6 D7 D8 D9 DJ DQ DK CA C2 C3 C4 
C5 C6 C7 C8 C9 CJ CQ C




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