# RabbitFarm

### 2020-12-13

The Weekly Challenge 090 (Prolog Solutions)

## 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

```
:- initialization(main).
nucleotide_pair('A', 'T').
nucleotide_pair('C', 'G').
compliment([H|T], [Compliment|RestOfCompliment]):-
var(Compliment),
atom_chars(A, [H]),
(nucleotide_pair(A, X); nucleotide_pair(X, A)),
atom_chars(X, [Compliment]),
compliment(T, RestOfCompliment).
compliment([H|T], [Compliment|RestOfCompliment]):-
(nucleotide_pair(A, Compliment); nucleotide_pair(Compliment, A)),
atom_chars(A, [H]),
compliment(T, RestOfCompliment).
compliment([], _).
compliment(_, []).
main:-
Sequence = 'GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG',
atom_chars(Sequence, SequenceChars),
length(SequenceChars, SequenceLength),
format("Sequence length is ~d.~n", [SequenceLength]),
length(Compliment, SequenceLength),
compliment(SequenceChars, Compliment),
atom_chars(ACompliment, Compliment),
compliment(OriginalSequence, Compliment),
atom_chars(AOriginalSequence, OriginalSequence),
format("Original sequence is ~a.~n", [AOriginalSequence]),
format("Complimentary sequence is ~a.~n", [ACompliment]),
halt.
```

### Sample Run

```
$ gplc ch-1.p
$ ch-1
Sequence length is 67.
Original sequence is GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG.
Complimentary sequence is CATTTGGGGAAAAGTAAATCTGTCTAGCTGAGGAATAGGTAAGAGTCTCTACACAACGACCAGCGGC.
```

### Notes

- The predicate
`compliment/2`

will work with either of the arguments instantiated. In other words it is a*bimodal predicate*.This is maybe a little silly in this case in particular because of the nature of the mappings between base pairs it is not necessary. Still, getting predicates to be bimodal requires some care and skill and I thought I’d take a crack at it here. - I am using Gnu Prolog here.
`gplc`

is the Gnu Prolog compiler. I love how it compiles Prolog to a single native executable. Beautiful!

## Part 2

*You are given two positive numbers $A and $B. Write a script to demonstrate Ethiopian Multiplication using the given numbers.*

### Solution

```
:- initialization(main).
ethiopean_multiplication(Operands, Product):-
ethiopean_multiplication(Operands, [], Product).
ethiopean_multiplication([1, _], IntermediateTerms, Product):-
sum_list(IntermediateTerms, Product).
ethiopean_multiplication(Operands, IntermediateTerms, Product):-
[A0, B0] = Operands,
A is A0 div 2,
B is B0 * 2,
M is A mod 2,
M == 1,
ethiopean_multiplication([A, B], [B|IntermediateTerms], Product).
ethiopean_multiplication(Operands, IntermediateTerms, Product):-
[A0, B0] = Operands,
A is A0 div 2,
B is B0 * 2,
M is A mod 2,
M == 0,
ethiopean_multiplication([A, B], IntermediateTerms, Product).
main:-
[A, B] = [14, 12],
ethiopean_multiplication([A, B], Product),
format("Product of ~d x ~d (via Ethiopean Multiplication) is ~d.~n", [A, B, Product]),
halt.
```

### Sample Run

```
$ gplc ch-2.p
$ ch-2
Product of 14 x 12 (via Ethiopean Multiplication) is 168.
```

### Notes

I think this is a fairly straightforward recursive Prolog solution. At each recursive step the two elements are either halved or doubled until the base step is hit and then the accumulated terms (the even elements from only the odd/even pairs) are summed.

## References

posted at: 18:34 by: Adam Russell | path: /prolog | permanent link to this entry

#### 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