How do I dereference an array of arrays when passed to a function?
I am doing it like this:
my #a = {\#array1, \#array2, \#array3};
func(\#a);
func{
#b = #_;
#c = #{#b};
}
Actually I want the array #c should contain the addresses of #array1, #array2, and #array3.
my #a = {\#array1, \#array2, \#array3};
The above is an array with a single member -> a hash containing:
{ ''.\#array1 => \#array2, ''.\#array3 => undef }
Because as a key in the hash, Perl coerces the reference to #array1 into a string. And Perl allows a scalar hash reference to be assigned to an array, because it is "understood" that you want an array with the first element being the scalar you assigned to it.
You create an array of arrays, like so:
my #a = (\#array1, \#array2, \#array3);
And then in your function you would unpack them, like so:
sub func {
my $ref = shift;
foreach my $arr ( #$ref ) {
my #list_of_values = #$arr;
}
}
Or some variation thereof, like say a map would be the easiest expression:
my #list_of_entries = map { #$_ } #$ref;
In your example, #c as a list of addresses is simply the same thing as a properly constructed #a.
You may want to read perldoc perlreftut, perldoc perlref, and perldoc perldsc You can say:
sub func {
my $arrayref = shift;
for my $aref (#$arrayref) {
print join(", ", #$aref), "\n";
}
}
my #array1 = (1, 2, 3);
my #array2 = (4, 5, 6);
my #array3 = (7, 8, 9);
my #a = \(#array1, #array2, #array3);
func \#a;
or more compactly:
sub func {
my $arrayref = shift;
for my $aref (#$arrayref) {
print join(", ", #$aref), "\n";
}
}
func [ [1, 2, 3], [4, 5, 6], [7, 8, 9] ];
Read the perlreftut documentation.
Edit: Others point out a good point I missed at first. In the initialization of #a, you probably meant either #a = (...) (create array containing references) or $arrayref = [...] (create reference to array), not {...} (create reference to hash). The rest of this post pretends you had the #a = (...) version.
Since you pass one argument (a reference to #a) to func, #_ is a list containing that one reference. You can get that reference and then dereference it by doing:
sub func {
my $arrayref = shift;
my #c = #{$arrayref};
}
Or in one line, it would look like:
sub func {
my #c = #{shift()};
}
(If you hadn't used the backslash in func(\#a), #_ would be equal to #a, the array of three references.)
The following function is designed to take either an array or an array reference and give back a sorted array of unique values. Undefined values are removed and HASH and GLOB are left as is.
#!/usr/bin/perl
use strict; use warnings;
my #one = qw / dog rat / ;
my #two = qw / dog mice / ;
my #tre = ( "And then they said it!", "No!?? ", );
open my $H, '<', $0 or die "unable to open $0 to read";
my $dog; # to show behavior with undefined value
my %hash; $hash{pig}{mouse}=55; # to show that it leaves HASH alone
my $rgx = '(?is)dog'; $rgx = qr/$rgx/; # included for kicks
my #whoo = (
'hey!',
$dog, # undefined
$rgx,
1, 2, 99, 999, 55.5, 3.1415926535,
%hash,
$H,
[ 1, 2,
[ 99, 55, \#tre, ],
3, ],
\#one, \#two,
[ 'fee', 'fie,' ,
[ 'dog', 'dog', 'mice', 'gopher', 'piranha', ],
[ 'dog', 'dog', 'mice', 'gopher', 'piranha', ],
],
[ 1, [ 1, 2222, ['no!', 'no...', 55, ], ], ],
[ [ [ 'Rat!', [ 'Non,', 'Tu es un rat!' , ], ], ], ],
'Hey!!',
0.0_1_0_1,
-33,
);
print join ( "\n",
recursively_dereference_sort_unique_array( [ 55, 9.000005555, ], #whoo, \#one, \#whoo, [ $H ], ),
"\n", );
close $H;
exit;
sub recursively_dereference_sort_unique_array
{
# recursively dereference array of arrays; return unique values sorted. Leave HASH and GLOB (filehandles) as they are.
# 2020v10v04vSunv12h20m15s
my $sb_name = (caller(0))[3];
#_ = grep defined, #_; #https://stackoverflow.com/questions/11122977/how-do-i-remove-all-undefs-from-array
my #redy = grep { !/^ARRAY\x28\w+\x29$/ } #_; # redy==the subset that is "ready"
my #noty = grep { /^ARRAY\x28\w+\x29$/ } #_; # noty==the subset that is "not yet"
my $countiter = 0;
while (1)
{
$countiter++;
die "$sb_name: are you in an infinite loop?" if ($countiter > 99);
my #next;
foreach my $refarray ( #noty )
{
my #tmparray = #$refarray;
push #next, #tmparray;
}
#next = grep defined, #next;
my #okay= grep { !/^ARRAY\x28\w+\x29$/ } #next;
#noty = grep { /^ARRAY\x28\w+\x29$/ } #next;
push #redy, #okay;
my %hash = map { $_ => 1 } #redy; # trick to get unique values
#redy = sort keys %hash;
return #redy unless (scalar #noty);
}
}
Should be
func {
$b = shift;
}
if you're passing in a reference. Hope that helps some.
Related
below code works fine but if I replace push #array,{%hash} with push #array,\%hash then it doesn't. Can someone please help me understand the difference. I believe {%hash} refers to an anonymous hash. Does it mean a anonymous hash lives longer than a reference to a named hash ( \%hash ).
use strict;
use warnings;
use Data::Dumper;
my #array;
my %hash;
%hash = ('a' => 1,
'b' => 2,
'c' => 3,);
push #array,{%hash};
%hash = ('e' => 1,
'f' => 2,
'd' => 3,);
push #array,{%hash};
print Dumper \#array;
output
$VAR1 = [
{
'c' => 3,
'a' => 1,
'b' => 2
},
{
'e' => 1,
'd' => 3,
'f' => 2
}
];
UPDATE
Below is the actual code I am working on. I think in this case taking copy of the reference is the only possible solution I believe. Please correct me if I am wrong.
use Data::Dumper;
use strict;
use warnings;
my %csv_data;
my %temp_hash;
my #cols_of_interest = qw(dev_file test_file diff_file status);
<DATA>; #Skipping the header
while (my $row = <DATA>) {
chomp $row;
my #array = split /,/,$row;
#temp_hash{#cols_of_interest} = #array[3..$#array];
push #{$csv_data{$array[0]}{$array[1] . ':' . $array[2]}},{%temp_hash};
}
print Dumper \%csv_data;
__DATA__
dom,type,id,dev_file,test_file,diff_file,status
A,alpha,1234,dev_file_1234_1.txt,test_file_1234_1.txt,diff_file_1234_1.txt,pass
A,alpha,1234,dev_file_1234_2.txt,test_file_1234_2.txt,diff_file_1234_2.txt,fail
A,alpha,1234,dev_file_1234_3.txt,test_file_1234_3.txt,diff_file_1234_3.txt,pass
B,beta,4567,dev_file_4567_1.txt,test_file_4567_1.txt,diff_file_4567_1.txt,pass
B,beta,4567,dev_file_4567_2.txt,test_file_4567_2.txt,diff_file_4567_2.txt,fail
C,gamma,3435,dev_file_3435_1.txt,test_file_3435_1.txt,diff_file_3435_1.txt,pass
D,hexa,6768,dev_file_6768_1.txt,test_file_6768_1.txt,diff_file_6768_1.txt,fail
Both \%hash and {%hash} create references, but they reference two different things.
\%hash is a ref to %hash. If dereferenced, its values will change with the values in %hash.
{%hash} creates a new anonymous hash reference from the values in %hash. It creates a copy. It's the simplest way of creating a shallow copy of a data structure in Perl. If you alter %hash, this copy is not affected.
How long a variable lives has nothing to do with what kind the variable is, or how it was created. Only the scope is relevant for that. References in Perl are a special case here, because there is an internal ref counter that keeps track of references to a value, so that it is kept alive if there are still references around somewhere even if it goes out of scope. That's why this works:
sub frobnicate {
my %hash = ( foo => 'bar' );
return \%hash;
}
If you want to disassociate the reference from the initial value, you need to turn it into a weak reference via weaken from Scalar::Util. That way, the ref count will not be influenced by it, but it will still be related to the value, while a copy would not be.
See perlref and perlreftut for more information on references. This question deals with how to see the ref count. A description for that is also available in the chapter Reference Counts and Mortality in perlguts.
You can't really compare \ to {} and [] since they don't do the same thing at all.
{ LIST } is short for my %anon = LIST; \%anon
[ LIST ] is short for my #anon = LIST; \#anon
Maybe you meant to compare
my %hash = ...;
push #a, \%hash;
push #a, { ... };
my %hash = ...;
push #a, { %hash };
The first snippet places a reference to %hash in #a. This is presumably found in a loop. As long as my %hash is found in the loop, a reference to a new hash will be placed in #a each time.
The second snippet does the same, just using an anonymous hash.
The third snippet makes a copy of %hash, and places a reference to that copy in #a. It gives the impression of wastefulness, so it's discouraged. (It's not actually not that wasteful because it allows %hash to be reused.)
You could also write your code
# In reality, the two blocks below are probably the body of one sub or one loop.
{
my %hash = (
a => 1,
b => 2,
c => 3,
);
push #a, \%hash;
}
{
my %hash = (
d => 3,
e => 1,
f => 2,
);
push #a, \%hash;
}
or
push #a, {
a => 1,
b => 2,
c => 3,
};
push #a, {
d => 3,
e => 1,
f => 2,
};
my #cols_of_interest = qw( dev_file test_file diff_file status );
my %csv_data;
if (defined( my $row = <DATA> )) {
chomp $row;
my #cols = split(/,/, $row);
my %cols_of_interest = map { $_ => 1 } #cols_of_interest;
my #cols_to_delete = grep { !$cols_of_interest{$_} } #cols;
while ( my $row = <DATA> ) {
chomp $row;
my %row; #row{#cols} = split(/,/, $row);
delete #row{#cols_to_delete};
push #{ $csv_data{ $row{dev_file} }{ "$row{test_file}:$row{diff_file}" } }, \%row;
}
}
Better yet, let's use a proper CSV parser.
use Text::CSV_XS qw( );
my #cols_of_interest = qw( dev_file test_file diff_file status );
my $csv = Text::CSV_XS->new({
auto_diag => 2,
binary => 1,
});
my #cols = $csv->header(\*DATA);
my %cols_of_interest = map { $_ => 1 } #cols_of_interest;
my #cols_to_delete = grep { !$cols_of_interest{$_} } #cols;
my %csv_data;
while ( my $row = $csv->getline_hr(\*DATA) ) {
delete #$row{#cols_to_delete};
push #{ $csv_data{ $row->{dev_file} }{ "$row->{test_file}:$row->{diff_file}" } }, $row;
}
am trying to map an array to a subroutine that accept 2 argument, i tried using php array_map concept but didn't work out:
sub m {
my ($n, $m) = #_;
return("The number $n is called $m in Spanish");
}
sub new_map {
my (#argument) = #_;
my #arg = #argument;
#array = map(m($_, $_), #{ $arg[0] }, #{ $arg[1]});
}
my #arr1 = (1, 2, 3);
my #arr2 = ("uno", "dos");
new_map(\#arr1, \#arr2);
#outputs
#The number 1 is called 1 in Spanish INSTEAD OF 'The number 1 is called uno in Spanish'
#The number 2 is called 2 in Spanish INSTEAD OF 'The number 1 is called dos in Spanish'
Is there a way to accomplish this.
Your updated code that uses new_map could be done like so:
use Algorithm::Loops 'MapCarMin';
my #arr1 = (1, 2, 3);
my #arr2 = ("uno", "dos");
#array = MapCarMin \&m, \#arr1, \#arr2;
or
sub call_m_over_pair_of_arrays {
my ($arrayref1, $arrayref2) = #_;
map &m($arrayref1->[$_], $arrayref2->[$_]), 0..( $#$arrayref1 < $#$arrayref2 ? $#$arrayref1 : $#$arrayref2 );
}
#array = call_m_over_pair_of_arrays( \#arr1, \#arr2 );
Answer to original question:
Parentheses don't create lists or arrays in perl; nested parentheses just flatten out into a single list; you would need to do this:
#array = map( &m(#$_), [ 1, 'uno' ], [ 2, 'dos' ] );
Or this:
use List::Util 1.29 'pairmap';
#array = pairmap { &m($a, $b) } (1, 'uno', 2, 'dos');
Don't name subroutines m; that conflicts when the m match operator. (Though you can still call such a subroutine using &, it is better not to.)
the original perl array is sorted and looks like this:
Original ARRARY:
ccc-->2
ccc-->5
abc-->3
abc-->7
cb-->6
and i like to have the following result:
FINAL ARRARY:
ccc-->7
abc-->10
cb-->6
Question:
can you please create a subroutine for that ?
this was the orig. subroutine that i used:
sub read_final_dev_file {
$dfcnt=0;
$DEVICE_ANZSUMZW=0;
$DEVICE_ANZSUM=0;
open(DATA,"$log_dir1/ALLDEVSORT.$log_file_ext1") || die ("Cannot Open Logfile: $log_dir1/$log_DEV_name.$log_file_ext1 !!!!");
#lines = <DATA>;
close(DATA);
chomp(#lines); # erase the last sign from a string
foreach $logline (#lines) {
if ($logline =~ /(.*)-->(.*)/) {
$DEVICE_CODE[$dfcnt] = $1;
$DEVICE_ANZAHL[$dfcnt] = $2;
print "DEVICE_final = $DEVICE_CODE[$dfcnt], D_ANZAHL_final = $DEVICE_ANZAHL[$dfcnt]\n";
if ($dfcnt > 0 ) {
if ( $DEVICE_CODE[$dfcnt] eq $DEVICE_CODE[$dfcnt-1] ) {
$DEVICE_ANZSUM = $DEVICE_ANZAHL[$dfcnt] + $DEVICE_ANZAHL[$dfcnt-1];
$DEVICE_ANZSUMZW = $DEVICE_ANZSUM++;
#$DEVICE_ANZSUM = $DEVICE_ANZAHL[$dfcnt]++;
#print "DEVICE_ANZAHL = $DEVICE_ANZAHL[$dfcnt],DEVICE_ANZAHL -1 = $DEVICE_ANZAHL[$dfcnt-1]\n";
print "DEVICE_eq = $DEVICE_CODE[$dfcnt], D_ANZAHL_eq = $DEVICE_ANZAHL[$dfcnt],DEVANZSUM = $DEVICE_ANZSUM,COUNT = $dfcnt\n";
}#end if
if ( $DEVICE_CODE[$dfcnt] ne $DEVICE_CODE[$dfcnt-1] ) {
#$DEVICE_ANZSUM=0;
#splice(#data3,$dfcnt+2,1) if ($DEVICE_ANZSUM > 1);
push (#data3,$DEVICE_ANZSUMZW) if ($DEVICE_ANZSUM > 1);
push (#data3,$DEVICE_ANZAHL[$dfcnt]) if ($DEVICE_ANZSUM == 0);
if ( $DEVICE_CODE[$dfcnt] ne $DEVICE_CODE[$dfcnt-1] ) {
$DEVICE_ANZSUM=0;
}
print "DEVICE_ne = $DEVICE_CODE[$dfcnt], D_ANZAHL_ne = $DEVICE_ANZAHL[$dfcnt], DEVANZSUM = $DEVICE_ANZSUM\n";
}#end if
}#end if $dfcnt
$dfcnt++;
}#end if logline
}#end for
print "#labels3\n";
print "#data3\n";
}#end sub read_final_dev_file
Probably not the best way, but this is what came to mind after seeing LeoNerd answer, since I don't have CPAN access in production and never have modules lying around:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my #input = (
[ ccc => 2 ],
[ ccc => 5 ],
[ abc => 3 ],
[ abc => 7 ],
[ cb => 6 ],
);
my %output;
$output{$_->[0]} += $_->[1] for #input;
print Dumper \%output;
my #output = map { [ $_ => $output{$_} ] } keys(%output);
print Dumper \#output;
Output:
$VAR1 = {
'abc' => 10,
'cb' => 6,
'ccc' => 7
};
$VAR1 = [
['abc', 10],
['cb', 6],
['ccc', 7],
];
You could use List::UtilsBy::partition_by to group the original list into partitions, by the first string:
use List::UtilsBy qw( partition_by );
my #input = (
[ ccc => 2 ],
[ ccc => 5 ],
[ abc => 3 ],
[ abc => 7 ],
[ cb => 6 ],
);
my %sets = partition_by { $_->[0] } #input;
Now you have a hash, keyed by the leading strings, whose values are all the ARRAY refs with that key first. You can now sum the values within them, by mapping over $_->[1] which contains the numbers:
use List::Util qw( sum );
my %totals;
foreach my $key ( keys %sets ) {
$totals{$key} = sum map { $_->[1] } #{ $sets{$key} };
}
If you're inclined towards code of a more compact and functional-looking nature, you could instead use the new pairmap here; making the whole thing expressible in one line:
use List::UtilsBy qw( partition_by );
use List::Util qw( pairmap sum );
my %totals = pairmap { $a => sum map { $_->[1] } #$b }
partition_by { $_->[0] } #input;
Edit: I should add that even though you stated in your original question that the array was sorted, this solution doesn't require it sorted. It will happily take the input in any order.
You can simplify your subroutine a lot by using a hash to track the counts instead of an array. The following uses an array #devices to track the order and a hash %device_counts to track the counts:
my #devices;
my %device_counts;
while (<DATA>) { # Read one line at a time from DATA
if (/(.*)-->(.*)/) { # This won't extract newlines so no need to chomp
if (!exists $device_counts{$1}) {
push #devices, $1; # Add to the array the first time we encounter a device
}
$device_counts{$1} += $2; # Add to the count for this device
}
}
for my $device (#devices) {
printf "%s-->%s\n", $device, $device_counts{$device};
}
I have an array of array that looks like this -
$VAR1 = [
'sid_R.ba',
'PS20TGB2YM13',
'SID_r.BA',
'ARS',
'XBUE'
]; $VAR2 = [
'sddff.pk',
'PQ10XD06K800',
'SDDFF.PK',
'USD',
'PINX'
]; $VAR3 = [
'NULL',
'NULL',
'NULL',
'.',
'XNAS'
]; $VAR4 = [
'NULL',
'NULL',
'NULL',
'.',
'XNAS'
]; $VAR5 = [
'NULL',
'NULL',
'NULL',
'EUR',
'OTCX'
]; $VAR6 = [
'sid.ba',
'PS20TGB1TN17',
'SID.BA',
'ARS',
'XBUE'
];
I want to remove the complete block (array ref) if any of its element is NULL
I have a code in which the array gets generated, so I tried a for loop to delete but then the index of the array is reduced on the inside the for loop.
So I dont know in which order the array will be or the length of array.
Please I need a generic solution.
Please help.
Thanks
You seem to have an array like
my #AoA = (
[1, 2, 3],
[4, 5, 6],
[7, 8, "NULL"],
[9, 10],
);
You want to select all child arrays that do not contain "NULL". Easy: Just use nested grep:
my #AoA_sans_NULL = grep {
not grep { $_ eq "NULL" } #$_
} #AoA;
The grep { CONDITION } #array selects all elements from #array where the CONDITION evaluates to true.
The grep { $_ eq "NULL" } #$_ counts the number of "NULL"s in the inner array. If this is zero, our condition is true, else, we don't want to keep that sub-array.
use List::MoreUtils qw(none);
my #filtered = grep {
none { $_ eq "NULL" } #$_;
} #array;
Does this do what you want?
my #new_array = grep { scalar(grep { $_ eq 'NULL' } #{$_}) == 0 } #old_array;
Old school:
my #filtered = ();
ARRAY_LOOP:
for my $array ( #AoA ){
ITEM_LOOP:
for my $item ( #$array ){
next ARRAY_LOOP if $item eq 'NULL';
} # end ITEM_LOOP
push #filtered, $array;
} # end ARRAY_LOOP
This code will be slower than the others, but an in-place solution might be useful if the data-set is very large.
use List::MoreUtils qw(any);
for(my $i = 0; $i < #AoA; $i ++) {
splice #AoA, $i --, 1
if any { $_ eq "NULL" } #{ $AoA[$i] };
}
A non-grep of a grep solution:
my #array = ...; #Array of Arrays
for my $array_index ( reverse 0 .. $#array ) {
my #inner_array = #{ $array[$array_index] };
if ( grep /^NULL$/, #inner_array ) {
splice #array, $array_index, 1;
}
}
say Dumper #array;
The splice command removes the entire subarray. I don't need to create #inner_array I could have used my dereferenced #{ $array[$array_index] } in the if statement, but I like going for clarity.
The only gotcha is that you have to go through your array of array backwards. If you go through your array from first element to last element, you'll remove element 2 which causes all the other elements to have their indexes decremented. If I first remove element 4, element 0 to 3 don't change their index.
It's not as elegant as the grep of a grep solutions, but it's a lot easier to maintain. Imagine someone who has to go through your program six months from now trying to figure out what:
grep { not grep { $_ eq "NULL" } #$_ } #array;
is doing.
I want to return several values from a perl subroutine and assign them in bulk.
This works some of the time, but not when one of the values is undef:
sub return_many {
my $val = 'hmm';
my $otherval = 'zap';
#$otherval = undef;
my #arr = ( 'a1', 'a2' );
return ( $val, $otherval, #arr );
}
my ($val, $otherval, #arr) = return_many();
Perl seems to concatenate the values, ignoring undef elements. Destructuring assignment like in Python or OCaml is what I'm expecting.
Is there a simple way to assign a return value to several variables?
Edit: here is the way I now use to pass structured data around. The #a array needs to be passed by reference, as MkV suggested.
use warnings;
use strict;
use Data::Dumper;
sub ret_hash {
my #a = (1, 2);
return (
's' => 5,
'a' => \#a,
);
}
my %h = ret_hash();
my ($s, $a_ref) = #h{'s', 'a'};
my #a = #$a_ref;
print STDERR Dumper([$s, \#a]);
Not sure what you mean by concatenation here:
use Data::Dumper;
sub return_many {
my $val = 'hmm';
my $otherval = 'zap';
#$otherval = undef;
my #arr = ( 'a1', 'a2' );
return ( $val, $otherval, #arr );
}
my ($val, $otherval, #arr) = return_many();
print Dumper([$val, $otherval, \#arr]);
prints
$VAR1 = [
'hmm',
'zap',
[
'a1',
'a2'
]
];
while:
use Data::Dumper;
sub return_many {
my $val = 'hmm';
my $otherval = 'zap';
$otherval = undef;
my #arr = ( 'a1', 'a2' );
return ( $val, $otherval, #arr );
}
my ($val, $otherval, #arr) = return_many();
print Dumper([$val, $otherval, \#arr]);
prints:
$VAR1 = [
'hmm',
undef,
[
'a1',
'a2'
]
];
The single difference being that $otherval is now undef instead of 'zap'.