Identify new pairs in an array

Discussion in 'Perl Misc' started by Andy, Mar 26, 2006.

  1. Andy

    Andy Guest

    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;

    }
     
    Andy, Mar 26, 2006
    #1
    1. Advertising

  2. Andy

    MSG Guest

    Andy wrote:
    > 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
     
    MSG, Mar 26, 2006
    #2
    1. Advertising

  3. Andy

    Joe Smith Guest

    Andy wrote:

    > 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
     
    Joe Smith, Mar 26, 2006
    #3
  4. Andy

    Andy Guest

    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";
    }
     
    Andy, Mar 26, 2006
    #4
  5. Andy <> wrote:
    > 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 SGML consulting
    Perl programming
    Fort Worth, Texas
     
    Tad McClellan, Mar 26, 2006
    #5
  6. Andy <> wrote:


    > 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.


    --
    Tad McClellan SGML consulting
    Perl programming
    Fort Worth, Texas
     
    Tad McClellan, Mar 26, 2006
    #6
  7. Andy

    Andy Guest

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

    I'm getting there: used Perl for the first time three weeks ago.
     
    Andy, Mar 26, 2006
    #7
  8. Andy

    Joe Smith Guest

    Anno Siegel wrote:
    > Joe Smith <> wrote in comp.lang.perl.misc:
    >>> @hash1{@uniq} = ();

    >> or
    >> @hash1{@uniq} = (undef) x @uniq;

    >
    > 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
     
    Joe Smith, Mar 27, 2006
    #8
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Replies:
    6
    Views:
    516
    bugbear
    Nov 17, 2006
  2. puzzlecracker

    generating random array of pairs

    puzzlecracker, Jul 29, 2008, in forum: Java
    Replies:
    10
    Views:
    582
  3. Greg Willits

    Array of Pairs data structure?

    Greg Willits, Oct 25, 2007, in forum: Ruby
    Replies:
    3
    Views:
    130
    Rick DeNatale
    Oct 25, 2007
  4. RedGrittyBrick

    Pulling pairs of values from an array

    RedGrittyBrick, Dec 17, 2010, in forum: Perl Misc
    Replies:
    3
    Views:
    160
  5. mark4asp
    Replies:
    3
    Views:
    160
    mark4asp
    Mar 5, 2007
Loading...

Share This Page