Bugorr has asked for the wisdom of the Perl Monks concerning the following question:

Hello dear monks. Today is the day that again I have to come to Monastery Gates and knock in search for wisdom.

I have to create a blender.
I have a huge file with email addresses and they grouped by domains:

sample:
ads@domain.com
ads@domain.com
ads@domain1.com
ads@domina1.com
etc.

My blender needs to read them from file into array and create a mixture of these domains into a new or original array.
My result should look like that:
ads@domain.com
ads@domain1.com
ads@domain2.com
ads@domain1.com
etc

Please enlighten me how do I create this magic blender and mix all the addresses together?

Thank you in advance.

Bugorr :)

2005-10-12 Retitled by g0n, as per Monastery guidelines
Original title: 'Blender'

  • Comment on Need to create a blender to mix up lines from a file

Replies are listed 'Best First'.
Re: Need to create a blender to mix up lines from a file
by Roy Johnson (Monsignor) on Oct 11, 2005 at 21:51 UTC
    You want to shuffle them?

    Caution: Contents may have been coded under pressure.
Re: Need to create a blender to mix up lines from a file
by ikegami (Patriarch) on Oct 11, 2005 at 21:51 UTC

    How about shuffle from List::Util?

    use List::Util qw( shuffle ); open(my $fh, '<', '...') or die("Unable to open input file: $!\n"); my @shuffed_array = shuffle <$fh>;

    On the other hand, you probably want to spread entries from the same domain, not randomize the order of the array. I'm not sure how to do that.

Re: Need to create a blender to mix up lines from a file
by GrandFather (Saint) on Oct 11, 2005 at 21:54 UTC

    What is the application? Often it helps us know how to advise you if we know what you are trying to achieve.


    Perl is Huffman encoded by design.
Re: Need to create a blender to mix up lines from a file
by GrandFather (Saint) on Oct 11, 2005 at 23:47 UTC

    If the number of entries for each domain is the same then the code below will interleave them for you

    use warnings; use strict; my %domains; while (my $line = <DATA>) { chomp $line; my ($name, $domain) = split /@/, $line; $domains{$domain} = [] if ! defined $domains{$domain}; push @{$domains{$domain}}, $line; } while (%domains) { for my $domain (keys %domains) { print ((shift @{$domains{$domain}}) . "\n"); delete $domains{$domain} if ! @{$domains{$domain}}; } } __DATA__ ads@domain.com ads@domain.com ads@domain1.com ads@domain1.com ads@domain2.com ads@domain2.com

    Prints:

    ads@domain.com ads@domain1.com ads@domain2.com ads@domain.com ads@domain1.com ads@domain2.com

    Perl is Huffman encoded by design.
Re: Need to create a blender to mix up lines from a file
by ikegami (Patriarch) on Oct 11, 2005 at 22:54 UTC

    I think the following will give you a very good spread. I concocted it from the top of my head, so I don't garantee results.

    use strict; use warnings; open(my $fh, '<', '...') or die("Unable to open input file: $!\n"); # Group domains into an AoA. # Very efficient since the input fileis already sorted by domain. my @grouped; my $prev_domain = 'invalid domain'; while (<$fh>) { chomp; my $addr = $_; my $domain = ...; if ($domain ne $prev_domain) { $prev_domain = $domain; unshift(@grouped, []); } push(@{$grouped[0]}, $addr); } # Sort groups by group size. # Gives something like: # @sorted = ( # [ qw( g1 ) ], # [ qw( f1 ) ], # [ qw( e1 ) ], # [ qw( d1 d2 ) ], # [ qw( c1 c2 c3 ) ], # [ qw( b1 b2 b3 ) ], # [ qw( a1 a2 a3 a4 a5 ) ], # ); my @sorted = sort { @$a <=> @$b } @grouped; my @ordered; my $prev_last = 0; my $break = 0; my $offset = 0; for (;;) { my $p = shift(@sorted); last if not defined $p; my $last = $#$p; if ($last != $prev_last) { $prev_last = $last; $break = @ordered / $last; $offset = 0; } foreach my $i (reverse 0..$last) { splice(@ordered, $i*$break+$offset, 0, $p->[$i]); } $offset++; } { local $, = ", "; local $\ = "\n"; print(@ordered); }
Re: Need to create a blender to mix up lines from a file
by GrandFather (Saint) on Oct 12, 2005 at 00:56 UTC

    or if you have unequal sized groups of domains then this may suit:

    use warnings; use strict; my %domains; while (my $line = <DATA>) { chomp $line; my ($name, $domain) = split /@/, $line; $domains{$domain} = [] if ! defined $domains{$domain}; push @{$domains{$domain}}, $line; } my @counts; my $avg = 0; for my $domain (keys %domains) { my $count = scalar @{$domains{$domain}}; $avg += $count; push @counts, $count } $avg /= @counts; my @ballanced; for my $domain (keys %domains) { my @names = @{$domains{$domain}}; if (@names <= int $avg) { push @ballanced, [@names]; next; } my $toIns = @names / int $avg; my $inc = int (@ballanced / $toIns); $inc = 1 if $inc < 1; my $index = 0; while (@names) { my @sublist = splice @names, 0, $avg; splice @ballanced, $index, 0, [@sublist]; $index += $inc; } } my $going = 1; while ($going) { $going = 0; for my $addrs (@ballanced) { next if ! @$addrs; my $name = shift @$addrs; print "$name\n"; $going = 1; } } __DATA__ ads1@domain.com ads2@domain.com ads1@domain1.com ads2@domain1.com ads1@domain2.com ads2@domain2.com ads3@domain2.com ads4@domain2.com ads1@domain3.com ads1@domain4.com ads2@domain4.com

    Prints:

    ads1@domain2.com ads1@domain4.com ads3@domain2.com ads1@domain.com ads1@domain3.com ads1@domain1.com ads2@domain2.com ads2@domain4.com ads4@domain2.com ads2@domain.com ads2@domain1.com

    Perl is Huffman encoded by design.