How do I take a reference to an array slice in Perl? - perl

How would you take a reference to an array slice such that when you modify elements of the slice reference, the original array is modified?
The following code works due to #_ aliasing magic, but seems like a bit of a hack to me:
my #a = 1 .. 10;
my $b = sub{\#_}->(#a[2..7]);
#$b[0, -1] = qw/ < > /;
print "#a\n";
# 1 2 < 4 5 6 7 > 9 10
Anyone have a better / faster way?
Edit: the code example above is simply to illustrate the relationship required between #a and $b, it in no way reflects the way this functionality will be used in production code.

Data::Alias seems to be able to do what you want:
#!/usr/bin/perl
use strict; use warnings;
use Data::Alias;
my #x = 1 .. 10;
print "#x\n";
my $y = alias [ #x[2 ..7] ];
#$y[0, -1] = qw/ < > /;
print "#x\n";
Output:
1 2 3 4 5 6 7 8 9 10
1 2 < 4 5 6 7 > 9 10

That's how you do it, yes. Think about it for a bit and it's not such a hack; it is simply using Perl's feature for assembling arbitrary lvalues into an array and then taking a reference to it.
You can even use it to defer creation of hash values:
$ perl -wle'my %foo; my $foo = sub{\#_}->($foo{bar}, $foo{baz}); print "before: ", keys %foo; $foo->[1] = "quux"; print "after: ", keys %foo'
before:
after: baz

Related

Why //= (defined-or) does not work in same way for array as for scalar? [duplicate]

This question already has answers here:
Why doesn't ||= work with arrays?
(2 answers)
Closed 5 years ago.
I have the following code:
$var //= 1;
#arr //= qw/ 1 2 3 /;
But I get error:
Can't modify array dereference in defined or assignment (//=) at ...
Even this #arr ||= qw/ 1 2 3 /; does not work:
Can't modify array dereference in logical or assignment (||=) at ...
But this works as expected:
#arr = #arr || qw/ 1 2 3 /;
print "#arr"; # 1 2 3
Array and hash variables can never be undefined, only empty. If I write #arr = undef then #arr becomes a one-element array containing a single undefined scalar. That isn't an undefined array
This expression
#arr //= qw/ 1 2 3 /
imposes scalar context on both operands. scalar(qw/ 1 2 3 /) is 3, while scalar #arr is the number of elements in #arr which cannot be assigned to and can never be undefined anyway
To set an empty array use this
#arr = qw/ 1 2 3 / unless #arr
You could also use a conditional expression
#arr = #arr ? #arr : qw/ 1 2 3 /
See "Assignment Operators" in perldoc perlop:
These combined assignment operators can only operate on scalars...

Perl find the elements that appears once in an array

Given an array of elements, how to find the element that occurs once only in that array:
my #array = qw(18 1 18 3 18 1 1 2 3 3);
result should be: 2
This is a variation on perlfaq5 - How can I remove duplicate elements from a list or array?
Just use a hash to count the elements, and then print the ones seen only once.
use strict;
use warnings;
my #array = qw(18 1 18 3 18 1 1 2 3 3);
my #nondup = do {
my %count;
$count{$_}++ for #array;
grep {$count{$_} == 1} keys %count;
};
print "#nondup\n";
Outputs:
2
You can also try this in simple way.
use strict;
use warnings;
my #array = qw(7 8 7 5 18 1 18 3 18 1 1 2 3 3 4 5 6 7);
my $tm = "";
my %hash=();
foreach $tm(#array){
if(exists $hash{$tm}){
$hash{$tm} = "";
}
else{
$hash{$tm} = "$tm";
}
}
print join ("\n", values %hash);exit;

Selecting elements from an array and putting it in another array in Perl

I have an array containing 10 numbers. I want to pick numbers in array index 0,2,4,6,8 and put them in a new array. Likewise with index 1,3,5,7,9. I am new to Perl (started a few days ago).
My program:
my #b;
#a = (1,2,3,4,5,6,7,8,9,10);
for($i=0;$i<=$#a;$i++)
{
push(#b,$a[$i+1]);
}
print "#b";
What am I doing wrong?
I suggest avoiding for loop as it's easier to make mistake somewhere in its usage, and use foreach
my #a = (1,2,3,4,5,6,7,8,9,10);
my (#even, #odd);
foreach my $i (0 .. $#a) {
if ($i % 2) { push #odd, $a[$i] } else { push #even, $a[$i] }
}
You can also use map to test array index modulo % 2, and then for #even decide to filter it by () or take value for it using $a[$_]
my #even = map { $_%2 ? () : $a[$_] } 0 .. $#a;
my #odd = map { $_%2 ? $a[$_] : () } 0 .. $#a;
Simple.
my #a = (1,2,3,4,5,6,7,8,9,10);
my (#even, #odd);
for ( #a ) {
$_ % 2 ? push #odd, $_ : push #even, $_;
}
A few things:
Use the pragmas use strict; and use warnings;. These will catch a lot of errors. If you use use strict;, you'll have to declare your variables with my (sometimes you'll use our, but 99% of the time, you'll use my)
In your for loop, you're using the default variable $_. This variable is evil for a variety of reasons. (One, it's global in scope, so something else could change this variable on your and you wouldn't know.). Declare your variables except in situations where you must use $_.
Standard is to put the { on the line with the for and while. Another is to avoid the C style for loop (and to avoid foreach which is just an alias to for)
Use spaces. It's much easier to read $i <= $#a than $i<=$a.
Here's my interpretation of your program:
#! /usr/bin/env perl
use strict;
use warnings;
use feature qw(say); #A nicer 'print'
my #a = qw(12 13 14 15 16 17 18 19 20);
my #even;
my #odd;
for my $element (0..$#a) {
if ( $element % 2 ) {
push #odd, $a[$element];
}
else {
push #even, $a[$element];
}
}
say '#even = ' . join ': ', #even;
say '#odd = ' . join ': ', #odd;
The output:
#even = 12: 14: 16: 18: 20
#odd = 13: 15: 17: 19
Note my for loop. I use the 0..$#a to go through each element of the array. The $# is returns the last index of the array. Note that this is easier to understand than the for($i=0;$i<=$#a;$i++) that you used. It's one of the reasons why C style for loops are discouraged.
I use the modulo operator % to parse my even/odd. Modulo is like remainder division. If the number is odd, the modulo % 2 will be a 1. Otherwise, it's zero. Modulo operations are great for anything that works on a cycle.
But let's get back to your program. Here's your original code with a few minor tweaks.
I added the use strict; and use warnings;. These catch about 99% of your programming errors.
I use use feature qw(say); because say is nicer when it comes to debugging. I can take a statement, copy it, and then throw say qq(...); around it and see what it's doing.
I added a bunch of say statements to reveal the logic of your code.
Let's watch what happens. Here's your program slightly modified:
#! /usr/bin/env perl
use strict;
use warnings;
use feature qw(say);
my #b;
my #a = (1,2,3,4,5,6,7,8,9,10);
my $i;
for($i=0; $i<=$#a; $i++) {
say "Index = $i Element = $a[$i + 1]";
say qq(push(\#b, $a[$i+1]););
push(#b,$a[$i+1]);
}
print "#b";
And here's the output:
Index = 0 Element = 2
push(#b, 2);
Index = 1 Element = 3
push(#b, 3);
Index = 2 Element = 4
push(#b, 4);
Index = 3 Element = 5
push(#b, 5);
Index = 4 Element = 6
push(#b, 6);
Index = 5 Element = 7
push(#b, 7);
Index = 6 Element = 8
push(#b, 8);
Index = 7 Element = 9
push(#b, 9);
Index = 8 Element = 10
push(#b, 10);
Use of uninitialized value in concatenation (.) or string at ./test.pl line 11.
Index = 9 Element =
Use of uninitialized value within #a in concatenation (.) or string at ./test.pl line 12.
push(#b, );
Use of uninitialized value $b[9] in join or string at ./test.pl line 15.
I can see the how each push statement is being executed, and look at that, you're pushing in each and every element. Actually, you're not because you used $a[$i+1] as what you're pushing.
Using use warnings and I can see that I am trying to push the non-existant $a[10] into your #b array.
Let's change your for loop to go to every other element
#! /usr/bin/env perl
use strict;
use warnings;
use feature qw(say);
my #b;
my #a = qw(1 2 3 4 5 6 7 8 9 10);
my $i;
for ($i=0; $i <= $#a; $i += 2) {
push #b, $a[$i];
}
The first element is $a[0]. The next element in the loop is $a[2] because I added 2 to the index instead of just incrementing it by 1. Now, I'll go through all the even elements and skip all of the odd elements.
And the output:
1 3 5 7 9
(Note that $a[0] = 1. That's why they're all odd numbers. It's why I started at 12 in my program, so $a[0] = 12 which is the even number).
My preference would be to use the while and avoid the for(...; ...; ...) construct:
#! /usr/bin/env perl
use strict;
use warnings;
use feature qw(say);
my #b;
my #a = qw(1 2 3 4 5 6 7 8 9 10);
my $i = 0;
while ( $i < $#a ) {
push #b, $a[$i];
$i += 2;
}
Even:
for($i=0;$i<=$#a;$i+=2)
{
push(#b,$a[$i]);
}
Odd:
for($i=1;$i<=$#a;$i+=2)
{
push(#b,$a[$i]);
}
List::MoreUtils has an indexes function:
use List::MoreUtils qw{indexes} ;
use 5.10.0 ;
my #a = (1,2,3,4,5,6,7,8,9,10) ;
# index of array where even
say foreach indexes { $_ % 2 == 0 } #a ;
# index of array where odd
say foreach indexes { $_ % 2 != 0 } #a ;
I admit this may be sort of inelegant and it's possibly cheating here to use a module - especially one that is not in CORE. It would be convenient if List::MoreUtils and List::Utils were just one CORE module, but still not as elegant as some the other answers here.

Builtin method of culling all values outside lower and upper, perl array

I've got an array in perl which contains sorted non-contiguous values. For example: 1 2 3 5 7 11 13 15.
I want to remove all values that are outside lower and upper, keeping lower and upper in the returned selection. My method of doing that looks like this (could probably be improved by using slice):
my #culledArray;
for ( my $i = 0; $i < scalar(#array); $i++ ) {
if ( ( $array[$i] <= $_[1] ) and ( $array[$i] >= $_[0] ) ) {
push(#culledArray, $array[$i]);
}
}
where the lower and upper are contained in $_[0] and $_[1], respectively. Is there a perl builtin that does this?
Don't know anything built-in that would do that (that is quite a specific requirement), but you can save yourself some typing by using grep:
my #culledArray = grep {( $_ <= $_[1] ) and ( $_ >= $_[0] )} #array;
If the list is long and you don't want to copy it, finding the start and end indices and using a slice might be interesting.
This is messy, but my unit tests pass, so it seems to work. Take the lower and upper indexes, based on the fact that #array is a sorted list and $_[0] >= $_[1], then create the #culledArray from #array[$lower..$upper]:
my #culledArray;
my $index = 0;
++$index until $array[$index] >= $_[0];
my $lowerIndex = $index;
while (($array[$index] <= $_[1]) and ($index < $#array)) { ++$index; }
my $upperIndex = $index;
#culledArray = #array[$lowerIndex .. $upperIndex];
return \#culledArray;
I'd love to know the efficiency of this vs the answer Mat gave. I'm almost sure that I don't necessarily traverse the entire #array (because I traverse from index of 0 until I find the $upperIndex. I'm not sure how the grep method in the linked answer works, or how perl implements the slicing of #array to #culledArray in the above code, though.
It looks like you may be using percentiles or quantiles? If so then Statistics::Descriptive may help.
The percentile method returns the value and index at that percentile, so you can use code as below
use strict;
use warnings;
use Statistics::Descriptive;
my #data = qw/ 1 2 3 5 7 11 13 15 /;
my $stat = Statistics::Descriptive::Full->new;
$stat->add_data(#data);
my ($d25, $i25) = $stat->percentile(25);
my ($d75, $i75) = $stat->percentile(75);
my #subset = ($stat->get_data)[$i25 .. $i75];
print "#subset\n";
output
2 3 5 7 11

Going out of loop Perl

I have two arrays, I am evaluating the values of one array with other. What i have done is
#array_x= qw(1 5 3 4 6);
#array_y= qw(-3 4 2 1 3);
foreach $x (#array_x){
foreach $y (#array_y){
if ($x-$y > 0){
next;
}
print "$x\n";
}
}
Here, problem is , in array_x, its first index i.e 1-(-3)=4, it satisfies, but next 1-4=-3 is not satisfying the condition, hence it should break the loop and go for next element of array_x. Here only 5 and 6 satisfies the condition with all elements of array_y, so i should get only 5,6 in the output.
Here is your loops with labels so you can break to the outer level:
XVALUE:
foreach $x (#array_x){
YVALUE:
foreach $y (#array_y){
if ($x-$y > 0){
next XVALUE;
}
print "$x\n";
}
}
You can label each loop and exit the one you want. See perldoc last
E.g.:
LINE: while (<STDIN>) {
last LINE if /^$/; # exit when done with header
#...
}
If the intention is to just find the elements which are greater than the element in the subsequent list, the following would find it in 1 iteration of each array.
use strict;
my #array_x= qw(1 5 3 4 6);
my #array_y= qw(-3 4 2 1 3);
my $max_y = $array_y[0];
foreach my $y (#array_y) {
$max_y = $y if $y > $max_y;
}
foreach my $x (#array_x) {
print "\nX=$x" if $x > $max_y;
}
Output:
X=5
X=6
Not really sure what is your need, but is this what you want?
#!/usr/bin/perl
use Modern::Perl;
my #array_x= qw(1 5 3 4 6);
my #array_y= qw(-3 4 2 1 3);
foreach my $x(#array_x){
my $OK=1;
foreach my $y(#array_y){
next if $x > $y;
$OK=0;
last;
}
say "x=$x" if $OK;
}
output:
x=5
x=6
I think you might want to rethink your method. You want to find all values in #x which are greater than all in #y. You shouldn't loop over all #y each time, you should find the max of it, then filter on the max.
use strict;
use warnings;
use List::Util 'max';
my #x= qw(1 5 3 4 6);
my #y= qw(-3 4 2 1 3);
my $ymax = max #y;
my #x_result = grep { $_ > $ymax } #x;
Or since I am crazy about the new state keyword:
use strict;
use warnings;
use 5.10.0;
use List::Util 'max';
my #x= qw(1 5 3 4 6);
my #y= qw(-3 4 2 1 3);
my #x_result = grep { state $ymax = max #y; $_ > $ymax } #x;
Edit: on re-reading previous answers, this is the same concept as angel_007, though I think this implementation is more self-documenting/readable.
Revised answer:
#!/usr/bin/perl
use strict;
use warnings;
my #array_x= qw(1 5 3 4 6);
my #array_y= qw(-3 4 2 1 3);
LABEL: for my $x (#array_x) {
for my $y (#array_y) {
next LABEL unless $x > $y;
}
print "$x\n";
}