Edward Wijaya wrote:
> Hi,
>
> I have following code that measure the substring.
> It basically the number of positions of substrings
> that occur (dotted count)
>
> CASE A:
> ....... ....... ......
> GATTACGAGTGGCGCTCGTGTAACGGCA #Score 21
> GATTACG GCGCTCG AACGGCA
>
>
> CASE B:
> .. .. #Score 4
> GATTACGAGTGGCGCTCGTGTAACGGCA
> GG GG
>
>
>
> But how come for CASE B, the code below returns Score = 2 instead of
> 4?
Your first case were 3 uniques and the the second had two alike. If
you had a dup in the first it would not have worked correctly. You will need
to use the offset value within index to get it to work. I placed a couple of
print statements and you see it goes right back to the same position on the
second one. I added three lines see below and it came out with the counts you
were expecting.
>
>
> __BEGIN__
> #!/usr/bin/perl -w
> use strict;
> use Data::Dumper;
>
> my $s1 = 'GATTACGAGTGGCGCTCGTGTAACGGCA';
> my @CASE_A = ('GATTACG','GCGCTCG','AACGGCA'); # 21
> my @CASE_B = ('GG','GG'); # 4
>
> print &score($s1,[EMAIL PROTECTED]) , "\n";
> print &score($s1,[EMAIL PROTECTED]) , "\n";
>
>
> sub score
> {
> my ($str,$array) = @_;
> my %position_score;
my $offset = 0;
>
> for my $frag (@{$array}) {
> my $idx = index($str, $frag) + 1;
my $idx = index($str, $frag, $offset) + 1;
>
> for my $pos ($idx .. $idx + (length($frag) - 1)) {
> $position_score{$pos} = 1;
> };
$offset = $idx;
Wags ;)
> };
>
> my $total_score = 0;
> for my $score (values %position_score) {
> $total_score += $score;
> };
>
> return $total_score;
>
> };
>
> __END__
>
>
> --
> Edward WIJAYA
> Singapore
*******************************************************
This message contains information that is confidential
and proprietary to FedEx Freight or its affiliates.
It is intended only for the recipient named and for
the express purpose(s) described therein.
Any other use is prohibited.
*******************************************************
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
