Replace foreach with grep in perl - perl

I'm new to perl and I tried to replace my foreach-statement (version 1):
use warnings;
use strict;
$cmd_list = "abc network xyz";
foreach my $item (split(" ", $cmd_list)) {
if( $item eq "network") {
$PRINT_IP = 1;
}
}
with a grep (version 2, from some example in the internet) which should give me the count (because of scalar context) of the value "network" in a string array:
$PRINT_IP = grep(/^$network$/, split(" ", $cmd_list));
for version 1 the if statement works as supposed, but for version 2 it always evaluates to false:
if($PRINT_IP) {
...
}
Where is my fault?

There seems to be a typo, as $network is a variable; you may mean /^network$/.
Having use strict; in your program would have alerted you to an untended (so undeclared) variable. Having use warnings; would have alerted you to the use of an uninitialized variable in regex compilation.
In the loop you only set the variable $PRINT_TP (to 1) if there are any elements that match. Then List::Util has a function just for that
my $PRINT_IP = any { $_ eq 'network' } split ' ', $cmd_list;
or
my $PRINT_IP = any { /^network\z/ } split ' ', $cmd_list;
if you need regex for more complex conditions.
This returns 1 on the first match, the result that your for loop produces. If you actually need a count then indeed use grep. When there's no match $PRINT_IP is set to '', an empty string.
The library is more efficient, firstly since it stops processing once a match happens. You can also do that by adding last in your if condition but List::Util routines are generally more efficient.
More importantly: please always have use warnings; and use strict; at the beginning.

Related

Using Perl hash table to delete vowels in string, but output is always empty

I'm trying to write a short script in Perl to go through a an array of strings provided by the user, check in a hash table to see if there are vowels in the strings, then return the strings minus the vowels. I know this would be easier to accomplish using regex, but the parameters for the problem state that a hash table, exists(), and split() must be used. This is the script I have so far:
my #vowels = qw(a e i o u A E I O U);
my %vowel;
foreach $v (#vowels) {
$vowel{$v} = undef;
}
foreach $word (#ARGV) {
my #letter_array = split(undef,$word);
}
foreach $letter (#letter_array) {
print($letter) if !exists($vowel{$letter})
}
print "\n"
Input: hello
Expected output: hll
Actual output: nothing
There are no error messages, so I know it's not a syntax error.
Any ideas what I'm messing up? I'm much more comfortable with Python and this is one of my first attempts at Perl.
An alternative and more compact method of achieving the same thing is to use the substitute operator, "s" with a regular expression that matches the vowels.
Here is an example
use strict;
use warnings;
for my $word (#ARGV)
{
print $word =~ s/[aeiou]//gri;
}
or more succinctly like this
use strict;
use warnings;
for (#ARGV)
{
print s/[aeiou]//gri;
}
Key points to note
the regular expression uses the Character Class [aeiou] to match a single lower-case vowel.
the substitute operator has been given three options
the i option to force a case insensitive match. This means the Character Class [aeiou] will match both uppercase and lower-case vowels.
the g option to make the substitute match all instances of the regular expression -- in this instance it will match against all the vowels in the string.
the r option (which is a newish addition to Perl) to get the substitute operator to return the substituted string.
running that gives this
$ perl try.pl hello world
hllwrld
You should use strict not to mess visibility of your variables.
If you require perl version 5.12 or higher it would be used automatically.
So your list #letter_array exists only in foreach my $word (#ARGV) loop. That's why it's empty in the end.
If you want to fix that you'll get the following code:
#!/usr/bin/env perl
use strict;
use warnings;
my #vowels = qw( a e i o u y A E I O U Y );
my %vowel;
foreach my $v (#vowels) {
$vowel{$v} = undef;
}
my #letter_array;
foreach my $word (#ARGV) {
#letter_array = split //, $word;
}
foreach my $letter (#letter_array) {
print($letter) if !exists($vowel{$letter})
}
print "\n"
But this code is still not practical.
If you would get more that 1 word in the input, you'll show only the last one, because the # letter_array overwrites each time.
You can use map to get the hash of vowels much easier without using extra variables.
You can use less loops if you would handle each word right after reading it.
You can also use unless if you want to check if not to make it prettier and more perl-style.
Don't use split on undef. Better use split //, $word
You can use for instead of foreach because it's the same but shorter :)
So you can get an optimised solution.
#!/usr/bin/env perl
use 5.012;
use warnings;
my %vowels = map { $_ => undef } qw( a e i o u y A E I O U Y );
for my $word (#ARGV) {
my #letters = split //, $word;
for my $letter (#letters) {
print $letter unless exists $vowels{$letter};
}
print ' ';
}
print "\n"
Result:
$ perl delete_vowels.pl hello world
hll wrld

How to print a string inside double quotes inside open brackets?

/* start of maker a_b.c[0] */
/* start of maker a_b.c[1] */
maker ( "a_b.c[0]" )
maker ( "a_b.c[1]" )
How to extract the strings inside double quotes and store them into an array? Here's what i have tried.
open(file, "P2.txt");
#A = (<file>) ;
foreach $str(#A)
{
if($str =~ /"a_b.c"/)
{
print "$str \n";
}
}
Note: Only content inside double quotes have to be stored into an array. If you see the 1st line of example inside slashes, you'll see same string that i want to match. That shouldn't get printed. So only the string inside double quotes should be stored into an array. Even if the same string gets repeated somewhere else without double quotes, it should not get printed. .
It's not about looking for strings in double quotes. It's about defining a pattern (a regular expression) that matches the lines that you want to find.
Here's the smallest change that I can make to your code in order to make this work:
open(file, "P2.txt");
#A = (<file>) ;
foreach $str(#A)
{
if($str =~ /"a_b.c/) # <=== Change here
{
print "$str \n";
}
}
All I've done is to remove the closing double-quote from your match expression. Because you don't care what comes after that, you don't need to specify it in the regular expression.
I should point out that this isn't completely correct. In a regular expression, a dot has a special meaning (it means "match any character here") so to match an actual dot (which is what you want), you need to escape the dot with a backslash. So it should be:
if($str =~ /"a_b\.c/)
Rewriting to use a few more modern Perl practices, I would do something like this:
# Two safety nets to find problems in your code
use strict;
use warnings;
# say() is a better print()
use feature 'say';
# Use a variable for the filehandle (and declare it with 'my')
# Use three-arg version of open()
# Check return value from open() and die if it fails
open(my $file, '<', "P2.txt") or die $!;
# Read data directly from filehandle
while ($str = <$file>)
{
if ($str =~ /"a_b\.c/)
{
say $str;
}
}
You could even use the implicit variable ($_) and statement modifiers to make your loop even simpler.
while (<$file>) {
say if /"a_b\.c/;
}
Looking at the sample input you provided, the task can be paraphrased as "extract single string arguments to things that look like function invocations". It seems like there is the added complication not matching in C-style comments. For that, note perlfaq -q comment.
As the FAQ entry demonstrates, ignoring content in arbitrary C-style comments is generally not trivial. I decided to try C::Tokenize to help:
#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use C::Tokenize qw( tokenize );
use Const::Fast qw( const );
use Path::Tiny qw( path );
sub is_open_paren {
($_[0]->{type} eq 'grammar') && ($_[0]->{grammar} eq '(');
}
sub is_close_paren {
($_[0]->{type} eq 'grammar') && ($_[0]->{grammar} eq ')');
}
sub is_comment {
$_[0]->{type} eq 'comment';
}
sub is_string {
$_[0]->{type} eq 'string';
}
sub is_word {
$_[0]->{type} eq 'word';
}
sub find_single_string_args_in_invocations {
my ($source) = #_;
my $tokens = tokenize(path( $source )->slurp);
for (my $i = 0; $i < #$tokens; ++$i) {
next if is_comment( $tokens->[$i] );
next unless is_word( $tokens->[$i] );
next unless is_open_paren( $tokens->[$i + 1] );
next unless is_string( $tokens->[$i + 2] );
next unless is_close_paren( $tokens->[$i + 3]);
say $tokens->[$i + 2]->{string};
$i += 3;
}
}
find_single_string_args_in_invocations($ARGV[0]);
which, with your input, yields:
C:\Temp> perl t.pl test.c
"a_b.c[0]"
"a_b.c[1]"

Autovivification doesnt work even as lvalue

I have this simple code:
#!/usr/bin/perl
#inp = map 2**$_, 0..6;
#cc = grep {
my $num = $inp[$_];
my $sum; #---- HERE, I have to have the var declared first, before init.
$sum += $_ for (split //, $num);
print "$sum\n";
$sum % 2;
} 0..$#inp;
Here, the $sum will be used in for loop, However in this case:
#!/usr/bin/perl
#inp = map 2**$_, 0..6;
#cc = grep {
my $num = $inp[$_];
my $sum += $_ for (split //, $num); # HERE, Trying to autovificate - wont work
print "$sum\n";
$sum % 2;
} 0..$#inp;
But when I used var $sum at the same line with for loop - that means I am trying to declare and initiate at once - where should work the autovivifaction - As i would expect to autovivificate the $sum to zero (because used with math operator +=), but will not work, but why so? What are the rules for autovivification?
This is not autovivification. You have a syntax mistake. If you had use strict and use warnings turned on, it would be more obvious.
The post-fix for construct treats the left-hand side like a block. So there is a scope for the body of the loop. Therefore you are declaring your my $sum inside that loop body scope, and it's not visible outside.
If you turn on use warnings, you'll get Use of uninitialized value $sum in concatenation (.) or string at ... line 6, which is the print after.
You need to declare the variable first (and use strict and warnings!).
my has two effects:
At compile time, my declares the variable.
At run time, my allocates a new variable. More or less.
The first effect is what allows you to refer to the variable until the end of the enclosing block.
The second effect means $sum can't possibly hold the sum at the end of the loop since you call my to create a new variable each pass of the loop.
[ Warning: This section discusses Perl's guts. Feel free to jump ahead. ]
But why is it undef instead of containing the number from the last pass?
Well, that's cause my doesn't actually allocate a new variable when executed. It places an instruction on the stack to allocate a new one on scope exit!
The for statement modifier creates a lexical scope so that $_ can be properly restored when the statement is complete, so my $sum is replaced with a fresh variable at the end of each loop pass. (It's technically only being cleared rather than deallocated and reallocated thanks to an optimization.)
Your code could be written as follows:
#!/usr/bin/perl
use strict;
use warnings;
sub sum { my $acc; $acc += $_ for #_; $acc }
my #inp = map 2**$_, 0..6;
my #cc = grep { ( sum split // ) % 2 } #inp;
or even just
my #cc = grep { ( sum split //, 2**$_ ) % 2 } 0..6;
Always use use strict; use warnings;. Note that use warnings; would have made it more obvious that something was going wrong.
By the way, I don't know what you think autovivification means, but it's wrong.
Autovivification is the creation of a variable and a reference to it when deferencing an undefined value.
$ perl -e'
my $x;
CORE::say $x // "[undef]";
$x->[0] = 123;
CORE::say $x // "[undef]";
'
[undef]
ARRAY(0x35d7f56740)
Less formally, it could also refer to the creation of hash or array elements when using them as lvalues.
$ perl -e'
my $x;
CORE::say exists($h{x}) ? 1 : 0;
my $ref = \( $h{x} );
CORE::say exists($h{x}) ? 1 : 0;
'
0
1
There's no attempt to autovivify in your code.

Not an ARRAY reference error in "pop($str)"

I am learning Perl for work and I'm trying to practise with some basic programs.
I want my program to take a string from STDIN and modify it by taking the last character and putting it at the start of the string.
I get an error when I use variable $str in $str = <STDIN>.
Here is my code:
my $str = "\0";
$str = <STDIN>;
sub last_to_first {
chomp($str);
pop($str);
print $str;
}
last_to_first;
Exec :
Matrix :hi
Not an ARRAY reference at matrix.pl line 13, <STDIN> line 1.
Why your approach doesn't work
The pop keyword does not work on strings. Strings in Perl are not automatically cast to character arrays, and those array keywords only work on arrays.
The error message is Not an ARRAY reference because pop sees a scalar variable. References are scalars in Perl (the scalar here is something like a reference to the address of the actual array in memory). The pop built-in takes array references in Perl versions between 5.14 and 5.22. It was experimental, but got removed in the (currently latest) 5.24.
Starting with Perl 5.14, an experimental feature allowed pop to take a scalar expression. This experiment has been deemed unsuccessful, and was removed as of Perl 5.24.
How to make it work
You have to split and join your string first.
my $str = 'foo';
# turn it into an array
my #chars = split //, $str;
# remove the last char and put it at the front
unshift #chars, pop #chars;
# turn it back into a string
$str = join '', #chars;
print $str;
That will give you ofo.
Now to use that as a sub, you should pass a parameter. Otherwise you do not need a subroutine.
sub last_to_first {
my $str = shift;
my #chars = split //, $str;
unshift #chars, pop #chars;
$str = join '', #chars;
return $str;
}
You can call that sub with any string argument. You should do the chomp to remove the trailing newline from STDIN outside of the sub, because it is not needed for switching the chars. Always build your subs in the smallest possible unit to make it easy to debug them. One piece of code should do exactly one functionality.
You also do not need to initialize a string with \0. In fact, that doesn't make sense.
Here's a full program.
use strict;
use warnings 'all';
my $str = <STDIN>;
chomp $str;
print last_to_first($str);
sub last_to_first {
my $str = shift;
my #chars = split //, $str;
unshift #chars, pop #chars;
$str = join '', #chars;
return $str;
}
Testing your program
Because you now have one unit in your last_to_first function, you can easily implement a unit test. Perl brings Test::Simple and Test::More (and other tools) for that purpose. Because this is simple, we'll go with Test::Simple.
You load it, tell it how many tests you are going to do, and then use the ok function. Ideally you would put the stuff you want to test into its own module, but for simplicity I'll have it all in the same program.
use strict;
use warnings 'all';
use Test::Simple tests => 3;
ok last_to_first('foo', 'ofo');
ok last_to_first('123', '321');
ok last_to_first('qqqqqq', 'qqqqqq');
sub last_to_first {
my $str = shift;
my #chars = split //, $str;
unshift #chars, pop #chars;
$str = join '', #chars;
return $str;
}
This will output the following:
1..3
ok 1
ok 2
ok 3
Run it with prove instead of perl to get a bit more comprehensive output.
Refactoring it
Now let's change the implementation of last_to_first to use a regular expression substitution with s/// instead of the array approach.
sub last_to_first {
my $str = shift;
$str =~ s/^(.+)(.)$/$2$1/;
return $str;
}
This code uses a pattern match with two groups (). The first one has a lot of chars after the beginning of the string ^, and the second one has exactly one char, after which the string ends $. You can check it out here. Those groups end up in $1 and $2, and all we need to do is switch them around.
If you replace your function in the program with the test, and then run it, the output will be the same. You have just refactored one of the units in your program.
You can also try the substr approach from zdim's answer with this test, and you will see that the tests still pass.
The core function pop takes an array, and removes and returns its last element.
To manipulate characters in a string you can use substr, for example
use warnings;
use strict;
my $str = <STDIN>;
chomp($str);
my $last_char = substr $str, -1, 1, '';
my $new_str = $last_char . $str;
The arguments to substr mean: search the variable $str, at offset -1 (one from the back), for a substring of length 1, and replace that with an empty string '' (thus removing it). The substring that is found, here the last character, is returned. See the documentation page linked above.
In the last line the returned character is concatenated with the remaining string, using the . operator.
You can browse the list of functions broken down by categories at Perl functions by category.
Perl documentation has a lot of goodies, please look around.
Strings are very often manipulated using regular expressions. See the tutorial perlretut, the quick start perlrequick, the quick reference perlreref, and the full reference perlre.
You can also split a string into a character array and work with that. This is shown in detail in the answer by simbabque, which packs a whole lot more of good advice.
This is for substring function used for array variables:
my #arrays = qw(jan feb mar);
last_to_first(#arrays);
sub last_to_first
{
my #lists = #_;
my $last = pop(#lists);
#print $last;
unshift #lists, $last;
print #lists;
}
This is for substring function used for scalar variables:
my $str = "";
$str = <STDIN>;
chomp ($str);
last_to_first($str);
sub last_to_first
{
my $chr = shift;
my $lastchar = substr($chr, -1);
print $lastchar;
}

How do I search a Perl array for a matching string?

What is the smartest way of searching through an array of strings for a matching string in Perl?
One caveat, I would like the search to be case-insensitive
so "aAa" would be in ("aaa","bbb")
It depends on what you want the search to do:
if you want to find all matches, use the built-in grep:
my #matches = grep { /pattern/ } #list_of_strings;
if you want to find the first match, use first in List::Util:
use List::Util 'first';
my $match = first { /pattern/ } #list_of_strings;
if you want to find the count of all matches, use true in List::MoreUtils:
use List::MoreUtils 'true';
my $count = true { /pattern/ } #list_of_strings;
if you want to know the index of the first match, use first_index in List::MoreUtils:
use List::MoreUtils 'first_index';
my $index = first_index { /pattern/ } #list_of_strings;
if you want to simply know if there was a match, but you don't care which element it was or its value, use any in List::Util:
use List::Util 1.33 'any';
my $match_found = any { /pattern/ } #list_of_strings;
All these examples do similar things at their core, but their implementations have been heavily optimized to be fast, and will be faster than any pure-perl implementation that you might write yourself with grep, map or a for loop.
Note that the algorithm for doing the looping is a separate issue than performing the individual matches. To match a string case-insensitively, you can simply use the i flag in the pattern: /pattern/i. You should definitely read through perldoc perlre if you have not previously done so.
I guess
#foo = ("aAa", "bbb");
#bar = grep(/^aaa/i, #foo);
print join ",",#bar;
would do the trick.
Perl 5.10+ contains the 'smart-match' operator ~~, which returns true if a certain element is contained in an array or hash, and false if it doesn't (see perlfaq4):
The nice thing is that it also supports regexes, meaning that your case-insensitive requirement can easily be taken care of:
use strict;
use warnings;
use 5.010;
my #array = qw/aaa bbb/;
my $wanted = 'aAa';
say "'$wanted' matches!" if /$wanted/i ~~ #array; # Prints "'aAa' matches!"
If you will be doing many searches of the array, AND matching always is defined as string equivalence, then you can normalize your data and use a hash.
my #strings = qw( aAa Bbb cCC DDD eee );
my %string_lut;
# Init via slice:
#string_lut{ map uc, #strings } = ();
# or use a for loop:
# for my $string ( #strings ) {
# $string_lut{ uc($string) } = undef;
# }
#Look for a string:
my $search = 'AAa';
print "'$string' ",
( exists $string_lut{ uc $string ? "IS" : "is NOT" ),
" in the array\n";
Let me emphasize that doing a hash lookup is good if you are planning on doing many lookups on the array. Also, it will only work if matching means that $foo eq $bar, or other requirements that can be met through normalization (like case insensitivity).
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
my #bar = qw(aaa bbb);
my #foo = grep {/aAa/i} #bar;
print Dumper \#foo;
Perl string match can also be used for a simple yes/no.
my #foo=("hello", "world", "foo", "bar");
if ("#foo" =~ /\bhello\b/){
print "found";
}
else{
print "not found";
}
For just a boolean match result or for a count of occurrences, you could use:
use 5.014; use strict; use warnings;
my #foo=('hello', 'world', 'foo', 'bar', 'hello world', 'HeLlo');
my $patterns=join(',',#foo);
for my $str (qw(quux world hello hEllO)) {
my $count=map {m/^$str$/i} #foo;
if ($count) {
print "I found '$str' $count time(s) in '$patterns'\n";
} else {
print "I could not find '$str' in the pattern list\n"
};
}
Output:
I could not find 'quux' in the pattern list
I found 'world' 1 time(s) in 'hello,world,foo,bar,hello world,HeLlo'
I found 'hello' 2 time(s) in 'hello,world,foo,bar,hello world,HeLlo'
I found 'hEllO' 2 time(s) in 'hello,world,foo,bar,hello world,HeLlo'
Does not require to use a module.
Of course it's less "expandable" and versatile as some code above.
I use this for interactive user answers to match against a predefined set of case unsensitive answers.