--- a/src/package.lisp Sun Jan 19 21:14:53 2020 -0500
+++ b/src/package.lisp Mon Jan 20 13:41:09 2020 -0500
@@ -31,7 +31,7 @@
:Σ :Π :binomial-coefficient
- :returning-final
+ :returning-final :summing* :multiplying*
:read-lines
:read-fasta
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/problems/aspc.lisp Mon Jan 20 13:41:09 2020 -0500
@@ -0,0 +1,13 @@
+(defpackage :rosalind/aspc (:use :cl :rosalind :losh :iterate))
+(in-package :rosalind/aspc)
+
+
+(define-problem aspc (data stream) "6 3" "42"
+ (let ((n (read data))
+ (m (read data)))
+ (iterate
+ (for k :from m :to n)
+ (u:summing* (u:binomial-coefficient n k) :modulo 1000000))))
+
+
+#; Scratch --------------------------------------------------------------------
--- a/src/problems/trie.lisp Sun Jan 19 21:14:53 2020 -0500
+++ b/src/problems/trie.lisp Mon Jan 20 13:41:09 2020 -0500
@@ -67,6 +67,13 @@
;;;; Problem ------------------------------------------------------------------
+(defun sorted-children (node)
+ ;; Need this for deterministic test output.
+ (_ node
+ trie-node-children
+ alexandria:hash-table-alist
+ (sort _ #'string< :key #'car)))
+
(defun trie-adjacency-list (root)
(gathering
(let ((i 0)
@@ -75,7 +82,7 @@
(alexandria:ensure-gethash node numbers (incf i))))
(recursively ((node root))
(iterate
- (for (ch child) :in-hashtable (trie-node-children node))
+ (for (ch . child) :in (sorted-children node))
(gather (list (n node) (n child) ch))
(recur child)))))))
--- a/src/utils.lisp Sun Jan 19 21:14:53 2020 -0500
+++ b/src/utils.lisp Mon Jan 20 13:41:09 2020 -0500
@@ -283,6 +283,28 @@
(finally (return ,result))
(setf ,result ,form))))
+(defmacro-clause (SUMMING* form &optional INTO var MODULO divisor INITIAL-VALUE n)
+ "Like vanilla `summing`, but with more options."
+ (let ((result (or var iterate::*result-var*)))
+ (with-gensyms (mod)
+ `(progn
+ (with ,result = ,(or n 0))
+ ,@(if divisor
+ `((with ,mod = ,divisor)
+ (setf ,result (mod (+ ,result ,form) ,mod)))
+ `((incf ,result ,form)))))))
+
+(defmacro-clause (MULTIPLYING* form &optional INTO var MODULO divisor INITIAL-VALUE n)
+ "Like vanilla `multiplying`, but using `*` and with more options."
+ (let ((result (or var iterate::*result-var*)))
+ (with-gensyms (mod)
+ `(progn
+ (with ,result = ,(or n 1))
+ ,@(if divisor
+ `((with ,mod = ,divisor)
+ (setf ,result (mod (* ,result ,form) ,mod)))
+ `((setf ,result (* ,result ,form))))))))
+
;;;; Readers ------------------------------------------------------------------
(defun read-lines (stream)
@@ -425,37 +447,49 @@
;;;; Output -------------------------------------------------------------------
-(defun float-string (float-or-floats &optional (precision 3))
+(defun float-string (float-or-floats &optional (places 3))
"Return a string of `float-or-floats` in the format Rosalind wants.
`float-or-floats` can be a number, list, vector, or 2D array.
- Each float will be printed with `precision` digits after the decimal point.
+ Each float will be printed with `places` digits after the decimal point.
If a list or vector is given, the floats will be separated by a space.
If a two-dimensional array is given, the rows will be separated by newlines.
"
- (with-output-to-string (s)
- (flet ((p (float &optional space)
- (format s "~,VF~:[~; ~]" precision float space)))
- (etypecase float-or-floats
- ((or number list)
- (loop :for (float . more) :on (alexandria:ensure-list float-or-floats)
- :do (p float more)))
- ((array * (*))
- (loop :with last = (1- (length float-or-floats))
- :for i :from 0
- :for f :across float-or-floats
- :do (p f (< i last))))
- ((array * (* *))
- (destructuring-bind (rows cols) (array-dimensions float-or-floats)
- (dotimes (r rows)
- (dotimes (c cols)
- (p (aref float-or-floats r c) (< c (1- cols))))
- (when (< r (1- rows))
- (terpri s)))))))))
+ (let ((precision (expt 10.0d0 places)))
+ (with-output-to-string (s)
+ ;; Rosalind's examples use half-up style rounding. I think their answer
+ ;; checking will tolerate half-even, but in order to get consistent test
+ ;; output we need consistent rounding. Unfortunately format's ~F allows
+ ;; an implementation-specific rounding strategy, so we have to hack this
+ ;; in ourselves, and we may as well match Rosalind. Sigh.
+ (labels ((round-half-up (float)
+ (_ float
+ (* _ precision)
+ (+ _ 0.5d0)
+ floor
+ (/ _ precision)))
+ (p (float &optional space)
+ (format s "~,VF~:[~; ~]" places (round-half-up float) space)))
+ (etypecase float-or-floats
+ ((or number list)
+ (loop :for (float . more) :on (alexandria:ensure-list float-or-floats)
+ :do (p float more)))
+ ((array * (*))
+ (loop :with last = (1- (length float-or-floats))
+ :for i :from 0
+ :for f :across float-or-floats
+ :do (p f (< i last))))
+ ((array * (* *))
+ (destructuring-bind (rows cols) (array-dimensions float-or-floats)
+ (dotimes (r rows)
+ (dotimes (c cols)
+ (p (aref float-or-floats r c) (< c (1- cols))))
+ (when (< r (1- rows))
+ (terpri s))))))))))
;;;; Testing ------------------------------------------------------------------