# HG changeset patch # User Steve Losh # Date 1541123679 14400 # Node ID 6088027147e180bb918eb01549d2dda372a584de # Parent 4cad0eb1a700fceaab679ad17b35761921f2dfc6 Do HAMM, add fancy stream/string management diff -r 4cad0eb1a700 -r 6088027147e1 rosalind.asd --- 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"))))))) diff -r 4cad0eb1a700 -r 6088027147e1 src/problems/dna.lisp --- 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") diff -r 4cad0eb1a700 -r 6088027147e1 src/problems/gc.lisp --- 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) diff -r 4cad0eb1a700 -r 6088027147e1 src/problems/hamm.lisp --- /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) diff -r 4cad0eb1a700 -r 6088027147e1 src/problems/revc.lisp --- 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) diff -r 4cad0eb1a700 -r 6088027147e1 src/problems/rna.lisp --- 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)) diff -r 4cad0eb1a700 -r 6088027147e1 src/utils.lisp --- 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)) diff -r 4cad0eb1a700 -r 6088027147e1 vendor/make-quickutils.lisp --- 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 ) diff -r 4cad0eb1a700 -r 6088027147e1 vendor/quickutils.lisp --- 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 ;;;;