Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW

Array name with a Variable

by godevars (Initiate)
on Apr 17, 2008 at 17:32 UTC ( #681250=perlquestion: print w/replies, xml ) Need Help??
godevars has asked for the wisdom of the Perl Monks concerning the following question:

I have 5 arrays I would like to compare but would like to do it a pair at a time. I initially had gotten help by seeing if I can have a variable in an array. My arrays were: @array1, @array2, @array3, @array4. I am able to compare 2 at a time manually with:
use strict; use warnings; @array1 = (c,d,e); @array2 = (e,f,g,h); @array3 = (a,b,d); @array4 = (s,g,h,j,k,l) my (%union, %intersect); foreach my $e (@array1, @array2) { $union{$e}++ && $intersect{$e}++ } my @intersect = sort keys %intersect; print FILEOUT "@intersect\n"; #prints intersecting words print FILEOUT scalar @intersect;
I thoutht I could change the array names to variable so that I can have the script run through all pairs. The idea was this; through a loop change the array name so that they could be compared. Name change would be done like this: foreach (1..4){@{"array$_"};} I started by testing it out like this:
foreach(1..4) { my (%union, %intersect); foreach my $e (@title1, @{"title$_"}) { $union{$e}++ && $intersect{$e}++ } my @intersect = sort keys %intersect; print FILEOUT "@intersect\n"; print FILEOUT scalar @intersect; print FILEOUT "\n"; }
It wasn't working. For some reason the comparison doesn't work and my results were four 0s. I thought it may have been where I declared the variables and moved it out of the loop but no luck. Wondering if anyone had any ideas or could help. My end result will be a table like this:
array1 : array2 : array3 : array4 array1: 10 : 5 : 17 : 2 array2: 5 : 15 : 8 : 1 array3: 17 : 8 : 14 : 6 array4: 2 : 1 : 6 : 19
Thought I'd start with the comparison first and then format it. I think as I loop through it, I can control the layout. Thanks-

Replies are listed 'Best First'.
Re: Array name with a Variable
by mr_mischief (Monsignor) on Apr 17, 2008 at 18:04 UTC
    Don't use symbolic references. Use regular references instead.

    Your exact spec and your example program don't quite cooperate with one another, but this should get you closer:

    Update: This code is buggy so I've put it in a readmore (not trying to hide that I make mistakes, after all). See Re^3: Array name with a Variable for the corrected code. The declaration of the hashes here is in the wrong scope and they weren't getting emptied properly.

    If you don't want the intersection of an array and itself, there's an easy way to do that with flow control for the loops. You might also want to look into Set::Scalar or other CPAN modules that have done much of the work for you.

      my ( %union, %intersect ) = ( (), () );

      That seems a little extravagant. Do you often have problems with freshly-declared hashes not being empty?

        No, I don't have that problem. It is superfluous. For some reason I was in the mindset that the example of how to assign to more than one variable might be useful to the OP, but I should've done that with @array1 through @array4 if I wanted to make that point I guess.
      I do actually want to keep the intersection of the array to itself. I also tried this in my script and ran into an issue. I then tried it against the basic example to see if I can follow the steps. The output is as follows:
      c d e 3 c d e 3 c d e 3 c d e 3 e 1 e f g h 4 e f g h 4 e f g h 4 d 1 ....
      I thought it would be more like this:
      cde 3 e 1 d 1 0 e 1 ....
      I thought it would compare @array1 to @arrays1 - 4 then compare @array2 to @arrays1 - 4 and so forth. I think I am just not following the loops. Thanks-
        Actually, I think I have a bug. Let me look a little closer. Yes, I have a bug. I moved the declaration of the variables into the wrong scope. This should work a little better.

        use strict; use warnings; my @array1 = qw( c d e ); my @array2 = qw( e f g h ); my @array3 = qw( a b d ); my @array4 = qw( s g h j k l ); open my $out, '>', 'output' or die "Cannot open: $!\n"; foreach my $a1 ( \@array1, \@array2, \@array3, \@array4 ) { foreach my $a2 ( \@array1, \@array2, \@array3, \@array4 ) { my ( %union, %intersect ); foreach my $item1 ( @$a1 ) { foreach my $item2 ( @$a2 ) { # print "item1: $item1\nitem2: $item2\n"; $union{$item1}++; $union{$item2}++; if ( $item1 eq $item2 ) { $intersect{$item1}++; } } } my @intersect = sort keys %intersect; print $out "@intersect\n"; #prints intersecting words print $out scalar @intersect . "\n"; } } close $out or die "Error closing output; $!\n";

Re: Array name with a Variable
by pc88mxer (Vicar) on Apr 17, 2008 at 17:39 UTC
    First I'd like to say that this is pretty clever:
    foreach my $e (@array1, @array2) { $union{$e}++ && $intersect{$e}++ }
    To solve your problem, just use an array of references to your set arrays:
    my @sets = (\@array1, \@array2, ...); for my $i (0..$#sets) { for my $j ($i+1..$#sets) { compute_stuff($sets[$i], $sets[$j]); } }
    Your union/intersection code will now look like:
    sub union_intersection { my ($set1, $set2) = @_; my (%union, %intersection) for my $e (@$set1, @$set2) { ... } ... }
      I tired this first and am running into an error. I am very new at Perl so may be missing how the subroutine is set up. I run my script witht he following (my actual arrays have many more words than that in my sample):
      my @sets = (\@array1, \@array2, \@array3, \@array4 ); for my $h (0..$#sets) { for my $j ($h+1..$#sets) { compute_stuff($sets[$h], $sets[$j]); } } Sub union_intersection { my ($set1, $set2) = @_; my (%union, %intersect); foreach my $e (@$set1, @$set2) { $union{$e}++ && $intersect{$e}++ } my @intersect = sort keys %intersect; #print FILEOUT "@intersect\n"; print FILEOUT scalar @intersect; print FILEOUT "\n"; }
      I get a syntax error on 2 lines. One on this line: my (%union, %intersect); The other near the last line (with '}'). Not sure why. In you example you did't have the semi-colon at the end and added it but that wasn't it. Also, don't I need to call the subroutine somewhere for it to work. Not sure if this an error on my part (e.g. not sure what compute_stuff should be doing). Thanks for the help-
Re: Array name with a Variable
by GrandFather (Sage) on Apr 17, 2008 at 21:10 UTC

    Is something like this what you are after?

    use strict; use warnings; use Set::Scalar; my @array1 = qw(c d e); my @array2 = qw(e f g h); my @array3 = qw(a b d); my @array4 = qw(s g h j k l); my @metaArray = (\@array1, \@array2, \@array3, \@array4, ); for my $first (0 .. $#metaArray - 1) { for my $second ($first + 1 .. $#metaArray) { my (%union, %intersect); $union{$_}++ && $intersect{$_}++ foreach @{$metaArray[$first]}, @{$metaArray[$second]}; my @intersect = sort keys %intersect; print "\@array$first, \@array$second: @intersect - "; print scalar @intersect, "\n"; } }


    @array0, @array1: e - 1 @array0, @array2: d - 1 @array0, @array3: - 0 @array1, @array2: - 0 @array1, @array3: g h - 2 @array2, @array3: - 0

    Perl is environmentally friendly - it saves trees
      If one of the input arrays has a duplicate entry, a spurious intersection will be detected.

      An input array set of

      my @array1 = qw(c d e); my @array2 = qw(e f g h); # my @array3 = qw(a b d); # original code my @array3 = qw(a a b d); # modified for test my @array4 = qw(s g h j k l);

      Produces output of

      @array0, @array1: e - 1 @array0, @array2: a d - 2 @array0, @array3: - 0 @array1, @array2: a - 1 @array1, @array3: g h - 2 @array2, @array3: a - 1

      godevars may be dealing with input arrays that have unique elements; certainly, his example data has this characteristic. However, it is nowhere stated explicitly that this is the case, so I just thought I'd mention it.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://681250]
Approved by pc88mxer
[stevieb]: I am thankful that I fell into Perl years ago in the manner I did. I don't believe there is another language that people care about so much, that they're willing to give everything. Langs come and go, but in Perl, it seems, things remain consistent.
[stevieb]: The people back then (~2000) are the same people now, but with much more experience. I'm appreciative that I fell into the Perl rabbit hole.
[stevieb]: Coding circles around Python devs, showing how unit tests should be done, enabling easy access to everything, learning basic C to wrap for direct hardware access... I am thankful.
[stevieb]: I'm in an appreciative mood. Thank you fellow Monks, for all I know, and for the knowledge which I can pass on

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (6)
As of 2017-02-25 01:22 GMT
Find Nodes?
    Voting Booth?
    Before electricity was invented, what was the Electric Eel called?

    Results (364 votes). Check out past polls.