I'm attempting to write a program that will determine if a 7-character string is a palindrome or not, and it keeps throwing me this error. I'm not exactly sure why it's doing it or how to fix it.
#!/usr/bin/perl
use Modern::Perl;
use strict;
use warnings;
print "Enter a 7 character string: ";
chomp (my $pal = <>);
my $size = length($pal);
if ($size == 7) {
$pal[0] = my $a; # Here's where it starts throwing errors
$pal[1] = my $b;
$pal[2] = my $c;
$pal[3] = my $d;
$pal[4] = my $e;
$pal[5] = my $f;
$pal[6] = my $g; # All the way to down here
if ($a eq $g) && ($b eq $f) && ($c eq $e) {
print "PALINDROME\n";
}
else {
print "NOT A PALINDROME\n";
}
}
else {
print "Your string must contain 7 characters!\n";
}
I am not allowed to use the reverse function in this code. Also, I'm pretty new to Perl, so please keep things basic for me.
You're using $pal as an array, but it's not. This collects from STDIN into $input, then transforms that into a #pal array which you're operating on. Your = variables were backwards, it's recommended not to use $a or $b as they are special in Perl, and you were missing parens around your if statement. This should get you going:
use strict;
use warnings;
print "Enter a 7 character string: ";
my $input = <STDIN>;
chomp $input;
my $size = length($input);
my #pal = split //, $input;
if ($size == 7) {
my $a = $pal[0];
my $b = $pal[1];
my $c = $pal[2];
my $d = $pal[3];
my $e = $pal[4];
my $f = $pal[5];
my $g = $pal[6];
if (($a eq $g) && ($b eq $f) && ($c eq $e)){
print "PALINDROME\n";
}
else {
print "NOT A PALINDROME\n";
}
}
else {
print "Your string must contain 7 characters!\n";
}
Here's an example if statement using #Biffen suggestion as your comparison instead of assigning the whole array into single scalars.
if ($size == 7) {
if ($pal[0] eq $pal[6] && $pal[1] eq $pal[5] && $pal[2] eq $pal[4]){
print "PALINDROME\n";
}
else {
print "NOT A PALINDROME\n";
}
}
You can't use the string $pal as an array in perl (one of the many ways that perl is not C). It'll tell you that #pal doesn't exist. You need to use substr, and your assignments are also backwards:
my $c0 = substr($pal, 0, 1);
my $c1 = substr($pal, 1, 1);
my $c2 = substr($pal, 2, 1);
my $c3 = substr($pal, 3, 1);
my $c4 = substr($pal, 4, 1);
my $c5 = substr($pal, 5, 1);
my $c6 = substr($pal, 6, 1);
if ($c0 eq $c6) && ($c1 eq $c5) && ($c2 eq $c4) {
print "PALINDROME\n";
}
else {
print "NOT A PALINDROME\n";
}
Using $a and $b can cause problems, so I've renamed the variables.
Simplifying slightly:
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
print 'Enter a 7 character string: ';
chomp(my $string = <STDIN>);
my #pal = split //, $string;
die "$string is not a 7 character string\n"
if #pal != 7;
for (0 .. 2) {
if ($pal[$_] ne $pal[$#pal - $_]) {
say "$string is not a palindrome";
exit;
}
}
say "$string is a palindrome";
Related
When ever I run this bit of code. it doesn't display any output. Anyone see anything wrong?
I am trying to display this in the out put:
A
AA
AAA
AAAB
AAABA
AAABAA
AAABAAA
AAABAAAB
etc.
#!/usr/local/bin/perl
$A = 3;
$B = 1;
$i = 1;
$output = "";
$j = 1;
while ($i <= $ARGV[0]) {
while ($j <= $i) {
if ($A == 0 && $B == 0) {
$A = 3;
$B = 1;
}
if ($A > 0) {
$output.= "A";
$A--;
}
else {
$output.= "B";
$B--;
}
$j++;
}
print($output . "\n");
$i++;
}
It works for me when I run it with a numeric argument (number of lines).
An idea how to simplify the code:
#!/usr/bin/perl
use warnings;
use strict;
my $count = shift;
my $A = 3;
my $B = 1;
my $string = q();
$string .= ('A' x $A) . ('B' x $B) while $count > length $string;
print substr($string, 0, $_), "\n" for 1 .. $count;
It uses a different algorithm - it creates the longest possible string, and then outputs parts of it.
if there is no #ARGV, while ($i <= $ARGV[0]) never runs.
#ARGV is an array of the command line arguments provided when the script is executed. you did not provide any command line arguments. if you had use warnings in effect, you would be warned that $ARGV[0] is uninitialized.
As from ikegami comment. You cann't pass the input at when the program is compile. For example, consider your file name is algo.pl. Can you run your program with
perl algo.pl 10
Here 10 is the input value of the program. In program value is retrieve by the $ARGV[0]
so in your program looks like while ($i <= $ARGV[0]).
If you want pass the several values like perl filename.pl 12 data1 data2In your data retrieve by $ARGV[0] $ARGV[1] $ARGV[2] for more information see here.
If you want pass the input at the time of execution used STDIN
use warnings;
use strict;
my $A = 3;
my $B = 1;
my $i = 1;
my $output = "";
my $j = 1;
print "Enter the value: ";
chomp(my $value = <STDIN>);
while ($i <= $value) {
while ($j <= $i) {
if ($A == 0 && $B == 0) {
$A = 3;
$B = 1;
}
if ($A > 0) {
$output.= "A";
$A--;
}
else {
$output.= "B";
$B--;
}
$j++;
}
print($output . "\n");
$i++;
}
I would like to create a program that replaces characters and retains the special characters. An example input and output is shown below.
Here's what I did so far:
$sentence = userinput;
#words = split(/ /, $sentence);
for ($i = 0; $i < #words.length; $i ++){
$words[$i] =~ s/\W//g;
#characters = split(//, $words[$i]);
#print $words[$i] . "\n";
$wordlength = length($words[$i]);
for ($j = 0; $j < #characters.length; $j ++){
$char = $characters[$j];
for ($x = 0; $x < $wordlength; $x++){
$char++;
if ($char eq "aa"){
$char = "a";
}
elsif ($char eq "AA"){
$char = "A";
}
}
print $char;
if ($x = 0){
$output[$i] = $char;
}
else {
$output[$i] = join ($char);
}
}
print $output[$i];
}
Input:
Hi! how are you doing?
Output:
Jk! krz duh brx itnsl?
A couple of things in your code don't make sense:
Missing use strict; use warnings;.
All variables are global (you should be using my to create variables)
#foo.length is not the number of elements in the array #foo. It's the number of elements in the array #foo concatenated with the number of characters in $_ (because arrays in scalar context return their length, . concatenates strings, and length works on $_ by default).
join ($char) always returns the empty string: You're joining an empty list (no elements) using $char as a separator.
Here's an attempt to fix all of these issues:
use strict;
use warnings;
my $sentence = readline;
$sentence =~ s{([A-Za-z]+)}{
my $word = $1;
join '', map {
my $base = ord(/^[A-Z]/ ? 'A' : 'a');
chr((ord($_) - $base + length($word)) % 26 + $base)
} split //, $word
}eg;
print $sentence;
I think what you are doing is rot3 encoding, but if so then your example is wrong
my $sentence = 'Hi! how are you doing?';
$sentence =~ tr/A-Za-z/D-ZA-Cd-za-c/;
print $sentence, "\n";
output
Kl! krz duh brx grlqj?
which is similar, but not identical to
Jk! krz duh brx itnsl?
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.
#!/usr/bin/perl
use warnings;
use Scalar::Util qw(looks_like_number);
sub term_value();
sub factor_value();
sub expression_value()
{
$num = #_;
#expression = $_[0];
print "expression[0]: " . $expression[0] . "\n";
$index = $_[$num-1];
print "index: $index\n";
$result = &term_value(#expression, $index);
$more = 1;
while($more)
{
$op = $expression[$index];
print "$op\n";
if ($op eq "+" || $op eq "-")
{
$index++;
$value = &term_value(#expression, $index);
if ($op eq '+')
{
$result = $result + $value;
} else {
$result = $result - $value;
}
}
else
{
$more = 0;
}
}
return $result;
}
sub term_value()
{
$num = #_;
#expression = $_[0];
print "expression[0]: " . $expression[0] . "\n";
$index = $_[$num-1];
print "index: $index\n";
$result = &factor_value(#expression, $index);
$more = 1;
while($more)
{
$op = $expression[$index];
if ($op eq "*" || $op eq "/")
{
$index++;
$value = &factor_value(#expression, $index);
if ($op eq '*')
{
$result = $result * $value;
} else {
$result = $result / $value;
}
} else {
$more = 0;
}
}
return $result;
}
sub factor_value()
{
$num = #_;
#expression = $_[0];
print "expression[0]: " . $expression[0] . "\n";
$index = $_[$num-1];
print "index: $index\n";
$result = 0;
$c = $expression[$index];
if ($c eq '(')
{
$index++;
$result = &expression_value(#expression, $index);
$index++;
} else {
while (looks_like_number($c))
{
$result = 10 * $result + $c - '0';
$index++;
$c = $expression[$index];
}
}
return $result;
}
#Collect argument and separate by character
#one_char = split(//, $ARGV[0]);
$index = 0;
$result = &expression_value(#one_char, $index);
print $result . "\n";
My console returns these warnings:
Use of uninitialized value $op in string eq at eval.pl line 58.
Use of uninitialized value $op in string eq at eval.pl line 58.
Use of uninitialized value $op in string eq at eval.pl line 25.
Use of uninitialized value $op in string eq at eval.pl line 25.
about the $op variable being uninitialized. I'm thinking this may be a scope problem...but I can't figure it out. I've tried everything I could think of (initializing the variable outside of the loop, etc.), but none of it seems to make a difference when running the program. Any suggestions would be greatly appreciated!
You're only using package (~global) variables, which is a huge problem given that you are using recursive functions! Start by adding
use strict;
Primarily, this will identify the variables you haven't declared. Use my to declare them in the appropriate scope.
You're trying to pass arrays to the subs, but you're failing. The only thing that can be passed to a sub is a list of scalars. If you want to pass an array to a sub, you'll need to pass a reference (~pointer) to the array.
sub foo {
my ($expressions, $index) = #_;
print($expressions->[$index], "\n");
}
foo(\#expressions, $index);
This is the reason you're getting the warnings. You are assigning one element to an array (#expression = $_[0]), then you try to index the second or later element.
By using prototype (), you're telling Perl the sub takes no arguments. Then you use & to tell Perl to ignore the prototype so you can pass arguments to your subs. Get rid of both the () after the sub names and & before sub calls.
my $more = 1;
while ($more) {
...
if (cond) {
...
} else {
$more = 0;
}
}
can be reduced to
while (1) {
...
last if !cond;
...
}
Higher Order Perl has a chapter on parsing. See section 8.1.2 for how you would build an expression parser and evaluator from scratch.
You can also take a look at the demo calculator script provided with Parse::RecDescent.
Just out of curiosity, I wanted to see what can be achieved without using parsers. The following script makes a lot of assumptions, but "works" for the simple cases.
#!/usr/bin/env perl
use strict;
use warnings;
use Regexp::Common qw(balanced number);
die "Need expression\n" unless #ARGV;
my ($expression) = #ARGV;
my $result = evaluate_expression($expression);
printf(
"'%s' evaluated to %g\n",
$expression, $result
);
my $expected = eval $expression;
unless ($result == $expected) {
die "Wrong result, should have been '$expected'\n";
}
sub evaluate_expression {
my ($expression) = #_;
my $n = qr!$RE{num}{real}!;
my $mul = qr![*/]!;
my $add = qr![+-]!;
my $subexpr = qr!$RE{balanced}{-parens=>'()'}{-keep}!;
1 while
$expression =~ s!
$subexpr
!
my $s = $1;
$s =~ s{(?:^\()|(?:\)\z)}{}g;
evaluate_expression($s)
!gex;
1 while
$expression =~ s!($n) \s* ($mul) \s* ($n)!"$1 $2 $3"!geex;
1 while
$expression =~ s!($n) \s* ($add) \s* ($n)!"$1 $2 $3"!geex;
return $expression;
}
Output:
C:\Temp> z "((1+1)*3 +2)*5"
'((1+1)*3 +2)*5' evaluated to 40
C:\Temp> z "(1+1)*3 + 2*5"
'(1+1)*3 + 2*5' evaluated to 16
But, of course, it's fragile:
C:\Temp> z "2*3+2*5"
'2*3+2*5' evaluated to 610
Wrong result, should have been '16'
As a bit of a corollary to Sinan's answer, here is a "parser" written from the other side of the camel.
use 5.010;
use strict;
use warnings;
my #ops;
use overload map {
my $op = $_;
$op => sub {
my ($x, $y) = #_[$_[2] ? (1, 0) : (0, 1)];
bless [$x, $op, $y]
}
} #ops = qw(+ - / *);
my %ops = map {$_ => eval "sub {\$_[0] $_ \$_[1]}"} #ops;
sub eval {
my $self = shift;
return $$self[0] if #$self == 1;
my ($x, $op, $y) = map {ref eq 'main' ? $_->eval : $_} #$self;
my $ret = $ops{$op}->($x, $y);
say "$ret = $x $op $y";
$ret;
}
BEGIN {overload::constant integer => sub {bless [$_[1]]}}
eval->eval for "#ARGV";
Which when run:
$ perl eval.pl 2*3+2*5
prints:
6 = 2 * 3
10 = 2 * 5
16 = 6 + 10
I have a hash of lists that is not getting populated.
I checked that the block at the end that adds to the hash is in fact being called on input. It should either add a singleton list if the key doesn't exist, or else push to the back of the list (referenced under the right key) if it does.
I understand that the GOTO is ugly, but I've commented it out and it has no effect.
The problem is that when printhits is called, nothing is printed, as if there are no values in the hash. I also tried each (%genomehits), no dice.
THANKS!
#!/usr/bin/perl
use strict;
use warnings;
my $len = 11; # resolution of the peaks
#$ARGV[0] is input file
#$ARGV[1] is call number
# optional -s = spread number from call
# optional -o specify output file name
my $usage = "see arguments";
my $input = shift #ARGV or die $usage;
my $call = shift #ARGV or die $usage;
my $therest = join(" ",#ARGV) . " ";
print "the rest".$therest."\n";
my $spread = 1;
my $output = $input . ".out";
if ($therest =~ /-s\s+(\d+)\s/) {$spread = $1;}
if ($therest =~ /-o\s+(.+)\s/) {$output = $1;}
# initialize master hash
my %genomehits = ();
foreach (split ';', $input) {
my $mygenename = "err_naming";
if ($_ =~ /^(.+)-/) {$mygenename = $1;}
open (INPUT, $_);
my #wiggle = <INPUT>;
&singlegene(\%genomehits, \#wiggle, $mygenename);
close (INPUT);
}
&printhits;
#print %genomehits;
sub printhits {
foreach my $key (%genomehits) {
print "key: $key , values: ";
foreach (#{$genomehits{$key}}) {
print $_ . ";";
}
print "\n";
}
}
sub singlegene {
# let %hash be the mapping hash
# let #mygene be the gene to currently process
# let $mygenename be the name of the gene to currently process
my (%hash) = %{$_[0]};
my (#mygene) = #{$_[1]};
my $mygenename = $_[2];
my $chromosome;
my $leftbound = -2;
my $rightbound = -2;
foreach (#mygene) {
#print "Doing line ". $_ . "\n";
if ($_ =~ "track" or $_ =~ "output" or $_ =~ "#") {next;}
if ($_ =~ "Step") {
if ($_ =~ /chrom=(.+)\s/) {$chromosome = $1;}
if ($_ =~ /span=(\d+)/) {$1 == 1 or die ("don't support span not equal to one, see wig spec")};
$leftbound = -2;
$rightbound = -2;
next;
}
my #line = split /\t/, $_;
my $pos = $line[0];
my $val = $line[-1];
# above threshold for a call
if ($val >= $call) {
# start of range
if ($rightbound != ($pos - 1)) {
$leftbound = $pos;
$rightbound = $pos;
}
# middle of range, increment rightbound
else {
$rightbound = $pos;
}
if (\$_ =~ $mygene[-1]) {goto FORTHELASTONE;}
}
# else reinitialize: not a call
else {
FORTHELASTONE:
# typical case, in an ocean of OFFs
if ($rightbound != ($pos-1)) {
$leftbound = $pos;
}
else {
# register the range
my $range = $rightbound - $leftbound;
for ($spread) {
$leftbound -= $len;
$rightbound += $len;
}
#print $range . "\n";
foreach ($leftbound .. $rightbound) {
my $key = "$chromosome:$_";
if (not defined $hash{$key}) {
$hash{$key} = [$mygenename];
}
else { push #{$hash{$key}}, $mygenename; }
}
}
}
}
}
You are passing a reference to %genomehits to the function singlegene, and then copying it into a new hash when you do my (%hash) = %{$_[0]};. You then add values to %hash which goes away at the end of the function.
To fix it, use the reference directly with arrow notation. E.g.
my $hash = $_[0];
...
$hash->{$key} = yadda yadda;
I think it's this line:
my (%hash) = %{$_[0]};
You're passing in a reference, but this statement is making a copy of your hash. All additions you make in singlegene are then lost when you return.
Leave it as a hash reference and it should work.
PS - Data::Dumper is your friend when large data structures are not behaving as expected. I'd sprinkle a few of these in your code...
use Data::Dumper; print Dumper \%genomehash;