# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1550943727 18000
# Node ID 474d88a2af2ebcadf7618e2a3ba59a55ebcd555a
# Parent  ca95211a2d98221f52a8d64275c47eee3e774c29
Refactor to remove some boilerplate

diff -r ca95211a2d98 -r 474d88a2af2e src/problems/iev.lisp
--- a/src/problems/iev.lisp	Fri Feb 22 19:32:24 2019 -0500
+++ b/src/problems/iev.lisp	Sat Feb 23 12:42:07 2019 -0500
@@ -9,14 +9,13 @@
          (hh (read data))
          (hr (read data))
          (rr (read data)))
-    (format nil "~,4F"
-            ;; It's just a weighted average…
-            (* 2 (+ (* dd 1)
-                    (* dh 1)
-                    (* dr 1)
-                    (* hh 3/4)
-                    (* hr 1/2)
-                    (* rr 0))))))
+    (float-string
+      ;; It's just a weighted average…
+      (* 2 (+ (* dd 1)
+              (* dh 1)
+              (* dr 1)
+              (* hh 3/4)
+              (* hr 1/2)
+              (* rr 0)))
+      4)))
 
-;; (problem-iev)
-;; (solve iev)
diff -r ca95211a2d98 -r 474d88a2af2e src/problems/iprb.lisp
--- a/src/problems/iprb.lisp	Fri Feb 22 19:32:24 2019 -0500
+++ b/src/problems/iprb.lisp	Sat Feb 23 12:42:07 2019 -0500
@@ -24,13 +24,14 @@
              ;;          = 2XY/N²-N
              (/ (* 2 x y)
                 (- (* n n) n))))
-      (format nil "~,5F"
-              (+ (* (p-same d d) 1)      ;; AA AA
-                 (* (p-diff d h) 1)      ;; AA Aa
-                 (* (p-diff d r) 1)      ;; AA aa
-                 (* (p-same h h) 3/4)    ;; Aa Aa
-                 (* (p-diff h r) 1/2)    ;; Aa aa
-                 (* (p-same r r) 0)))))) ;; aa aa
+      (float-string
+        (+ (* (p-same d d) 1)      ;; AA AA
+           (* (p-diff d h) 1)      ;; AA Aa
+           (* (p-diff d r) 1)      ;; AA aa
+           (* (p-same h h) 3/4)    ;; Aa Aa
+           (* (p-diff h r) 1/2)    ;; Aa aa
+           (* (p-same r r) 0))
+        5)))) ;; aa aa
 
 ;; (problem-iprb)
 ;; (solve iprb)
diff -r ca95211a2d98 -r 474d88a2af2e src/problems/lia.lisp
--- a/src/problems/lia.lisp	Fri Feb 22 19:32:24 2019 -0500
+++ b/src/problems/lia.lisp	Sat Feb 23 12:42:07 2019 -0500
@@ -51,4 +51,4 @@
   (let* ((generations (read data))
          (target (read data))
          (population (expt 2 generations)))
-    (format nil "~,3F" (bernoulli-at-least target population 1/4))))
+    (float-string (bernoulli-at-least target population 1/4))))
diff -r ca95211a2d98 -r 474d88a2af2e src/problems/prob.lisp
--- a/src/problems/prob.lisp	Fri Feb 22 19:32:24 2019 -0500
+++ b/src/problems/prob.lisp	Sat Feb 23 12:42:07 2019 -0500
@@ -18,4 +18,4 @@
            (iterate
              (for base :in-string dna)
              (summing (log (base-probability gc-content base) 10)))))
-      (format nil "~{~,3F~^ ~}" (mapcar #'prob gc-contents)))))
+      (float-string (mapcar #'prob gc-contents)))))
diff -r ca95211a2d98 -r 474d88a2af2e src/problems/prtm.lisp
--- a/src/problems/prtm.lisp	Fri Feb 22 19:32:24 2019 -0500
+++ b/src/problems/prtm.lisp	Sat Feb 23 12:42:07 2019 -0500
@@ -36,6 +36,6 @@
   (-<> data
     (delete #\newline <>)
     (summation <> :key #'monoisotopic-mass)
-    (format nil "~,3F" <>)))
+    float-string))
 
 
diff -r ca95211a2d98 -r 474d88a2af2e src/problems/rstr.lisp
--- a/src/problems/rstr.lisp	Fri Feb 22 19:32:24 2019 -0500
+++ b/src/problems/rstr.lisp	Sat Feb 23 12:42:07 2019 -0500
@@ -12,5 +12,5 @@
   (let* ((n (read data))
          (gc (coerce (read data) 'double-float))
          (dna (read-line data))
-         (prob (product dna :key (curry #'base-probability gc))))
-    (format nil "~,3F" (- 1 (expt (- 1 prob) n)))))
+         (prob (sequence-probability gc dna)))
+    (float-string (- 1 (expt (- 1 prob) n)))))
diff -r ca95211a2d98 -r 474d88a2af2e src/utils.lisp
--- a/src/utils.lisp	Fri Feb 22 19:32:24 2019 -0500
+++ b/src/utils.lisp	Sat Feb 23 12:42:07 2019 -0500
@@ -95,6 +95,10 @@
     (/ gc-content 2)
     (/ (- 1 gc-content) 2)))
 
+(defun sequence-probability (gc-content sequence)
+  "Return the probability of seeing `sequence` when generating a random sequence with the given `gc-content`."
+  (product sequence :key (curry #'base-probability gc-content)))
+
 
 (defun mapcount (predicate sequence &rest more-sequences)
   "Map `predicate` across sequences, counting satisfactory applications."
@@ -107,6 +111,12 @@
     result))
 
 
+(defun ensure-list (value)
+  (if (listp value)
+    value
+    (list value)))
+
+
 ;;;; Math ---------------------------------------------------------------------
 (defmacro do-sum ((var from to) &body body)
   "Sum `body` with `var` iterating over `[from, to]`.
@@ -354,6 +364,13 @@
                 first)))
 
 
+;;;; Output -------------------------------------------------------------------
+(defun float-string (float-or-floats &optional (precision 3))
+  (with-output-to-string (s)
+    (loop :for (float . more) :on (ensure-list float-or-floats)
+          :do (format s "~,VF~:[~; ~]" precision float more))))
+
+
 ;;;; Testing ------------------------------------------------------------------
 (defmacro define-test (problem input output &optional (test 'string=))
   `(test ,(symb 'test- problem)