Ok, artist has informed me that each pair may appear in only one row. I must've missed that, and as such I'm offering a different version of maximize_rows. I put this in a reply as the other post was obscenely long.

sub maximize_rows {
  my @array = @_;

  my %hash = ();
  foreach (@array) {
    $hash{$_->[0]}++;
    $hash{$_->[1]}++;
  }

  # the following is done to generate a fitness for each   
  # pair..which happens to be the better fitness of the 
  # elements within the pair
  push @$_, ($hash{$_->[0]} < $hash{$_->[1]} ? $hash{$_->[1]}:$hash{$_
+->[0]}) foreach (@array);
  
  # sort by fitness
  @array = sort { $b->[2] <=> $a->[2] } @array;
  
  my $counter = 0;
  foreach my $x (0..$#array - 1) {
    next unless $array[$x];
    foreach my $y ($x+1..$#array) {
      next unless $array[$y];
      %hash = ();
      $hash{$_}++ foreach (@{$array[$x]}[0,1],@{$array[$y]}[0,1]);
      if (scalar keys %hash == 4) {
        $counter++;
        print "$counter = $array[$x]->[0] $array[$x]->[1]  $array[$y]-
+>[0] $array[$y]->[1]$/";
        $array[$x] = $array[$y] = undef;
        last;
      }
    }
  }
  @array = grep { $_ } @array;
  print "Unused ",$_ + 1,": $array[$_]->[0] $array[$_]->[1]$/" foreach
+ (0..$#array);
}

__DATA__
7 7 1 1 1 2 2 2 2 5 5 5 5 4 4 4 4 4 3 3 3 3 3 8 8 8 8 8 8 6 6 6 6 6 6 
+6
====================
1 = 1 2
2 = 1 3
3 = 1 4
4 = 2 3
5 = 2 4
6 = 2 5
7 = 3 4
8 = 3 5
9 = 3 6
10 = 4 5
11 = 4 6
12 = 5 6
13 = 6 7
14 = 6 8
15 = 7 8
15 counts
$VAR1 = {
          '6' => 2,
          '8' => 4,
          '4' => 0,
          '1' => 0,
          '3' => 0,
          '7' => 0,
          '2' => 0,
          '5' => 0
        };
1 = 6 8
2 = 4 6
3 = 3 6
4 = 2 6
5 = 5 6
6 = 1 6
7 = 6 7
8 = 4 8
9 = 3 8
10 = 2 8
11 = 5 8
12 = 1 8
13 = 3 4
14 = 2 4
15 = 4 5
16 = 2 3
17 = 3 5
18 = 1 7
18 counts
$VAR1 = {
          '6' => 0,
          '8' => 0,
          '4' => 0,
          '1' => 0,
          '3' => 0,
          '7' => 0,
          '2' => 0,
          '5' => 0
        };
1 = 1 3  2 4
2 = 1 4  2 3
3 = 3 4  5 6
4 = 3 5  4 6
5 = 3 6  4 5
6 = 6 7  1 2
7 = 6 8  2 5
Unused 1: 7 8
next
1 = 6 8  3 4
2 = 4 6  3 8
3 = 3 6  4 8
4 = 2 6  5 8
5 = 5 6  2 8
6 = 1 6  2 4
7 = 6 7  1 8
8 = 4 5  2 3
9 = 3 5  1 7

[download]

As you can see, grouping like elements together and then trying to cut the larger groups down first offers the maximum number of pairs and rows.

Update:I have discovered a condition within the pairing subs that messes up the ability for maximum number of rows to be generated. I admit that my sub is more vulnerable to it than artist's. It occurs when there exists a particular number that has enough to match all the other numbers in the listing and the other numbers occur only once. As an example:

@array = qw(1 1 1 2 3 4);

__DATA__
1 = 1 2
2 = 1 3
3 = 1 4
3 counts
$VAR1 = {
          '4' => 0,
          '1' => 0,
          '3' => 0,
          '2' => 0
        };
1 = 1 4
2 = 1 3
3 = 1 2
3 counts
$VAR1 = {
          '4' => 0,
          '1' => 0,
          '3' => 0,
          '2' => 0
        };
Unused 1: 1 2
Unused 2: 1 3
Unused 3: 1 4
next
Unused 1: 1 4
Unused 2: 1 3
Unused 3: 1 2

...
@array = qw(1 2 3 4 4 4);

__DATA__
1 = 1 2
2 = 3 4
2 counts
$VAR1 = {
          '4' => 2,
          '1' => 0,
          '3' => 0,
          '2' => 0
        };
1 = 1 4
2 = 3 4
3 = 2 4
3 counts
$VAR1 = {
          '4' => 0,
          '1' => 0,
          '3' => 0,
          '2' => 0
        };
1 = 1 2  3 4
next
Unused 1: 1 4
Unused 2: 3 4
Unused 3: 2 4

[download]

As you can see, there's a problem in them there code. I haven't decided how to tackle this yet. Perhaps someone could lend a hand? :)

Final Update (I hope): I've created a condition to find when and where it happens and now seems to work fantastic and stuff. :-P

sub get_pairs {
  my %hash = ();
  $hash{$_}++ foreach @_;
  my @keys = ();
  
  @keys = sort { $hash{$b} <=> $hash{$a} } keys %hash;
  # let's check for condition red
  if (@keys > 2 && ($hash{$keys[0]} + $hash{$keys[1]} > @keys - 3) && 
+$hash{$keys[3]} == 1) {
    # !!!!CONDITION RED!!!!
    # ok...let's calm down...we can do this...just don't panic
    my $workarea = scalar @keys - 2;
    
    if ($keys[1] < int ($workarea / 2)) {
      $workarea -= 2 * $keys[1];
      $hash{$keys[0]} = $keys[1] + int ($workarea / 3);
    }
    else {
      $hash{$keys[0]} = $hash{$keys[1]} = int ($workarea / 2);
    }
  }
  
  my @pairs = ();
  
  foreach my $x (0..$#keys - 1) {
    next unless $hash{$keys[$x]};
    foreach my $y ($x+1..$#keys) {
      last unless $hash{$keys[$x]};
      next unless $hash{$keys[$y]};
      push @pairs, ($keys[$x] < $keys[$y] ? [$keys[$x],$keys[$y]]:[$ke
+ys[$y],$keys[$x]]);
      print scalar @pairs," = @{$pairs[$#pairs]}$/";
      $hash{$keys[$x]}--;
      $hash{$keys[$y]}--;
    }
  }
  print scalar @pairs," counts$/";
  return @pairs;
}

__DATA__
1 1 1 2 3 4
====================
1 = 1 2
2 = 1 3
3 = 1 4
3 counts
$VAR1 = {
          '4' => 0,
          '1' => 0,
          '3' => 0,
          '2' => 0
        };
1 = 1 4
2 = 2 3
2 counts
$VAR1 = {
          '4' => 0,
          '1' => 0,
          '3' => 0,
          '2' => 0
        };
Unused 1: 1 2
Unused 2: 1 3
Unused 3: 1 4
next
1 = 1 4  2 3

[download]

The demons have been exercised! This code is clear.

antirice    
The first rule of Perl club is - use Perl
The ith rule of Perl club is - follow rule i - 1 for i > 1

In reply to Re: Re: Pairing the pairs by antirice
in thread Pairing the pairs by artist

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.