Identify new pairs in an array

[Andy]

To all,

I have an array:

my @uniq=qw{a b c d}

and a second array with pairs of elements:

my @pairs = ( ['z','g'], ['a','c'], ['b','a'] )

I would like to identify all possible pairs of elements (order not
important) in @uniq and add them to @pairs if @pairs doesn't already
include these pairs. I would also like to print out any new pair added
to @pairs. So, all possible pairs in @uniq=

ab ac ad bc bd cd

ab and ac already occur in @pairs but the other 4 pairs do not.
Therefore, @pairs should be updated to:

my @pairs = ( ['z','g'], ['a','c'], ['b','a'],['a','d'], ['b','c'],
['b','d'],['c','d'] )

The code would print out:

ad
bc
bd
cd

My attempt is shown below. I think that I am very close. Any
suggestions would be welcome. Thanks.

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

my @uniq=qw{a b c d};
my @pairs = ( ['z','g'], ['a','c'], ['b','a'] );
my $b=1;
my %hash1;
@hash1{@uniq} = ();

my $d;
my $e;
my @bud1;
my @hash1;
my $f;
my $g;
my $done=0;
my $k=$#pairs;

foreach my $i ( 0 .. $#uniq-1 ) {
foreach my $j ( $b .. $#uniq ) {
$f=$uniq[$i];
$g=$uniq[$j];
while ($done==0){
foreach my $p ( 0 .. $k ) {
if( ($pairs[$p][0]=$f or $pairs[$p][1]=$f) and
($pairs[$p][0]=$g or $pairs[$p][1]=$g) ){
$done=1;
}
else {
$d=$f;
$e=$g;
@bud1=( [$d,$e] );
push(@pairs, @bud1);
print $d." ".$e;
print "\n";
$done=1;
}
}
$done=0;
}
print "\n";

}
$b=$b+1;

}

 

[MSG]

To all,

I have an array:

my @uniq=qw{a b c d}

and a second array with pairs of elements:

my @pairs = ( ['z','g'], ['a','c'], ['b','a'] )

I would like to identify all possible pairs of elements (order not
important) in @uniq and add them to @pairs if @pairs doesn't already
include these pairs. I would also like to print out any new pair added
to @pairs. So, all possible pairs in @uniq=

ab ac ad bc bd cd

ab and ac already occur in @pairs but the other 4 pairs do not.
Therefore, @pairs should be updated to:

my @pairs = ( ['z','g'], ['a','c'], ['b','a'],['a','d'], ['b','c'],
['b','d'],['c','d'] )

The code would print out:

ad
bc
bd
cd

My attempt is shown below. I think that I am very close. Any
suggestions would be welcome. Thanks.

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

my @uniq=qw{a b c d};
my @pairs = ( ['z','g'], ['a','c'], ['b','a'] );
my $b=1;
my %hash1;
@hash1{@uniq} = ();

People explained to you about it in your previous posts. I don't know
if you understand what they were saying. Can you describe to yourself
what this line of code is doing?

my $d;
my $e;
my @bud1;
my @hash1;
my $f;
my $g;
my $done=0;
my $k=$#pairs;

foreach my $i ( 0 .. $#uniq-1 ) {
foreach my $j ( $b .. $#uniq ) {
$f=$uniq[$i];
$g=$uniq[$j];
while ($done==0){
foreach my $p ( 0 .. $k ) {
if( ($pairs[$p][0]=$f or $pairs[$p][1]=$f) and
($pairs[$p][0]=$g or $pairs[$p][1]=$g) ){
$done=1;
}
else {
$d=$f;
$e=$g;
@bud1=( [$d,$e] );
push(@pairs, @bud1);
print $d." ".$e;
print "\n";
$done=1;
}
}
$done=0;

This lines makes your while loop an infinate loop.
That is why your program never finishes running!

}
print "\n";

}
$b=$b+1;

}

In fact the problem you presented here has many layers. Let me
help you break it down to make it easier. Basically you have two
arrays here:
@uniq = qw( ab ac ad bc bd cd );
@pairs = qw( ab ac gz );
Now can you compute the difference or intersection of @uniq and
@pairs? Please see:
perldoc -q intersection

 

[Joe Smith]

my %hash1;
@hash1{@uniq} = ();

And just why are you using that, as opposed to
@hash1{@uniq} = @uniq;
or
@hash1{@uniq} = (1) x scalar @uniq; # deliberate
or
@hash1{@uniq} = (undef) x @uniq;

-Joe

 

[Andy]

Thanks to all. I have used the intersection concept as suggested and
cleaned up the code as suggested. I now have the code below. Two
(probably basic) questions:

1. How do I print out the contents of @pairs at the end of this
sequence of code? I have made an attempt but it doesn't seem to work.

2. If I call this subroutine again to test for new unique elements of
a second array @uniq2 against @pairs generated as below, will the order
of the pairs be maintained? I guess the answer to my first question can
be used to answer this question. Thanks.


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

my @uniq=qw{a b c d};
my @pairs = ( ['z','g'], ['a','c'], ['b','a'] );
my $b=1;
my %hash1;
@hash1{@uniq} = @uniq;

my $f;
my $g;
my @bud1;
my @temp;

foreach my $i ( 0 .. $#uniq-1 ) {
foreach my $j ( $b .. $#uniq ) {
$f=$uniq[$i];
$g=$uniq[$j];
#print $f.$g;
@bud1=( [$f,$g] );
push(@temp, @bud1);
print "\n";
}
$b=$b+1;
}


my @isect;
my @diff;
my %isect;
my $e;
my $union;


my @union = @isect = @diff = ();
my %union = %isect = ();
my %count = ();

foreach $e (@pairs) { $union{$e} = 1 }

foreach $e (@temp) {
if ( $union{$e} ) { $isect{$e} = 1 }
$union{$e} = 1;
}
@union = keys %union;
@isect = keys %isect;

@pairs=@isect;

foreach my $k (0 .. #$pair)[
print $pairs[$k];
print "\n";
}

 

[Tad McClellan]

To all,

I have an array:

my @uniq=qw{a b c d}

and a second array with pairs of elements:

my @pairs = ( ['z','g'], ['a','c'], ['b','a'] )

I would like to identify all possible pairs of elements (order not
important)

If you normalize the order within each pair, then you can halve the
number of comparisons that you will need to do.

I'll normalize them in the code below.

in @uniq and add them to @pairs if @pairs doesn't already
include these pairs. I would also like to print out any new pair added
to @pairs. So, all possible pairs in @uniq=

ab ac ad bc bd cd

ab and ac already occur in @pairs but the other 4 pairs do not.
Therefore, @pairs should be updated to:

my @pairs = ( ['z','g'], ['a','c'], ['b','a'],['a','d'], ['b','c'],
['b','d'],['c','d'] )

The code would print out:

ad
bc
bd
cd

Note that I make absolutely no consideration of time/space efficiency
in the code below. If @uniq and/or @pairs are much much bigger than
shown, I would use and entirely different approach...


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

my @uniq = sort qw{d b c a};
my @pairs = map {[ sort @$_ ]} ['z','g'], ['a','c'], ['b','a'];

foreach my $comb ( combinations(@uniq) ) {
next if grep {$comb->[0] eq $_->[0] and $comb->[1] eq $_->[1]} @pairs;
print "@$comb\n";
push @pairs, $comb;
}
print "-----\n";

foreach my $pair ( @pairs ) {
print "@$pair\n";
}


sub combinations {
my @combs;

while ( my $elem = shift ) {
push @combs, [ $elem, $_ ] for @_;
}

return @combs;
}

 

[Tad McClellan]

My attempt is shown below. I think that I am very close.

But you are not going to tell us what little bit it is that is missing?

Leaving us to figure it out for ourselves from the (quite horrid) code?

Many readers will simply move on to answering someone else's question
if you don't make it easier for them to answer yours...

Any
suggestions would be welcome.

I have two meta-suggestions:

1) Please see the Posting Guidelines that are posted here frequently.

2) Adopt a coding style that won't make people spit.

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

Keep the pragma, lose the switch.


[ declarations below rearranged into groups I can comment on ]

my %hash1;
@hash1{@uniq} = ();

my @hash1;

Those are 2 *different* variables, and your code does not
make use of either one of them!

So what are they there for?

my $d;
my $e;
my $f;
my $g;

One-character variable names suck.

One-character variable names suck even more when they
are "global" variables.

Try to chose meaningful variable names.


You should limit the scope of variables to the smallest possible scope.

So you should be declaring your variables at their first use, not
all at the top of the program.

foreach my $i ( 0 .. $#uniq-1 ) {
foreach my $j ( $b .. $#uniq ) {

There's a nice style, spaces between significant parts.

while ($done==0){

Why did that nice style suddenly disappear?

while ( $done == 0 ) {
or
until ( $done ) {

foreach my $p ( 0 .. $k ) {

Nice style now reappears...

if( ($pairs[$p][0]=$f or $pairs[$p][1]=$f) and
($pairs[$p][0]=$g or $pairs[$p][1]=$g) ){

.... now it is gone again!

I'm getting dizzy.


Did you really want _assignments_ in your conditional, or did you
instead mean to use comparisons (==) ?

And if so, did you want to do a numeric comparison (==) or
a string comparison (eq) ?

$done=1;
}

You should indent the contents of blocks, so that the structure of the
program is easier to see.


$done=1;
}

@bud1=( [$d,$e] );
push(@pairs, @bud1);

You don't need the @bud1 temporary variable.

push( @pairs, [$d,$e] );

print $d." ".$e;
print "\n";

Using interpolation instead of literal concatenation nearly always
results in something that is easier to read and understand.

print "$d $e\n"



Note that I made no attempt to understand what your code is
doing or how to fix it, because you've made that too hard.

 

[Andy]

Thanks for the input. Great advice that I will take.

I'm getting there: used Perl for the first time three weeks ago.

 

[Joe Smith]

Same result as the original, only longer. What's the advantage?

It was my misunderstanding of an incomplete assignment to hash slices.

I thought that using an empty list would only set $hash1{$uniq[0]}, but
I see now that is not the case.
-Joe