Is there a Perl module for parsing numbers, including ranges? - perl

Is there a module, which does this for me?
sample_input: 2, 5-7, 9, 3, 11-14
#!/usr/bin/env perl
use warnings; use strict; use 5.012;
sub aw_parse {
my( $in, $max ) = #_;
chomp $in;
my #array = split ( /\s*,\s*/, $in );
my %zahlen;
for ( #array ) {
if ( /^\s*(\d+)\s*$/ ) {
$zahlen{$1}++;
}
elsif ( /^\s*(\d+)\s*-\s*(\d+)\s*$/ ) {
die "'$1-$2' not a valid input $!" if $1 >= $2;
for ( $1 .. $2 ) {
$zahlen{$_}++;
}
} else {
die "'$_' not a valid input $!";
}
}
#array = sort { $a <=> $b } keys ( %zahlen );
if ( defined $max ) {
for ( #array ) {
die "Input '0' not allowed $!" if $_ == 0;
die "Input ($_) greater than $max not allowed $!" if $_ > $max;
}
}
return \#array;
}
my $max = 20;
print "Input (max $max): ";
my $in = <>;
my $out = aw_parse( $in, $max );
say "#$out";

A CPAN search for number range gives me this, which looks pretty much like what you're looking for:
Number::Range
Here's an example of how you can use the module in your aw_parse function:
$in =~ s/\s+//g; # remove spaces
$in =~ s/(?<=\d)-/../g; # replace - with ..
my $range = new Number::Range($in); # create the range
my #array = sort { $a <=> $b } $range->range; # get an array of numbers
Applied to the sample from the question:
Input (max 20): 2, 5-7, 9, 3, 11-14
2 3 5 6 7 9 11 12 13 14

Related

Get value from next N rows of a file

I'm having problems intercepting the contents of the lines above what I'm reading $lines[0] as following foreach loop
my $IN_DIR = "/tmp/appo/log"; # Input Directories
my $jumprow = '<number of row to skip>'; # This is a value
foreach my $INPUT ( glob( "$IN_DIR/logrotate_*.log" ) ) {
open( my $fh, '<', $INPUT ) or die $!;
while ( <$fh> ) {
next unless $. > $jumprow;
my #lines = split /\n/;
my $i = 0;
foreach my $lines ( #lines ) {
if ( $lines[$i] =~ m/\A#\d.\d.+#\d{4}\s\d{2}\s\d{2}\s\d{2}:\d{2}:\d{2}:\d{3}#\+\d+#\w+#\/\w+\/\w+\/Authentication/ ) {
# Shows only LOGIN/LOGOUT access type and exclude GUEST users
if ( $lines[ $i + 2 ] =~ m/Login/ || $lines[ $i + 2 ] =~ m/Logout/ && $lines[ $i + 3 ] !~ m/Guest/ ) {
my ( $y, $m, $d, $time ) = $lines[$i] =~ /\A#\d.\d.+#(\d{4})\s(\d{2})\s(\d{2})\s(\d{2}:\d{2}:\d{2}:\d{3})/;
my ( $action ) = $lines[ $i + 2 ] =~ /\A(\w+)/;
my ( $user ) = $lines[ $i + 3 ] =~ /\w+:\s(.+)/;
print "$y/$m/$d;$time;$action;$user\n";
}
}
else {
next; # Is this next technically necessary according to you?
}
$i++;
}
}
close( $fh );
}
The Tie::File
module could help me
my $IN_DIR = "/tmp/appo/log"; # Input Directories
my $jumprow = '<number of row to skip>'; # This is a value
foreach my $INPUT ( glob( "$IN_DIR/logrotate_*.log" ) ) {
tie #lines, 'Tie::File', $INPUT, mode => O_RDONLY;
or die $!;
my $i = $.;
next unless $i > $jumprow;
foreach my $lines ( #lines ) {
if ( $lines[$i] =~ m/\A#\d.\d.+#\d{4}\s\d{2}\s\d{2}\s\d{2}:\d{2}:\d{2}:\d{3}#\+\d+#\w+#\/\w+\/\w+\/Authentication/ ) {
# Shows only LOGIN/LOGOUT access type and exclude GUEST users
if ( $lines[ $i + 2 ] =~ m/Login/ || $lines[ $i + 2 ] =~ m/Logout/ && $lines[ $i + 3 ] !~ m/Guest/ ) {
my ( $y, $m, $d, $time ) = $lines[$i] =~ /\A#\d.\d.+#(\d{4})\s(\d{2})\s(\d{2})\s(\d{2}:\d{2}:\d{2}:\d{3})/;
my ( $action ) = $lines[ $i + 2 ] =~ /\A(\w+)/;
my ( $user ) = $lines[ $i + 3 ] =~ /\w+:\s(.+)/;
print "$y/$m/$d;$time;$action;$user\n";
}
}
else {
next; # Is this next technically necessary according to you?
}
$i++;
}
}
Could you tell me if my declaration with Tie::File is correct or not?
This is only a part of my master script as indicated in following guide mcve
Actually without tie, my master scripts works only with $lines[0], it doesn't take value from $lines[$i+2] or $lines[$i+3]
It looks like you're getting very lost here. I've written a working program that processes the data you showed in your previous question; it should at least form a stable basis for you to continue your work. I think it's fairly straightforward, but ask if there's anything that's not obvious in the Perl documentation
use strict;
use warnings 'all';
use feature 'say';
use autodie; # Handle IO failures automatically
use constant IN_DIR => '/tmp/appo/log';
chdir IN_DIR; # Change to input directory
# Status handled by autodie
for my $file ( glob 'logrotate_*.log' ) {
say $file;
say '-' x length $file;
say "";
open my $fh, '<', $file; # Status handled by autodie
local $/ = ""; # Enable block mode
while ( <$fh> ) {
my #lines = split /\n/;
next unless $lines[0] =~ /
^
\# \d.\d .+?
\# (\d\d\d\d) \s (\d\d) \s (\d\d)
\s
( \d\d : \d\d : \d\d : \d\d\d )
/x;
my ( $y, $m, $d, $time ) = ($1, $2, $3, $4);
$time =~ s/.*\K:/./; # Change decimal point to dot for seconds
next unless $lines[2] =~ /^(Log(?:in|out))/;
my $action = $1;
next unless $lines[3] =~ /^User:\s+(.*\S)/ and $1 ne 'Guest';
my $user = $1;
print "$y/$m/$d;$time;$action;$user\n";
}
say "";
}
output
logrotate_0.0.log
-----------------
2018/05/24;11:05:04.011;Login;USER4
2018/05/24;11:04:59.410;Login;USER4
2018/05/24;11:05:07.100;Logout;USER3
2018/05/24;11:07:21.314;Login;USER2
2018/05/24;11:07:21.314;Login;USER2
2018/05/26;10:48:02.458;Logout;USER2
2018/05/28;10:00:25.000;Logout;USER0
logrotate_1.0.log
-----------------
2018/05/29;10:09:45.969;Login;USER4
2018/05/29;11:51:06.541;Login;USER1
2018/05/30;11:54:03.906;Login;USER4
2018/05/30;11:59:59.156;Logout;USER3
2018/05/30;08:32:11.348;Login;USER4
2018/05/30;11:09:54.978;Login;USER2
2018/06/01;08:11:30.008;Logout;USER2
2018/06/01;11:11:29.658;Logout;USER1
2018/06/02;12:05:00.465;Logout;USER9
2018/06/02;12:50:00.065;Login;USER9
2018/05/24;10:43:38.683;Login;USER1

Running a nested while loop inside a foreach loop in Perl

I'm trying to use a foreach loop to loop through an array and then use a nested while loop to loop through each line of a text file to see if the array element matches a line of text; if so then I push data from that line into a new array to perform calculations.
The outer foreach loop appears to be working correctly (based on printed results with each array element) but the inner while loop is not looping (same data pushed into array each time).
Any advice?
The code is below
#! /usr/bin/perl -T
use CGI qw(:cgi-lib :standard);
print "Content-type: text/html\n\n";
my $input = param('sequence');
my $meanexpfile = "final_expression_complete.txt";
open(FILE, $meanexpfile) or print "unable to open file";
my #meanmatches;
#regex = (split /\s/, $input);
foreach $regex (#regex) {
while (my $line = <FILE>) {
if ( $line =~ m/$regex\s(.+\n)/i ) {
push(#meanmatches, $1);
}
}
my $average = average(#meanmatches);
my $std_dev = std_dev($average, #meanmatches);
my $average_round = sprintf("%0.4f", $average);
my $stdev_round = sprintf("%0.4f", $std_dev);
my $coefficient_of_variation = $stdev_round / $average_round;
my $cv_round = sprintf("%0.4f", $coefficient_of_variation);
print font(
{ color => "blue" }, "<br><B>$regex average: $average_round
&nbspStandard deviation: $stdev_round&nbspCoefficient of
variation(Cv): $cv_round</B>"
);
}
sub average {
my (#values) = #_;
my $count = scalar #values;
my $total = 0;
$total += $_ for #values;
return $count ? $total / $count : 0;
}
sub std_dev {
my ($average, #values) = #_;
my $count = scalar #values;
my $std_dev_sum = 0;
$std_dev_sum += ($_ - $average)**2 for #values;
return $count ? sqrt($std_dev_sum / $count) : 0;
}
Yes, my advice would be:
Turn on strict and warnings.
perltidy your code,
use 3 argument open: open ( my $inputfile, "<", 'final_expression.txt' );
die if it doesn't open - the rest of your program is irrelevant.
chomp $line
you are iterating your filehandle, but once you've done this you're at the end of file for the next iteration of the foreach loop so your while loops becomes a null operation. Simplistically, reading the file into an array my #lines = <FILE>; would fix this.
So with that in mind:
#!/usr/bin/perl -T
use strict;
use warnings;
use CGI qw(:cgi-lib :standard);
print "Content-type: text/html\n\n";
my $input = param('sequence');
my $meanexpfile = "final_expression_complete.txt";
open( my $input_file, "<", $meanexpfile ) or die "unable to open file";
my #meanmatches;
my #regex = ( split /\s/, $input );
my #lines = <$input_file>;
chomp (#lines);
close($input_file) or warn $!;
foreach my $regex (#regex) {
foreach my $line (#lines) {
if ( $line =~ m/$regex\s(.+\n)/i ) {
push( #meanmatches, $1 );
}
}
my $average = average(#meanmatches);
my $std_dev = std_dev( $average, #meanmatches );
my $average_round = sprintf( "%0.4f", $average );
my $stdev_round = sprintf( "%0.4f", $std_dev );
my $coefficient_of_variation = $stdev_round / $average_round;
my $cv_round = sprintf( "%0.4f", $coefficient_of_variation );
print font(
{ color => "blue" }, "<br><B>$regex average: $average_round
&nbspStandard deviation: $stdev_round&nbspCoefficient of
variation(Cv): $cv_round</B>"
);
}
sub average {
my (#values) = #_;
my $count = scalar #values;
my $total = 0;
$total += $_ for #values;
return $count ? $total / $count : 0;
}
sub std_dev {
my ( $average, #values ) = #_;
my $count = scalar #values;
my $std_dev_sum = 0;
$std_dev_sum += ( $_ - $average )**2 for #values;
return $count ? sqrt( $std_dev_sum / $count ) : 0;
}
The problem here is that starting from the second iteration of foreach you are trying to read from already read file handle. You need to rewind to the beginning to read it again:
foreach $regex (#regex) {
seek FILE, 0, 0;
while ( my $line = <FILE> ) {
However that does not look very performant. Why read file several times at all, when you can read it once before the foreach starts, and then iterate through the list:
my #lines;
while (<FILE>) {
push (#lines, $_);
}
foreach $regex (#regex) {
foreach $line (#lines) {
Having the latter, you might also what to consider using grep instead of the while loop.

Take random substrings from genome data

I am trying to use the substring function to take random 21 base sequences from a genome in fasta format. Below is the start of the sequence:
FILE1 data:
>gi|385195117|emb|HE681097.1| Staphylococcus aureus subsp. aureus HO 5096 0412 complete genome
CGATTAAAGATAGAAATACACGATGCGAGCAATCAAATTTCATAACATCACCATGAGTTTGGTCCGAAGCATGAGTGTTTACAATGTTTGAATACCTTATACAGTTCTTATACATAC
I have tried adapting a previous answer to use while reading my file and i'm not getting any error messages, just no output! The code hopefully prevents there being any overlap of sequences, though the chances of that are very small anyway.
Code as follows:
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
my $outputfile = "/Users/edwardtickle/Documents/randomoutput.txt";
open FILE1, "/Users/edwardtickle/Documents/EMRSA-15.fasta";
open( OUTPUTFILE, ">$outputfile" );
while ( my $line = <FILE1> ) {
if ( $line =~ /^([ATGCN]+)/ ) {
my $genome = $1;
my $size = 21;
my $count = 5;
my $mark = 'X';
if ( 2 * $size * $count - $size - $count >= length($genome) ) {
my #substrings;
while ( #substrings < $count ) {
my $pos = int rand( length($genome) - $size + 1 );
push #substrings, substr( $genome, $pos, $size, $mark x $size )
if substr( $genome, $pos, $size ) !~ /\Q$mark/;
for my $random (#substrings) {
print OUTPUTFILE "random\n";
}
}
}
}
}
Thanks for your help!
One of the neatest ways to select a random start point is to shuffle a list of all possible start points and select the first few -- as many as you need.
It's also best practice to use the three-parameter form of open, and lexical file handles.
The loop in this example starts much like your own -- picking up the genomes using a regex. The subsequences of length $size can start anywhere from zero up to $len_genome - $size, so the program generates a list of all these starting points, shuffles them using the utility function from List::Util, and puts them in #start_points.
Finally, if there are sufficient start points to form $count different subsequences, then they are printed, using substr in the print statement.
use strict;
use warnings;
use autodie;
use List::Util qw/ shuffle /;
my $outputfile = '/Users/edwardtickle/Documents/randomoutput.txt';
open my $in_fh, '<', '/Users/edwardtickle/Documents/EMRSA-15.fasta';
open my $out_fh, '>', $outputfile;
my $size = 21;
my $count = 5;
while (my $line = <$in_fh>) {
next unless $line =~ /^([ATGCN]+)/;
my $genome = $1;
my $len_genome = length $genome;
my #start_points = shuffle(0 .. $len_genome-$size);
next unless #start_points >= $count;
print substr($genome, $_, 21), "\n" for #start_points[0 .. $count-1];
}
output
TACACGATGCGAGCAATCAAA
GTTTACAATGTTTGAATACCT
ACATCACCATGAGTTTGGTCC
ATAACATCACCATGAGTTTGG
GGTCCGAAGCATGAGTGTTTA
I would recommend saving all possible positions for a substring in an array. That way you can remove possibilities after each substring to prevent overlap:
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
my $infile = "/Users/edwardtickle/Documents/EMRSA-15.fasta";
my $outfile = "/Users/edwardtickle/Documents/randomoutput.txt";
my $size = 21;
my $count = 5;
my $min_length = ( $count - 1 ) * ( 2 * $size - 1 ) + $size;
#open my $infh, '<', $infile;
#open my $outfh, '>', $outfile;
my $infh = \*DATA;
my $outfh = \*STDOUT;
while ( my $line = <$infh> ) {
next unless $line =~ /^([ATGCN]+)/;
my $genome = $1;
# Need a long enough sequence for multiple substrings with no overlap
if ( $min_length > length $genome ) {
warn "Line $., Genome too small: Must be $min_length, not ", length($genome), "\n";
next;
}
# Save all possible positions for substrings in an array. This enables us
# to remove possibilities after each substring to prevent overlap.
my #pos = ( 0 .. length($genome) - 1 - ( $size - 1 ) );
for ( 1 .. $count ) {
my $index = int rand #pos;
my $pos = $pos[$index];
# Remove from possible positions
my $min = $index - ( $size - 1 );
$min = 0 if $min < 0;
splice #pos, $min, $size + $index - $min;
my $substring = substr $genome, $pos, $size;
print $outfh "$pos - $substring\n";
}
}
__DATA__
>gi|385195117|emb|HE681097.1| Staphylococcus aureus subsp. aureus HO 5096 0412 complete genome
CGATTAAAGATAGAAATACACGATGCGAGCAATCAAATTTCATAACATCACCATGAGTTTGGTCCGAAGCATGAGTGTTTACAATGTTTGAATACCTTATACAGTTCTTATACATACCGATTAAAGATAGAAATACACGATGCGAGCAATCAAA
CGATTAAAGATAGAAATACACGATGCGAGCAATCAAATTTCATAACATCACCATGAGTTTGGTCCGAAGCATGAGTGTTTACAATGTTTGAATACCTTATACAGTTCTTATACATACCGATTAAAGATAGAAATACACGATGCGAGCAATCAAATTTCATAACATCACCATGAGTTTGGTCCGAAGCATGAGTGTTTACAATGTTTGAATACCTTATACAGTTCTTATACATAC
Outputs:
Line 2, Genome too small: Must be 185, not 154
101 - CAGTTCTTATACATACCGATT
70 - ATGAGTGTTTACAATGTTTGA
6 - AAGATAGAAATACACGATGCG
38 - TTCATAACATCACCATGAGTT
182 - GAAGCATGAGTGTTTACAATG
Alternative method for large genomes
You mentioned in a comment that genome may be 2 gigs in size. If that's the case then it's possible that there won't be enough memory to have an array of all possible positions.
Your original approach of substituting a fake character for each chosen substring would work in that case. The following is how I would do it, using redo:
for ( 1 .. $count ) {
my $pos = int rand( length($genome) - ( $size - 1 ) );
my $str = substr $genome, $pos, $size;
redo if $str =~ /X/;
substr $genome, $pos, $size, 'X' x $size;
print $outfh "$pos - $str\n";
}
Also note, that if your genome really is that big, then you must also be wary of the randbits setting of your Perl version:
$ perl -V:randbits
randbits='48';
For some Windows versions, the randbits setting was just 15, therefore only returning 32,000 possible random values: Why does rand($val) not warn when $val > 2 ** randbits?
I found it more effective to move the output for loop outside the inner while, and to add a condition to the while such that $genome must contain a $size-long chunk that hasn't already been partly selected.
Just because you've got a string that's 117 characters long doesn't mean you'll find 5 random non-overlapping chunks.
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
my $outputfile = "/Users/edwardtickle/Documents/randomoutput.txt";
open FILE1, "/Users/edwardtickle/Documents/EMRSA-15.fasta";
open( OUTPUTFILE, ">$outputfile" );
while ( my $line = <FILE1> ) {
if ( $line =~ /^([ATGCN]+)/ ) {
my $genome = $1;
my $size = 21;
my $count = 5;
my $mark = 'X';
if ( 2 * $size * $count - $size - $count >= length($genome) ) {
my #substrings;
while ( #substrings < $count
and $genome =~ /[ATGCN]{$size}/ ) { # <- changed this
my $pos = int rand( length($genome) - $size + 1 );
push #substrings, substr( $genome, $pos, $size, $mark x $size )
if substr( $genome, $pos, $size ) !~ /\Q$mark/;
}
# v- changed this
print OUTPUTFILE "$_\n" for #substrings;
}
}
}

How do I speed up pattern recognition in perl

This is the program as it stands right now, it takes in a .fasta file (a file containing genetic code), creates a hash table with the data and prints it, however, it is quite slow. It splits a string an compares it against all other letters in the file.
use strict;
use warnings;
use Data::Dumper;
my $total = $#ARGV + 1;
my $row;
my $compare;
my %hash;
my $unique = 0;
open( my $f1, '<:encoding(UTF-8)', $ARGV[0] ) or die "Could not open file '$ARGV[0]' $!\n";
my $discard = <$f1>;
while ( $row = <$f1> ) {
chomp $row;
$compare .= $row;
}
my $size = length($compare);
close $f1;
for ( my $i = 0; $i < $size - 6; $i++ ) {
my $vs = ( substr( $compare, $i, 5 ) );
for ( my $j = 0; $j < $size - 6; $j++ ) {
foreach my $value ( substr( $compare, $j, 5 ) ) {
if ( $value eq $vs ) {
if ( exists $hash{$value} ) {
$hash{$value} += 1;
} else {
$hash{$value} = 1;
}
}
}
}
}
foreach my $val ( values %hash ) {
if ( $val == 1 ) {
$unique++;
}
}
my $OUTFILE;
open $OUTFILE, ">output.txt" or die "Error opening output.txt: $!\n";
print {$OUTFILE} "Number of unique keys: " . $unique . "\n";
print {$OUTFILE} Dumper( \%hash );
close $OUTFILE;
Thanks in advance for any help!
It is not clear from the description what is wanted from this script, but if you're looking for matching sets of 5 characters, you don't actually need to do any string matching: you can just run through the whole sequence and keep a tally of how many times each 5-letter sequence occurs.
use strict;
use warnings;
use Data::Dumper;
my $str; # store the sequence here
my %hash;
# slurp in the whole file
open(IN, '<:encoding(UTF-8)', $ARGV[0]) or die "Could not open file '$ARGV[0]' $!\n";
while (<IN>) {
chomp;
$str .= $_;
}
close(IN);
# not sure if you were deliberately omitting the last two letters of sequence
# this looks at all the sequence
my $l_size = length($str) - 4;
for (my $i = 0; $i < $l_size; $i++) {
$hash{ substr($str, $i, 5) }++;
}
# grep in a scalar context will count the values.
my $unique = grep { $_ == 1 } values %hash;
open OUT, ">output.txt" or die "Error opening output.txt: $!\n";
print OUT "Number of unique keys: ". $unique."\n";
print OUT Dumper(\%hash);
close OUT;
It might help to remove searching for information that you already have.
I don't see that $j depends upon $i so you're actually matching values to themselves.
So you're getting bad counts as well. It works for 1, because 1 is the square of 1.
But if for each five-character string you're counting strings that match, you're going
to get the square of the actual number.
You would actually get better results if you did it this way:
# compute it once.
my $lim = length( $compare ) - 6;
for ( my $i = 0; $i < $lim; $i++ ){
my $vs = substr( $compare, $i, 5 );
# count each unique identity *once*
# if it's in the table, we've already counted it.
next if $hash{ $vs };
$hash{ $vs }++; # we've found it, record it.
for ( my $j = $i + 1; $j < $lim; $j++ ) {
my $value = substr( $compare, $j, 5 );
$hash{ $value }++ if $value eq $vs;
}
}
However, it could be an improvement on this to do an index for your second loop
and let the c-level of perl do your matching for you.
my $pos = $i;
while ( $pos > -1 ) {
$pos = index( $compare, $vs, ++$pos );
$hash{ $vs }++ if $pos > -1;
}
Also, if you used index, and wanted to omit the last two characters--as you do, it might make sense to remove those from the characters you have to search:
substr( $compare, -2 ) = ''
But you could do all of this in one pass, as you loop through file. I believe the code
below is almost an equivalent.
my $last_4 = '';
my $last_row = '';
my $discard = <$f1>;
# each row in the file after the first...
while ( $row = <$f1> ) {
chomp $row;
$last_row = $row;
$row = $last_4 . $row;
my $lim = length( $row ) - 5;
for ( my $i = 0; $i < $lim; $i++ ) {
$hash{ substr( $row, $i, 5 ) }++;
}
# four is the maximum we can copy over to the new row and not
# double count a strand of characters at the end.
$last_4 = substr( $row, -4 );
}
# I'm not sure what you're getting by omitting the last two characters of
# the last row, but this would replicate it
foreach my $bad_key ( map { substr( $last_row, $_ ) } ( -5, -6 )) {
--$hash{ $bad_key };
delete $hash{ $bad_key } if $hash{ $bad_key } < 1;
}
# grep in a scalar context will count the values.
$unique = grep { $_ == 1 } values %hash;
You may be interested in this more concise version of your code that uses a global regex match to find all the subsequences of five characters. It also reads the entire input file in one go, and removes the newlines afterwards.
The path to the input file is expected as a parameter on the command line, and the output is sent to STDIN, and can be redirected to a file on the command line, like this
perl subseq5.pl input.txt > output.txt
I've also used Data::Dump instead of Data::Dumper because I believe it to be vastly superior. However it is not a core module, and so you will probably need to install it.
use strict;
use warnings;
use open qw/ :std :encoding(utf-8) /;
use Data::Dump;
my $str = do { local $/; <>; };
$str =~ tr|$/||d;
my %dups;
++$dups{$1} while $str =~ /(?=(.{5}))/g;
my $unique = grep $_ == 1, values %dups;
print "Number of unique keys: $unique\n";
dd \%dups;

how to compare 2 overlapping ranges without any repetition [duplicate]

This question already has answers here:
comparing values of range from different arrays
(2 answers)
Closed 8 years ago.
I am trying to compare values of range from #arr3 with values of range from #arr4 but I am not getting the desired output. Please suggest me the modifications in the following code to get the output as 3,4,5,6,7,9,10,11,12,14,15 (without repeating the values example 5 and 10) and total matched=11.
File 1: result
3..7
9..12
14..17
File 2: annotation
1..5
5..10
10..15
Code:
#!/usr/bin/perl
open ($inp1,"<result") or die "not found";
open ($inp2,"<annotation") or die "not found";
my #arr3=<$inp1>;
my #arr4=<$inp2>;
foreach my $line1 (#arr4) {
foreach my $line2 (#arr3) {
my ($from1,$to1)=split(/\.\./,$line1);
my ($from2,$to2)=split(/\.\./,$line2);
#print $from1;print "\n";
for (my $i=$from1;$i<=$to1 ;$i++) {
for (my $j=$from2;$j<=$to2 ;$j++) {
if ($i==$j) {
print "$i";`enter code here`print "\n";
}
}
}
}
If your lists are not too large, you can use a hash, which is the best way how to achieve "without repeating" in Perl:
#!/usr/bin/perl
use warnings;
use strict;
my #result = ('3..4', '9..12', '14..17');
my #annotation = ('1..5', '5..10', '10..15');
my %cmp;
my $pass = 1;
for my $range (#result, undef, #annotation) {
$pass = 2, next unless $range;
my ($from, $to) = split /\Q../, $range;
for my $num ($from .. $to) {
$cmp{$num} = $pass if 1 == $pass or $cmp{$num};
}
}
my #output = sort { $a <=> $b } grep 2 == $cmp{$_}, keys %cmp;
print join(',', #output), "\nTotal matched: ", scalar #output, "\n";
Works for me
#!/usr/bin/perl
open ($inp1,"<result") or die "not found";
open ($inp2,"<annotation") or die "not found";
my #arr3=<$inp1>;
my #arr4=<$inp2>;
foreach my $line1 (#arr4) {
foreach my $line2 (#arr3) {
my ($from1,$to1)=split(/\.\./,$line1);
my ($from2,$to2)=split(/\.\./,$line2);
for (my $i=$from1;$i<=$to1 ;$i++) {
for (my $j=$from2;$j<=$to2 ;$j++) {
$res = grep(/$i/, #result);
if ($i==$j && $res == 0) {
print "$i enter code here\n";
push(#result, $i);
}
}
}
}
}