# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1545632744 18000
# Node ID 32944636e2d38a5931cb09bd446c062a0be775f4
# Parent  df2880a47218b1ae4a1178dc6b55edeb357f7621
TRAN

diff -r df2880a47218 -r 32944636e2d3 src/problems/revc.lisp
--- a/src/problems/revc.lisp	Mon Dec 24 00:41:30 2018 -0500
+++ b/src/problems/revc.lisp	Mon Dec 24 01:25:44 2018 -0500
@@ -29,14 +29,8 @@
 ;; not 100% sure.
 
 (defun nreverse-complement (dna)
-  (flet ((dna-complement (base)
-           (case base
-             (#\A #\T)
-             (#\T #\A)
-             (#\G #\C)
-             (#\C #\G))))
-    (map-into dna #'dna-complement dna)
-    (nreverse dna)))
+  (map-into dna #'dna-complement dna)
+  (nreverse dna))
 
 (defun reverse-complement (dna)
   (nreverse-complement (copy-seq dna)))
diff -r df2880a47218 -r 32944636e2d3 src/problems/tran.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/problems/tran.lisp	Mon Dec 24 01:25:44 2018 -0500
@@ -0,0 +1,30 @@
+(in-package :rosalind)
+
+(defparameter *input-tran* ">Rosalind_0209
+GCAACGCACAACGAAAACCCTTAGGGACTGGATTATTTCGTGATCGTTGTAGTTATTGGA
+AGTACGGGCATCAACCCAGTT
+>Rosalind_2200
+TTATCTGACAAAGAAAGCCGTCAACGGCTGGATAATTTCGCGATCGTGCTGGTTACTGGC
+GGTACGAGTGTTCCTTTGGGT")
+
+(defparameter *output-tran* "1.21428571429")
+
+(defun transitionp (x y)
+  (and (char/= x y)
+       (= (rings x) (rings y))))
+
+(defun transversionp (x y)
+  (and (char/= x y)
+       (/= (rings x) (rings y))))
+
+(define-problem tran (data stream)
+    *input-tran*
+    *output-tran*
+  (destructuring-bind (x y)
+      (mapcar #'cdr (read-fasta-into-alist data))
+    (format nil "~,11F" (coerce (/ (mapcount #'transitionp x y)
+                                   (mapcount #'transversionp x y))
+                                'double-float))))
+
+;; (problem-tran "2")
+;; (solve tran)
diff -r df2880a47218 -r 32944636e2d3 src/utils.lisp
--- a/src/utils.lisp	Mon Dec 24 00:41:30 2018 -0500
+++ b/src/utils.lisp	Mon Dec 24 01:25:44 2018 -0500
@@ -56,6 +56,45 @@
   (gathering (alexandria:map-permutations #'gather items)))
 
 
+(defun dna-complement (base)
+  (ecase base
+    (#\A #\T)
+    (#\T #\A)
+    (#\G #\C)
+    (#\C #\G)))
+
+(defun rna-complement (base)
+  (ecase base
+    (#\A #\U)
+    (#\U #\A)
+    (#\G #\C)
+    (#\C #\G)))
+
+
+(defun rings (base)
+  "Return the number of rings in the structure of `base`.
+
+  Pyrimidines (cytosine, thymine, and uracil) have a single-ring structure.
+
+  Purines (adenine and guanine) have a double-ring structure.
+
+  "
+  (ecase base
+    ((#\A #\G) 2)
+    ((#\C #\T #\U) 1)))
+
+
+(defun mapcount (predicate sequence &rest more-sequences)
+  "Map `predicate` across sequences, counting satisfactory applications."
+  (let ((result 0))
+    (apply #'map nil
+           (lambda (&rest args)
+             (when (apply predicate args)
+               (incf result)))
+           sequence more-sequences)
+    result))
+
+
 ;;;; Iterate ------------------------------------------------------------------
 (defmacro-driver (FOR var SEED seed THEN then)
   "Bind `var` to `seed` initially, then to `then` on every iteration.