RabbitFarm
2020-12-13
Perl Weekly Challenge 090
Part 1
Write a script to print the nucleiobase count in the given DNA sequence. Also print the complementary sequence where Thymine (T) on one strand is always facing an adenine (A) and vice versa; guanine (G) is always facing a cytosine (C) and vice versa.
Solution
use strict;
use warnings;
##
# Write a script to print the nucleiobase count in
# the given DNA sequence. Also print the complementary
# sequence where Thymine (T) on one strand is always
# facing an adenine (A) and vice versa; guanine (G) is
# always facing a cytosine (C) and vice versa.
##
use constant SEQUENCE => "GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG";
my %nucleotide_map = (
"T" => "A",
"A" => "T",
"G" => "C",
"C" => "G"
);
sub complementary_sequence{
my($sequence) = @_;
my @complement = map { $nucleotide_map{$_} } split(//, $sequence);
return @complement;
}
MAIN:{
print "length of sequence: " . length(SEQUENCE) . "\n";
print "complementary sequence: " . join("", complementary_sequence(SEQUENCE)) . "\n";
}
Sample Run
$ perl perl/ch-1.pl
length of sequence: 67
complementary sequence: CATTTGGGGAAAAGTAAATCTGTCTAGCTGAGGAATAGGTAAGAGTCTCTACACAACGACCAGCGGC
Notes
When doing this problem I recalled a talk I attended at YAPC 2009. In that talk Steven Lembark discussed how allocating array storage for very long arrays, such as DNA sequences!, could result in memory issues. He presented an interesting use of LinkedLists to deal with this. I have to say that I am not sure if Perl’s internals have changed in some way that these concerns are still valid. If you are looking to deal with actual (tremendously large) DNA sequences and not the sample shown here this would be something to consider!
Part 2
You are given two positive numbers $A and $B. Write a script to demonstrate Ethiopian Multiplication using the given numbers.
Solution
use strict;
use warnings;
##
# You are given two positive numbers $A and $B.
# Write a script to demonstrate Ethiopian Multiplication
# using the given numbers.
##
sub ethiopian_multiplication{
my($a, $b) = @_;
my @steps;
my $product = 0;
my ($x, $y) = ($a, $b);
do{
$x = int($x / 2);
$y = $y * 2;
push @steps, [$x, $y] if $x % 2 != 0;
}until $steps[-1]->[0] == 1;
for my $step (@steps){
$product += $step->[1];
}
return $product;
}
MAIN:{
my($A, $B) = (14, 12);
print "$A x $B = " . ethiopian_multiplication($A, $B) . "\n";
}
Sample Run
$ perl perl/ch-2.pl
14 x 12 = 168
Notes
My implementation here follows pretty directly from the definition of the procedure. At each step there is a check to see if the odd/even condition holds and if true the result for that step is saved to an array. After the loop terminates the results are evaluated.
References
posted at: 18:34 by: Adam Russell | path: /perl | permanent link to this entry