sub get_pairs {
my %hash = ();
$hash{$_}++ foreach @_;
my @keys = sort { $hash{$b} <=> $hash{$a} } keys %hash;
my $counter = 0;
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]};
$counter++;
print "$counter = ",($keys[$x] < $keys[$y] ? "$keys[$x] $keys[$y]":"$keys[$y] $keys[$x]"),$/;
$hash{$keys[$x]}--;
$hash{$keys[$y]}--;
}
}
print "$counter counts$/" print "$counter counts$/"
print Dumper(\%hash); #to see how many matches are made
}
get_pairs(@array);
__DATA__
1 = 3 6
2 = 4 6
3 = 1 6
4 = 6 7
5 = 5 6
6 = 6 8
7 = 2 6
8 = 3 4
9 = 1 3
10 = 3 7
11 = 3 5
12 = 3 8
13 = 1 4
14 = 4 7
15 = 4 5
16 = 4 8
17 = 1 7
17 counts
$VAR1 = {
'6' => 0,
'8' => 0,
'4' => 0,
'1' => 0,
'3' => 1,
'7' => 0,
'2' => 0,
'5' => 1
};
####
1 = 1 2
2 = 1 3
3 = 1 4
4 = 1 5
5 = 3 4
6 = 3 5
7 = 3 6
8 = 3 7
9 = 3 8
10 = 4 5
11 = 4 6
12 = 4 7
13 = 4 8
14 = 5 6
15 = 6 7
16 = 6 8
Counts 16
$VAR1 = {
'6' => 2,
'8' => 0,
'4' => 0,
'1' => 0,
'3' => 1,
'7' => 1,
'2' => 0,
'5' => 0
};
####
#!/usr/bin/perl
use strict;
use warnings;
my $Z;
my @array;
foreach (1..36){
$Z->{1 + int rand(8)}++;
}
foreach (sort { $Z->{$a} <=> $Z->{$b}} keys %{$Z}){
my $element = $_;
foreach (1..$Z->{$element}){
push @array, $element;
}
}
@array = qw(2 8 8 8 1 1 1 1 5 5 5 5 7 7 7 7 4 4 4 4 4 4 3 3 3 3 3 3 3
+6 6 6 6 6 6 6);
print join " " => @array,"\n";
sub get_pairs1 {
print "====================\n";
my @array = @_;
my $X;
my $hash;
my $A;
my $counter;
my @pairs;
foreach (@array){
$X->{$_} += 1;
}
foreach my $x (sort { $a <=> $b } keys %{$X}){
foreach my $y (sort { $a <=> $b } keys %{$X}){
next if $X->{$x} == 0;
next if $x eq $y;
next if $X->{$y} == 0;
next if defined $hash->{$x}{$y};
$counter++;
print "$counter = $x $y\n";
push @pairs, [$x,$y];
$hash->{$x}{$y} = $hash->{$y}{$x} = 1;
$X->{$x} -= 1; $X->{$y} -= 1;
}
}
print "$counter counts$/";
return @pairs;
}
sub get_pairs2 {
my %hash = ();
$hash{$_}++ foreach @_;
my @keys = sort { $hash{$b} <=> $hash{$a} } keys %hash;
my $counter = 0;
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;
}
# assumes that all pairs within the array are unique
sub maximize_rows {
my @array = @_;
my $counter = 0;
foreach my $x (0..$#array - 1) {
foreach my $y ($x+1..$#array) {
my %hash = ();
$hash{$_}++ foreach (@{$array[$x]},@{$array[$y]});
if (scalar keys %hash == 4) {
$counter++;
print "$counter = $array[$x]->[0] $array[$x]->[1] $array[$y]-
+>[0] $array[$y]->[1]$/";
}
}
}
}
my @arr1 = get_pairs1(@array);
my @arr2 = get_pairs2(@array);
print "====================ROWS$/";
maximize_rows(@arr1);
print "====================NEXT$/";
maximize_rows(@arr2);
__DATA__
2 8 8 8 1 1 1 1 5 5 5 5 7 7 7 7 4 4 4 4 4 4 3 3 3 3 3 3 3 6 6 6 6 6 6
+6
====================
1 = 1 2
2 = 1 3
3 = 1 4
4 = 1 5
5 = 3 4
6 = 3 5
7 = 3 6
8 = 3 7
9 = 3 8
10 = 4 5
11 = 4 6
12 = 4 7
13 = 4 8
14 = 5 6
15 = 6 7
16 = 6 8
16 counts
1 = 3 6
2 = 4 6
3 = 1 6
4 = 6 7
5 = 5 6
6 = 6 8
7 = 2 6
8 = 3 4
9 = 1 3
10 = 3 7
11 = 3 5
12 = 3 8
13 = 1 4
14 = 4 7
15 = 4 5
16 = 4 8
17 = 1 7
17 counts
====================ROWS
1 = 1 2 3 4
2 = 1 2 3 5
3 = 1 2 3 6
4 = 1 2 3 7
5 = 1 2 3 8
6 = 1 2 4 5
7 = 1 2 4 6
8 = 1 2 4 7
9 = 1 2 4 8
10 = 1 2 5 6
11 = 1 2 6 7
12 = 1 2 6 8
13 = 1 3 4 5
14 = 1 3 4 6
15 = 1 3 4 7
16 = 1 3 4 8
17 = 1 3 5 6
18 = 1 3 6 7
19 = 1 3 6 8
20 = 1 4 3 5
21 = 1 4 3 6
22 = 1 4 3 7
23 = 1 4 3 8
24 = 1 4 5 6
25 = 1 4 6 7
26 = 1 4 6 8
27 = 1 5 3 4
28 = 1 5 3 6
29 = 1 5 3 7
30 = 1 5 3 8
31 = 1 5 4 6
32 = 1 5 4 7
33 = 1 5 4 8
34 = 1 5 6 7
35 = 1 5 6 8
36 = 3 4 5 6
37 = 3 4 6 7
38 = 3 4 6 8
39 = 3 5 4 6
40 = 3 5 4 7
41 = 3 5 4 8
42 = 3 5 6 7
43 = 3 5 6 8
44 = 3 6 4 5
45 = 3 6 4 7
46 = 3 6 4 8
47 = 3 7 4 5
48 = 3 7 4 6
49 = 3 7 4 8
50 = 3 7 5 6
51 = 3 7 6 8
52 = 3 8 4 5
53 = 3 8 4 6
54 = 3 8 4 7
55 = 3 8 5 6
56 = 3 8 6 7
57 = 4 5 6 7
58 = 4 5 6 8
59 = 4 7 5 6
60 = 4 7 6 8
61 = 4 8 5 6
62 = 4 8 6 7
====================NEXT
1 = 3 6 1 4
2 = 3 6 4 7
3 = 3 6 4 5
4 = 3 6 4 8
5 = 3 6 1 7
6 = 4 6 1 3
7 = 4 6 3 7
8 = 4 6 3 5
9 = 4 6 3 8
10 = 4 6 1 7
11 = 1 6 3 4
12 = 1 6 3 7
13 = 1 6 3 5
14 = 1 6 3 8
15 = 1 6 4 7
16 = 1 6 4 5
17 = 1 6 4 8
18 = 6 7 3 4
19 = 6 7 1 3
20 = 6 7 3 5
21 = 6 7 3 8
22 = 6 7 1 4
23 = 6 7 4 5
24 = 6 7 4 8
25 = 5 6 3 4
26 = 5 6 1 3
27 = 5 6 3 7
28 = 5 6 3 8
29 = 5 6 1 4
30 = 5 6 4 7
31 = 5 6 4 8
32 = 5 6 1 7
33 = 6 8 3 4
34 = 6 8 1 3
35 = 6 8 3 7
36 = 6 8 3 5
37 = 6 8 1 4
38 = 6 8 4 7
39 = 6 8 4 5
40 = 6 8 1 7
41 = 2 6 3 4
42 = 2 6 1 3
43 = 2 6 3 7
44 = 2 6 3 5
45 = 2 6 3 8
46 = 2 6 1 4
47 = 2 6 4 7
48 = 2 6 4 5
49 = 2 6 4 8
50 = 2 6 1 7
51 = 3 4 1 7
52 = 1 3 4 7
53 = 1 3 4 5
54 = 1 3 4 8
55 = 3 7 1 4
56 = 3 7 4 5
57 = 3 7 4 8
58 = 3 5 1 4
59 = 3 5 4 7
60 = 3 5 4 8
61 = 3 5 1 7
62 = 3 8 1 4
63 = 3 8 4 7
64 = 3 8 4 5
65 = 3 8 1 7
66 = 4 5 1 7
67 = 4 8 1 7
####
@array = qw(6 6 5 5 1 1 1 3 3 3 3 2 2 2 2 4 4 4 4 4 8 8 8 8 8 8 8 8 7 7 7 7 7 7 7 7);
__DATA__
6 6 5 5 1 1 1 3 3 3 3 2 2 2 2 4 4 4 4 4 8 8 8 8 8 8 8 8 7 7 7 7 7 7 7 7
====================
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 = 4 6
10 = 4 7
11 = 6 7
12 = 7 8
12 counts
$VAR1 = {
'6' => 0,
'3' => 0,
'7' => 5,
'2' => 0,
'8' => 7,
'1' => 0,
'4' => 0,
'5' => 0
};
1 = 7 8
2 = 4 7
3 = 3 7
4 = 2 7
5 = 1 7
6 = 6 7
7 = 5 7
8 = 4 8
9 = 3 8
10 = 2 8
11 = 1 8
12 = 6 8
13 = 5 8
14 = 3 4
15 = 2 4
16 = 1 4
17 = 2 3
17 counts
$VAR1 = {
'6' => 0,
'3' => 0,
'7' => 1,
'2' => 0,
'8' => 1,
'1' => 0,
'4' => 0,
'5' => 0
};
get_pairs1 produces: 36 rows
get_pairs2 produces: 67 rows