I made a subroutine that I want to pass a string and an array into:
sub pass_in {
my ($str, $array) = #_;
for my $e (#$array) {
print "I see str $str and list elem: $e\n";
}
return 0;
}
my #temp_arr = qw(A B C D E);
my $str = "hello";
pass_in( $str, \#temp_arr );
This works fine, but I don't want to have to create a temp_arr. Is it possible to do?
Doesn't work:
pass_in( $str, qw(A B C D E));
Also doesn't work:
pass_in( $str, \qw(A B C D E));
I don't want to create a temporary variable.
You can use square brackets to create a reference to an array:
pass_in( $str, [qw(A B C D E)]);
perldoc perlref
In order to pass an in array, you have must an array to pass!
qw() does not create an array. It just puts a bunch of scalars on the stack. That for which you are looking is [ ]. It conveniently creates an array, initializes the array using the expression within, and returns a reference to the array.
pass_in( $str, [qw( A B C D E )] );
Alternatively, you could rewrite your subroutine to accept a list of values.
sub pass_in {
my $str = shift;
for my $e (#_) {
print "I see str $str and list elem: $e\n";
}
return 0;
}
pass_in( "hello", qw( A B C D E ) );
Related
This question already has answers here:
Difference of Two Arrays Using Perl
(10 answers)
Closed 8 years ago.
I have two arrays ,so i want to get the similar values from both the arrays in a array.
This is array :
my #a = qw( a e c d );
my #b = qw( c d e f );
Please help me how could i get the similar values in Perl.I am new in Perl
try this easy code:
my #a = qw( a e c d );
my #b = qw( c d e f );
foreach $my(#a){
print "$my\n";
if ((grep(/$my/,#b))){
push #new,$my;
}
}
print "new----#new";
Try something like below:
use strict;
use Data::Dumper;
my #a1 = qw( a e c d );
my #b1 = qw( c d e f );
my %seen;
my #final;
#seen{#a1} = (); # hash slice
foreach my $new ( #b1 ) {
push (#final, $new ) if exists $seen{$new};
}
print Dumper(\#final);
Output:
$VAR1 = [
'c',
'd',
'e'
];
A common pattern is to map a hash for seen elements and search the other array using grep.
my #a = qw( a e c d );
my #b = qw( c d e f );
my %seen = map { $_ => 1 } #a;
my #intersection = grep { $seen{$_} } #b;
print #intersection;
Assuming the end result contains elements which are present in both the arrays:
#!/usr/bin/perl -w
use strict;
my #a = qw( a e c d );
my #b = qw( c d e f );
my #c;
foreach my $x (#a)
{
foreach my $y (#b)
{
push #c, $x if ($x eq $y);
}
}
foreach (#c) {print $_."\n"};
Output:
e
c
d
You can also try http://vti.github.io/underscore-perl a clone of underscore-js. You can do an intersection of 2 arrays -> http://vti.github.io/underscore-perl/#intersection
use Underscore;
_->intersection([1, 2, 3], [101, 2, 1, 10], [2, 1]);
# [1, 2]
i declared the following sub (In reality, the values come out of the Database - so i simplified it):
sub get_date {
my ($ref_last)=#_;
$$ref_last->{duration}='24,0,4';
($$ref_last->{duration}->{d},
$$ref_last->{duration}->{h},
$$ref_last->{duration}->{m})
= split(/\,/, $$ref_last->{duration});
}
This sub is called from the main-Part of the script, like this:
my $hashy;
get_date(\$hashy);
print $hashy->{duration}->{d};
Everything ist fine, and works like a charm, until i use strict:
use strict;
my $hashy;
get_date(\$hashy);
print $hashy->{duration}->{d};
in this case perl says "Can't use string ("24,0,4") as a HASH ref while "strict refs" in use"
I already tried ref($ref_last) - but ref is a read-only function.
Any suggestions, why this happens - and perhaps a better solution ?
Here's the full (non)-Working script:
#!/usr/bin/perl -w
use strict;
my $hashy;
get_date(\$hashy);
print $hashy->{duration}->{d};
sub get_date {
my ($ref_last)=#_;
$$ref_last->{duration}='24,0,4';
($$ref_last->{duration}->{d},
$$ref_last->{duration}->{h},
$$ref_last->{duration}->{m})
= split(/\,/, $$ref_last->{duration});
}
Based on comments, you're trying to change the format of an existing hash value (from «24,0,4» to «{ d=>24, h=>0, m=>4 }»). Here's how I'd do it.
sub split_duration { # Changes in-place.
my ($duration) = #_;
my %split;
#split{qw( d h m )} = split(/,/, $duration);
$_[0] = \%split;
}
my $row = $sth->fetchrow_hashref();
split_duration( $row->{duration} );
or
sub split_duration {
my ($duration) = #_;
my %split;
#split{qw( d h m )} = split(/,/, $duration);
return \%split;
}
my $row = $sth->fetchrow_hashref();
$row->{duration} = split_duration( $row->{duration} );
Explanation of the problem and initial solutions below.
Without strict, 24,0,4 was treated as a hash reference, which means Perl was creating a variable named $24,0,4!!! That's bad, which is why use strict 'refs'; prevents it.
The underlying problem is your attempt to assign two values to $$ref_last->{duration}: a string
'24,0,4'
and a reference to a hash
{ d => 24, h => 0, m => 4 }
It can't hold both. You need to rearrange your data.
I suspect you don't actually use 24,0,4 after you split it, so you could fix the code as follows:
sub get_date {
my ($ref_last)=#_;
my $duration = '24,0,4';
#{ $$ref_last->{duration} }{qw( d h m )} =
split(/,/, $duration);
}
If you need 24,0,4, you can reconstruct it. Or maybe, you can store the combined duration along with d,h,m.
sub get_date {
my ($ref_last)=#_;
my $duration = '24,0,4';
$$ref_last->{duration}{full} = $duration;
#{ $$ref_last->{duration} }{qw( d h m )} =
split(/,/, $duration);
}
Or in a separate elements of the higher up hash.
sub get_date {
my ($ref_last)=#_;
my $duration = '24,0,4';
$$ref_last->{full_duration} = $duration;
#{ $$ref_last->{duration} }{qw( d h m )} =
split(/,/, $duration);
}
Inside get_date, you assign a string to $ref_last->{duration} but then attempt to access it like a hashref. You also have extra dollar signs that attempt to dereference individual values plucked from the hash.
I would write it as
sub get_date {
my($ref_last) = #_;
my $duration = '24,0,4';
#{ $ref_last->{duration} }{qw/ d h m /} = split /\,/, $duration;
}
The last line is a hash slice that allows you to assign values to the d, h, and m keys in a single list-assignment.
In the context of the caller, you need to set up a bit of scaffolding.
my $hashy = {};
get_date($hashy);
Without initializing $hashy to contain a new empty hashref, get_date does all its assignments and then throws away newly-built edifice. This is because when you copy parameters out of #_, you are using pass-by-value semantics.
Perl will accommodate pass-by-reference as well. Perl has a feature known as autovivification where the language builds necessary scaffolding for you on demand. To use that style, you would write
my $hashy;
get_date($hashy);
sub get_date {
my($ref_last) = #_;
my $duration = '24,0,4';
#{ $_[0]->{duration} }{qw/ d h m /} = split(/\,/, $duration);
}
Note the use of $_[0] to directly access the first parameter, which is an alias to $hashy in this case. That is, get_date modifies $hashy directly.
Either way, say we print the contents with
print "[", join("][" => %{ $hashy->{duration} }), "]\n";
in which case the output is some permutation of
[h][0][m][4][d][24]
Building complex data structures with Perl isn’t difficult, but you have to learn the rules.
Perl references and nested data structures, man perlref
Perl Data Structures Cookbook, perldoc perldsc
Manipulating Arrays of Arrays in Perl, perldoc perllol
This happens because you have a weird syntax for your hash reference.
#!/usr/bin/perl -w
use strict;
my $hashref = {};
get_date($hashref);
print $hashref->{duration}->{d};
sub get_date {
my ($ref_last) = #_;
$tmp = '24,0,4';
($ref_last->{duration}->{d},
$ref_last->{duration}->{h},
$ref_last->{duration}->{m})
= split(/,/, $tmp);
}
and in your subroutine use $ref_last->{duration}, without $$.
I have this problem: Given a number of arrays (for example in Perl, or any other language):
1. (A,B,C)
2. (B,D,E,F)
3. (C,H,G)
4. (G,H)
In each array, the first element is the parent, the rest are its children. In this case, element A has two children B and C, and B has three children D, E, and F, etc. I would like to process this set of arrays, and generate a list which contains the correct order. In this case, A is the root element, so comes B and C, then under B is D, E and F, and under C is G and H, and G also has H as children (which means an element can have multiple parent). This should be the resulting array.
Important: Look at array number 3, H comes before G, even though it's a child of G in the fourth array. So there is not particular order of children in each array, but in the final result (as shown below), must have any parent before it's child/ren.
(A,B,C,D,E,F,G,H) or (A,C,B,D,E,F,G,H) or (A,B,C,G,H,D,E,F)
Would be nice to have some recursive way of creating that array, but not a requirement.
Thanks for your time..
This would be a simple post-order traversal if it wasn't for the possibility that a node has multiple parents.
To get around this, the easiest method is to assign a tier level to each node. In this case H appears on both tiers 3 and 4, and it is always the highest tier number that is required.
This code implements that design.
use strict;
use warnings;
my #rules = (
[qw/ A B C / ],
[qw/ B D E F / ],
[qw/ C H G / ],
[qw/ G H / ],
);
# Build the tree from the set of rules
#
my %tree;
for (#rules) {
my ($parent, #kids) = #$_;
$tree{$parent}{$_}++ for #kids;
}
# Find the root node. There must be exactly one node that
# doesn't appear as a child
#
my $root = do {
my #kids = map keys %$_, values %tree;
my %kids = map {$_ => 1} #kids;
my #roots = grep {not exists $kids{$_}} keys %tree;
die qq(Multiple root nodes "#roots" found) if #roots > 1;
die qq(No root nodes found) if #roots < 1;
$roots[0];
};
# Build a hash of nodes versus their tier level using a post-order
# traversal of the tree
#
my %tiers;
my $tier = 0;
traverse($root);
# Build the sorted list and show the result
#
my #sorted = sort { $tiers{$a} <=> $tiers{$b} } keys %tiers;
print "#sorted\n";
sub max {
no warnings 'uninitialized';
my ($x, $y) = #_;
$x > $y ? $x : $y;
}
sub traverse {
my ($parent) = #_;
$tier++;
my #kids = keys %{ $tree{$parent} };
if (#kids) {
traverse($_) for #kids;
}
$tiers{$parent} = max($tiers{$parent}, $tier);
$tier--;
}
output
A B C F E D G H
Edit
This works slightly more cleanly as a hash of arrays. Here is that refactor.
use strict;
use warnings;
my #rules = (
[qw/ A B C / ],
[qw/ B D E F / ],
[qw/ C H G / ],
[qw/ G H / ],
);
# Build the tree from the set of rules
#
my %tree;
for (#rules) {
my ($parent, #kids) = #$_;
$tree{$parent} = \#kids;
}
# Find the root node. There must be exactly one node that
# doesn't appear as a child
#
my $root = do {
my #kids = map #$_, values %tree;
my %kids = map {$_ => 1} #kids;
my #roots = grep {not exists $kids{$_}} keys %tree;
die qq(Multiple root nodes "#roots") if #roots > 1;
die qq(No root nodes) if #roots < 1;
$roots[0];
};
# Build a hash of nodes versus their tier level using a post-order
# traversal of the tree
#
my %tiers;
traverse($root);
# Build the sorted list and show the result
#
my #sorted = sort { $tiers{$a} <=> $tiers{$b} } keys %tiers;
print "#sorted\n";
sub max {
no warnings 'uninitialized';
my ($x, $y) = #_;
$x > $y ? $x : $y;
}
sub traverse {
my ($parent, $tier) = #_;
$tier //= 1;
my $kids = $tree{$parent};
if ($kids) {
traverse($_, $tier + 1) for #$kids;
}
$tiers{$parent} = max($tiers{$parent}, $tier);
}
The output is equivalent to the previous solution, given that there are multiple correct orderings. Note that A will always be first and H last, and A C B F G D E H is a possiblity.
This version also works, but it gives you a permutation of all correct answers, so you get correct result each time, but it may not be as your previous result (unless you have a lot of spare time...:-)).
#!/usr/bin/perl -w
use strict;
use warnings;
use Graph::Directed qw( );
my #rules = (
[qw( A B C )],
[qw( B D E F )],
[qw( C H G )],
[qw( G H )],
);
print #rules;
my $graph = Graph::Directed->new();
for (#rules) {
my $parent = shift(#$_);
for my $child (#$_) {
$graph->add_edge($parent, $child);
}
}
$graph->is_dag()
or die("Graph has a cycle--unable to analyze\n");
$graph->is_weakly_connected()
or die "Graph is not weakly connected--unable to analyze\n";
print join ' ', $graph->topological_sort(); # for eks A C B D G H E F
The array I want to query does not change during execution:
my #const_arr=qw( a b c d e f g);
The input is a string containing the indices I want to access, for example:
my $str ="1,4";
Is there something (besides iterating over the indices in $str) along the lines of #subarray = #const_arr[$str] that will result in #subarray containing [b,e]
?
If the indices are in a string, you can split the string to get them:
#array = qw(a b c d e);
$indices = '1,4';
#subarray = #array[split /,/, $indices];
print "#subarray\n";
An array slice will do this:
#const_arr=qw(a b c d e);
#subarray=(#const_arr)[1,4];
print "#subarray"'
my #const_arr = qw(a b c d e f); # the {...} creates a hash reference,
# not what you wanted
my $str = "1,4";
my #idx = split /,/ => $str;
my #wanted = #const_arr[#idx];
or in one line:
my #wanted = #const_arr[split /,/ => $str];
#const_arr should initiate like this:
my #const_arr = qw(a b c d e f);
then you can access to 1 and 4 element by:
#const_arr[1,4]
Is there a simple way to declare a hash with multiple keys which all point to the same value in perl?
Here is something similar to what I'm looking for (I don't actually know if this works or not):
my $hash = {
a, b, c => $valA,
d, e, f => $valB
};
such that....
print $hash->{a}; #prints $valA
print $hash->{b}; #prints $valA
print $hash->{c}; #prints $valA
print $hash->{d}; #prints $valB
print $hash->{e}; #prints $valB
print $hash->{f}; #prints $valB
You can write this:
my %hash;
$hash{$_} = $valA for qw(a b c);
$hash{$_} = $valB for qw(d e f);
No, there is no simple syntax for this. (Actually, => is documented to be an alias for , whose only formal effect is that it allows a bareword to the left of it even in strict mode).
The best you could do without defining your own subs might be something like
#hash{qw(a b c)} = ($valA) x 3 ;
#hash(qw(d e f)} = ($valB) x 3 ;
I like to use a hash slice on one side and the list replication operator on the other. I use the scalar value of the keys array to figure out how many values to replicate:
#hash{ #keys } = ($value) x #keys;
There is no built in syntax, but you can always write your own:
my $value = sub {map {$_ => $_[1]} #{$_[0]}};
my $hash = {
[qw(a b c)]->$value('valA'),
[qw(d e f)]->$value('valB'),
};
say join ', ' => map "$_: $$hash{$_}", sort keys %$hash;
# a: valA, b: valA, c: valA, d: valB, e: valB, f: valB
If you are going to be doing this a lot, you might want to look at Hash::Util's hv_store function, which allows you to load multiple keys with exactly the same memory location.
You can use hash slice assignment:
my $hash = {};
#$hash{a,b,c} = ($valA) x 3;
#$hash{d,e,f} = ($valB) x 3;
Assignment can be done with statements too, such as with map. Here, map will expand into two lists.
my $hash = {
( map { $_ => $valA } ('a' .. 'c') ),
( map { $_ => $valB } ('d' .. 'f') ),
};
Yeah, as Henning Makholm pointed out, there is no direct shortcut, since => is an alias for ,. The closest thing to a shortcut I can think of is:
foreach('a','b','c')
{
$hash->{$_}=$valA;
}
foreach('d','e','f')
{
$hash->{$_}=$valB;
}