Perl - subroutine to translate variables - perl

I wrote the following subroutine:
sub MakeNan {
my $n = $_;
if ( $n !~ /^Positive|^Negative/ ) {
return "N/A";
}
else { return "$n"; }
}
I have been calling it in the following context:
open ( FILE, $file);
while (<FILE>) {
chomp;
my #a = split("\t", $_);
my $hr = $a[55];
$hr = &MakeNan($hr);
print "$hr\n";
}
close FILE;
Unfortunately, it returns "N/A" for every value it is given despite the fact that there are many instances of values that should return either "Positive..." or "Negative..."
I don't understand what I am doing wrong to make the subroutine return "N/A" each time.

There are several mistakes. $n doesn't contain your argument because the default variable is not your argument. Your regex is wrong. Do this instead:
sub make_nan {
my ($n) = #_; # or: my $n = shift;
return $n =~ /^(Positive|Negative)/ ? $n : 'N/A';
}
And drop the & when calling your function.
But then, you don't need a subroutine since all you need is a ternary operator.

Since items passed into a subroutine are passed thru #_, your first line in sub MakeNan should be:
my $n = $_[0];
Or, since there is more than one way to do it, you could also make a scalar reference in the first line of the subroutine to $hr like this.
my $hr_ref = \$hr;

Related

Perl Sub routine to get the square of a number

I am trying to write a subroutine to demonstrate getting a subroutine of a number as a function in Perl. I have no idea how to use the #_ operator in perl
#!/usr/bin/perl
use strict ;
use warnings ;
my $number = $ARGV[0] ;
if (not defined $number) {
die " I need a number to multiply" }
sub square {
my $number = shift ;
print "$number\n"
return $number * $number ;
}
my $result = square() ;
print "$result";
Your subroutine expects a number as first argument. You access the argument when you do :
my $number = shift;
Which is actually roughly equivalent to :
my ($number) = #_;
So as you can see, #_ is a special variable that represents the list of arguments that were passed to the subroutine.
The problem in your code is that you do not pass any argument to your sub. This :
my $result = square();
Should be written as :
my $result = square($number);
You are not passing $number to your sub. Try this:
#!/usr/bin/perl
use strict ;
use warnings ;
my $number = $ARGV[0] ;
die "I need a number to multiply" unless(defined $number);
sub square {
my $number = shift ;
print "$number\n";
return $number * $number;
}
my $result = square($number);
print "$result\n";

Perform the same operation to all the variables but first variable passed in a Perl function

I am using a Perl function to dump a CSV file, where I pass certain values, and indie this function, I want to perform same operation for these passed variables except for the first variable, which is the file handle.
What I want to do is to check whether a passed argument (string) has commas in it, if so, make enclose them in quotation mark (") s.
But I need to assign these values to variable names, as I have to use them later for different purposes.
Following is my subroutine:
sub printCSVRowData
{
my $CSVFileHandle = shift;
foreach my $str (#_) {
if ($str eq "" or not defined $str or $str =~ /^ *$/) {
$str = "NA";
}
$str =~ s/\"//g;
}
my $firstCol = shift;
my $secondCol = shift;
my $thirdCol = shift;
# Do some modifications
print $CSVFileHandle "$firstCol, $secondCol, $thirdCol";
}
Now the issue is when I values to this subroutine, I get the following error message:
Modification of a read-only value attempted at line (where $str =~ s/\"//g; is called).
Can anyone help me on this ? What am I doing wrong here ? Is there any other way around for this ?
You are modifying #_, whose elements are the scalars passed as arguments. For this reason, modifying the elements of #_ isn't safe. That's why we copy the elements of #_ and the modify copies instead.
sub printCSVRowData {
my ($csv, $fh, #fields) = #_;
#fields = map { defined($_) && /\S/ ? $_ : "NA" } #fields;
$csv->say($fh, \#fields);
}
You should be using Text::CSV_XS or similar.
my $csv = Text::CSV_XS->new({
auto_diag => 2,
binary => 1,
});

No values being output

I'm having a problem coding my first Perl program.
What I'm trying to do here is getting the maximum, minimum,total and average of a list of numbers using a subroutine for each value and another subroutine to print the final values. I'm using a "private" for all my variables, but I still couldn't print my values.
Here is my code:
&max(<>);
&print_stat(<>);
sub max {
my ($mymax) = shift #_;
foreach (#_) {
if ( $_ > $mymax ) {
$mymax = $_;
}
}
return $mymax;
}
sub print_stat {
print max($mymax);
}
Please try this one:
use strict;
use warnings;
my #list_nums = qw(10 21 30 42 50 63 70);
ma_xi(#list_nums);
sub ma_xi
{
my #list_ele = #_;
my $set_val_max = '0'; my $set_val_min = '0';
my $add_all_vals = '0';
foreach my $each_ele(#list_ele)
{
$set_val_max = $each_ele if($set_val_max < $each_ele);
$set_val_min = $each_ele if($set_val_min eq '0');
$set_val_min = $each_ele if($set_val_min > $each_ele);
$add_all_vals += $each_ele;
}
my $set_val_avg = $add_all_vals / scalar(#list_ele) + 1;
print "MAX: $set_val_max\n";
print "MIN: $set_val_min\n";
print "TOT: $add_all_vals\n";
print "AVG: $set_val_avg\n";
#Return these values into array and get into the new sub routine's
}
Some notes
Use plenty of whitespace to lay out your code. I have tidied the Perl code in your question so that I could read it more easily, without changing its semantics
You must always use strict and use warnings 'all' at the top of every Perl program you write
Never use an ampersand & in a subroutine call. That hasn't been necessary or desirable since Perl 4 over twenty-five years ago. Any tutorial that tells you otherwise is wrong
Using <> in a list context (such as the parameters to a subroutine call) will read all of the file and exhaust the file handle. Thereafter, any calls to <> will return undef
You should use chomp to remove the newline from each line of input
You declare $mymax within the scope of the max subroutine, but then try to print it in print_stat where it doesn't exists. use strict and use warnings 'all' would have caught that error for you
Your max subroutine returns the maximum value that it calculated, but you never use that return value
Below is a fixed version of your code.
Note that I've read the whole file into array #values and then chomped them all at once. In general it's best to read and process input one line at a time, which would be quite possible here but I wanted to say as close to your original code as possible
I've also saved the return value from max in variable $max, and then passed that to print_stat. It doesn't make sense to try to read the file again and pass all of those values to print_stat, as your code does
I hope this helps
use strict;
use warnings 'all';
my #values = <>;
chomp #values;
my $max = max(#values);
print_stat( $max );
sub max {
my $mymax = shift;
for ( #_ ) {
if ( $_ > $mymax ) {
$mymax = $_;
}
}
return $mymax;
}
sub print_stat {
my ($val) = #_;
print $val, "\n";
}
Update
Here's a version that calculates all of the statistics that you mentioned. I don't think subroutines are a help in this case as the solution is short and no code is reusable
Note that I've added the data at the end of the program file, after __DATA__, which lets me read it from the DATA file handle. This is often handy for testing
use strict;
use warnings 'all';
my ($n, $max, $min, $tot);
while ( <DATA> ) {
next unless /\S/; # Skip blank lines
chomp;
if ( not defined $n ) {
$max = $min = $tot = $_;
}
else {
$max = $_ if $max < $_;
$min = $_ if $min > $_;
$tot += $_;
}
++$n;
}
my $avg = $tot / $n;
printf "\$n = %d\n", $n;
printf "\$max = %d\n", $max;
printf "\$min = %d\n", $min;
printf "\$tot = %d\n", $tot;
printf "\$avg = %.2f\n", $avg;
__DATA__
7
6
1
5
1
3
8
7
output
$n = 8
$max = 8
$min = 1
$tot = 38
$avg = 4.75

How to pass a hash table by refrence Perl

I am currently trying to implement a suffix tree using Perl, however, when I attempt to set the reference for the tree function, the reference location is not set, if I pass the address via a string then check the text in the string vs the location of the hash table and they are different. Any help is appreciated!
use strict;
use warnings;
use Data::Dumper;
my $count = 0;
my $str; # holds the complete string
my %root;
# takes in all lines of code
open(IN, '<:encoding(UTF-8)', $ARGV[0]) or die "Could not open file '$ARGV[0]' $!\n";
while (<IN>) {
chomp;
# concatinates with string
$str .= $_;
}
# closes input
close(IN);
#length of input string
my $l_size = length($str) - 1;
#recursively makes
sub tree {
#recursive root
my %treeRoot;
#checking incomming data
print "1 ".Dumper(\#_)."\n";
#checking incomming data
print "2 ".Dumper(\%root)."\n";
#attempts to set tree's refrence
\%treeRoot, $count = #_;
#checking incomming data
print "3 ".Dumper(\%root)."\n";
#checking incomming data
print "4 ".$count."\n";
#leaf for each node
my %leaf;
for (my $i = 0; $i < $l_size; $i++) {
#creates alphabet tree
$treeRoot { substr($str, $i, 1) } = %leaf;
}
#checking incomming data
print "5 ".Dumper(\%root)."\n";
while ($count > 0) {
#checking incomming data
print "loop 6 ".Dumper(\%root)."\n";
$count--;
#checking incomming data
print "loop 7 ".$count."\n";
#recursion not implamented yet
#tree(\$treeRoot{'a'}, $count);
}
}
tree(\%root, 2);
#print Dumper(\%root);
You need parentheses to disambiguate. This:
\%treeRoot, $count = #_;
means this:
\%treeRoot;
$count = #_;
Because the assignment operator = has higher precedence than the comma operator ,. The warning that you got from running that code tells you this: Useless use of reference constructor in void context.
To pass the arguments correctly, you need parentheses:
(\%treeRoot, $count) = #_;
Unfortunately, this does not work, because you cannot assign to a reference this way. The following error tells you that: Can't modify reference constructor in list assignment.
So what you need is to pass the reference to a scalar:
my ($href, $count) = #_;
print $href->{'value'};
I think this method is a bit backwards, though. Passing variables by reference is likely to become a source of bugs. A more natural solution is to use the return value of the subroutine to assign values:
sub foo {
my %hash;
$hash{'value'} = ....
....
return \%hash;
}
my $hashref = foo();
print $hashref->{'value'};
Your question isn't actually how to pass a hash reference, but how to receive it, as the following will not work:
\%treeRoot, $count = #_;
Basically, you need to assign your reference to a scalar like so:
use strict;
use warnings;
sub example_sub {
my ($hashref, $count) = #_;
# Add two values to the hash:
$hashref->{newkey} = 'val';
$hashref->{newkey2} = 'val2';
}
my %root;
example_sub(\%root, 2);
use Data::Dump;
dd \%root;
Outputs:
{ newkey => "val", newkey2 => "val2" }
If you don't want to modify your original hash, you can assign the values to a new hash within the sub:
my %newhash = %$hashref;
For more info on working with references, check out: perlref - Perl references and nested data structures

How to find out if a file exists in Perl

For example:
#!/usr/bin/perl
my #arr = ('/usr/test/test.*.con');
my $result = FileExists(\#arr);
print $result;
sub FileExists {
my $param = shift;
foreach my $file (#{$param}) {
print $file;
if (-e $file) {
return 1;
}
}
return 0;
}
It returns 0. But I want to find all wild characters too... How can I solve this?
-e can't handle file globs. Change this line
my #arr = ('/usr/test/test.*.con');
to
my #arr = glob('/usr/test/test.*.con');
To expand the glob pattern first and then check the matched files for existence. However, since glob will only return existing files matching the pattern, all the files will exist anyway.
If you want to handle glob patterns, use the glob operator to expand them. Then test all the paths, store the results in a hash, and return the hash.
sub FileExists {
my #param = map glob($_) => #{ shift #_ };
my %exists;
foreach my $file (#param) {
print $file, "\n";
$exists{$file} = -e $file;
}
wantarray ? %exists : \%exists;
}
Then say you use it as in
use Data::Dumper;
my #arr = ('/tmp/test/test.*.con', '/usr/bin/a.txt');
my $result = FileExists(\#arr);
$Data::Dumper::Indent = $Data::Dumper::Terse = 1;
print Dumper $result;
Sample run:
$ ls /tmp/test
test.1.con test.2.con test.3.con
$ ./prog.pl
/tmp/test/test.1.con
/tmp/test/test.2.con
/tmp/test/test.3.con
/usr/bin/a.txt
{
'/tmp/test/test.3.con' => 1,
'/tmp/test/test.1.con' => 1,
'/usr/bin/a.txt' => undef,
'/tmp/test/test.2.con' => 1
}
You need to use glob() to get the file list.
Also, I'm not sure why you are passing the array as a reference, when subroutines take an array by default. You could much more easily write it like this:
my #arr = (...);
my $result = FileExists(#arr);
sub FileExists {
foreach my $file (#_) {
...
}
return 0;
}
Using glob() you would have the shell expansion, and files using shell wildcards can be retrieved, as the others have pointed out.
And just in case you find it useful, a bit more concise function for 'all_files_exist' could be
sub all_files_exist {
# returns 1 if all files exist and 0 if the number of missing files (!-e)
# captured with grep is > 0.
# This method expect an array_ref as first and only argument
my $files=shift;
return (grep {!-e $_} #$files)>0? 0 : 1;
}
sub non_existing_files {
# or you can capture which ones fail, and print with
# print join("\n", #(non_existing_files($files)))
my $files = shift;
return [grep {!-e $_} #$files]
}