--- a/rosalind.asd Thu Nov 01 21:10:34 2018 -0400
+++ b/rosalind.asd Thu Nov 01 21:54:39 2018 -0400
@@ -13,6 +13,7 @@
:1am
:iterate
:losh
+ :alexandria
)
@@ -27,5 +28,6 @@
:components ((:file "dna")
(:file "rna")
(:file "revc")
- (:file "gc")))))))
+ (:file "gc")
+ (:file "hamm")))))))
--- a/src/problems/dna.lisp Thu Nov 01 21:10:34 2018 -0400
+++ b/src/problems/dna.lisp Thu Nov 01 21:54:39 2018 -0400
@@ -11,13 +11,14 @@
;; (separated by spaces) counting the respective number of times that the
;; symbols 'A', 'C', 'G', and 'T' occur in s.
-(define-problem dna (data)
+(define-problem dna (data string)
"AGCTTTTCATTCTGACTGCAACGGGCAATATGTCTCTGTGTGGATTAAAAAAAGAGTGTCTGATAGCAGC"
"20 12 17 21"
(let ((results (frequencies data)))
(format nil "~D ~D ~D ~D"
- (gethash #\A results)
- (gethash #\C results)
- (gethash #\G results)
- (gethash #\T results))))
+ (gethash #\A results 0)
+ (gethash #\C results 0)
+ (gethash #\G results 0)
+ (gethash #\T results 0))))
+(problem-dna "AT")
--- a/src/problems/gc.lisp Thu Nov 01 21:10:34 2018 -0400
+++ b/src/problems/gc.lisp Thu Nov 01 21:54:39 2018 -0400
@@ -35,7 +35,7 @@
60.919540")
-(define-problem gc (data)
+(define-problem gc (data stream)
*input-gc*
*output-gc*
(labels ((gcp (base)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/problems/hamm.lisp Thu Nov 01 21:54:39 2018 -0400
@@ -0,0 +1,20 @@
+(in-package :rosalind)
+
+;; Given two strings s and t of equal length, the Hamming distance between s and
+;; t, denoted dH(s,t), is the number of corresponding symbols that differ in
+;; s and t.
+;;
+;; Given: Two DNA strings s and t of equal length (not exceeding 1 kbp).
+;;
+;; Return: The Hamming distance dH(s,t)
+
+(defparameter *input-hamm* "GAGCCTACTAACGGGAT
+CATCGTAATGACGGCCT")
+
+(define-problem hamm (data stream)
+ *input-hamm*
+ "7"
+ (hamming (read-line data) (read-line data) :test #'char=))
+
+;; (problem-hamm *input-hamm*)
+;; (solve problem-hamm)
--- a/src/problems/revc.lisp Thu Nov 01 21:10:34 2018 -0400
+++ b/src/problems/revc.lisp Thu Nov 01 21:54:39 2018 -0400
@@ -11,10 +11,9 @@
;;
;; Return: The reverse complement sc of s.
-(define-problem revc (data)
+(define-problem revc (data string)
"AAAACCCGGT"
"ACCGGGTTTT"
- (copyf data)
(flet ((dna-complement (base)
(case base
(#\A #\T)
--- a/src/problems/rna.lisp Thu Nov 01 21:10:34 2018 -0400
+++ b/src/problems/rna.lisp Thu Nov 01 21:54:39 2018 -0400
@@ -10,7 +10,7 @@
;;
;; Return: The transcribed RNA string of t.
-(define-problem rna (data)
+(define-problem rna (data string)
"GATGGAACTTGACTACGTAAATT"
"GAUGGAACUUGACUACGUAAAUU"
(substitute #\U #\T data))
--- a/src/utils.lisp Thu Nov 01 21:10:34 2018 -0400
+++ b/src/utils.lisp Thu Nov 01 21:54:39 2018 -0400
@@ -1,6 +1,5 @@
(in-package :rosalind)
-
;;;; Misc ---------------------------------------------------------------------
(defun sh (command input)
(declare (ignorable command input))
@@ -24,14 +23,16 @@
(defun pbcopy (string)
(values string (sh '("pbcopy") string)))
-(defmacro copyf (sequence)
- `(setf ,sequence (copy-seq ,sequence)))
-
(defun ensure-stream (input)
(ctypecase input
(stream input)
(string (make-string-input-stream input))))
+(defun ensure-string (input)
+ (ctypecase input
+ (stream (alexandria:read-stream-content-into-string input))
+ (string (copy-seq input))))
+
(defun nconcatenate (v1 v2)
(let* ((l1 (length v1))
(l2 (length v2))
@@ -58,18 +59,17 @@
"
(* precision (round number precision)))
-
-;;;; Testing ------------------------------------------------------------------
-(defmacro define-test (problem input output &optional (test 'string=))
- `(test ,(symb 'test- problem)
- (is (,test ,output (,problem ,input)))))
-
-(defun run-tests ()
- (1am:run))
+(defun hamming (sequence1 sequence2 &key (test #'eql))
+ (let ((result 0))
+ (map nil (lambda (x y)
+ (unless (funcall test x y)
+ (incf result)))
+ sequence1
+ sequence2)
+ result))
;;;; File Formats -------------------------------------------------------------
-
(defmacro-driver (FOR vars IN-FASTA source)
(nest
(destructuring-bind (label line) vars)
@@ -95,23 +95,34 @@
(parse-next))))))
+;;;; Testing ------------------------------------------------------------------
+(defmacro define-test (problem input output &optional (test 'string=))
+ `(test ,(symb 'test- problem)
+ (is (,test ,output (,problem ,input)))))
+
+(defun run-tests ()
+ (1am:run))
+
;;;; Problems -----------------------------------------------------------------
-(defmacro define-problem (name args sample-input sample-output &body body)
+(defmacro define-problem (name (arg type) sample-input sample-output &body body)
(let ((symbol (symb 'problem- name)))
`(progn
- (defun ,symbol ,args ,@body)
+ (defun ,symbol (,arg)
+ (setf ,arg ,(ecase type
+ (string `(ensure-string ,arg))
+ (stream `(ensure-stream ,arg))))
+ (aesthetic-string (progn ,@body)))
(setf (get ',symbol 'rosalind-name) ,(string-downcase name))
(define-test ,symbol ,sample-input ,sample-output)
',symbol)))
-(defun read-problem-data (problem)
- (-<> (get problem 'rosalind-name)
- (format nil "~~/Downloads/rosalind_~A.txt" <>)
- read-file-into-string))
+(defun problem-data-path (problem)
+ (format nil "~~/Downloads/rosalind_~A.txt" (get problem 'rosalind-name)))
(defun solve% (problem)
- (pbcopy (funcall problem (read-problem-data problem))))
+ (with-open-file (input (problem-data-path problem))
+ (pbcopy (funcall problem input))))
(defmacro solve (problem)
`(solve% ',problem))
--- a/vendor/make-quickutils.lisp Thu Nov 01 21:10:34 2018 -0400
+++ b/vendor/make-quickutils.lisp Thu Nov 01 21:54:39 2018 -0400
@@ -8,7 +8,6 @@
:curry
:rcurry
:with-gensyms
- :read-file-into-string
:symb
)
--- a/vendor/quickutils.lisp Thu Nov 01 21:10:34 2018 -0400
+++ b/vendor/quickutils.lisp Thu Nov 01 21:54:39 2018 -0400
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :RCURRY :WITH-GENSYMS :READ-FILE-INTO-STRING :SYMB) :ensure-package T :package "ROSALIND.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :RCURRY :WITH-GENSYMS :SYMB) :ensure-package T :package "ROSALIND.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "ROSALIND.QUICKUTILS")
@@ -16,9 +16,7 @@
(setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
:COMPOSE :CURRY :RCURRY
:STRING-DESIGNATOR :WITH-GENSYMS
- :ONCE-ONLY :WITH-OPEN-FILE*
- :WITH-INPUT-FROM-FILE
- :READ-FILE-INTO-STRING :MKSTR :SYMB))))
+ :MKSTR :SYMB))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun make-gensym-list (length &optional (x "G"))
"Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
@@ -146,97 +144,6 @@
`(with-gensyms ,names ,@forms))
- (defmacro once-only (specs &body forms)
- "Evaluates `forms` with symbols specified in `specs` rebound to temporary
-variables, ensuring that each initform is evaluated only once.
-
-Each of `specs` must either be a symbol naming the variable to be rebound, or of
-the form:
-
- (symbol initform)
-
-Bare symbols in `specs` are equivalent to
-
- (symbol symbol)
-
-Example:
-
- (defmacro cons1 (x) (once-only (x) `(cons ,x ,x)))
- (let ((y 0)) (cons1 (incf y))) => (1 . 1)"
- (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY"))
- (names-and-forms (mapcar (lambda (spec)
- (etypecase spec
- (list
- (destructuring-bind (name form) spec
- (cons name form)))
- (symbol
- (cons spec spec))))
- specs)))
- ;; bind in user-macro
- `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string (car n)))))
- gensyms names-and-forms)
- ;; bind in final expansion
- `(let (,,@(mapcar (lambda (g n)
- ``(,,g ,,(cdr n)))
- gensyms names-and-forms))
- ;; bind in user-macro
- ,(let ,(mapcar (lambda (n g) (list (car n) g))
- names-and-forms gensyms)
- ,@forms)))))
-
-
- (defmacro with-open-file* ((stream filespec &key direction element-type
- if-exists if-does-not-exist external-format)
- &body body)
- "Just like `with-open-file`, but `nil` values in the keyword arguments mean to use
-the default value specified for `open`."
- (once-only (direction element-type if-exists if-does-not-exist external-format)
- `(with-open-stream
- (,stream (apply #'open ,filespec
- (append
- (when ,direction
- (list :direction ,direction))
- (when ,element-type
- (list :element-type ,element-type))
- (when ,if-exists
- (list :if-exists ,if-exists))
- (when ,if-does-not-exist
- (list :if-does-not-exist ,if-does-not-exist))
- (when ,external-format
- (list :external-format ,external-format)))))
- ,@body)))
-
-
- (defmacro with-input-from-file ((stream-name file-name &rest args
- &key (direction nil direction-p)
- &allow-other-keys)
- &body body)
- "Evaluate `body` with `stream-name` to an input stream on the file
-`file-name`. `args` is sent as is to the call to `open` except `external-format`,
-which is only sent to `with-open-file` when it's not `nil`."
- (declare (ignore direction))
- (when direction-p
- (error "Can't specifiy :DIRECTION for WITH-INPUT-FROM-FILE."))
- `(with-open-file* (,stream-name ,file-name :direction :input ,@args)
- ,@body))
-
-
- (defun read-file-into-string (pathname &key (buffer-size 4096) external-format)
- "Return the contents of the file denoted by `pathname` as a fresh string.
-
-The `external-format` parameter will be passed directly to `with-open-file`
-unless it's `nil`, which means the system default."
- (with-input-from-file
- (file-stream pathname :external-format external-format)
- (let ((*print-pretty* nil))
- (with-output-to-string (datum)
- (let ((buffer (make-array buffer-size :element-type 'character)))
- (loop
- :for bytes-read = (read-sequence buffer file-stream)
- :do (write-sequence buffer datum :start 0 :end bytes-read)
- :while (= bytes-read buffer-size)))))))
-
-
(defun mkstr (&rest args)
"Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
@@ -254,7 +161,6 @@
(values (intern (apply #'mkstr args))))
(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(compose curry rcurry with-gensyms with-unique-names
- read-file-into-string symb)))
+ (export '(compose curry rcurry with-gensyms with-unique-names symb)))
;;;; END OF quickutils.lisp ;;;;