perl: function that gives nonzero integers between 1 and $input - perl

Im looking for (how to make?) a function (module?) that for
my $scalar = 16;
return function ($scalar);
gives
#return = ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16 );
That is, gives the non-zero integers between 1 and $scalar.
It's ok to assume $scalar is a big number, but im not particularly searching for a super optimal solution.

The Range Operator .. returns a list which matches exactly what you want.
To create a list from 1 to $x, the syntax is just 1 .. $x
To assign that to an array variable, #array = 1 .. $x;

[1..16]
creates an array reference
1..16 creates a list.
Try this source
use Data::Dumper;
$c = [1..16];
#d = 1..16;
print Dumper $c;
print Dumper \#d;

sub getvalue {
my #array1 = 1..$_[0];
return (#array1);
}
else
sub getvalue {
return ( 1..$_[0]);
}
refer this too know more about range operator
http://www.perlmonks.org/?node_id=377450

What happens when you want all integers between 1 and 1_000_000_000? You wouldn't want to create an array that big even if your computer has enough memory.
#!/usr/bin/env perl
use strict;
use warnings;
sub make_lazy_increasing_sequence {
my ($current, $end) = map int, #_;
return sub {
return if $current > $end;
return $current++;
}
}
my $from_1_to_5 = make_lazy_increasing_sequence(1, 5);
my #others;
while (defined(my $i = $from_1_to_5->())) {
push #others, make_lazy_increasing_sequence($i, 10_000);
}
for (1 .. 10) { # perl makes sure this range is lazy
print join(',', map $_->(), #others), "\n";
}
print $others[-1]->(), "\n";
Output:
1,2,3,4,5
2,3,4,5,6
3,4,5,6,7
4,5,6,7,8
5,6,7,8,9
6,7,8,9,10
7,8,9,10,11
8,9,10,11,12
9,10,11,12,13
10,11,12,13,14
15

Related

Hash not changing the value

use warnings;
use strict;
my $number = 1;
my %hash =
(
key1 => $number,
key2 => 'something'
);
for (1 .. 10)
{
print $hash{key1}, "\n";
$number++;
}
The number changes in every step. The expected result was 1, 2, 3, ..., 10 but the real result is 1, 1, 1, ..., 1. Why the hash doesn't change??
You assign 1 to the variable $number, then assign the value of $number to the hash element with key key1. You then print that element ten times while incrementing the $number variable.
The changes you've made in "number" variable doesn't affect the hash since you have already assigned it and only change the value of $number afterwards
Unless you write your loop like this, and copy the value of $number into the hash every time it changes
for ( 1 .. 10 ) {
$hash{key1} = $number;
print $hash{key1}, "\n";
++$number;
}
The value of a hash element is a scalar variable in its own right
What you have written is like this
use strict;
use warnings;
my $number = 1;
my $hash_key1 = $number;
my $hash_key2 = 'something';
for ( 1 .. 10 ) {
print $hash_key1, "\n";
++$number;
}
You can use scalar reference to assign hash value.
use strict;
use warnings;
my $number = 1;
my $hash_key1 = \$number;
my $hash_key2 = 'something';
for ( 1 .. 10 ) {
print $$hash_key1 "\n";
++$number;
}
Derefering the hash_key.

perl: sprintf for element in list

I've been really confused about this, I'm trying to create a big matrix of numbers and I want to use sprintf with perl to have a nicer output. I'm trying to use sprintf like so
my $x = 0;
my $y = 0;
for ($x=1; $x<=$steps; $y++) { # loop through lines
for ($y=0; $y<=$distances; $y++) {
my $format = sprintf ("%s",$matrix[$x][$y]);
but this is really doing my head in, as I am looping through all the values of $x and $y and getting their combinations. So I am not sure if I'm meant to use more formatting arguments like so
my $format = sprintf ("%s%s%s",$matrix[$x][$y]);
(of course this is giving me compilation errors as it's not right)
But when I only use one argument, I can't put spaces in between my columns :/ Can somebody explain what's happening? I really don't understand what I'm meant to do to get the formatting nice. I'm looking to just align the columns and have a couple of whitespaces between them. Thank you all so much.
I would be thinking in terms of using map, as a way to display every element:
#!/usr/bin/env perl
use strict;
use warnings;
my #matrix = ( [1,2,3,4],
[5,6,7,8],
[9,10,11,12], );
print join ("\n", map { join ( "\t", #$_ ) } #matrix );
This is formatting on tab-stops, rather than fixed width columns, and outputs:
1 2 3 4
5 6 7 8
9 10 11 12
If you particularly wanted sprintf though:
foreach my $row ( #matrix ) {
print map { sprintf("%5s", $_) } #$row,"\n";
}
(5 columns wide).
In each of these, I'm working on whole rows - that only really applies though, if I'm right about the assumptions I've made about which elements you're displaying.
At a very basic level - your code could work as:
#!/usr/bin/env perl
use strict;
use warnings;
my #matrix = ( [ 1, 2, 3, 4 ],
[ 5, 6, 7, 8 ],
[ 9, 10, 11, 12 ], );
my $steps = 2;
my $distances = 3;
for ( my $x = 1; $x <= $steps; $x++ ) { # loop through lines
for ( my $y = 0; $y <= $distances; $y++ ) {
printf( "%5s", $matrix[$x][$y] );
}
print "\n";
}
Although note - that will only work with equal numbers of columns. You could, however, do something like:
#!/usr/bin/env perl
use strict;
use warnings;
my #matrix = ( [ 1, 2, ],
[ 3, 4, 5, ],
[ 6, 7, 8, 9, 10, 11, 12 ], );
my $steps = 2;
my $distances = 3;
for ( my $x = 1; $x <= $steps; $x++ ) { # loop through lines
for ( my $y = 0; $y <= $distances; $y++ ) {
printf( "%5s", $matrix[$x][$y] // '' );
}
print "\n";
}
Which omits the first row (because you set $x to 1), and iterates up to 4 columns:
3 4 5
6 7 8 9
This omits the extra values on the last line, and uses // to test if the cell is empty or not.
for my $row (#matrix) {
my $format = join(' ', ('%5.2f') x #$row)."\n";
printf($format, #$row);
}
If all rows have the same number of columns, you could calculate the format once.
if (#matrix) {
my $format = join(' ', ('%5.2f') x #{$matrix[0]})."\n";
for my $row (#matrix) {
printf($format, #$row);
}
}
If the size of the columns isn't unknown in advance, you'll need to need to perform the following in order:
Format the cells (if needed),
Find the length of the largest cell of each column, then
Print out the matrix with padding.
The following assumes every row of the matrix is the same length.
use List::Util qw( max );
if (#matrix) {
for my $row (#matrix) {
$_ = sprinf('%.2f', $_) for #$row;
}
my $num_cols = #{$matrix[0]};
my #col_sizes = (0) x $num_cols;
for my $row (#matrix) {
$col_sizes[$x] = max(0, $col_sizes[$x], $row->[$x]);
}
my $format = join(' ', map { "%$_s" } #col_sizes)."\n";
for my $row (#matrix) {
printf($format, #$row);
}
}

Modifying an array through a reference

I am trying to write a subroutine that will receive an array reference and then delete some of the elements of the array. For example:
use strict;
use warnings;
my #a = (1, 2, 3, 6);
func1 (\#a);
sub func1 {
my $a = shift;
my #b = (2, 6);
for my $val_to_remove (#b) {
for my $i (0..$#$a) {
my $val = $a->[$i];
if ( $val == $val_to_remove ) {
splice #$a, $i, 1;
last;
}
}
}
}
This seems, to say the least, a little awkward using two for loops.
Is it possible to simplify this?
I also tried
use strict;
use warnings;
my #a = (1, 2, 3, 6);
my $temp = \#a;
func2 (\$temp );
sub func2 {
my $a = shift;
$$a = [2, 6];
}
but then #a is not modified, but rather $temp will be..
I would also rather like to avoid passing a reference to a reference, since that will mess up the calling syntax for other modules.
Use a hash as an indicator function for identifying efficiently the items to be removed; use a grep for filtering them out:
sub func1 {
my $a = shift;
my %b = map { ($_ => 1) } (2, 6);
#$a = grep { !$b{$_} } #$a;
}
Loic's solution works well and is quite readable. I would recommend it unless you're working with large arrays that cause the grep to eat a lot of memory, or if performance is absolutely critical.
You can get a bit of a performance boost by using splice:
use strict;
use warnings;
use Data::Dump;
my #haystack = (1, 2, 3, 6);
my %needle = map { $_ => 1 } (2, 6);
foreach my $i (reverse 0 .. $#haystack) {
splice #haystack, $i, 1 if exists $needle{ $haystack[$i] };
}
dd \#haystack;
Output:
[1, 3]
Note that you must iterate through #haystack in reverse order, since every time you remove an element, the remaining elements shift to the left, changing the array indexes.
Benchmark
Here are the results from a slightly modified version of BrowserUk's corrected benchmark, written in response to foreach array - delete current row ? on PerlMonks. The original benchmark included several other methods for removing elements from an array, which I've left out for simplicity.
$ ./benchmark -N=1e2
Rate grep for_splice
grep 40959/s -- -37%
for_splice 65164/s 59% --
$ ./benchmark -N=1e3
Rate grep for_splice
grep 4072/s -- -38%
for_splice 6515/s 60% --
$ ./benchmark -N=1e4
Rate grep for_splice
grep 366/s -- -33%
for_splice 550/s 50% --
$ ./benchmark -N=1e5
Rate grep for_splice
grep 32.7/s -- -38%
for_splice 52.9/s 62% --
$ ./benchmark -N=1e6
(warning: too few iterations for a reliable count)
Rate grep for_splice
grep 2.36/s -- -28%
for_splice 3.28/s 39% --
And the benchmark code itself:
#!/usr/bin/perl -sl
use strict;
use warnings;
use Benchmark 'cmpthese';
our $N //= 1e3;
our $I //= -1;
# 10% the size of the haystack
my $num_needles = int($N / 10) || 1;
our #as;
#{ $as[ $_ ] } = 1 .. $N for 0 .. 4;
our %needle = map { int(rand($N)) => 1 } 1 .. $num_needles;
cmpthese $I, {
for_splice => q[
my $ar = $as[0];
foreach my $i (reverse 0 .. $#$ar) {
splice #$ar, $i, 1 if exists $needle{ $ar->[$i] };
}
$I == 1 and print "0: ", "#$ar";
],
grep => q[
my $ar = $as[1];
#$ar = grep { ! exists $needle{$_} } #$ar;
$I == 1 and print "1: ", "#$ar";
],
};
You can't use a simple for (LIST) loop to iterate over the indices of an array if you're also modifying the contents of the array. That's because the index of the last item may change, and you will also skip over elements if you delete the current element and increment the counter.
A while loop is required instead, or the equivalent C-style for.
This program demonstrates, as well as uing List::Util::any to check whether an array elemnent should be deleted
use strict;
use warnings;
use List::Util 'any';
my #a = (1, 2, 3, 6);
func1 (\#a);
use Data::Dump;
dd \#a;
sub func1 {
my ($a) = #_;
my #b = (2, 6);
for ( my $i = 0; $i < #$a; ) {
if ( any { $a->[$i] == $_ } #b ) {
splice #$a, $i, 1;
}
else {
++$i;
}
}
}
output
[1, 3]
With problems of this nature, it is often easier to build the array you want rather than delete from an existing one.
my #a = ( 1, 2, 3, 6 );
sub func1 {
my $aref = shift #_;
my #b = ( 2, 6 );
my #results = ();
for my $item ( #$aref ){
if( grep { $item == $_ } #b ){
next;
}
push #results, $item;
}
return #results;
}
my #results = func1( \#a );
say "#results";

Building and printing a multidimensional list in Perl without looping

The top answer in this post: How can I create a multidimensional array in Perl? suggests building a multi-dimensional array as follows:
my #array = ();
foreach my $i ( 0 .. 10 ) {
foreach my $j ( 0 .. 10 ) {
push #{ $array[$i] }, $j;
}
}
I am wondering if there is a way of building the array more compactly and avoiding the nested loop, e.g. using something like:
my #array = ();
my #other_array = (0 ... 10);
foreach my $i ( 0 .. 10 ) {
$array[$i] = #other_array; # This does not work in Perl
}
}
Does Perl support any syntax like that for building multi-dimensional arrays without nested looping?
Similarly, is there a way to print the multidimensional array without (nested) looping?
There is more than one way to do it:
Generating
push accepts LISTs
my #array;
push #{$array[$_]}, 0 .. 10 for 0 .. 10;
Alternative syntax:
my #array;
push #array, [ 0 .. 10 ] for 0 .. 10;
map eye-candy
my #array = map { [ 0 .. 10 ] } 0 .. 10;
Alternative syntax:
my #array = map [ 0 .. 10 ], 0 .. 10;
Printing
With minimal looping
print "#$_\n" for #array;
On Perl 5.10+
use feature 'say';
say "#$_" for #array;
With more formatting control
print join( ', ', #$_ ), "\n" for #array; # "0, 1, 2, ... 9, 10"
"No loops" (The loop is hidden from you)
use Data::Dump 'dd';
dd #array;
Data::Dumper
use Data::Dumper;
print Dumper \#array;
Have a look at perldoc perllol for more details
You are close, you need a reference to the other array
my #array; # don't need the empty list
my #other_array = (0 ... 10);
foreach my $i ( 0 .. 10 ) {
$array[$i] = \#other_array;
# or without a connection to the original
$array[$i] = [ #other_array ];
# or for a slice
$array[$i] = [ #other_array[1..$#other_array] ];
}
}
You can also make anonymous (unnamed) array reference directly using square braces [] around a list.
my #array;
foreach my $i ( 0 .. 10 ) {
$array[$i] = [0..10];
}
}
Edit: printing is probably easiest using the postfix for
print "#$_\n" for #array;
for numerical multidimensional arrays, you can use PDL. It has several constructors for different use cases. The one analogous to the above would be xvals. Note that PDL objects overload printing, so you can just print them out.
use PDL;
my $pdl = xvals(11, 11);
print $pdl;

How can I partition a Perl array into equal sized chunks?

I have a fixed-sized array where the size of the array is always in factor of 3.
my #array = ('foo', 'bar', 'qux', 'foo1', 'bar', 'qux2', 3, 4, 5);
How can I cluster the member of array such that we can get
an array of array group by 3:
$VAR = [ ['foo','bar','qux'],
['foo1','bar','qux2'],
[3, 4, 5] ];
my #VAR;
push #VAR, [ splice #array, 0, 3 ] while #array;
or you could use natatime from List::MoreUtils
use List::MoreUtils qw(natatime);
my #VAR;
{
my $iter = natatime 3, #array;
while( my #tmp = $iter->() ){
push #VAR, \#tmp;
}
}
I really like List::MoreUtils and use it frequently. However, I have never liked the natatime function. It doesn't produce output that can be used with a for loop or map or grep.
I like to chain map/grep/apply operations in my code. Once you understand how these functions work, they can be very expressive and very powerful.
But it is easy to make a function to work like natatime that returns a list of array refs.
sub group_by ($#) {
my $n = shift;
my #array = #_;
croak "group_by count argument must be a non-zero positive integer"
unless $n > 0 and int($n) == $n;
my #groups;
push #groups, [ splice #array, 0, $n ] while #array;
return #groups;
}
Now you can do things like this:
my #grouped = map [ reverse #$_ ],
group_by 3, #array;
** Update re Chris Lutz's suggestions **
Chris, I can see merit in your suggested addition of a code ref to the interface. That way a map-like behavior is built in.
# equivalent to my map/group_by above
group_by { [ reverse #_ ] } 3, #array;
This is nice and concise. But to keep the nice {} code ref semantics, we have put the count argument 3 in a hard to see spot.
I think I like things better as I wrote it originally.
A chained map isn't that much more verbose than what we get with the extended API.
With the original approach a grep or other similar function can be used without having to reimplement it.
For example, if the code ref is added to the API, then you have to do:
my #result = group_by { $_[0] =~ /foo/ ? [#_] : () } 3, #array;
to get the equivalent of:
my #result = grep $_->[0] =~ /foo/,
group_by 3, #array;
Since I suggested this for the sake of easy chaining, I like the original better.
Of course, it would be easy to allow either form:
sub _copy_to_ref { [ #_ ] }
sub group_by ($#) {
my $code = \&_copy_to_ref;
my $n = shift;
if( reftype $n eq 'CODE' ) {
$code = $n;
$n = shift;
}
my #array = #_;
croak "group_by count argument must be a non-zero positive integer"
unless $n > 0 and int($n) == $n;
my #groups;
push #groups, $code->(splice #array, 0, $n) while #array;
return #groups;
}
Now either form should work (untested). I'm not sure whether I like the original API, or this one with the built in map capabilities better.
Thoughts anyone?
** Updated again **
Chris is correct to point out that the optional code ref version would force users to do:
group_by sub { foo }, 3, #array;
Which is not so nice, and violates expectations. Since there is no way to have a flexible prototype (that I know of), that puts the kibosh on the extended API, and I'd stick with the original.
On a side note, I started with an anonymous sub in the alternate API, but I changed it to a named sub because I was subtly bothered by how the code looked. No real good reason, just an intuitive reaction. I don't know if it matters either way.
Or this:
my $VAR;
while( my #list = splice( #array, 0, 3 ) ) {
push #$VAR, \#list;
}
Another answer (a variation on Tore's, using splice but avoiding the while loop in favor of more Perl-y map)
my $result = [ map { [splice(#array, 0, 3)] } (1 .. (scalar(#array) + 2) % 3) ];
Try this:
$VAR = [map $_ % 3 == 0 ? ([ $array[$_], $array[$_ + 1], $array[$_ + 2] ])
: (),
0..$#array];
Another generic solution, non-destructive to the original array:
use Data::Dumper;
sub partition {
my ($arr, $N) = #_;
my #res;
my $i = 0;
while ($i + $N-1 <= $#$arr) {
push #res, [#$arr[$i .. $i+$N-1]];
$i += $N;
}
if ($i <= $#$arr) {
push #res, [#$arr[$i .. $#$arr]];
}
return \#res;
}
print Dumper partition(
['foo', 'bar', 'qux', 'foo1', 'bar', 'qux2', 3, 4, 5],
3
);
The output:
$VAR1 = [
[
'foo',
'bar',
'qux'
],
[
'foo1',
'bar',
'qux2'
],
[
3,
4,
5
]
];
As a learning experience I decided to do this in Perl6
The first, perhaps most simplest way I tried was to use map.
my #output := #array.map: -> $a, $b?, $c? { [ $a, $b // Nil, $c // Nil ] };
.say for #output;
foo bar qux
foo1 bar qux2
3 4 5
That didn't seem very scalable. What if I wanted to take the items from the list 10 at a time, that would get very annoying to write. ... Hmmm I did just mention "take" and there is a keyword named take lets try that in a subroutine to make it more generally useful.
sub at-a-time ( Iterable \sequence, Int $n where $_ > 0 = 1 ){
my $is-lazy = sequence.is-lazy;
my \iterator = sequence.iterator;
# gather is used with take
gather loop {
my Mu #current;
my \result = iterator.push-exactly(#current,$n);
# put it into the sequence, and yield
take #current.List;
last if result =:= IterationEnd;
}.lazy-if($is-lazy)
}
For kicks let's try it against an infinite list of the fibonacci sequence
my $fib = (1, 1, *+* ... *);
my #output = at-a-time( $fib, 3 );
.say for #output[^5]; # just print out the first 5
(1 1 2)
(3 5 8)
(13 21 34)
(55 89 144)
(233 377 610)
Notice that I used $fib instead of #fib. It was to prevent Perl6 from caching the elements of the Fibonacci sequence.
It might be a good idea to put it into a subroutine to create a new sequence everytime you need one, so that the values can get garbage collected when you are done with them.
I also used .is-lazy and .lazy-if to mark the output sequence lazy if the input sequence is. Since it was going into an array #output it would have tried to generate all of the elements from an infinite list before continuing onto the next line.
Wait a minute, I just remembered .rotor.
my #output = $fib.rotor(3);
.say for #output[^5]; # just print out the first 5
(1 1 2)
(3 5 8)
(13 21 34)
(55 89 144)
(233 377 610)
.rotor is actually far more powerful than I've demonstrated.
If you want it to return a partial match at the end you will need to add a :partial to the arguments of .rotor.
Use the spart function from the List::NSect package on CPAN.
perl -e '
use List::NSect qw{spart};
use Data::Dumper qw{Dumper};
my #array = ("foo", "bar", "qux", "foo1", "bar", "qux2", 3, 4, 5);
my $var = spart(3, #array);
print Dumper $var;
'
$VAR1 = [
[
'foo',
'bar',
'qux'
],
[
'foo1',
'bar',
'qux2'
],
[
3,
4,
5
]
];
Below a more generic solution to the problem:
my #array = ('foo', 'bar', 1, 2);
my $n = 3;
my #VAR = map { [] } 1..$n;
my #idx = sort map { $_ % $n } 0..$#array;
for my $i ( 0..$#array ){
push #VAR[ $idx[ $i ] ], #array[ $i ];
}
This also works when the number of items in the array is not a factor of 3.
In the above example, the other solutions with e.g. splice would produce two arrays of length 2 and one of length 0.