Union/Intersection of Multiple Arrays

VinsWorldcom has asked for the wisdom of the Perl Monks concerning the following question:

SUMMARY: I'm trying to simulate a MANET (mobile ad-hoc network) in which a variable number of nodes roam about in a fixed grid size each simulating a handheld device with wireless capability. The wireless signal degrades with distance such that two nodes at opposite ends of the grid won't be able to talk to each other.

Each node can also act as a relay - that is, if the signal strenght between nodes 1<->2 is good and the signal strenght between nodes 2<->3 is good but there is no signal at all between nodes 1<->3 (direct), nodes 1 and 3 *CAN* still communicate - using 2 as a relay.

QUESTION: How can I compute the sub-groups of nodes that can communicate based on signal strength and print the lists? I don't necessarily need to know "full adjacencies"; rather, just like the example above, if 1-2 and 2-3, then 1,2,3 are in a "group".

My predicament gets hairy as the nodes separate within the grid. There may be several sub-groups that can communicate intra-sub-group, but not inter-sub-group. Thus this isn't just a simple union or intersection of 2 arrays, but a variable number of arrays that changes for each iteration.

Assume 6 nodes. Assume the above example: 1<->2, 2<->3. Also assume 4<->5. My output should be:

1 2 3
4 5
6
[download]

Since 1 can talk directly to 2 and use 2 to get to 3. No need to re-print this for nodes 2 (2 1 3) and 3 (3 1 2). Nodes 4 and 5 can talk, but only to each other - again print this group only once (not 4 5 and 5 4). Finaly, node 6 is by itself and can talk to no one - list it by itself.

CODE: Unlike normal questions, I have 'an' answer that works that you can all test out. I won't call this a "challenge" as my code skills are weak and my knowledge of recursion even weaker (I'm not even sure I needed to do it in this case), but I'm *SURE* there has to be an easier way/algorithm to get the results.

I've included the full working code below (apologies for not shortening it); however, the procedure I'm looking to "fine-tune" (my answer to QUESTION above) is 'sub print_union()'. The whole code is necessary to run the simulation so you can see the bits I'm looking to fix actually function. I suppose I could have taken the POD bit out, but thought that may be helpful to understand the program a bit more and I used 'readmore' - hopefully that will suffice.

To run a good example to illustrate the output I'm interested in, use:

C:\> manet.pl 9 -g 40 -s 2 -S -G 1
[download]

Pay attention to the "UNION/INTERSECTION" sub-section of output - this is from the "print_union" sub and the main point of my question. I've run this on both Windows and Unix (MacOS) and it runs fine. Be sure to make your window large enough to see the output (80 cols by 70 rows worked for me).

#!/usr/bin/perl -w

use vars qw($VERSION);

$VERSION = "1.0 - 16 APR 2010";

use strict;
use warnings;
use Getopt::Long qw(:config no_ignore_case); #bundling
use Pod::Usage;

my %opt;
my ($opt_help, $opt_man, $opt_versions);

GetOptions(
  'acceleration=i' => \$opt{acceleration},
  'delay=i'        => \$opt{delay},
  'Distances:s'    => \$opt{Distances},
  'grid=i'         => \$opt{size},
  'Grid:s'         => \$opt{Grid},
  'iterations=i'   => \$opt{loop},
  'Locations:s'    => \$opt{Locations},
  'signal=f'       => \$opt{multiplier},
  'Signals:s'      => \$opt{Signals},
  'help!'          => \$opt_help,
  'man!'           => \$opt_man,
  'versions!'      => \$opt_versions
) or pod2usage(-verbose => 0);

pod2usage(-verbose => 1) if defined $opt_help;
pod2usage(-verbose => 2) if defined $opt_man;

if(defined $opt_versions){
    print
      "\nModules, Perl, OS, Program info:\n",
      "  $0\n",
      "  Version               $VERSION\n",
      "    strict              $strict::VERSION\n",
      "    warnings            $warnings::VERSION\n",
      "    Pod::Usage          $Pod::Usage::VERSION\n",
      "    Getopt::Long        $Getopt::Long::VERSION\n",
      "    Perl version        $]\n",
      "    Perl executable     $^X\n",
      "    OS                  $^O\n",
      "\n\n";
    exit
}

# Start Program
########################################################

if ((!@ARGV) || ($ARGV[0] !~ /^\d+$/)) {
    pod2usage(-verbose => 0, -message => "$0: number of nodes required
+\n")
}

if ($ARGV[0] < 2) {
    pod2usage(-verbose => 0, -message => "$0: number of nodes >= 2\n")
}

my @nodes;
my $numnodes      = $ARGV[0];
my $delay         = $opt{delay}        || 0;
my $acceleration  = $opt{acceleration} || 2;
   $acceleration += 1;
my $size          = $opt{size}         || 5*$numnodes;
   $size         -= 1;
my $iterations    = $opt{loop}         || -1;
my $multiplier    = $opt{multiplier}   || 1;

if ($size <= $numnodes) {
    $size = 5*$numnodes - 1;
}

if ($multiplier <= 0) {
    $multiplier = 1
}

# Initialize Nodes
for my $i (1..$numnodes) {
    my %coords;
    $coords{x} = $coords{y} = int($size/2);
    $nodes[$i] = \%coords;
}

my $i = 0;
while ($i++ != $iterations) {

    move(\@nodes, $size);

    if (defined($opt{Distances}) || defined($opt{Grid}) || defined($op
+t{Locations}) || defined($opt{Signals})) {
        print "---- ITERATION $i ----\n"
    }
    if (defined($opt{Locations})) {
        print "LOCATIONS\n";
        print_locations(\@nodes);
        if ($opt{Locations} ne '') {
            if ($^O eq 'MSWin32') {
                system('cls')
            } else {
                system('clear')
            }
        }
    }

    my ($distances, $signals) = compute(\@nodes);

    if (defined($opt{Distances})) {
        print "DISTANCES\n";
        print_metrics(\@nodes, $distances);
        if ($opt{Distances} ne '') {
            if ($^O eq 'MSWin32') {
                system('cls')
            } else {
                system('clear')
            }
        }
    }
    if (defined($opt{Signals})) {
        print "SIGNALS\n";
        print_metrics(\@nodes, $signals);
        if ($opt{Signals} ne '') {
            if ($^O eq 'MSWin32') {
                system('cls')
            } else {
                system('clear')
            }
        }
    }

print "UNION/INTERSECTION\n";
print_union(\@nodes, $signals);

    if (defined($opt{Grid})) {
        print "GRID\n";
        print_grid(\@nodes, $size);
        if ($opt{Grid} ne '') {
            if ($^O eq 'MSWin32') {
                system('cls')
            } else {
                system('clear')
            }
        }
    }
    sleep ($delay);
}

########################################

sub compute {
    my ($node) = @_;

    my @distance;
    my @signal;
    for my $i (1..$#{$node}) {
        for my $j ($i+1..$#{$node}) {
            #  Pythagoras
            $distance[$i][$j] = sqrt(
                                     (($node->[$i]->{x} - $node->[$j]-
+>{x}) *
                                      ($node->[$i]->{x} - $node->[$j]-
+>{x}))
                                                        + 
                                     (($node->[$i]->{y} - $node->[$j]-
+>{y}) *
                                      ($node->[$i]->{y} - $node->[$j]-
+>{y}))
                                    );
            # Signal by distance
            if      ($distance[$i][$j] <= 1 * $multiplier) {
                $signal[$i][$j] = 5;
            } elsif ($distance[$i][$j] <= 2 * $multiplier) {
                $signal[$i][$j] = 4;
            } elsif ($distance[$i][$j] <= 3 * $multiplier) {
                $signal[$i][$j] = 3;
            } elsif ($distance[$i][$j] <= 4 * $multiplier) {
                $signal[$i][$j] = 2;
            } elsif ($distance[$i][$j] <= 5 * $multiplier) {
                $signal[$i][$j] = 1;
            } else {
                $signal[$i][$j] = 0;
            }
        }
    }
    return (\@distance, \@signal)
}

sub move {
    my ($node, $size) = @_;

    for my $i (1..$#{$node}) {

        my $speed = int(rand($acceleration));
        my $dir   = int(rand(9));

        if ($speed > 0) {
            # Direction is as follows.  Node starts at 4
            #
            # 0 1 2
            # 3 4 5
            # 6 7 8
            #
            if        ($dir == 0) {
                if (($node->[$i]->{x} - $speed) >= 0) {
                    $node->[$i]->{x} -= $speed
                }
                if (($node->[$i]->{y} - $speed) >= 0) {
                    $node->[$i]->{y} -= $speed
                }
            } elsif ($dir == 1) {
                if (($node->[$i]->{y} - $speed) >= 0) {
                    $node->[$i]->{y} -= $speed
                }
            } elsif ($dir == 2) {
                if (($node->[$i]->{x} + $speed) <= $size) {
                    $node->[$i]->{x} += $speed
                }
                if (($node->[$i]->{y} - $speed) >= 0) {
                    $node->[$i]->{y} -= $speed
                }
            } elsif ($dir == 3) {
                if (($node->[$i]->{x} - $speed) >= 0) {
                    $node->[$i]->{x} -= $speed
                }
            } elsif ($dir == 4) {
                # no move
            } elsif ($dir == 5) {
                if (($node->[$i]->{x} + $speed) <= $size) {
                    $node->[$i]->{x} += $speed
                }
            } elsif ($dir == 6) {
                if (($node->[$i]->{x} - $speed) >= 0) {
                    $node->[$i]->{x} -= $speed
                }
                if (($node->[$i]->{y} + $speed) <= $size) {
                    $node->[$i]->{y} += $speed
                }
            } elsif ($dir == 7) {
                if (($node->[$i]->{y} + $speed) <= $size) {
                    $node->[$i]->{y} += $speed
                }
            } elsif ($dir == 8) {
                if (($node->[$i]->{x} + $speed) <= $size) {
                    $node->[$i]->{x} += $speed;
                }
                if (($node->[$i]->{y} + $speed) <= $size) {
                    $node->[$i]->{y} += $speed
                }
            }
        }
    }
}

sub print_locations {
    my ($node) = @_;

    for my $i (1..$#{$node}) {
        printf "$i => (%i,%i)\n", $node->[$i]->{x}, $node->[$i]->{y}
    }
    print "\n"
}

sub print_grid {
    my ($node, $size) = @_;

    my @grid;
    for my $i (1..$#{$node}) {
        $grid[$node->[$i]->{x}][$node->[$i]->{y}] = $i
    }

    print "-" for (0..$size+2);
    print "\n";
    for my $y (0..$size) {
        print "|";
        for my $x (0..$size) {
            printf "%s", defined($grid[$x][$y]) ? $grid[$x][$y] : " "
        }
        print "|\n"
    }
    print "-" for (0..$size+2);
    print "\n"
}

sub print_metrics {
    my ($node, $metric) = @_;

    print "    ";
    for my $i (2..$#{$node}) {
        printf "%5i ", $i 
    }
    print "\n    ";
    for my $i (2..$#{$node}) {
        printf "----- ",  
    }
    print "\n";
    for my $i (1..$#{$node}-1) {
        printf "%2i] ", $i;
        for my $j (2..$#{$node}) {
            my $p = sprintf "%2.2f", defined($metric->[$i][$j]) ? $met
+ric->[$i][$j] : 9999;
            printf "%5s ", ($p == 9999) ? "  -  " : $p
        }
        print "\n"
    }
    print "\n"
}

sub print_union {
    my ($node, $signal) = @_;

# PERL CODE found for union/intersection
#
# foreach $e (@a) { $union{$e} = 1 }
# foreach $e (@b) {
#     if ( $union{$e} ) { $isect{$e} = 1 }
#     $union{$e} = 1;
# }
# @union = keys %union;
# @isect = keys %isect;

    my (@srcs, @dsts);
    for my $i (1..$#{$node}-1) {
        for my $j (2..$#{$node}) {
            if (defined($signal->[$i][$j])) {
                if ($signal->[$i][$j] > 0) {
                    push @srcs, $i;
                    push @dsts, $j;
                    push @srcs, $j;
                    push @dsts, $i
                }
            }
        }
    }

    my %neighbors;
    for my $n (1..$#{$node}) {
        my @neighbor;
#        print "$n -> ";
        for my $i (0..$#srcs) {
            if ($srcs[$i] == $n) {
#                print "$dsts[$i] ";
                push @neighbor, $dsts[$i]
            }
        }
        $neighbors{$n} = \@neighbor;
#        print "\n"
    }

    my %allnodes;
    my %seen;
    my @onstack;
    my $FULL= 0;
    my $DONE = 0;
    my @nodeneigh;

    for my $n (1..$#{$node}) {

        if (!exists($allnodes{$n})) {

            (%seen, @onstack) = ();
            while (1) {
                if (!exists($seen{$n})) {
                    $seen{$n} = 1;
                    $allnodes{$n} = 1;
                    push @onstack, $n
                }

                my $a = pop @onstack;

                if (!defined($a)) {
                    last
                }

                do_it($a, \%neighbors, \%seen, \%allnodes, \@onstack);

                if ((my $hshcount = keys %seen) == $#{$node}) {
                    $FULL = 1;
                    last
                }

                if ((my $hshcount = keys %allnodes) == $#{$node}) {
                    $DONE = 1;
                    last
                }
            }

            if ($FULL) {
                last
            } else {
                my @temp;
                push @temp, $_ for (keys %seen);
                $nodeneigh[$n] = \@temp;
                if ($DONE) {
                    last
                }
            }
        }
    }

    if ($FULL) {
        print "FULL\n"
    } else {
        for my $i (@nodeneigh) {
            my $NEWLINE;
            for my $j (@{$i}) {
                if (defined($j)) {
                    print "$j ";
                    $NEWLINE = 1
                }
            }
            if ($NEWLINE) {
                print "\n"
            }
        }
    }
    print "\n";

    sub do_it {
        my ($n, $neighbors, $seen, $allnodes, $onstack) = @_;

        for my $neighbor (@{$neighbors->{$n}}) {
            if (!exists($seen->{$neighbor})) {
                $seen->{$neighbor} = 1;
                $allnodes->{$neighbor} = 1;
                push @{$onstack}, $neighbor;
                do_it($neighbor, $neighbors, $seen, $allnodes, $onstac
+k)
            }
        }
    }
}

########################################################
# End Program

__END__

=head1 NAME

MANET - Simulate MANET

=head1 SYNOPSIS

 manet [options] nodes

=head1 DESCRIPTION

Mobile Ad-Hoc Network (MANET) simulator takes a variable number of 
nodes and creates an appropriate grid size to randomly move the nodes 
about.  Distance and signal strength are computed for each iteration 
of node moves.

=head1 ARGUMENTS

 nodes         The number of nodes.

=head1 OPTIONS:

 -a #           Use # as an optional acceleration multiplier for 
 --acceleration each node move.  A random number x:  0 <= x <= # 
                is chosen to accelerate the move in the randomly 
                selected direction for each node on each iteration.
                DEFAULT:  (or not specified) 2.

 -D [1]         Print distance between each node matrix.
 --Distances    Optional argument causes screen refresh after each 
                iteration.

 -g #           Force grid size of # x #.  nodes < # < MAX_INT
 --grid         DEFAULT:  (or not specified) nodes*5 x nodes*5.

 -G [1]         Print visual representation of grid with nodes.
 -Grid          Optional argument causes screen refresh after each 
                iteration.

 -i #           Run the simulation # times.
 -iterations    DEFAULT:  (or not specified) Loop forever.

 -L [1]         Print node coordinates.
 -Locations     Optional argument causes screen refresh after each 
                iteration.

 -s #           Signal multiplier.  There are 6 signal levels:
 -signal          0 = no signal
                  1 = weak
                  2 = weak-to-moderate
                  3 = moderate
                  4 = moderate-to-strong
                  5 = strong

                By default, signal is inversely proportional to 
                node distance.
                  Distance between nodes <= 1 --> Signal 5
                  Distance between nodes <= 2 --> Signal 4
                  Distance between nodes <= 3 --> Signal 3
                  Distance between nodes <= 4 --> Signal 2
                  Distance between nodes <= 5 --> Signal 1
                  Distance between nodes  > 5 --> Signal 0

                This option # allows for a floating point number 
                multiplier to adjust signal calculation as below:
                  Distance between nodes <= 1 * # --> Signal 5
                  Distance between nodes <= 2 * # --> Signal 4
                  Distance between nodes <= 3 * # --> Signal 3
                  Distance between nodes <= 4 * # --> Signal 2
                  Distance between nodes <= 5 * # --> Signal 1
                  Distance between nodes  > 5 * # --> Signal 0

                DEFAULT:  (or not specified) 1.

 -S [1]         Print signal strenght between each node matrix.
 -Signals       Optional argument causes screen refresh after each 
                iteration.

 --help         Print Options and Arguments.
 --man          Print complete man page.
 --versions     Print Modules, Perl, OS, Program info.

=head1 LICENSE

This software is released under the same terms as Perl itself.
If you don't know what that means visit L<http://perl.com/>.

=head1 AUTHOR

Copyright (C) Michael Vincent 2010

L<http://www.VinsWorld.com>

All rights reserved

=cut
[download]

Comment on Union/Intersection of Multiple Arrays Select or Download Code

Replies are listed 'Best First'.
Re: Union/Intersection of Multiple Arrays by JavaFan (Canon) on Apr 21, 2010 at 14:35 UTC
QUESTION: How can I compute the sub-groups of nodes that can communicate based on signal strength and print the lists? I don't necessarily need to know "full adjacencies"; rather, just like the example above, if 1-2 and 2-3, then 1,2,3 are in a "group". What you want is called a Transitive Closure, which is a well known problem from graph theory. There are simple algorithms that run in cubic time worst case, but IIRC, an n^2.5 algorithm exists as well. Search on CPAN for "Graph" and "Transitive Closure" should give you a few pointers.	[reply]
Re^2: Union/Intersection of Multiple Arrays by VinsWorldcom (Prior) on Mar 07, 2018 at 20:18 UTC
Shame I'm only getting around to updating this little gem now, but funny how $work has a way of leading you astray just to bring you back to the same thing years later. Indeed you are CORRECT - "transitive closure", and the module Graph has a submodule Graph::TransitiveClosure::Matrix that handles this. Following is code that simply replaces the "print_union" sub from my original post. use Graph; use Graph::TransitiveClosure::Matrix; ... sub print_union { my ( $node, $signal ) = @_; my $g = Graph->new(); for my $i ( 1 .. $#{$node} - 1 ) { for my $j ( 2 .. $#{$node} ) { if ( defined( $signal->[$i][$j] ) and ( $signal->[$i][$j] +> 0 ) ) { $g->add_edge( $i, $j ); } } } my $tcm = Graph::TransitiveClosure::Matrix->new( $g, reflexive => +0 ); print " "; for my $i ( 2 .. $#{$node} ) { printf "%2i ", $i; } print "\n "; for my $i ( 2 .. $#{$node} ) { printf "-- ",; } print "\n"; for my $i ( 1 .. $#{$node} - 1 ) { printf "%2i] ", $i; for my $j ( 2 .. $#{$node} ) { printf "%2s ", ( $tcm->is_transitive( $i, $j ) ) ? "X" : " + "; } print "\n"; } } [download]	[reply] [d/l]
Re: Union/Intersection of Multiple Arrays by SuicideJunkie (Vicar) on Apr 21, 2010 at 15:32 UTC
This sounds like a matter of finding the connected components of a graph. Particularly if signal strength doesn't matter except as a boolean. Something somewhat like this: `my @networks = (); for my $device (@deviceList) { if (not defined $device->{network}) { $_->{network} = $numDisjointNetworks for BFSonConnections($device) +; #DFS works fine too $numDisjointNetworks++; } push @{$networks[$device->{network}]}, $device; }` [download] should give you a LoL of networks and devices in them, and each device will know which network it is in.	[reply] [d/l]


Pathologically Eclectic Rubbish Lister
	PerlMonks