Passing arrays to a subroutine that prints each array separately - arrays

I know that this is probably a simple fix, but I have not been able to find the answer through google and searching through the questions here.
My goal is to pass multiple arrays to a subroutine that simply iterates through each array separately and prints each array with something before and after it.
What I have:
#A1 = (1, 2, 3);
#A2 = (4, 5, 6);
printdata(#A1, #A2) ;
sub printdata {
foreach(#_) {
print "$_" ;
print "###"
}
}
What I am attempting to get is:
123###456###
Instead its treating both arrays as one and iterating through each variable in the array, Putting the separator after every variable vice the entire array.
1###2###3###etc.....
I am not sure how to get the subroutine to treat the arrays as separate rather than as one.
Any Help would be greatly appreciated!

You need to pass the arrays as references:
#A1 = (1, 2, 3);
#A2 = (4, 5, 6);
printdata(\#A1, \#A2) ;
sub printdata {
foreach(#_) {
print #$_ ;
print "###"
}
}
The sub call expands the arrays into a list of scalars, which is then passed to the sub within the #_ variable. E.g.:
printdata(#A1, #A2);
is equal to:
printdata(1,2,3,4,5,6);

See the section on "Pass by Reference" in perldoc perlsub.

use strict;
use warnings;
use English qw<$LIST_SEPARATOR>;
my #A1 = (1, 2, 3);
my #A2 = (4, 5, 6);
{ local $LIST_SEPARATOR = '';
my #a = map { "#$_" } \#A1, \#A2;
$LIST_SEPARATOR = '###';
print "#a\n";
}
You also could have used join (po-tay-to, po-tah-to).
my #a = map { join( '', #$_ ) } \#A1, \#A2;
print join( '###', #a ), "\n";

Related

How to insert an array into another array at a particular index in perl

I'm very new to perl. Need some assistance in the below scenario.
I have declared an array and trying to initialize like
my #array1;
$array1[0] = 1;
$array1[1] = 2;
$array1[3] = 4;
Now I want to insert another array lets say my #data = [10,20,30]; at index 2 of array1.
So after insert array1 should look like [1, 2, [10,20,30],4]
How can I do that?
You will need to use array references.
In short you can do
$array1[2] = \#data;
This will make the second member of $array1 a reference to #data. Because this is a reference you can't access it in quite the same way as a normal array. To access #data via array1 you would use #{$array1[2]}. To access a particular member of the reference to #data you can use -> notation. See for example the simple program below:
use strict;
use warnings;
my #array1;
$array1[0] = 1;
$array1[1] = 2;
$array1[3] = 4;
my #data = (10,20,30);
$array1[2] = \#data;
print "A #array1\n"; #Note that this does not print contents of data #data
print "B #{$array1[2]}\n"; #Prints #data via array1
print "C $array1[2]->[0]\n"; #Prints 0th element of #data
You can write
$array1[2] = [10,20,30];
Be aware that what you inserting into the host array is actually an array reference. Hence the syntax: [10,20,30] is a reference while (10,20,30) is a list proper.
Perl doesn't have nested arrays.
You can use splice for doing so.
use Data::Dumper;
splice #array1, 2, 0, #data;
print Dumper \#array1;
the splice prototype is:
splice [origin array], [index], [length of elements to replace], [replacement]

Perl - Filter function for arrays

i am trying to create a subroutine that does the following :
Takes two arrays as input (Filter, Base)
Outputs only the values of the second array that do not exist in the first
Example :
#a = ( 1, 2, 3, 4, 5 );
#b = ( 1, 2, 3, 4, 5, 6, 7);
Expected output : #c = ( 6, 7 );
Called as : filter_list(#filter, #base)
###############################################
sub filter_list {
my #names = shift;
my #arrayout;
foreach my $element (#_)
{
if (!($element ~~ #names )){
push #arrayout, $element;
}
}
return #arrayout
}
Test Run :
#filter = ( 'Tom', 'John' );
#array = ( 'Tom', 'John', 'Mary' );
#array3 = filter_list(#filter,#array);
print #array3;
print "\n";
Result :
JohnJohnMary
Can anyone help? Thank you.
You can't pass arrays to subs, only scalars. So when you do
my #filtered = filter_list(#filter, #base);
you are really doing
my #filtered = filter_list($filter[0], $filter[1], ..., $base[0], $base[1], ...);
As such, when you do
my #names = shift;
you are really doing
my #names = $filter[0];
which is obviously wrong.
The simplest solution is to pass references to the arrays.
my #filtered = filter_list(\#filter, \#base);
A hash permits an efficient implementation (O(N+M)).
sub filter_list {
my ($filter, $base) = #_;
my %filter = map { $_ => 1 } #$filter;
return grep { !$filter{$_} } #$base;
}
Alternatively,
my #filtered = filter_list(\#filter, #base);
could be implemented as
sub filter_list {
my $filter = shift;
my %filter = map { $_ => 1 } #$filter;
return grep { !$filter{$_} } #_;
}
What you're looking for is the difference of two sets. This, along with union, intersection, and a bunch of others are set operations. Rather than writing your own, there's plenty of modules for dealing with sets.
Set::Object is very fast and featureful. I'd avoid using the operator interface (ie. $set1 - $set2) as it makes the code confusing. Instead use explicit method calls.
use strict;
use warnings;
use v5.10;
use Set::Object qw(set);
my $set1 = set(1, 2, 3, 4, 5);
my $set2 = set(1, 2, 3, 4, 5, 6, 7);
say join ", ", $set2->difference($set1)->members;
Note that sets are unordered and cannot contain duplicates. This may or may not be what you want.
This uses List::Compare, a module with a large collection of routines for comparing lists.
Here you want get_complement
use warnings;
use strict;
use List::Compare;
my #arr1 = ( 1, 2, 3, 4, 5 );
my #arr2 = ( 1, 2, 3, 4, 5, 6, 7);
my $lc = List::Compare->new(\#arr1, \#arr2);
my #only_in_second = $lc->get_complement;
print "#only_in_second\n";
The module has many options.
If you don't need the result sorted, pass -u to the constructor for faster operation.
There is also the "Accelerated Mode", obtained by passing -a. For the purpose of efficient repeated comparisons between the same arrays many things are precomputed at construction. With this flag that is suppressed, which speeds up single comparisons. See List::Compare Modes.
These two options can be combined, List::Compare->new('-u', '-a', \#a1, \#a2).
Operations on three or more lists are supported.
There is also the functional interface, as a separate List::Compare::Functional module.

Creating an array of arrays for GD::Graph

All right, I'm trying to make an array of arrays in Perl for use with the GD::Graph module. And I can't figure out why the following is not valid array of arrays for GD::Graph.
my #t = (1, 2, 3, 4);
my #g = (2, 4, 5, 6);
my #data = (#t, #g);
I've also tried constructing the data like below, and it still does not like it.
my #data;
push #data, #t;
push #data, #g;
I want to keep my values in seperate arrays and just combine them for use with GD::Graph, because that is what I've found to be the easiest way, even if it is ugly. How would I go about creating a valid structure for use with GD::Graph, that is created on the fly?
It complains about it here.
my $gd = $graph->plot(\#data) or die $graph->error;
Looks like #data is just a single dimension array with 8 elements.
You can define array of arrays by using the anonymous array constructor []
my #data = (
[1, 2, 3, 4],
[2, 4, 5, 6]
);
For me using array references did the trick
my #t = (1, 2, 3, 4);
my #g = (2, 4, 5, 6);
my #data = (\#t, \#g);
and the plot the chart with fro example:
my $graph = new GD::Graph::lines(800,600 );
my $gd = $graph->plot( \#data );
open OUT, ">","whatever.png" or die "Couldn't open for output: $!";
binmode(OUT);
print OUT $gd->png( );
close OUT;

Pushing an array reference repeatedly: the pushed references end up all equal

I want to create a 2d array(#combinations) that holds all combinations of another array (#indices).
I'm using push to append a reference to another array(#temp2). When I print my 2d array (using Dumper) it is not as I expect: the print statement inside the loop shows that every pushed reference is to a non-empty list, but eventually all my references point to an empty list. Why?
use Math::Combinatorics;
use Data::Dumper;
my (#combinations, #temp2);
my #indices = (0, 2, 4);
my $count = 1;
my $counter = #indices;
while ($counter>= $count) {
my $c = Math::Combinatorics->new(
count => $count,
data => \#indices,
);
$count++;
while (#temp2 = $c->next_combination) {
print "#temp2 \n";
push #combinations, \#temp2;
}
}
print Dumper(\#combinations);
Because you declare #temp2 at the top level, the reference \#temp2 will always point to the same data. Because you exit the loop as soon as #temp2 is empty, all the references in #combinations will point to this same empty array.
The remedy is easy: declare the #temp2 to be local to the while loop, by writing
while (my #temp2 = $c->next_combination) {
This will create a new variable #temp2, with its own reference, each time the loop is repeated.

How can I check if two arrays contain the same elements in Perl?

So all I need is a simple way to tell if two arrays are identical in perl. Order does not matter, so I'm looking for something like this:
my #a = (1, 2, 3);
my #b = (2, 3, 1);
my #c = (1, 2, 4);
&identical(#a, #b) returns 1
&identical(#a, #c) returns 0
Thanks!
You could tally the elements' counts in a hash. Have a (element => count) hash, and bump the count up every time the first array has that element, and down every time the other has it (or vice versa). If the two arrays have all the same elements, every value in the hash will be 0.
sub have_same_elements {
my ($arr1, $arr2) = #_;
my %counts = ();
$counts{$_} += 1 foreach (#$arr1);
$counts{$_} -= 1 foreach (#$arr2);
return !(grep { $_ != 0 } values %counts);
}
$a_and_b_same = have_same_elements(\#a, \#b); # will be true
$a_and_c_same = have_same_elements(\#a, \#c); # will be false
(Note, this might or might not work with objects that do their own stringification. Hash keys can't be references, so Perl stringifies references as you use them. Its default stringifier turns references into something like ARRAY(0x12345678), which makes references distinct unless they're to the same thingie. But if an object does its own stringification and doesn't return distinct strings for different references, this will probably break. Just so you know.)
If you're using Perl 5.10 or greater (and if you aren't, you really should upgrade), you can use the smart match operator:
use strict;
use warnings;
my #a = (1, 2, 3);
my #b = (2, 3, 1);
my #c = (1, 2, 4);
#sort each of them (numerically)
#a = sort { $a <=> $b } #a;
#b = sort { $a <=> $b } #b;
#c = sort { $a <=> $b } #c;
if ( #a ~~ #b ) {
print "\#a and \#b are the same! (after sorting)\n";
}
else {
print "nope\n";
}
if ( #a ~~ #c ) {
print "\#a and \#c are the same! (after sorting)\n";
}
else {
print "nope\n";
}
You could also roll your own function:
use strict;
use warnings;
my #a = (1, 2, 3);
my #b = (2, 3, 1);
my #c = (1, 2, 4);
print same_elements(\#a, \#b) . "\n";
print same_elements(\#a, \#c) . "\n";
#arguments are two array references
sub same_elements {
my $array_ref_1 = shift;
my $array_ref_2 = shift;
my #arr1 = #$array_ref_1;
my #arr2 = #$array_ref_2;
#If they are not the same length, we are done.
if( scalar(#arr1) != scalar(#arr2) ) {
return 0;
}
#sort them!
#arr1 = sort { $a <=> $b } #arr1;
#arr2 = sort { $a <=> $b } #arr2;
foreach my $i( 0 .. $#arr1 ) {
if ( $arr1[$i] != $arr2[$i] ) {
return 0;
}
}
return 1;
}
First off, you are going to have to rethink your function.
identical(#a, #b);
Doesn't pass two arrays to the function, but passes a single array with all of the elements in both arrays in it. It's as if you said:
identical(1, 2, 3, 2, 3, 1);
In order for your function to work, you'll have to pass references to your arrays:
identical(\#a, \#b);
I'd say to prototype your subroutine, but that's probably going to cause you more problems that it'll solve.
If order is not important, sort the arrays before comparing them. You might even be able to cheat...
sub identical {
my $array_ref_1 = shift;
my $array_fef_2 = shift;
use Digest::SHA qw(sha1_hex);
if ( ref( $array_ref_1 ) ne "ARRAY") or ( ref( $array_ref_2 ) ne "ARRAY") {
return; #Error, need two array references
}
# Dereference Arrays
my #array_1 = #{$array_ref_1};
my #array_2 = #{$array_ref_2};
# Setup Arrays to be one big scalar
my $scalar_1 = join "\n", sort #array_1;
my $scalar_2 = join "\n", sort #array_2;
my $checksum_1 = sha1_hex $scalar_1;
my $checksum_2 = sha1_hex $scalar_2;
if ($checksum_1 eq $checksum_2) {
return 1;
}
else {
return 0_but_true;
A few notes:
I could have dereferences, joined, generated the checksum, and did the comparison in a single statement. I did them separately in order to make it clearer what I was doing. Programmatically, it probably doesn't make any difference. Perl will optimize the whole thing anyway. I always go for clarity.
0_but_true returns a 0, but at the same time returns a true value. This way, you can do something like if ( identical( \#A, \#B ) ) { to make sure that the function worked. Then, you can test for zero or one.
Be sure to test your parameters. I used the ref function to do this.
I cheated. I first turned the two sorted arrays into scalars. Then, I used the sha1 checksum to verify that they're the same. A checksum using the sha1 function should be pretty good. It is highly unlikely to fail.
The real issue is what if you had multi-lined arrays like this:
#a = ("this", "that", "the\nother");
#b = ("this", "that\nthe", "other");
Using the join the way I did would cause the resulting scalars to be equal.
I guess you could write it like this in a way that makes the least assumptions on the kind of input you are dealing with (just pass the appropriate comparison sub):
use List::Util;
sub identical {
my #this = #{ +shift };
my #that = #{ +shift };
my $cmp = shift // sub { shift eq shift };
return '' unless #this == #that;
for my $idx (List::Util::shuffle keys #this) {
return '' unless $cmp->($this[$idx], $that[$idx]);
}
return 1;
}
which behaves like so:
0> identical([0..100], [0..100])
$res[0] = 1
1> identical([0..100], ['0.0', 1..100])
$res[1] = ''
2> identical([0..100], ['0.0', 1..100], sub {shift == shift})
$res[2] = 1
3> identical(['0.66666666666', 0..10], [2/3, 0..10], sub {shift == shift})
$res[3] = ''
4> identical(['0.66666666666', 0..10], [2/3, 0..10], sub {shift() - shift() < 1e-5})
$res[4] = 1
# if you need this to be true check out https://stackoverflow.com/a/12127428/13992
5> identical([0..100], [List::Util::shuffle(0..100)])
$res[5] = ''

Resources