Related
It is getting the correct inputs and printing them inside the for loop but when I try to send it to a function module later or if I try to print it outside the for loop it is empty.
What do I need to change?
#!/usr/bin/perl
use lib "."; # This pragma include the current working directory
use Mytools;
$inputfilename = shift #ARGV;
open (INFILE, $inputfilename) or die
("Error reading file $inputfilename: $! \n");
# Storing every line of the input file in array #file_array
while (<INFILE>){
$file_array[ $#file_array + 1 ] = $_;
}
my $protein;
my #AA;
foreach $protein (#file_array)
{
#AA = Mytools::dnaToAA($protein);
print "The main AA\n",#AA;
}
print "The main array",#file_array;
my $header1 = "AA";
my $header2 = "DNA";
Mytools::printreport($header1, $header2, \#AA, \#file_array);
You're overwriting the #AA in every iteration of the foreach loop.
Instead of
#AA = Mytools::dnaToAA($protein);
use
push #AA, Mytools::dnaToAA($protein);
See push.
Next time, try to post runnable code (see mre), i.e. avoid Mytools as they're irrelevant to the problem and make the code impossible to run for anyone else but you.
Using Text::Table or Text::ANSITable, or something similar...
If I have a two-dimensional array (which represents a grid of data), where the first row can be the column headers, how can I apply that data and format it into a command line grid with columns.
Something like this: PERL : How to create table from an array?
Except that the number of rows and columns is variable depending on the array setup and needs to automatically output as such.
Thanks
You can use Text::Table to accomplish this, as it handles variable numbers of rows and columns. Although the documentation leaves a lot to be desired, you can usually look to the test files or examples to show you how the library should actually get used. I've adapted example.pl to illustrate this:
table.pl
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Text::Table;
binmode STDOUT, ':utf8';
my ($rows, $cols) = #ARGV;
$rows ||= 5;
$cols ||= 7;
my #cols = map { "column " . $_} ( 1..$cols );
my $sep = \'│';
my $major_sep = \'║';
my $tb = Text::Table->new($sep, " Number ", $major_sep,
(map { +(" $_ ", $sep) } #cols)
);
my $num_cols = #cols;
for my $row (1..$rows) {
$tb->load([ "row $row", map { "r$row,c$_" } ( 1..$cols ) ]);
}
my $make_rule = sub {
my ($args) = #_;
my $left = $args->{left};
my $right = $args->{right};
my $main_left = $args->{main_left};
my $middle = $args->{middle};
return $tb->rule(
sub {
my ($index, $len) = #_;
return ('─' x $len);
},
sub {
my ($index, $len) = #_;
my $char =
( ($index == 0) ? $left
: ($index == 1) ? $main_left
: ($index == $num_cols+1) ? $right
: $middle
);
return $char x $len;
},
);
};
my $start_rule = $make_rule->(
{
left => '┌',
main_left => '╥',
right => '┐',
middle => '┬',
}
);
my $mid_rule = $make_rule->(
{
left => '├',
main_left => '╫',
right => '┤',
middle => '┼',
}
);
my $end_rule = $make_rule->(
{
left => '└',
main_left => '╨',
right => '┘',
middle => '┴',
}
);
print $start_rule, $tb->title,
(map { $mid_rule, $_, } $tb->body()), $end_rule;
output
perl table.pl 3 5
┌────────╥──────────┬──────────┬──────────┬──────────┬──────────┐
│ Number ║ column 1 │ column 2 │ column 3 │ column 4 │ column 5 │
├────────╫──────────┼──────────┼──────────┼──────────┼──────────┤
│row 1 ║r1,c1 │r1,c2 │r1,c3 │r1,c4 │r1,c5 │
├────────╫──────────┼──────────┼──────────┼──────────┼──────────┤
│row 2 ║r2,c1 │r2,c2 │r2,c3 │r2,c4 │r2,c5 │
├────────╫──────────┼──────────┼──────────┼──────────┼──────────┤
│row 3 ║r3,c1 │r3,c2 │r3,c3 │r3,c4 │r3,c5 │
└────────╨──────────┴──────────┴──────────┴──────────┴──────────┘
While modules offer easier control and features, if you only need to print it out as a grid
use warnings;
use strict;
use feature 'say';
my #ary = ([1..3], [10..12], [100..102]);
foreach my $row (#ary) {
printf "%7.3f ", $_ for #$row;
say ''
}
Prints
1.000 2.000 3.000
10.000 11.000 12.000
100.000 101.000 102.000
Choose your specifier (%7.3f above) accordingly to what data you have. See sprintf
If the first row is headers, shift it off of the array and print with the same width but using %s
my #ary = ([qw(one two three)], [1..3], [10..12], [100..102]);
printf "%7s ", $_ for #{shift #ary};
say '';
foreach my $row (#ary) {
printf "%7.3f ", $_ for #$row;
say ''
}
This prints the same as above but with (aligned) column names in the first row.
If "grid of data" means numeric data, then the code can discover whether there is a header line, with a reasonable assumption that the first line contains something non-numeric
use List::Util qw(any);
my $have_header = any { /[^0-9.+-]/ } #{$ary[0]};
what also assumes the absence of NaN and 1e02 or such on the first line (can be checked).
Better yet, use looks_like_number from Scalar::Util
use List::Util qw(any);
use Scalar::Util qw(looks_like_number);
my $have_header = any { not looks_like_number($_) } #{$ary[0]};
This uses Perl's internal sense of what a number is, and accounts for NaN and exponential notation, among other things.
If the program needs to find out the width of columns, or they differ a lot, there is more to do for a nice output since we need the maximum width of each column.
use warnings;
use strict;
use feature 'say';
use List::Util qw(max);
my $file = shift #ARGV || 'data.txt';
open my $fh, '<', $file or die "Can't open $file: $!";
my #ary = map { [ split ] } <$fh>;
my #maxw = (1) x #{$ary[0]};
for my $r (#ary) {
for (0..$#$r) {
my $len = length $r->[$_];
$maxw[$_] = $len if $len > $maxw[$_]
}
};
my $hdr = shift #ary;
printf "%$maxw[$_]s ", $hdr->[$_] for 0..$#$hdr;
say '';
for my $i (0..$#ary) {
printf "%-$maxw[$_].2f ", $ary[$i]->[$_] for 0..$#{$ary[$i]};
say '';
}
This expects numbers, except for the header. A few other reasonable assumptions are made.
With input data.txt file used to populate the array
one two three
1.12 1.1 12
1.00 10.00 102.00
the program prints
one two three
1.12 1.10 12.00
1.00 10.00 102.00
If there is a reason to "underline" the column names print this line right after headers
say join(" ", map { '-'x$maxw[$_] } 0..$#$hdr);
(However, tables are generally most readable when free of extra decorations.)
Note. If the numbers are computed in the program those scalars are used as numbers and the length of the string representing them in print should be queried as length sprintf "%s", $num. When they are read from a file they are taken as strings, what is used above for simplicity.
Note for another refinement. The above uses (fixed) 2 decimal places. That can be changed, if needed, so to first count the number of decimal places in input and print out accordingly. However, it is probably more sensible to decide on the uniform width, or at least fix the maximum width. (One doesn't want an accidental column with 16 decimal places, most useless!)
I have a little script where I want to return an array of Dates between two dates.
Problem is that the scalar that is being added is by reference, how do I store a copy or the derefferenced value
#!/usr/bin/perl
use strict;
use warnings;
use DateTime;
my $now = DateTime->today;
my $start_date = DateTime->today;
$start_date = $start_date->subtract( days => 45 );
my #dates;
while ( $start_date <= $now ) {
push #dates, $start_date;
$start_date->add( days => 1 );
}
my $date;
foreach (#dates) {
print $_->ymd('/'), "\n";
}
You can clone the object as you push it onto the array, like this
my #dates;
while ( $start_date <= $now) {
push #dates, $start_date->clone;
$start_date->add( days => 1 );
}
foreach (#dates) {
print $_->ymd('/'), "\n";
}
but that is wasteful if you want only ever want the YMD string from each date. You can just push that instead
my #dates;
while ( $start_date <= $now) {
push #dates, $start_date->ymd('/');
$start_date->add( days => 1 );
}
print "$_\n" for #dates;
You can set up the array more simply by working on the elements of the array itself, as follows
my #dates = (DateTime->today);
unshift #dates, $dates[0]->clone->subtract(days => 1) for 1 .. 45;
But in the end it is neater, and probably faster, to use the Time::Piece to do the same thing. It is a core module, and so shouldn't need installing if your copy of perl is at all recent, it is far smaller than DateTime, and is probably faster
use strict;
use warnings;
use Time::Piece;
use Time::Seconds 'ONE_DAY';
my #dates = map { localtime() - $_ * ONE_DAY } reverse 0 .. 45;
print $_->ymd('/'), "\n" for #dates;
output
2014/07/24
2014/07/25
2014/07/26
2014/07/27
2014/07/28
2014/07/29
2014/07/30
2014/07/31
2014/08/01
2014/08/02
2014/08/03
2014/08/04
2014/08/05
2014/08/06
2014/08/07
2014/08/08
2014/08/09
2014/08/10
2014/08/11
2014/08/12
2014/08/13
2014/08/14
2014/08/15
2014/08/16
2014/08/17
2014/08/18
2014/08/19
2014/08/20
2014/08/21
2014/08/22
2014/08/23
2014/08/24
2014/08/25
2014/08/26
2014/08/27
2014/08/28
2014/08/29
2014/08/30
2014/08/31
2014/09/01
2014/09/02
2014/09/03
2014/09/04
2014/09/05
2014/09/06
2014/09/07
Update
To store strings in the array instead of Time::Piece objects, you could write this instead
use strict;
use warnings;
use Time::Piece;
use Time::Seconds 'ONE_DAY';
my $today = localtime;
my #dates = map { ($today - $_ * ONE_DAY)->ymd('/') } reverse 0 .. 45;
print "$_\n" for #dates;
The output is identical to that of the previous program.
apparently there is a function for it called clone()
so this
push(#dates, $start_date);
changes into
push(#dates, $start_date->clone);
I'm trying to filter an array of a delimited text file in my program. The array from this text file looks like this:
YCL049C 1 511.2465 0 0 MFSK
YCL049C 2 4422.3098 0 0 YLVTASSLFVALT
YCL049C 3 1131.5600 0 0 DFYQVSFVK
YCL049C 4 1911.0213 0 0 SIAPAIVNSSVIFHDVSR
YCL049C 5 774.4059 0 0 GVAMGNVK
..
.
and the code I have for this section of the program is:
my #msfile_filtered;
my $msline;
foreach $msline (#msfile) {
my ($name, $pnum, $m2c, $charge, $missed, $sequence) = split (" ", $msline);
if (defined $amino) {
if ($amino =~ /$sequence/i) {
push (#msfile_filtered, $msline);
}
}
else {
push (#msfile_filtered, $msline);
}
}
$amino will just be a letter that will be input by the user, and corresponds to the last field $sequence. It is not essential that the user actually inputs $amino, so I need to duplicate this array and keep it unchanged if this is the case (hence the else statement). At the minute the #msfile_filtered array is empty, but I am unsure why, any ideas?
EDIT: just to clarify, there is only one space between each field, I copy and pasted this from notpad++, so extra spaced were added. The file itself will only have one space between fields.
Thanks in advance!
The regex that tries to find matching rows is backwards. To find a needle in a haystack, you need to write $haystack =~ /needle/, not the other way around.
Also, to simplify your logic, if $amino is undef, skip the loop entirely. I would rewrite your code as follows:
if (defined $amino)
{
foreach $msline (#msfile)
{
my ($name, $pnum, $m2c, $charge, $missed, $sequence) = split(" ", $msline);
push #msfile_filtered, $msline if ($sequence =~ /$amino/i);
}
} else
{
#msfile_filtered = #msfile;
}
You could simplify this further down to a single grep statement, but that begins to get hard to read. An example of such a line might be:
#msfile_filtered =
defined $amino
? grep { ( split(" ", $_ ) )[5] =~ /$amino/i } #msfile
: #msfile;
The split is should take more than one whitespaces, and the regex vars are vice versa.
First debug to check that values are correct after the split.
Also, you must swap your regex variables like this:
if ($sequence =~ /$amino/i) {
Now you're checking if $amino contains $sequence, which obviously it doesn't
I am trying to teach myself Perl and I have been struggling... Last night I did a program to calculate the average of a set of numbers that the user provided in order to learn about lists and user input so today I thought I would do a Morse Code decoder to learn about Hashes. I have looked through the book that I bought and it doesn't really explain hashes very well... it actually doesn't explain a lot of things very well. Any help would be appreciated!
Anyways, I am wanting to write a program that decodes the morse code that the user inputs. So the user would enter:
-.-.
.-
-
...
!
.-.
..-
.-..
.
The exclamation point would signify a separate word. This message would return "Cats Rule" to the user. Below is the code I have so far... Remember.. I have been programming in perl for under 24 hours haha.
Code:
use 5.010;
my %morsecode=(
'.-' =>'A', '-...' =>'B', '-.-.' =>'C', '-..' =>'D',
'.' =>'E', '..-.' =>'F', '--.' =>'G', '....' =>'H',
'..' =>'I', '.---' =>'J', '-.-' =>'K', '.-..' =>'L',
'--' =>'M', '-.' =>'N', '---' =>'O', '.--.' =>'P',
'--.-' =>'Q', '.-.' =>'R', '...' =>'S', '-' =>'T',
'..-' =>'U', '...-' =>'V', '.--' =>'W', '-..-' =>'X',
'-.--' =>'Y', '--..' =>'Z', '.----' =>'1', '..---' =>'2',
'...--' =>'3', '....-' =>'4', '.....' =>'5', '-....' =>'6',
'--...' =>'7', '---..' =>'8', '----.' =>'9', '-----' =>'0',
'.-.-.-'=>'.', '--..--'=>',', '---...'=>':', '..--..'=>'?',
'.----.'=>'\'', '-...-' =>'-', '-..-.' =>'/', '.-..-.'=>'\"'
);
my #k = keys %morsecode;
my #v = values %morsecode;
say "Enter a message in morse code separated by a line. Use the exclamation point (!) to separate words. Hit Control+D to signal the end of input.";
my #message = <STDIN>;
chomp #message;
my $decodedMessage = encode(#message);
sub encode {
foreach #_ {
if (#_ == #k) {
return #k;
#This is where I am confused... I am going to have to add the values to an array, but I don't really know how to go about it.
}
else if(#_ == '!') {return ' '}
else
{
return 'Input is not valid';
}
}
}
Your code contains two syntactic errors: foreach requires a list to iterate over; this means parens. Unlike C and other languages, Perl doesn't support else if (...). Instead, use elsif (...).
Then there are a few semantic mistakes: The current value of an iteration is stored in $_. The array #_ contains the arguments of the call to your function.
Perl comparse strings and numbers differently:
Strings Numbers
eq ==
lt <
gt >
le <=
ge >=
ne !=
cmp <=>
Use the correct operators for the task at hand, in this case, the stringy ones.
(Your code #_ == #k does something, namely using arrays in numeric context. This produces the number of elements, which is subsequenty compared. #_ == '!' is just weird.)
What you really want to do is to map the inputted values to a list of characters. Your hash defines this mapping, but we want to apply it. Perl has a map function, it works like
#out_list = map { ACTION } #in_list;
Inside the action block, the current value is available as $_.
We want our action to look up the appropriate value in the hash, or include an error message if there is no mapping for the input string:
my #letters = map { $morsecode{$_} // "<unknown code $_>" } #message;
This assumes ! is registered as a space in the morsecode hash.
We then make a single string of these letters by joining them with the empty string:
my $translated_message = join "", #letters;
And don't forget to print out the result!
The complete code:
#!/usr/bin/perl
use strict; use warnings; use 5.012;
my %morsecode=(
'.-' =>'A', '-...' =>'B', '-.-.' =>'C', '-..' =>'D',
'.' =>'E', '..-.' =>'F', '--.' =>'G', '....' =>'H',
'..' =>'I', '.---' =>'J', '-.-' =>'K', '.-..' =>'L',
'--' =>'M', '-.' =>'N', '---' =>'O', '.--.' =>'P',
'--.-' =>'Q', '.-.' =>'R', '...' =>'S', '-' =>'T',
'..-' =>'U', '...-' =>'V', '.--' =>'W', '-..-' =>'X',
'-.--' =>'Y', '--..' =>'Z', '.----' =>'1', '..---' =>'2',
'...--' =>'3', '....-' =>'4', '.....' =>'5', '-....' =>'6',
'--...' =>'7', '---..' =>'8', '----.' =>'9', '-----' =>'0',
'.-.-.-'=>'.', '--..--'=>',', '---...'=>':', '..--..'=>'?',
'.----.'=>'\'', '-...-' =>'-', '-..-.' =>'/', '.-..-.'=>'"',
'!' =>' ',
);
say "Please type in your morse message:";
my #codes = <>;
chomp #codes;
my $message = join "", map { $morsecode{$_} // "<unknown code $_>" } #codes;
say "You said:";
say $message;
This produces the desired output.
There's a lot of value in learning the how and why, but here's the what:
sub encode {
my $output;
foreach my $symbol (#_) {
my $letter = $morsecode{$symbol};
die "Don't know how to decode $symbol" unless defined $letter;
$output .= $letter
}
return $output;
}
or even as little as sub encode { join '', map $morsecode{$_}, #_ } if you're not too worried about error-checking. #k and #v aren't needed for anything.
Searching for values in hashes is a very intense job, you are better of by just using a reverse hash. You can easily reverse a hash with the reverse function in Perl. Also, while watching your code I have seen that you will be able to enter lower-case input. But while searching in hashes on keys, this is case-sensitive. So you will need to uppercase your input. Also, I do not really like the way to "end" an STDIN. An exit word/sign would be better and cleaner.
My take on your code
my %morsecode=(
'.-' =>'A', '-...' =>'B', '-.-.' =>'C', '-..' =>'D',
'.' =>'E', '..-.' =>'F', '--.' =>'G', '....' =>'H',
'..' =>'I', '.---' =>'J', '-.-' =>'K', '.-..' =>'L',
'--' =>'M', '-.' =>'N', '---' =>'O', '.--.' =>'P',
'--.-' =>'Q', '.-.' =>'R', '...' =>'S', '-' =>'T',
'..-' =>'U', '...-' =>'V', '.--' =>'W', '-..-' =>'X',
'-.--' =>'Y', '--..' =>'Z', '.----' =>'1', '..---' =>'2',
'...--' =>'3', '....-' =>'4', '.....' =>'5', '-....' =>'6',
'--...' =>'7', '---..' =>'8', '----.' =>'9', '-----' =>'0',
'.-.-.-'=>'.', '--..--'=>',', '---...'=>':', '..--..'=>'?',
'.----.'=>'\'', '-...-' =>'-', '-..-.' =>'/', '.-..-.'=>'\"'
);
my %reversemorse = reverse %morsecode;
print "Enter a message\n";
chomp (my $message = <STDIN>);
print &encode($message);
sub encode{
my $origmsg = shift(#_);
my #letters = split('',$origmsg);
my $morse = '';
foreach $l(#letters)
{
$morse .= $reversemorse{uc($l)}." ";
}
return $morse;
}