Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Union/Intersection of Multiple Arrays

by VinsWorldcom (Prior)
on Apr 21, 2010 at 14:21 UTC ( #836074=perlquestion: print w/replies, xml ) Need Help??

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

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

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

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 n2.5 algorithm exists as well. Search on CPAN for "Graph" and "Transitive Closure" should give you a few pointers.

      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"; } }
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; }
    should give you a LoL of networks and devices in them, and each device will know which network it is in.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://836074]
Approved by Corion
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (3)
As of 2021-03-04 00:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favorite kind of desktop background is:











    Results (97 votes). Check out past polls.

    Notices?