I am running the following in Perl v5.12.3 on Mac OS X v10.7.2 (Lion):
#!/usr/local/bin/perl
use strict;
use warnings;
use DBI;
my $db = DBI->connect("dbi:SQLite:testdrive.db") or die "Cannot connect: $DBI::errstr";
my #times = ("13:00","14:30","16:00","17:30","19:00","20:30","22:00");
my $counter = 1;
for (my $d = 1; $d < 12; $d++) {
for (my $t = 0; $t < 7; $t++) {
# Weekend days have seven slots, weekdays
# have only four (barring second friday)
if (($d+4) % 7 < 2 || ($t > 3)) {
$db->do("INSERT INTO tbl_timeslot VALUES ($counter, '$times[$t]', $d);");
$counter++;
# Add 4:00 slot for second Friday
} elsif (($d = 9) && ($t = 3)) {
$db->do("INSERT INTO tbl_timeslot VALUES ($counter, '$times[$t]', $d);");
$counter++;
}
}
}
$db->disconnect;
I get a "Found = in conditional, should be == at addtimes.pl line 16" warning, but there's no equal sign on that line. Also, the loop seems to start at $d == 9. What am I missing?
Line 16:
if (($d+4) % 7 < 2 || ($t > 3)) {
The problem is in your elsif
} elsif (($d = 9) && ($t = 3)) {
^-----------^--------- should be ==
Because the if statement started on line 16, and the elsif is part of that statement, that's where the error got reported from. This is an unfortunate limitation of the Perl compiler.
On an unrelated note, it's much nicer to avoid C-style loops when you can:
for my $d ( 1 .. 11 ) {
...
for my $t ( 0 .. 6 ) {
...
}
}
Isn't that prettier? :)
} elsif (($d = 9) && ($t = 3)) {
This line will assign 9 to $d and 3 to $t. As the warning says, you probably want this instead:
} elsif (($d == 9) && ($t == 3)) {
Related
The program below works fine, but there is a warning that says:
Use of uninitialized value in numeric lt (<) line 17.
How do I fix the warning?
Any help would be really appreciated !
#!/usr/bin/perl
use strict;
use Carp;
use warnings;
my #array = (1,3,7,9,7,10,11,12,13,14,15,16,27,10,9,18,19,20,21,22,23,24,9,3,4);
my $i = 0;
my $j = 0;
my $k = 0;
my $n = $#array+1;
my $tempj = 0;
while(1){
$j=$i;
while (($array[$i] < $array[$i+1]) && ($i < ($n-1))){
$i++;
}
if(( $i - $j) > $k){
$k = $i-$j;
$tempj=$j;
}
if ($i >= ($n-1)){
print "la position : ",$j," , la langueur: ",$k,"\n";
exit;
}
else{
$j=$i;
while ($array[$i]>$array[$i+1] && $i < ($n-1)){
$i++;
}
if(($i-$j) > $k){
$k = $i-$j;
$tempj=$j;
}
if ($i >= ($n-1)){
print "la position : ",$j," , la langueur",$k,"\n";
exit;
}
}
}
Thank you in advance
Change the order of the conditions to make sure the array access is not out of bounds. This eliminates the warning:
while ( ($i < ($n-1)) && ($array[$i] < $array[$i+1]) ) {
I tried writing a simple code to find whether a number can be expressed as the sum of primes or not, in Perl. The sample code is as shown:
sub funcIsPrime {
my $num = $_[0];
my $isPrime = 1;
for($i= 2; $i <= $num/2; $i++){
if($num%$i == 0){
$isPrime = 0;
last;
}
}
return $isPrime;
}
#my $num = <>;
my $num = 20;
for($i = 2; $i <= $num/2; $i++){
print "$i\t";
my $j = $num-$i;
print "$j\n";
if(funcIsPrime($i) and funcIsPrime($j)){ # Line x
print "$num = $i + $j\n";
}
}
The function call statements in Line x do not execute. The same line when put outside the loop works fine. What can be the possible solution? Please help. Thank you.
The main issue is missing my in variable declarations. Perl won't let you run the program if you include use warnings; and use strict;:
Global symbol "$i" requires explicit package name (did you forget to declare "my $i"?) at test.pl line 22.
Execution of test.pl aborted due to compilation errors.
Here's simplified working code (you can search for factors up to the square root of n, by the way, although this isn't a perfect or efficient prime test by any means):
use strict;
use warnings;
sub isPrime {
my $num = $_[0];
for (my $i = int sqrt $num; $i > 1; $i--) {
if ($num % $i == 0) {
return 0;
}
}
return 1;
}
my $num = 20;
for (my $i = 2; $i <= $num / 2; $i++) {
my $j = $num - $i;
if (isPrime($i) && isPrime($j)) {
print "$num = $i + $j\n";
}
}
Output
20 = 3 + 17
20 = 7 + 13
Got a very technical coding problem with perl. Basically I am search for some specific DNA sequences.
my $seq = '...';
my #dna = split //, $seq;
my $amount = scalar #dna;
for my $index (0 .. $amount - 1){
if ($dna[$index] eq 'A' and $dna[$index+1] eq 'T' and
$dna[$index+2] eq 'G' and $dna[$index+3] eq 'C'
) {
do {
print $dna[$index++];
} until ($dna[$index] eq 'C' and $dna[$index+1] eq 'C' and $dna[$index+2] eq'G')
}
}
The problem is,is that the "until" portion is in an infinite loop. I am getting all my sequences, but for some reason the until loop wont stop looping. I have tried
until ($dna[$index] eq 'C' and $dna[$index+1] eq 'C' and $dna[$index+2] eq 'G' ){last;}
But that breaks out of the "for" loop.
Is there a way to break out of do-until loop without breaking the for loop?
Case 1
my $seq = 'xxxxxATGCyyyyyCCGzzzzz'; # Ouputs ATGCyyyyy
When every ATGC is followed by a CCG, your code works.
Case 2
my $seq = 'xxxxxATGCyyyyy'; # Infinite loop
When there's no CCG following a ATGC, you keep incrementing $index past the end of #dna, causing an infinite loop.
Case 3
my $seq = 'wwwwwATGCxxxxxATGCyyyyyCCGzzzzz'; # Ouputs ATGCxxxxxATGCyyyyy and ATGCyyyyy
You start looking for another match where the previous match started rather than where it ended, so you can end up with overlapping matches. This is partly due to a bad assumption the loop will continue from the value to which you changed $index.
Solution
my $seq = '...';
my #seq = split //, $seq;
my $seq_len = #seq;
for (my $i = 0; $i < $seq_len-7; ++$i) {
if ( $seq[$i+0] eq 'A'
&& $seq[$i+1] eq 'T'
&& $seq[$i+2] eq 'G'
&& $seq[$i+3] eq 'C'
) {
my $start = $i;
$i += 4;
for (; $i < $seq_len-3; ++$i) {
if ( $seq[$i+0] eq 'C'
&& $seq[$i+1] eq 'C'
&& $seq[$i+2] eq 'G'
) {
my $end = $i;
print(join('', #seq[$start .. $end-1]), "\n");
last;
}
}
}
}
substr simplifies things.
my $seq = '...';
my $seq_len = length($seq);
for (my $i = 0; $i < $seq_len-7; ++$i) {
if (substr($seq, $i, 4) eq 'ATGC') {
my $start = $i;
$i += 4;
for (; $i < $seq_len-3; ++$i) {
if (substr($seq, $i, 3) eq 'CCG') {
my $end = $i;
print(substr($seq, $start, $end-$start), "\n");
last;
}
}
}
}
But regular expressions simply things much further.
my $seq = '...';
while ($seq =~ / ( ATGC .*? ) (?= CCG ) /xsg) {
print("$1\n");
}
If you wanted to output the remainder of the string when there is no CCG, you can use the following:
my $seq = '...';
while ($seq =~ / ( ATGC (?:(?! CCG ).)* ) /xsg) {
print("$1\n");
}
As mentioned in perlsyn
For "last", you have to be more elaborate:
LOOP: {
do {
last if $x = $y**2;
# do something here
} while $x++ <= $z;
}
If the sequence doesn't contain CCG somewhere later than ATGC, the loop won't terminate. Add or $index == $#dna to the condition.
Although I definitely endorse #ikegami's regular expression-based approach, let's try to salvage what you have. Some specific issues:
Use the C-style for/foreach loop so that adjustments to $index carry over to the outer loop
You can't use last or next directly in a do {} until () or do {} while () loop -- these aren't while () or until () loops, they are do constructs and these keywords don't apply. See some of the other answers with respect to wrapping the do construct in a one-shot loop to make these keywords viable.
You need to deal with the possiblity of running out of data before finding the things you're looking for.
Here's my rework of your code to get it to run and clear #ikegami's test hurdles:
use constant { START => 'ATGC', STOP => 'CCG' };
use constant { START_LENGTH => length(START), STOP_LENGTH => length(STOP) };
my $sequence = 'wwwwwATGCxxxxxATGCyyyyyCCGzzzzz';
my #dna = split //, $sequence;
for (my $index = 0; $index < #dna - START_LENGTH; $index++) {
if (join('', #dna[$index .. $index + START_LENGTH - 1]) eq START) {
do {
print $dna[$index++];
} until ($index > $#dna or ($index < #dna - STOP_LENGTH and join('', #dna[$index .. $index + STOP_LENGTH - 1]) eq STOP));
print("\n");
}
}
(Yes, the $#dna messes with the SO formatter as it thinks it's introducing a comment. I'm sure someone knows how to fix this and will edit this answer accordingly.)
I am writing a Perl code, using substr to extract characters one by one but encountered a very strange problem.
I am trying to do the following
Scan character one by one, if it is # go to end of line, if it is ' or " then find the next matching one. Also added HTML color tag to highlight them. Everything else just print.
Here is the block of code
while ($char = (substr $src, $off_set, 1)) {
if ($char eq '#') {
$end_index = index $src, "\n", $off_set+ 1;
my $c = substr($src, $off_set, $end_index-$off_set+1);
print $comment_color.$c.$color_end;
} elsif (($char eq '"') || ($char eq "'")) {
$end_index = index ($src, $char, $off_set+1);
my $char_before = substr $src, $end_index-1, 1;
while ($end_index > 0 && $char_before eq '\\') {
$end_index = index $src, $char, $end_index + 1;
$char_before = substr $src, $end_index-1, 1;
}
my $s = substr($src, $off_set, $end_index-$off_set+1);
print $string_color.$s.$color_end;
} else {
print $char;
$end_index++;
}
$off_set = $end_index + 1;
}
When I use the following testing code, the script will just exit on first 0, if I remove all the 0 then it runs ok. If I remove first 0, it will exit on 2nd. I really have no idea why this happens.
# Comment 1
my $zero = 0;
my #array = (0xdead_beef, 0377, 0b011011);
# xor
sub sample2
{
print "true or false";
return 3 + 4 eq " 7"; # true or false
}
#now write input to STDOUT
print $time . "\n";
my $four = "4";
Check for defined in your while loop:
while (defined(my $char = substr $src, $off_set, 1)) {
The reason why your code was exiting early is because '0' is a false value, and therefore the while would end. Instead, this will check if any value is pulled from the substr call.
This is your loop condition:
while ($char = (substr $src, $off_set, 1)) {
...
So what happens when $char = "0"? As Perl considers that to be a false value, the loop will terminate. Instead, loop as long as characters are left:
while ($off_set < length $src) {
my $char = substr $src, $off_set, 1;
...
Anyway, your code is convoluted and hard to read. Consider using regular expressions instead:
use re '/xsm';
my $src = ...;
pos($src) = 0;
my $out = '';
while (pos($src) < length $src) {
if ($src =~ m/\G ([#][^\n]*)/gc) {
$out .= colored(comment => $1);
}
elsif ($src =~ m/\G (["] (?:[^"\\]++|[\\].)* ["])/gc) {
$out .= colored(string => $1);
}
elsif ($src =~ m/\G (['] (?:[^'\\]++|[\\]['\\])* ['])/gc) {
$out .= colored(string => $1);
}
elsif ($src =~ m/\G ([^"'#]+)/gc) {
$out .= $1;
}
else {
die "illegal state";
}
}
where colored is some helper function.
Finally, figured out it is the while loop. It exit the loop when it sees a 0.
Updated the while loop condition to
while (($char = (substr $src, $off_set, 1)) || ($off_set < (length $src))) {
and it is working now.
#!/bin/usr/perl -w
use strict;
print "Enter your input filename for original sample data values: \n";
chomp($data=<STDIN>);
print "Enter your input filename for adjustment values\n";
chomp($adj=<STDIN>) ;
print "Enter your output filename for resultant adjusted new sample data \n";
chomp($new=<STDIN>);
open(R1,"$data") or die("error");
open(R2,"$adj") or die ("error");
open(WW,"+>$new") or die ("error");
while( ($line1=(<R1>)) && ($line2=(<R2>)) )
{
$l1=$line1;
#arr1= split(" ",$l1);
$l2=$line2;
#arr2= split(" ",$l2);
$l= ( scalar#arr1);
$p= (scalar#arr2);
for ( $i = 0; $i <= $l; $i++ ){
for ( $j =($i+1); $j <= $l; $j++ ){
if ($arr1[$i]< $arr1[$j]){
$a = $arr1[$i] + ($arr2[$i]/2);
$b = $arr1[$j] - ($arr2[$i]/2);
push ( $arr1[$i]->$a , $arr1[$j]->$b);
}
elsif ( $arr1[$i]= $arr1[$j]){
$a = $arr1[$i];
$b = $arr1[$j];
push ($arr1[$i]->$a,$arr1[$j]->$b);
}
else{
$a = $arr1[$i]-($arr2[$i]/2);
$b = $arr1[$j]+ ($arr2[$i]/2);
push ($arr1[$i]->$a,$arr1[$j]->$b);
}
}
}
$l1 = scalar#arr1;
for ($k = 0; $k <= $l1 ; $k++)
{
if (($k % 10) != 0){
print WW "$arr1[$k]";
print WW "\t" ;
}
else {
print WW "\n";
print WW "$arr1[$k]";
print WW "\t";
}
}
}
close(R1);
close(R2);
close(WW);
exit;
when i am running this prog. i am getting an error that "not an ARRAY reference at line 29".
how can i create the reference to my first array #arr1 ??? so that it stores the changed values of the element at the particular index after running the iteration.
input :
#array1
1 2 3 4 5 6 7 8 9 10
#array2
1 2 3 4 5 6 7 8 9 10 9 8 7 6 5 4 3 2
desired output
#array1
15 1.5 2 3 6 4 11.5 5 5.5
Well, I'm not getting the answer you say you're looking for, but what it appears you're trying to do is to store the value of $a into the $i'th index of array #arr1 and the value of $b into the $jth index of #arr1. I have hoisted the assignment code out of the if branches since it will be the same for all three cases. I have also fixed a subtle error you had in your conditions. You had
elsif ( $arr1[$i]= $arr1[$j]){
but you surely meant to do an equality comparison rather than an assignment here:
elsif ( $arr1[$i] == $arr1[$j]){
So here is the modified section. As I say, it still doesn't print out what you say the desired result is, and I'm not sure whether it's because your computation is wrong or your printing is wrong (I couldn't figure out any obvious transform from your inputs to your desired output), but this should at least put you in the right direction:
for ( $i = 0; $i <= $l; $i++ ){
for ( $j =($i+1); $j <= $l; $j++ ){
if ($arr1[$i]< $arr1[$j]){
$a = $arr1[$i] + ($arr2[$i]/2);
$b = $arr1[$j] - ($arr2[$i]/2);
# push ( $arr1[$i]->$a , $arr1[$j]->$b);
}
elsif ( $arr1[$i] == $arr1[$j]){
$a = $arr1[$i];
$b = $arr1[$j];
# push ($arr1[$i]->$a,$arr1[$j]->$b);
}
else{
$a = $arr1[$i]-($arr2[$i]/2);
$b = $arr1[$j]+ ($arr2[$i]/2);
# push ($arr1[$i]->$a,$arr1[$j]->$b);
}
$arr1[$i] = $a;
$arr1[$j] = $b;
}
}