Related
I want to translate a sequence of DNA or RNA to protein, but after run it, I have tons of "Use of uninitialized value within %genetic_code in substitution iterator at translateRNAToProtein.pl line 95, line 1." warning. I double checked the translation table and no error there. My code is following:
use strict;
use warnings;
use feature qw(say);
translation (my $sequence);
my %genetic_code = (
UCA => 'S',
UCC => 'S',
UCG => 'S',
UCU => 'S',
UUC => 'F',
UUU => 'F',
UUA => 'L',
UUG => 'L',
UAC => 'Y',
UAU => 'Y',
UAA => '_',
UAG => '_',
UGC => 'C',
UGU => 'C',
UGA => '_',
UGG => 'W',
CUA => 'L',
CUC => 'L',
CUG => 'L',
CUU => 'L',
CCA => 'P',
CCC => 'P',
CCG => 'P',
CCU => 'P',
CAC => 'H',
CAU => 'H',
CAA => 'Q',
CAG => 'Q',
CGA => 'R',
CGC => 'R',
CGG => 'R',
CGU => 'R',
AUA => 'I',
AUC => 'I',
AUU => 'I',
AUG => 'M',
ACA => 'U',
ACC => 'U',
ACG => 'U',
ACU => 'U',
AAC => 'N',
AAU => 'N',
AAA => 'K',
AAG => 'K',
AGC => 'S',
AGU => 'S',
AGA => 'R',
AGG => 'R',
GUA => 'V',
GUC => 'V',
GUG => 'V',
GUU => 'V',
GCA => 'A',
GCC => 'A',
GCG => 'A',
GCU => 'A',
GAC => 'D',
GAU => 'D',
GAA => 'E',
GAG => 'E',
GGA => 'G',
GGC => 'G',
GGG => 'G',
GGU => 'G',
);
sub translation {
say "enter a RNA or DNA sequence: ";
my $sequence = <STDIN>;
chomp $sequence;
$sequence = uc ($sequence);
if ($sequence =~ /T/){
$sequence =~ tr/ATGC/UACG/;
}
say "\nThe result of translation is:\n\n";
foreach ($a = 0; $a < 3; $a++) {
my $main_seq = substr($sequence, $a);
if ($main_seq =~ /(AUG(...)*(UAG|UGA|UAA))/){
$main_seq = $1;
$main_seq =~ s/(...)/$genetic_code{$1}/g; #Here is the warning place
say "$main_seq\n";
}
else {
say "No start or stop codon!"
}
}
}
Other parts work fine. For example, when I enter a 669 bp DNA:
TACATCCACCACACCATTTCCGCCAATGAAATTTGCATGCAAATCAATCCAGGTTCTTCAAACTGTATGCCCAGTCAACCCAGTCATGCAACACTGACCATTGAATCCATCAATTCAGAAACAGACGAAAGGACCAAGACACGGTTTCGCTGCAGGTTTGAAGGGTGCAAACGAACTTACAGCTCTGCTGGAAACTTGAAAGCACACACTAAAAGTCACACAGGGGAGTATACATTTAAATGTACTGAAGAAGAATGTGGGAAGGCATTTCTCAACTCCCACAGCCTAAAGATTCATGTCAGAGTACACACCAAAGATCGTCCCTATGGCTGTGACATTGGGGGATGTGACAAGAACTTCAACACACTCTACCGATTGAAAGCTCATCAGAGGGTACACAACGGCACCACCTTTAAATGTGAACAATCTGGATGTGTGAAATTCTTCACCACCCTCAGTGACTTACGGAAACACGAACGTGTCCATTCGGGAGACCGGCCATTCAAATGCGAGCACGAAGATTGCAACAAGTCATTTCGCAATAGCCATCATCTGAAATCGCACATGTTATCTCATACGGGTGAACGACCCTACACATGCAGTGATTCTGCATGTGGACGAACCTTCGCCAAGCGTAATTCGTGGAAGTTGCATCTATTGAAGCATGAA
it can correctly recognize it, convert it to RNA and find the sequences from start codon to stop codon:
AUGUAGGUGGUGUGGUAAAGGCGGUUACUUUAAACGUACGUUUAGUUAGGUCCAAGAAGUUUGACAUACGGGUCAGUUGGGUCAGUACGUUGUGACUGGUAACUUAGGUAGUUAAGUCUUUGUCUGCUUUCCUGGUUCUGUGCCAAAGCGACGUCCAAACUUCCCACGUUUGCUUGAAUGUCGAGACGACCUUUGAACUUUCGUGUGUGAUUUUCAGUGUGUCCCCUCAUAUGUAAAUUUACAUGACUUCUUCUUACACCCUUCCGUAAAGAGUUGAGGGUGUCGGAUUUCUAAGUACAGUCUCAUGUGUGGUUUCUAGCAGGGAUACCGACACUGUAA
AUGUCGAGACGACCUUUGAACUUUCGUGUGUGAUUUUCAGUGUGUCCCCUCAUAUGUAAAUUUACAUGACUUCUUCUUACACCCUUCCGUAAAGAGUUGAGGGUGUCGGAUUUCUAAGUACAGUCUCAUGUGUGGUUUCUAGCAGGGAUACCGACACUGUAA
AUGUCGAGACGACCUUUGAACUUUCGUGUGUGAUUUUCAGUGUGUCCCCUCAUAUGUAAAUUUACAUGACUUCUUCUUACACCCUUCCGUAAAGAGUUGAGGGUGUCGGAUUUCUAAGUACAGUCUCAUGUGUGGUUUCUAGCAGGGAUACCGACACUGUAA
However, when I try to use a short sequence "uacauguauuaacag" to test this code,
it returns "UACAUGUAUUAACAG", "AUGUAUUAA"(which I add extra code to print out and get what I expected) and three warnings shown above. So clearly it's not an error from translation table. Any advice is appreciated!
The problem seems to be that you invoke translation() before you've defined %genetic_code. Simply moving translation(my $sequence); to after the definition of %genetic_code (and &translation) resolves the problem. Of course, you should remove the unused and uninitialized parameter too. Hence, from:
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw(say);
my %genetic_code = (
UCA => 'S', UCC => 'S', UCG => 'S', UCU => 'S',
UUC => 'F', UUU => 'F', UUA => 'L', UUG => 'L',
UAC => 'Y', UAU => 'Y', UAA => '_', UAG => '_',
UGC => 'C', UGU => 'C', UGA => '_', UGG => 'W',
CUA => 'L', CUC => 'L', CUG => 'L', CUU => 'L',
CCA => 'P', CCC => 'P', CCG => 'P', CCU => 'P',
CAC => 'H', CAU => 'H', CAA => 'Q', CAG => 'Q',
CGA => 'R', CGC => 'R', CGG => 'R', CGU => 'R',
AUA => 'I', AUC => 'I', AUU => 'I', AUG => 'M',
ACA => 'U', ACC => 'U', ACG => 'U', ACU => 'U',
AAC => 'N', AAU => 'N', AAA => 'K', AAG => 'K',
AGC => 'S', AGU => 'S', AGA => 'R', AGG => 'R',
GUA => 'V', GUC => 'V', GUG => 'V', GUU => 'V',
GCA => 'A', GCC => 'A', GCG => 'A', GCU => 'A',
GAC => 'D', GAU => 'D', GAA => 'E', GAG => 'E',
GGA => 'G', GGC => 'G', GGG => 'G', GGU => 'G',
);
sub translation {
say "enter a RNA or DNA sequence: ";
my $sequence = <STDIN>;
chomp $sequence;
$sequence = uc ($sequence);
if ($sequence =~ /T/){
$sequence =~ tr/ATGC/UACG/;
}
say "\nThe result of translation is:\n\n";
foreach ($a = 0; $a < 3; $a++) {
my $main_seq = substr($sequence, $a);
if ($main_seq =~ /(AUG(...)*(UAG|UGA|UAA))/){
$main_seq = $1;
$main_seq =~ s/(...)/$genetic_code{$1}/g;
say "$main_seq\n";
}
else {
say "No start or stop codon!"
}
}
}
translation();
And given the first line of data as input, the output is:
enter a RNA or DNA sequence:
The result of translation is:
M_VVW_RRLL_UYV_LGPRSLUYGSVGSVRCDW_LR_LSLCLLSWFCAKAUSKLPUFA_MSRRPLNFRV_FSVCPLICKFU_LLLUPFRKELRVSDF_VQSHVWFLAGIPUL_
MSRRPLNFRV_FSVCPLICKFU_LLLUPFRKELRVSDF_VQSHVWFLAGIPUL_
MSRRPLNFRV_FSVCPLICKFU_LLLUPFRKELRVSDF_VQSHVWFLAGIPUL_
With absolutely no warnings about uninitialized values.
I have a hash which contain sub hash, I want to abstract that sub hash separately and create a array from that,
hash look like
'a1' => '1',
'a2' => '2'.
'Def' => [
'd' => 'x',
'e' => 'y'
]
I need to make a separate hash for 'Def'. and print only 'Def' as a array
Its hard from reading your question to know just exactly what you are trying to achieve but my interpretation of it is that you want to extract the anonymous hash allocated to def and store it in another hash. Then you want to print this hash as an array. I have also included examples to print just the keys of the values of the hash.
use strict;
use Data::Dumper;
my %first_hash = (
a1 => '1',
a2 => '2',
def => {
d => 'x',
e => 'y'
}
);
my %second_hash = %{$first_hash{'def'}};
my #full_array = %second_hash;
my #keys_array = keys %second_hash;
my #values_array = values %second_hash;
print Dumper (\%first_hash);
print Dumper (\%second_hash);
print "full array: ", join(' ',#full_array), "\n";
print "keys array: ", join(' ',#keys_array), "\n";
print "values array: ", join(' ',#values_array), "\n";
OUTPUT
$VAR1 = {
'a2' => '2',
'def' => {
'e' => 'y',
'd' => 'x'
},
'a1' => '1'
};
$VAR1 = {
'e' => 'y',
'd' => 'x'
};
full array: e y d x
keys array: e d
values array: y x
Below you'll find the answer.
print "#{$a{'Def'}}";
I would like to write an simple perl script to generate all possible words for given phone number.
I started with definition of an array:
my #nums = (
['0'],
['1'],
['2', 'a', 'b', 'c'],
['3', 'd', 'e', 'f'],
['4', 'g', 'h', 'i'],
['5', 'j', 'k', 'l'],
['6', 'm', 'n', 'o'],
['7', 'p', 'q', 'r', 's'],
['8', 't', 'u', 'v'],
['9', 'w', 'x', 'y', 'z']
);
The final script should generate following output:
$ num2word 12
12
1a
1b
1c
$ num2word 213
213
21d
21e
21f
a13
a1d
a1e
a1f
b13
b1d
b1e
b1f
c13
c1d
c1e
c1f
I am looking for any module which can do most part of the job (something like List::Permutor which does not seem to qualify for this task).
Any hints?
Thanks!
Our very own #brian d foy has solved this problem with his Set::CrossProduct module.
use Set::CrossProduct;
my $iterator = Set::CrossProduct->new(
[ [ qw(8 t u v) ], [ qw(0) ], [ qw(7 p q r s) ] ] );
print "#$_\n" for $iterator->combinations;
Output:
8 0 7
8 0 p
8 0 q
8 0 r
8 0 s
t 0 7
t 0 p
t 0 q
t 0 r
t 0 s
u 0 7
u 0 p
u 0 q
u 0 r
u 0 s
v 0 7
v 0 p
v 0 q
v 0 r
v 0 s
This does what you ask.
use strict;
use warnings;
my #nums = (
[ qw/ 0 / ],
[ qw/ 1 / ],
[ qw /2 a b c / ],
[ qw /3 d e f / ],
[ qw /4 g h i / ],
[ qw /5 j k l / ],
[ qw /6 m n o / ],
[ qw /7 p q r s / ],
[ qw /8 t u v / ],
[ qw /9 w x y z / ],
);
list_matching('12');
list_matching('213');
sub list_matching {
my ($num) = #_;
my #num = $num =~ /\d/g;
my #map = (0) x #num;
do {
print join('', map { $nums[$num[$_]][$map[$_]] } 0 .. $#num), "\n";
my $i = $#map;
while ($i >= 0) {
last if ++$map[$i] < #{ $nums[$num[$i]] };
$map[$i--] = 0;
}
} while grep $_, #map;
}
output
12
1a
1b
1c
213
21d
21e
21f
a13
a1d
a1e
a1f
b13
b1d
b1e
b1f
c13
c1d
c1e
c1f
See the functions in Algorithm::Combinatorics.
Actually, does work, too early for me...
use autodie;
use strict;
use warnings;
my #nums = (
['0'],
['1'],
['2', 'a', 'b', 'c'],
['3', 'd', 'e', 'f'],
['4', 'g', 'h', 'i'],
['5', 'j', 'k', 'l'],
['6', 'm', 'n', 'o'],
['7', 'p', 'q', 'r', 's'],
['8', 't', 'u', 'v'],
['9', 'w', 'x', 'y', 'z']
);
my $input = shift || die "Need a number!\n";
die "Input not numeric!\n" unless $input =~ m/^\d+$/;
my #digits = split //, $input;
my #rows;
push #rows, $nums[$_] for #digits;
print_row(0,'');
exit;
sub print_row {
my $i = shift;
my $word = shift;
my $row = $rows[$i];
for my $j (0..$#{$row}) {
my $word2 = $word . $row->[$j];
if ($i < $#rows) {
print_row($i+1, $word2);
}
else {
print "$word2\n";
}
}
}
No modules required:
my #nums = (
['0'],
['1'],
['2', 'a', 'b', 'c'],
['3', 'd', 'e', 'f'],
['4', 'g', 'h', 'i'],
['5', 'j', 'k', 'l'],
['6', 'm', 'n', 'o'],
['7', 'p', 'q', 'r', 's'],
['8', 't', 'u', 'v'],
['9', 'w', 'x', 'y', 'z']
);
print "$_\n" while glob join '', map sprintf('{%s}', join ',', #{$nums[$_]}), split //, $ARGV[0]
use strict;
use warnings;
my #nums = (
['0'], ['1'], ['2', 'a', 'b', 'c'],
['3', 'd', 'e', 'f'], ['4', 'g', 'h', 'i'],
['5', 'j', 'k', 'l'], ['6', 'm', 'n', 'o'],
['7', 'p', 'q', 'r', 's'], ['8', 't', 'u', 'v'],
['9', 'w', 'x', 'y', 'z']);
num2word(12);
num2word(213);
sub num2word {
my ($i, $n, $t) = ($_[0]=~/(.)(.*)/, $_[1]);
for (#{$nums[$i]}) {
print "$t$_\n" and next if !length($n);
num2word($n, defined $t ? $t.$_ : $_);
}
}
A basic recursive solution:
#!/usr/bin/perl
use strict;
use warnings;
my $phone_number = $ARGV[0] or die "No phone number";
my #nums = (
['0'],
['1'],
[ '2', 'a', 'b', 'c' ],
[ '3', 'd', 'e', 'f' ],
[ '4', 'g', 'h', 'i' ],
[ '5', 'j', 'k', 'l' ],
[ '6', 'm', 'n', 'o' ],
[ '7', 'p', 'q', 'r', 's' ],
[ '8', 't', 'u', 'v' ],
[ '9', 'w', 'x', 'y', 'z' ]
);
my %letters = map { shift #{$_} => $_ } #nums;
my #permutations;
sub recurse {
my $str = shift;
my $done = shift || '';
unless ($str) {
push #permutations, $done;
return;
}
my $next = substr( $str, 0, 1 );
$str = substr( $str, 1 );
recurse( $str, $done . $next );
if ( my #chars = #{ $letters{$next} } ) {
recurse( $str, $done . $_ ) foreach #chars;
}
}
recurse($phone_number);
print "$_\n" foreach #permutations;
and:
perl num2word 12
12
1a
1b
1c
perl num2word 213
213
21d
21e
21f
a13
a1d
a1e
a1f
b13
b1d
b1e
b1f
c13
c1d
c1e
c1f
Given the following variable:
$test = {
'1' => 'A',
'2' => 'B',
'3' => 'C',
'4' => 'G',
'5' => 'K',
}
How can loop through all assignments without knowing which keys I have?
I would like to fill a select box with the results as label and the keys as hidden values.
Just do a foreach loop on the keys:
#!/usr/bin/perl
use strict;
use warnings;
my $test = {
'1' => 'A',
'2' => 'B',
'3' => 'C',
'4' => 'G',
'5' => 'K',
};
foreach my $key(keys %$test) {
print "key=$key : value=$test->{$key}\n";
}
output:
key=4 : value=G
key=1 : value=A
key=3 : value=C
key=2 : value=B
key=5 : value=K
You can use the built-in function each:
while (my ($key, $value) = each %$test) {
print "key: $key, value: $value\n";
}
You can find out what keys you have with keys
my #keys = keys %$test; # Note that you need to dereference the hash here
Or you could just do the whole thing in one pass:
print map { "<option value='$_'>$test->{$_}</option>" } keys %$test;
But you'd probably want some kind of order:
print map { "<option value='$_'>$test->{$_}</option>" } sort keys %$test;
… and you'd almost certainly be better off moving the HTML generation out to a separate template system.
I am trying to read values from an input file in Perl.
Input file looks like:
1-sampledata1 This is a sample test
and data for this continues
2-sampledata2 This is sample test 2
Data for this also is on second line
I want to read the above data so that data for 1-sampledata1 goes into #array1 and data for 2-sampledata2 goes in #array2 and so on.
I will have about 50 sections like this. like 50-sampledata50.
EDIT: The names wont always be X-sampledataX. I just did that for example. So names cant be in a loop. I think I'll have to type them manually
I so far have the following (which works). But I am looking for a more efficient way to do this..
foreach my $line(#body){
if ($line=~ /^1-sampledata1\s/){
$line=~ s/1-ENST0000//g;
$line=~ s/\s+//g;
push (#array1, $line);
#using splitarray because i want to store data as one character each
#for ex: i wana store 'This' as T H I S in different elements of array
#splitarray1= split ('',$line);
last if ($line=~ /2-sampledata2/);
}
}
foreach my $line(#body){
if ($line=~ /^2-sampledata2\s/){
$line=~ s/2-ENSBTAP0//g;
$line=~ s/\s+//g;
#splitarray2= split ('',$line);
last if ($line=~ /3-sampledata3/);
}
}
As you can see I have different arrays for each section and different for loops for each section. If I go with approach I have so far then I will end up with 50 for loops and 50 arrays.
Is there another better way to do this? In the end I do want to end up with 50 arrays but do not want to write 50 for loops. And since I will be looping through the 50 arrays later on in the program, maybe store them in an array? I am new to Perl so its kinda overwhelming ...
The first thing to notice is that you are trying to use variable names with integer suffixes: Don't. Use an array whenever you find your self wanting to do that. Second, you only need to read to go over the file contents once, not multiple times. Third, there is usually no good reason in Perl to treat a string as an array of characters.
Update: This version of the code uses existence of leading spaces to decide what to do. I am leaving the previous version up as well for reference.
#!/usr/bin/perl
use strict;
use warnings;
my #data;
while ( my $line = <DATA> ) {
chomp $line;
if ( $line =~ s/^ +/ / ) {
push #{ $data[-1] }, split //, $line;
}
else {
push #data, [ split //, $line ];
}
}
use Data::Dumper;
print Dumper \#data;
__DATA__
1-sampledata1 This is a sample test
and data for this continues
2-sampledata2 This is sample test 2
Data for this also is on second line
Previous version:
#!/usr/bin/perl
use strict;
use warnings;
my #data;
while ( my $line = <DATA> ) {
chomp $line;
$line =~ s/\s+/ /g;
if ( $line =~ /^[0-9]+-/ ) {
push #data, [ split //, $line ];
}
else {
push #{ $data[-1] }, split //, $line;
}
}
use Data::Dumper;
print Dumper \#data;
__DATA__
1-sampledata1 This is a sample test
and data for this continues
2-sampledata2 This is sample test 2
Data for this also is on second line
#! /usr/bin/env perl
use strict;
use warnings;
my %data;
{
my( $key, $rest );
while( my $line = <> ){
unless( ($rest) = $line =~ /^ \s+(.*)/x ){
($key, $rest) = $line =~ /^(.*?)\s+(.*)/;
}
push #{ $data{$key} }, $rest;
}
}
The code below is very similar to #Brad Gilbert's and #Sinan Unur's solutions:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my (%arrays, $label);
while (my $line = <DATA>)
{
($label, $line) = ($1, $2) if $line =~ /^(\S+)(.*)/; # new data block
$line =~ s/^\s+//; # strip whitespaces from the begining
# append data for corresponding label
push #{$arrays{$label}}, split('', $line) if defined $label;
}
print $arrays{'1-sampledata1'}[2], "\n"; # 'i'
print join '-', #{$arrays{'2-sampledata2'}}; # 'T-h-i-s- -i-s- -s-a-m-p-l
print Dumper \%arrays;
__DATA__
1-sampledata1 This is a sample test
and data for this continues
2-sampledata2 This is sample test 2
Data for this also is on second line
Output
i
T-h-i-s- -i-s- -s-a-m-p-l-e- -t-e-s-t- -2-D-a-t-a- -f-o-r- -t-h-i-s- -a-l-s-o- -i-s- -o-n- -s-e-c-o-n-d- -l-i-n-e-
$VAR1 = {
'2-sampledata2' => [
'T',
'h',
'i',
's',
' ',
'i',
's',
' ',
's',
'a',
'm',
'p',
'l',
'e',
' ',
't',
'e',
's',
't',
' ',
'2',
'D',
'a',
't',
'a',
' ',
'f',
'o',
'r',
' ',
't',
'h',
'i',
's',
' ',
'a',
'l',
's',
'o',
' ',
'i',
's',
' ',
'o',
'n',
' ',
's',
'e',
'c',
'o',
'n',
'd',
' ',
'l',
'i',
'n',
'e',
'
'
],
'1-sampledata1' => [
'T',
'h',
'i',
's',
' ',
'i',
's',
' ',
'a',
' ',
's',
'a',
'm',
'p',
'l',
'e',
' ',
't',
'e',
's',
't',
'a',
'n',
'd',
' ',
'd',
'a',
't',
'a',
' ',
'f',
'o',
'r',
' ',
't',
'h',
'i',
's',
' ',
'c',
'o',
'n',
't',
'i',
'n',
'u',
'e',
's',
'
'
]
};
You should, instead, use a hash map to arrays.
Use this regex pattern to get the index:
/^(\d+)-sampledata(\d+)/
And then, with my %arrays, do:
push($arrays{$index}), $line;
You can then access the arrays with $arrays{$index}.