How to compare except the first digit of the string? Suppose I have 713 and 213, the return is 13.
another example:
518 and 21 => no result
423 and 413 => no result
315 and 215 => 15
Thanks
with this you can do:
if(substr($str1,1) eq substr($str2,1))
tested here
The substr operator will extract substrings for you. The second parameter of substr is the offset of the start of the substring that you want, so if you want the second character onwards you must say substr $string, 1.
This program takes your own data and puts the two numbers into $i and $j. Then substr is called twice to copy the second character onwards of those strings into $i2 and $j2. The if statement compares the two values and prints output accordingly.
use strict;
use warnings;
for (
'518 and 21',
'423 and 413',
'315 and 215') {
my ($i, $j) = /\d+/g;
my $i2 = substr $i, 1;
my $j2 = substr $j, 1;
if ($i2 eq $j2) {
print "$i and $j => $i2\n";
}
else {
print "$i and $j => no result\n";
}
}
output
518 and 21 => no result
423 and 413 => no result
315 and 215 => 15
Related
I wanted to create a conditional statement that would say if an element of an array is odd or even after getting the elements of the array from a line. Here's the code:
#! /usr/bin/perl
use warnings;
use strict;
my $numbers='23 45 34 12 9 3 56';
chomp $numbers;
my #getnum= (split(/ /, $numbers));
my $a;
if($getnum[0]>10){
$a=$getnum[0];
}
if($a%2==0){
print $a, " is even";
}
else{
print $a, " is odd";
}
Now the problem is I only did it for the first element. Is there a way I can do this for all elements without creating a conditional statement for each? Thanks for your help!
You need to use a for (or foreach) loop.
for my $n (#numbers) { # Loops over #numbers, assigning each to $n
if ( $n % 2 == 0 ) {
print "$n is even"
}
}
Additionally, this is rather un-idiomatic
my $numbers='23 45 34 12 9 3 56';
chomp $numbers;
my #getnum= (split(/ /, $numbers));
If you have a string you wish to split on whitespace, there is a special way to do that in Perl
split( ' ', $string );
This will split on arbitrary whitespace (and will strip leading and trailing whitespace), eg.
my #words = split( ' ', ' one two three ' );
# #words is ('one', 'two', 'three')
But if you are just hardcoding the number in your script itself, you can bypass the split all-together and use the 'quote-words' syntax
my #numbers = qw( 23 45 34 12 9 3 56 );
Hope this helps.
My question is similar to this question posted earlier.
I am having many files which I need to merge them based on the presence or absence of the first column ID, but while merging I am getting lots of empty values in my output file, I want those empty values to be zero if it is not present in another file. The example below is based on only two files content, but I have many sample files like this format (tabular).
For example:
File1
ID Value
123 1
231 2
323 3
541 7
File2
ID Value
541 6
123 1
312 3
211 4
Expected Output:
ID File1 File2
123 1 1
231 2 0
323 3 0
541 7 6
312 0 3
211 0 4
Obtaining Output:
ID File1 File2
123 1 1
231 2
323 3
541 7 6
312 undef 3
211 undef 4
As you can see above I am getting output but in file2 column, it's not adding zero or leaving empty and in case of file1 column it is having undef value. I have checked undef values and then my final output gives zeros in place of undef values but still I am having those empty spaces. Please find my code below (hardcoded only for two files).
#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;
use Data::Dumper;
my $path = "/home/pranjay/Projects/test";
my #files = ("s1.txt","s2.txt");
my %classic_com;
my $cnt;
my $classic_txt;
my $sample_cnt = 0;
my $classic_txtcomb = "test_classic.txt";
open($classic_txt,">$path/$classic_txtcomb") or die "Couldn't open file
$classic_txtcomb for writing,$!";
print $classic_txt "#ID\t"."file1\tfile2\n";
foreach my $file(#files){
$sample_cnt++;
print "$sample_cnt\n";
open($cnt,"<$path/$file")or die "Couldn't open file $file for reading,$!";
while(<$cnt>){
chomp($_);
my #count = ();
next if($_=~/^ID/);
my #record=();
#record=split(/\t/,$_);
my $scnt = $sample_cnt -1;
if((exists($classic_com{$record[0]})) and ($sample_cnt > 0)){
${$classic_com{$record[0]}}[$scnt]=$record[1];
}else{
$count[$scnt] = "$record[1]";
$classic_com{$record[0]}= [#count];
}
}
}
my %final_txt=();
foreach my $key ( keys %classic_com ) {
#print "$key: ";
my #val = #{ $classic_com{$key} };
my #v;
foreach my $i ( #val ) {
if(not defined($i)){
$i = 0;
push(#v, $i);
}else{
push(#v, $i);
next;
}
}
$final_txt{$key} = [#v];
}
#print Dumper %classic_com;
while(my($key,$value)=each(%final_txt)){
my $val=join("\t", #{$value});
print $classic_txt "$key\t"."#{$value}"."\n";
}
Just read the input files into a hash of arrays. The topmost key is the ID, each inner array contains the value for file i on the i-th position. When printing, use the // defined-or operator to replace undefs with zeroes:
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
my %merged;
my $file_tally = 0;
while (my $file = shift) {
open my $in, '<', $file or die "$file: $!";
<$in>; # skip the header
while (<$in>) {
my ($id, $value) = split;
$merged{$id}[$file_tally] = $value;
}
++$file_tally;
}
for my $value (keys %merged) {
my #values = #{ $merged{$value} };
say join "\t", $value, map $_ // 0, #values[0 .. $file_tally - 1];
}
program.pl
my %val;
/ (\d+) \s+ (\d+) /x and $val{$1}{$ARGV} = $2 while <>;
pr( 'ID', my #f = sort keys %{{map%$_,values%val}} );
pr( $_, map$_//0, #{$val{$_}}{#f} ) for sort keys %val;
sub pr{ print join("\t",#_)."\n" }
Run:
perl program.pl s1.txt s2.txt
ID s1.txt s2.txt
123 1 1
211 0 4
231 2 0
312 0 3
323 3 0
541 7 6
Input Data (example):
40A3B35A3C
30A5B28A2C2B
Desired output (per-line) is a single number determined by the composition of the code 40A3B35A3C and the following rules:
if A - add the proceeding number to the running total
if B - add the proceeding number to the running total
if C - subtract the proceeding number from the running total
40A 3B 35A 3C would thus produce 40 + 3 + 35 - 3 = 75.
Output from both lines:
75
63
Is there an efficient way to achieve this for a particular column (such as $F[2]) in a tab-delimited .txt file using a one-liner? I have considered splitting the entire code into individual characters, then performing if statement checks to detect A/B/C, but my Perl knowledge is limited and I am unsure how to go about this.
When you use split with a capture, the captured group is returned from split, too.
perl -lane '
#ar = split /([ABC])/, $F[2];
$s = 0;
$s += $n * ("C" eq $op ? -1 : 1) while ($n, $op) = splice #ar, 0, 2;
print $s
' < input
Or maybe more declarative:
BEGIN { %one = ( A => 1,
B => 1,
C => -1 ) }
#ar = split /([ABC])/, $F[2];
$s = 0;
$s += $n * $one{$op} while ($n, $op) = splice #ar, 0, 2;
print $s
When working through a string like this, it's useful to know that regular expressions can return a list of results.
E.g.
my #matches = $str =~ m/(\d+[A-C])/g; #will catch repeated instances
So you can do something like this:
#!/usr/bin/env perl
use strict;
use warnings;
while (<DATA>) {
my $total;
#break the string into digit+letter groups.
for (m/(\d+[A-C])/g) {
#separate out this group into num and code.
my ( $num, $code ) = m/(\d+)([A-C])/;
print "\t",$num, " => ", $code, "\n";
if ( $code eq "C" ) {
$total -= $num;
}
else {
$total += $num;
}
}
print $total, " => ", $_;
}
__DATA__
40A3B35A3C
30A5B28A2C2B
perl -lne 'push #a,/([\d]+)[AB]/g;
push #b,/([\d]+)[C]/g;
$sum+=$_ for(#a);$sum-=$_ for(#b);
print $sum;#a=#b=();undef $sum' Your_file
how it works
use the command line arg as the input
set the hash "%op" to the
operations per letter
substitute the letters for operators in the
input evaluate the substituted input as an expression
use strict;
use warnings;
my %op=qw(A + B + C -);
$ARGV[0] =~ s/(\d+)(A|B|C)/$op{$2} $1/g;
print eval($ARGV[0]);
As I was understanding the difference between [] and \ in references,I used both on subroutine the former was fine but when I tried later I thought it should give error but the below program in perl
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my #b;
for my $i ( 0 .. 10 ) {
$b[$i] = \somefunc($i);
}
print Dumper( \#b );
sub somefunc {
my $n = shift;
my ( #a, $k );
for my $j ( 11 .. 13 ) {
$k = $n * $j;
push( #a, $k );
}
print "a: #a \n";
return #a;
}
gives output as :
a: 0 0 0
a: 11 12 13
a: 22 24 26
a: 33 36 39
a: 44 48 52
a: 55 60 65
a: 66 72 78
a: 77 84 91
a: 88 96 104
a: 99 108 117
a: 110 120 130
$VAR1 = [
\0,
\13,
\26,
\39,
\52,
\65,
\78,
\91,
\104,
\117,
\130
];
I was unable to understand the output.Need explanation.
What is happening here is:
You are returning an array from somefunc.
But you are assigning it to a scalar. What this is effectively doing therefore, is simply putting the last value in the array, into the scalar value.
my $value = ( 110, 120, 130 );
print $value;
When you do this - $value is set to the last value in the array. This is what's actually happening in your code. See for example perldata:
List values are denoted by separating individual values by commas (and enclosing the list in parentheses where precedence requires it):
(LIST)
In a context not requiring a list value, the value of what appears to be a list literal is simply the value of the final element, as with the C comma operator. For example,
#foo = ('cc', '-E', $bar);
assigns the entire list value to array #foo, but
foo = ('cc', '-E', $bar);
assigns the value of variable $bar to the scalar variable $foo. Note that the value of an actual array in scalar context is the length of the array; the following assigns the value 3 to $foo:
#foo = ('cc', '-E', $bar);
$foo = #foo; # $foo gets 3
It's this latter case that's often the gotcha, because it's a list in a scalar context.
And in your example - the backslash prefix denotes 'reference to' - which is largely meaningless because it's a reference to a number.
But for a scalar, it might be more meaningful:
my $newvalue = "fish";
my $value = ( 110, 120, 130, \$newvalue );
print Dumper $value;
$newvalue = 'barg';
print Dumper $value;
Gives:
$VAR1 = \'fish';
$VAR1 = \'barg';
That's why you're getting the results. Prefix with the slash indicates that you're getting a reference to the result, not a reference to the sub. Reference to 130 isn't actually all that meaningful.
Normally, when doing the assignment above - you'd get a warning about Useless use of a constant (110) in void context but this doesn't apply when you've got a subroutine return.
If you wanted to insert a sub reference, you'd need to add &, but if you just want to insert the returned array by reference - you either need to:
$b[$i] = [somefunc($i)]
Or:
return \#a;
I have a output file which is a two dimensional array (this file was output generated after running script written to produce 2D array) and I have to read information under a particular column, say column 1. In other words, how do I read and print out information listed, corresponding to all the rows, under column 1.
Any suggestions?
__DATA__
1 2 3 4 5 6 7 8 9
A B C D E F G H I
93 48 57 66 52 74 33 22 91
From the above data I want to extract information column wise, say if I want information from column 1, I should be able to list only the following output.
want to list Then I want
OUTPUT:
1
A
93
Final version after all corrections:
#!/usr/bin/perl
use strict;
use warnings;
my $column_to_show = 0;
while ( <DATA> ) {
last unless /\S/;
print +(split)[$column_to_show], "\n";
}
__DATA__
1 2 3 4 5 6 7 8 9
A B C D E F G H I
93 48 57 66 52 74 33 22 91
Output:
C:\Temp> u
1
A
93
Explanation of print +(split)[$column_to_show], "\n";:
perldoc -f split:
Splits the string EXPR into a list of strings and returns that list.
...
If EXPR is omitted, splits the $_ string. If PATTERN is also omitted,
splits on whitespace (after skipping any leading whitespace).
So: (split)[3] selects the fourth element of the list returned by split. The + in front of (split) is necessary to help perl parse the expression correctly. See perldoc -f print:
Also be careful not to follow the
print keyword with a left parenthesis
unless you want the corresponding
right parenthesis to terminate the
arguments to the print — interpose a +
or put parentheses around all the
arguments.
I thoroughly recommend every Perl programmer to occasionally skim through all of the documentation perldoc perltoc. It is on your computer.
my $line ;
foreach $line (#DATA)
{
my #DATA1 = split( / +/, "$line" );
print "first element of array is $DATA1[0]";
}
__DATA__
1 2 3 4 5 6 7 8 9
A B C D E F G H I
93 48 57 66 52 74 33 22 91
OUTPUT:-
1
A
93
Try playing with this code. Basically I load the data into an array of arrays
Each line is a reference to a row.
#!/usr/bin/perl
use strict;
use warnings;
my $TwoDimArray;
while (my $line=<DATA>) {
push #$TwoDimArray, [split(/,/,$line)];
};
for my $column (0..2) {
print "[$column,0] : " . $TwoDimArray->[0]->[$column] ."\n";
print "[$column,1] : " . $TwoDimArray->[1]->[$column] ."\n";
print "\n";
}
__DATA__
1,2,3,04,05,06
7,8,9,10,11,12
The map function is your friend:
open FILE, "data.txt";
while ($line = <FILE>) {
chomp($line);
push #data, [split /[, ]+/, $line];
}
close FILE;
#column1 = map {$$_[0]} #data;
print "#column1\n";
And in data.txt something like:
1, 2, 3, 4
5, 6, 7, 8
9, 10, 11, 12
13, 14, 15, 16
perl -lne '#F = split /\s+/ and print $F[1]'
This might be what you want:
use English qw<$OS_ERROR>; # Or just use $!
use IO::Handle;
my #columns;
open my $fh, '<', 'columns.dat' or die "I'm dead. $OS_ERROR";
while ( my $line = <$fh> ) {
my #cols = split /\s+/, $line;
$columns[$_][$fh->input_line_number()-1] = $cols[$_] foreach 0..$#cols;
}
$fh->close();
You can access them directly by element.
$arrays[0][0] = 1;
$arrays[0][1] = 2;
$arrays[1][0] = 3;
$arrays[1][1] = 4;
for (my $i = 0; $i <= $#{$arrays[1]}; $i++) {
print "row for $i\n";
print "\tfrom first array: " . $arrays[0][$i] . "\n";
print "\tfrom second array: " . $arrays[1][$i] . "\n";
}
prints
row for 0
from first array: 1
from second array: 3
row for 1
from first array: 2
from second array: 4