Merge pull request #3014 from pauloscustodio/090-gforth

Challenge 090 solution in gforth

3 files changed, 76 insertions, 0 deletions

diff --git a/challenge-090/paulo-custodio/gforth/ch-1.fth b/challenge-090/paulo-custodio/gforth/ch-1.fth
new file mode 100644
index 0000000000..fa8e29dfba
--- /dev/null
+++ b/challenge-090/paulo-custodio/gforth/ch-1.fth
@@ -0,0 +1,40 @@
+\ Challenge 090
+\ TASK #1 › DNA Sequence
+\ Submitted by: Mohammad S Anwar
+\ DNA is a long, chainlike molecule which has two strands twisted into a double helix. 
+\ The two strands are made up of simpler molecules called nucleotides. Each nucleotide is 
+\ composed of one of the four nitrogen-containing nucleobases cytosine (C), guanine (G), 
+\ adenine (A) and thymine (T).
+\ 
+\ You are given DNA sequence, 
+\ GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG.
+\ 
+\ Write a script to print 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.
+
+\ start with sequence in input buffer
+
+: compl-one		( c -- c )
+	DUP      'T' = IF DROP 'A'
+	ELSE DUP 'A' = IF DROP 'T'
+	ELSE DUP 'G' = IF DROP 'C'
+	ELSE DUP 'C' = IF DROP 'G'
+	ELSE DROP BL
+	THEN THEN THEN THEN
+;
+
+: compl-seq 	( c-addr n -- c-addr n )
+	PAD C!
+	PAD 1+ PAD C@ CMOVE	\ copy as counted string to PAD
+	PAD 1+
+	PAD C@ 0 DO
+		DUP C@ compl-one OVER C! 1+
+	LOOP
+	PAD COUNT
+;
+
+next-arg				\ collect string
+DUP . CR				\ print length
+compl-seq TYPE CR		\ print complemented sequence
+BYE
diff --git a/challenge-090/paulo-custodio/gforth/ch-2.fth b/challenge-090/paulo-custodio/gforth/ch-2.fth
new file mode 100644
index 0000000000..2f949db3db
--- /dev/null
+++ b/challenge-090/paulo-custodio/gforth/ch-2.fth
@@ -0,0 +1,21 @@
+\ Challenge 090
+\ TASK #2 › Ethiopian Multiplication
+\ Submitted by: Mohammad S Anwar
+\ You are given two positive numbers $a and $b.
+\ 
+\ Write a script to demonstrate Ethiopian Multiplication using the given numbers.
+
+: mult 		{ a b -- a*b }		\ a, b: locals
+	0							( sum )
+	BEGIN
+		a 1 AND IF 				\ a is even
+			b +					\ sum += b
+		THEN
+		a 1 = IF EXIT THEN		\ exit when a=1
+		a 2/ TO a
+		b 2* TO b
+	AGAIN
+;
+
+\ input in stack
+mult . CR BYE
diff --git a/challenge-090/paulo-custodio/gforth/test.pl b/challenge-090/paulo-custodio/gforth/test.pl
new file mode 100644
index 0000000000..278659d91f
--- /dev/null
+++ b/challenge-090/paulo-custodio/gforth/test.pl
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More;
+
+is `gforth ch-1.fth \\
+GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG`, <<'END';
+67 
+CATTTGGGGAAAAGTAAATCTGTCTAGCTGAGGAATAGGTAAGAGTCTCTACACAACGACCAGCGGC
+END
+
+is `gforth -e '14 12' ch-2.fth`, "168 \n";
+
+done_testing;