How to display user input on one line in a palandrome assignment? - perl

In perl, I have to determine whether user input is a palindrome or not and it must display like this:
Enter in 7 characters: ghghghg #one line here #
Palindrome! #second line answer#
But instead this is what it does:
Enter in 7 characters: g #one line#
h #second line#
g #third line#
h #fourth line#
g #fifth line#
h #sixth line#
g Palindrom
e! #seventh line#
My problem seems to be on the chomp lines with all the variables but I just can't figure out what to do and I've been at if for hours. I need a simple solution, but have not progressed to arrays yet so need some simple to fix this. Thanks
And here is what i have so far, the formula seems to work but it keeps printing a new line for each character:
use strict;
use warnings;
my ($a, $b, $c, $d, $e, $f, $g);
print "Enter in 7 characters:";
chomp ($a = <>); chomp ($b = <>); chomp ($c = <>); chomp ($d = <>); chomp ($e = <>); chomp ($f = <>); chomp ($g = <>);
if (($a eq $g) && ($b eq $f) && ($c eq $e) && ($d eq $d) && ($e eq $c) && ($f eq $b) && ($g eq $a))
{print "Palindrome! \n";}
else
{print "Not Palindrome! \n";}

If you're going to determine if a word is the same backwards, may I suggest using reverse and lc?
chomp(my $word = <>);
my $reverse = reverse $word;
if (lc($word) eq lc($reverse)) {
print "Palindrome!";
} else {
print "Not palindrome!";
}

Perl is famous for its TIMTOWTDI. Here are two more ways of doing it:
print "Enter 7 characters: ";
chomp(my $i= <STDIN>);
say "reverse: ", pal_reverse($i) ? "yes" : "no";
say "regex: ", pal_regex($i) ? "yes" : "no";
sub pal_reverse {
my $i = (#_ ? shift : $_);
return $i eq reverse $i;
}
sub pal_regex {
return (#_ ? shift() : $_) =~ /^(.?|(.)(?1)\2)$/ + 0;
}

use strict;
use warnings;
use feature 'say';
print "Please enter 7 characters : ";
my $input = <>; # Read in input
chomp $input; # To remove trailing "\n"
# Season with input validation
warn 'Expected 7 characters, got ', length $input, ' instead'
unless length $input == 7;
# Determine if it's palindromic or not
say $input eq reverse $input
? 'Palindrome'
: 'Not palindrome' ;
TIMTOWTDI for the recursion-prone:
sub is_palindrome {
return 1 if length $_[0] < 2; # Whole string is palindromic
goto \&is_palindrome
if substr $_[0], 0, 1, '' eq substr $_[0], -1, 1, ''; # Check next chars
return; # Not palindromic if we reach here
}
say is_palindrome( 'ghghghg' ) ? 'Palindromic' : 'Not palindromic' ;
And perldoc perlretut for those who aren't :)
Recursive patterns
This feature (introduced in Perl 5.10) significantly extends the power
of Perl's pattern matching. By referring to some other capture group
anywhere in the pattern with the construct (?group-ref), the pattern
within the referenced group is used as an independent subpattern in
place of the group reference itself. Because the group reference may
be contained within the group it refers to, it is now possible to
apply pattern matching to tasks that hitherto required a recursive
parser.
To illustrate this feature, we'll design a pattern that matches if a
string contains a palindrome. (This is a word or a sentence that,
while ignoring spaces, interpunctuation and case, reads the same
backwards as forwards. We begin by observing that the empty string or
a string containing just one word character is a palindrome. Otherwise
it must have a word character up front and the same at its end, with
another palindrome in between.
/(?: (\w) (?...Here be a palindrome...) \g{-1} | \w? )/x
Adding \W* at either end to eliminate what is to be ignored, we
already have the full pattern:
my $pp = qr/^(\W* (?: (\w) (?1) \g{-1} | \w? ) \W*)$/ix;
for $s ( "saippuakauppias", "A man, a plan, a canal: Panama!" ){
print "'$s' is a palindrome\n" if $s =~ /$pp/;
}

Related

The output of a subroutine is returning 0

I have written a script which uses a subroutine to call percentage of nucleotides in a given sequence. When I run the script the output for each nucleotide percentage is always shown to be zero.
Here's my code;
#!/usr/bin/perl
use strict;
use warnings;
#### Subroutine to report percentage of each nucleotide in DNA sequence ####
my $input = $ARGV[0];
my $nt = $ARGV[1];
my $args = $#ARGV +1;
if($args != 2){
print "Error!!! Insufficient number of arguments\n";
print "Usage: $0 <input fasta file>\n";
}
my($FH, $line);
open($FH, '<', $input) || die "Could\'nt open file: $input\n";
$line = do{
local $/;
<$FH>;
};
$line =~ s/>(.*)//g;
$line =~ s/\s+//g;
my $perc = perc_nucleotide($line , $nt);
printf("The percentage of $nt nucleotide in given sequence is %.0f", $perc);
print "\n";
sub perc_nucleotide {
my($line, $nt) = #_;
print "$nt\n";
my $count = 0;
if( $nt eq "A" || $nt eq "T" || $nt eq "G" || $nt eq "C"){
$count++;
}
my $total_len = length($line);
my $perc = ($count/$total_len)*100;
}
I think that I am setting the $count variable wrong. I tried different ways but can't figure it out.
This is the input file
>XM_024894547.1 Trichoderma citrinoviride Redoxin (BBK36DRAFT_1163529), partial mRNA
ATGGCCTTCCGTCTCCCTCTGCGCCGCATTGCCCTGGCCCGCCCCGCCACCGTTGCGCGTGGCTTCCACT
CGACGCCCCGCGCCCTGGTCAAGGTCGGCGACGAGGTCCCGAGCTTGGAGCTGTTCGAGAAGTCGGCCGC
CAGCAAGATCAACCTGGCCGACGAGTTCAAGAAGGGCGACGGCTACATTGTCGGCGTCCCGGGCGCCTTC
TCCGGCACCTGCTCCGGCACCCACGTCCCGTCGTACATCAACCACCCTGACATCAAGACGGCCGGCCAGG
TCTTTGTCGTCTCCGTCAACGACCCCTTTGTCATGAAGGCTTGGGCAGACCAGCTGGATCCCGCCGGAGA
GACAGGAATCCGGTTCGTTGCCGACCCCACGGCTGAGTTCACAAAGGCTCTGGAACTGGGATTCGACGAC
GCTGCTCCTCTGTTCGGAGGCACCCGAAGCAAGCGCTATGCTCTCAAGGTTAAGGATGGCAAGGTCACTG
CCGCCTTTGTTGAGCCCGACAACACGGGCACTTCCGTGTCAATGGCCGACAAGGTCCTCAGCTAA
The problem is here:
my $perc = perc_nucleotide($line , $nt);
printf("The percentage of $nt nucleotide in given sequence is %.0f", $perc);
perc_nucleotide is returning 0.18018018018018 but the format %.0f says to print it with no decimal places. So it gets truncated to 0. You should probably use something more like %.2f.
It's also worth noting that perc_nucleotide does not have a return. It still works, but for reasons that might not be obvious.
perc_nucleotide sets my $perc = ($count/$total_len)*100; but never uses that $perc. The $perc in the main program is a different variable.
perc_nucleotide does return something, every Perl subroutine without an explicit return returns the "last evaluated expression". In this case it's my $perc = ($count/$total_len)*100; but the last evaluated expression rules can get a bit tricky.
It's easier to read and safer to have an explicit return. return ($count/$total_len)*100;
I corrected the script and it gave me right answers.
#!/usr/bin/perl
use strict;
use warnings;
##### Subroutine to calculate percentage of all nucleotides in a DNA sequence #####
my $input = $ARGV[0];
my $nt = $ARGV[1];
my $args = $#ARGV + 1;
if($args != 2){
print "Error!!! Insufficient number of arguments\n";
print "Usage: $0 <input_fasta_file> <nucleotide>\n";
}
my($FH, $line);
open($FH, '<', $input) || die "Couldn\'t open input file: $input\n";
$line = do{
local $/;
<$FH>;
};
chomp $line;
#print $line;
$line =~ s/>(.*)//g;
$line =~ s/\s+//g;
#print "$line\n";
my $total_len = length($line);
my $perc_of_nt = perc($line, $nt);
**printf("The percentage of nucleotide $nt in a given sequence is %.2f%%", $perc_of_nt);
print "\n";**
#print "$total_len\n";
sub perc{
my($line, $nt) = #_;
my $char; my $count = 0;
**foreach $char (split //, $line){
if($char eq $nt){
$count += 1;
}
}**
**return (($count/$total_len)*100)**
}
The answer for the above input file is:
Total_len = 555
The percentage of nucleotide A in a given sequence is 18.02%
The percentage of nucleotide T in a given sequence is 18.74%
The percentage of nucleotide G in a given sequence is 28.47%
The changes which I made are in bold.
Thanks for amazing insight!!!

Nested perl matching groups not working? [duplicate]

This question already has an answer here:
Regex $1 into variable interferes with another variable
(1 answer)
Closed 5 years ago.
I want the following code to print out "bye", and then print out "hello". However, when I run it, it prints out "bye" and then perl tells me that $str2 has not been initialized.
my $item = "hello/bye";
if($item =~ m/.*(bye)/g){
my $str1 = $1;
print "$str1\n";
my $str2 = ($item =~ m/(hello).*/g)[0];
print "$str2\n";
}
I think that there is probably something I do not understand about the m//g part, but I am having trouble finding my answer in the perldoc page for perlre.
When you do
if($item =~ m/.*(bye)/g)
that does not reset the match iterator (we are in scalar context). The "position" remains at the character after the bye substring. So the following m//g picks up from there the previous one left off.
You can verify this yourself:
if ($item =~ /(bye)/g) {
printf "pos \$item = %d\n", pos $item;
...
}
which will print pos $item =9.
Incidentally $item =~ /.*(bye)/ is better written as $item =~ /(bye)/ (assuming you don't care if you match the first or the last bye substring, just that $item has bye somewhere). Similarly, $item =~ /(hello).*/ is better written as $item =~ /(hello)/.
#!/usr/bin/env perl
use strict;
use warnings;
my $item = "hello/bye";
if ($item =~ /(bye)/) {
my $str1 = $1;
print "$str1\n";
my $str2 = ($item =~ /(hello)/g)[0];
print "$str2\n";
}

Perl calculator reads in numbers will not do calculation

I have a problem with my simple calculator program. It is not performing the calculation with my if statement: it goes straight to the else.
#!/usr/bin/perl
print "enter a symbol operation symbol to and two numbers to make a calculation";
chomp($input = <>);
if ($input eq '+') {
$c = $a + $b;
print $c;
}
elsif ($input eq '-') {
$c = $a - $b;
print $c;
}
elsif ($input eq '*') {
$c = $a * $b;
print $c;
}
elsif ($input eq '/') {
$c = $a / $b;
print $c;
}
elsif ($input eq '%') {
$c = $a % $b;
print $c;
}
elsif ($input eq '**') {
$c = $a**$b;
print $c;
}
elsif ($input eq 'root') {
$c = sqrt($a);
$c = sqrt($b);
print $c;
}
else {
print " you messed up" . "$input" . "$a" . "$b";
}
To start off with, you need to add strict and warnings to the top of your script
#!/usr/bin/perl
use strict;
use warnings;
That is going to alert you to a lot of syntax errors, and force you to completely rethink/refactor your code. This is a good thing though.
One obvious thing is that $a and $b are never initialized at all. And your first if is missing the dollar sign before input.
I would change the capturing of your variables to the following:
print "enter a symbol operation symbol to and two numbers to make a calculation";
chomp(my $input = <>);
my ($operation, $x, $y) = split ' ', $input.
I'd also lean away from using $a and $b as variable names, as they are special variables used by perl's sort. Once your certain that you're getting your input properly, then start working the rest of your logic.
You forgot '$' sign in the first condition before input:
if($input eq '+'){
$c = $a + $b;
print $c;
my $a = shift(#ARGV); // first argument is a
my $b = shift(#ARGV); // second argument is b
my $input = shift(#ARGV); // third argument is an operator
if($input eq '+'){...
Also, I would recommend 'use strict' and 'use warnings' at the top unless you're proficient at Perl.

Perl - How to change every $variable occurrence of ";" in a string

Very new here so be gentle. :)
Here is the jist of what I want to do:
I want to take a string that is made up of numbers separated by semi-colons (ex. 6;7;8;9;1;17;4;5;90) and replace every "X" number of semicolons with a "\n" instead. The "X" number will be defined by the user.
So if:
$string = "6;7;8;9;1;17;4;5;90";
$Nth_number_of_semicolons_to_replace = 3;
The output should be:
6;7;8\n9;1;17\n4;5;90
I've found lots on changing the Nth occurrence of something but I haven't been able to find anything on changing every Nth occurrence of something like I am trying to describe above.
Thanks for all your help!
use List::MoreUtils qw(natatime);
my $input_string = "6;7;8;9;1;17;4;5;90";
my $it = natatime 3, split(";", $input_string);
my $output_string;
while (my #vals = $it->()) {
$output_string .= join(";", #vals)."\n";
}
Here is a quick and dirty answer.
my $input_string = "6;7;8;9;1;17;4;5;90";
my $count = 0;
$input_string =~ s/;/++$count % 3 ? ";" : "\n"/eg;
Don't have time for a full answer now, but this should get you started.
$string = "6;7;8;9;1;17;4;5;90";
$Nth_number_of_semicolons_to_replace = 3;
my $regexp = '(' . ('\d+;' x ($Nth_number_of_semicolons_to_replace - 1)) . '\d+);';
$string =~ s{ $regexp ) ; }{$1\n}xsmg
sub split_x{
my($str,$num,$sep) = #_;
return unless defined $str;
$num ||= 1;
$sep = ';' unless defined $sep;
my #return;
my #tmp = split $sep, $str;
while( #tmp >= $num ){
push #return, join $sep, splice #tmp, 0, $num;
}
push #return, join $sep, #tmp if #tmp;
return #return;
}
print "$_\n" for split_x '6;7;8;9;1;17;4;5;90', 3
print join( ',', split_x( '6;7;8;9;1;17;4;5;90', 3 ) ), "\n";
my $string = "6;7;8;9;1;17;4;5;90";
my $Nth_number_of_semicolons_to_replace = 3;
my $num = $Nth_number_of_semicolons_to_replace - 1;
$string =~ s{ ( (?:[^;]+;){$num} [^;]+ ) ; }{$1\n}gx;
print $string;
prints:
6;7;8
9;1;17
4;5;90
The regex explained:
s{
( # start of capture group 1
(?:[^;]+;){$num} # any number of non ';' characters followed by a ';'
# repeated $num times
[^;]+ # any non ';' characters
) # end of capture group
; # the ';' to replace
}{$1\n}gx; # replace with capture group 1 followed by a new line
If you've got 5.10 or higher, this could do the trick:
#!/usr/bin/perl
use strict;
use warnings;
my $string = '1;2;3;4;5;6;7;8;9;0';
my $n = 3;
my $search = ';.*?' x ($n -1);
print "string before: [$string]\n";
$string =~ s/$search\K;/\n/g;
print "print string after: [$string]\n";
HTH,
Paul

How can I find and increment a number in a larger Perl string?

I have strings similar to this
INSERT INTO `log_action` VALUES (1,'a',1,4),(2,'a',1,1),(3,'a',4,4),(4,'a',1,1),(5,'a',6,4);
where I would like to add a number each of the first values, so it becomes (when value is 10)
INSERT INTO `log_action` VALUES (11,'a',1,4),(12,'a',1,1),(13,'a',4,4),(14,'a',1,1),(15,'a',6,4);
I have tried this
#!/usr/bin/perl -w
use strict;
my $input;
if ($#ARGV == 0) {
$input = $ARGV[0];
} else {
print "Usage: test.pl filename\n\n";
die "Wrong number of arguments.\n";
}
my $value;
$value = 10;
open(FILE, '<', $input) or die $!;
foreach my $line (<FILE>) {
if ($line =~ m/^INSERT INTO \`log_action\` VALUES/) {
$line =~ s/\((\d+),/\($1+$value,/ge;
print $line . "\n";
}
}
close FILE;
It fails because of the \($1+$value,. The \( and , is there to as the search eats those.
Any suggestions how to solve it?
You where almost there, but the part you put in the replacement side of s///e needs to be valid Perl. You are evaluating Perl code:
my $string =<<HERE;
INSERT INTO `log_action` VALUES
(1,'a',1,4),(2,'a',1,1),(3,'a',4,4),(4,'a',1,1),(5,'a',6,4);
HERE
my $value = 10;
$string =~ s/\((\d+),/ '(' . ($1+$value) . ',' /ge;
print "$string\n";
The Perl code that /e evaluates is just a string concatenation:
'(' . ($1+$value) . ','
However, when I want to match parts of the string that I don't want to replace, I use lookarounds so those parts aren't part of the replacement:
my $string =<<HERE;
INSERT INTO `log_action` VALUES
(1,'a',1,4),(2,'a',1,1),(3,'a',4,4),(4,'a',1,1),(5,'a',6,4);
HERE
my $value = 10;
$string =~ s/ (?<=\() (\d+) (?=,) / $1+$value /xge;
print "$string\n";