Permalink
Browse files

cl-bio 0.0.2

 * added flexchain-sequences and various functions to operate on them (insert/append/delete)
  • Loading branch information...
1 parent 98faee0 commit 2ff20a014fdde7385850edf32afd68e85265414c sly committed Oct 26, 2006
Showing with 134 additions and 85 deletions.
  1. +120 −74 src/bio-sequence.lisp
  2. +7 −4 src/encoding.lisp
  3. +6 −6 src/utilities.lisp
  4. +1 −1 version.lisp-expr
View
@@ -7,6 +7,9 @@
(defgeneric seq-length (seq))
(defgeneric residues-string (seq))
+(defgeneric (setf residues-string) (val seq))
+(defgeneric residue (seq i))
+(defgeneric (setf residue) (val seq i))
(defclass sequence-with-residues ()
((residues :accessor residues)))
@@ -26,12 +29,6 @@
do (setf (residue seq i) (elt residues i)))
residues)
-;;; TODO: add (setf residues-string) and use that down in the make-foo-seqeuence-from-string methods
-
-;;; TODO: rework make-random-foo-sequence methods to use (setf residue)
-
-(defgeneric residue (seq i))
-(defgeneric (setf residue) (val seq i))
(defgeneric residue-code (seq i))
(defgeneric (setf residue-code) (val seq i))
@@ -44,6 +41,9 @@
(length (or (and initial-contents
(length initial-contents))
length)))
+ (when element-type
+ (setf (slot-value seq 'element-type)
+ (upgraded-array-element-type element-type)))
(setf (residues seq)
(apply #'make-array length
(when element-type `(:element-type ,element-type)))))
@@ -63,25 +63,113 @@
(defmethod (setf residue-code) (val (seq simple-sequence) i)
(setf (aref (residues seq) i) val))
-(defclass na-sequence (bio-sequence) ())
-(defclass dna-sequence (na-sequence) ())
+(defgeneric insert-residue (seq pos res))
+(defgeneric insert-residues (seq pos str))
+(defgeneric insert-residue-codes (seq pos vec))
+(defgeneric append-residues (seq res))
+(defgeneric append-residues (seq str))
+(defgeneric append-residue-codes (seq vec))
+(defgeneric delete-residue (seq pos))
+
+(defclass flexichain-sequence (sequence-with-residues) ())
+
+(defmethod initialize-instance :after ((seq flexichain-sequence) &rest initargs
+ &key length initial-contents)
+ (declare (ignore initargs))
+ (let ((element-type (slot-value seq 'element-type))
+ (length (or (and initial-contents
+ (length initial-contents))
+ length)))
+ (setf (residues seq)
+ (apply #'make-instance 'flexichain:standard-flexichain
+ (append (when length `(:min-size ,length))
+ (when element-type `(:element-type ,element-type))))))
+ (when initial-contents
+ (let ((chain (residues seq)))
+ (loop for res across initial-contents
+ do (flexichain:push-end chain (char-to-seq-code seq res))))))
+
+(defmethod seq-length ((seq flexichain-sequence))
+ (flexichain:nb-elements (residues seq)))
+
+(defmethod residue ((seq flexichain-sequence) i)
+ (seq-code-to-char seq (flexichain:element* (residues seq) i)))
+
+(defmethod (setf residue) (val (seq flexichain-sequence) i)
+ (setf (flexichain:element* (residues seq) i)
+ (char-to-seq-code seq val)))
+
+(defmethod residue-code ((seq flexichain-sequence) i)
+ (flexichain:element* (residues seq) i))
+
+(defmethod (setf residue-code) (val (seq flexichain-sequence) i)
+ (setf (flexichain:element* (residues seq) i) val))
+
+(defmethod insert-residue ((seq flexichain-sequence) pos res)
+ (flexichain:insert* (residues seq)
+ pos
+ (char-to-seq-code seq res)))
+
+(defmethod insert-residues ((seq flexichain-sequence) pos str)
+ (flexichain:insert-vector* (residues seq)
+ pos
+ (map (if (slot-value seq 'element-type)
+ `(vector ,(slot-value seq 'element-type))
+ 'vector)
+ #'(lambda (x)
+ (char-to-seq-code seq x))
+ str)))
+
+(defmethod insert-residue-codes ((seq flexichain-sequence) pos vec)
+ (flexichain:insert-vector* (residues seq) pos vec))
+
+
+(defmethod append-residue ((seq flexichain-sequence) res)
+ (flexichain:push-end (residues seq)
+ (char-to-seq-code seq res)))
+
+(defmethod append-residues ((seq flexichain-sequence) str)
+ (flexichain:insert-vector* (residues seq)
+ (seq-length seq)
+ (map (if (slot-value seq 'element-type)
+ `(vector ,(slot-value seq 'element-type))
+ 'vector)
+ #'(lambda (x)
+ (char-to-seq-code seq x))
+ str)))
+
+(defmethod append-residue-codes ((seq flexichain-sequence) vec)
+ (flexichain:insert-vector* (residues seq) (seq-length seq) vec))
+
+(defmethod delete-residue ((seq flexichain-sequence) pos)
+ (flexichain:delete* (residues seq) pos))
+
+(defmethod delete-residues ((seq flexichain-sequence) pos count)
+ (loop for i below count
+ do (flexichain:delete* (residues seq) pos)))
+
(defclass 2-bit-sequence (bio-sequence)
((element-type :initform '(unsigned-byte 2) :allocation :class)))
-(defclass rna-sequence (na-sequence) ())
+(defclass 5-bit-sequence (bio-sequence)
+ ((element-type :initform '(unsigned-byte 5) :allocation :class)))
+
+;;; nucleic acid sequences
+(defclass na-sequence (bio-sequence) ())
-(defclass simple-dna-sequence (dna-sequence simple-sequence 2-bit-sequence 2-bit-dna-sequence-encoding) ())
+;;; DNA sequences
+(defclass dna-sequence (na-sequence) ())
+(defclass 2-bit-dna-sequence (dna-sequence 2-bit-sequence 2-bit-dna-sequence-encoding) ())
+(defclass simple-dna-sequence (2-bit-dna-sequence simple-sequence) ())
+(defclass flexichain-dna-sequence (2-bit-dna-sequence flexichain-sequence) ())
(defun make-simple-dna-sequence (length)
- (make-instance 'simple-dna-sequence
- :length length))
+ (make-instance 'simple-dna-sequence :length length))
(defun make-dna-sequence-from-string (residues)
- (let* ((seq (make-simple-dna-sequence (length residues))))
- (setf (residues-string seq) residues)
- seq))
+ (make-instance 'simple-dna-sequence :initial-contents residues))
(defun make-random-dna-sequence (length)
(let* ((dna (make-simple-dna-sequence length)))
@@ -90,83 +178,41 @@
do (setf (residue-code dna i) (random k))))
dna))
-(defclass simple-rna-sequence (rna-sequence simple-sequence 2-bit-rna-sequence-encoding) ())
+;;; RNA sequences
+(defclass rna-sequence (na-sequence) ())
+(defclass 2-bit-rna-sequence (rna-sequence 2-bit-sequence 2-bit-rna-sequence-encoding) ())
+(defclass simple-rna-sequence (2-bit-rna-sequence simple-sequence) ())
+(defclass flexichain-rna-sequence (2-bit-rna-sequence flexichain-sequence) ())
(defun make-simple-rna-sequence (length)
- (let* ((storage (make-array length :element-type '(unsigned-byte 2)))
- (rna (make-instance 'simple-rna-sequence)))
- (declare (type (simple-array (unsigned-byte 2))
- storage))
- (setf (residues rna) storage)
- rna))
+ (make-instance 'simple-rna-sequence :length length))
(defun make-rna-sequence-from-string (residues)
- (let* ((seq (make-simple-rna-sequence (length residues))))
- (setf (residues-string seq) residues)
- seq))
+ (make-instance 'simple-rna-sequence :initial-contents residues))
(defun make-random-rna-sequence (length)
- (let* ((rna (make-simple-rna-sequence length))
- (storage (residues rna)))
- (declare (type (simple-array (unsigned-byte 2))
- storage))
- (setf (residues rna) storage)
+ (let* ((rna (make-simple-rna-sequence length)))
(let ((k (length *simple-rna-sequence-char-map*)))
(loop for i below length
- do (setf (aref storage i)
- (random k))))
+ do (setf (residue-code rna i) (random k))))
rna))
+;;; amino acid sequences
(defclass aa-sequence (bio-sequence) ())
-
-(defclass simple-aa-sequence (aa-sequence simple-sequence aa-sequence-encoding) ())
+(defclass 5-bit-aa-sequence (aa-sequence 5-bit-sequence aa-sequence-encoding) ())
+(defclass simple-aa-sequence (5-bit-aa-sequence simple-sequence) ())
+(defclass flexichain-aa-sequence (5-bit-aa-sequence flexichain-sequence) ())
(defun make-simple-aa-sequence (length)
- (let* ((storage (make-array length :element-type '(unsigned-byte 5)))
- (aa (make-instance 'simple-aa-sequence)))
- (declare (type (simple-array (unsigned-byte 5))
- storage))
- (setf (residues aa) storage)
- aa))
+ (make-instance 'simple-aa-sequence :length length))
(defun make-aa-sequence-from-string (residues)
- (let* ((aa (make-simple-aa-sequence (length residues))))
- (loop for res across residues
- for i from 0
- do (setf (residue aa i) (elt residues i)))
- aa))
+ (make-instance 'simple-aa-sequence :initial-contents residues))
(defun make-random-aa-sequence (length)
- (let* ((aa (make-simple-aa-sequence length))
- (storage (residues aa)))
- (declare (type (simple-array (unsigned-byte 5))
- storage))
+ (let* ((aa (make-simple-aa-sequence length)))
(let ((k (length *simple-aa-sequence-char-map*)))
(loop for i below length
- do (setf (aref storage i) (random k))))
+ do (setf (residue-code aa i) (random k))))
aa))
-
-
-
-;;;; OPTIMIZATION HACKS
-
-;;;
-;;; if we ever need a faster version of the make-random-foo-sequence functions,
-;;; we can use the following template:
-;;;
-
-#+bio-sequence-optimization-hacks
-(defun %fast-make-random-dna-sequence (length)
- (let* ((dna (make-simple-dna-sequence length))
- (storage (residues dna)))
- (declare (type (simple-array (unsigned-byte 2))
- storage))
- (setf (residues dna) storage)
- (let ((k (length *simple-dna-sequence-char-map*)))
- (loop for i below length
- do (setf (aref storage i)
- (random k))))
- dna))
-
-
View
@@ -15,14 +15,15 @@
(let ((char-list (coerce *simple-dna-sequence-char-map* 'list)))
(let ((simple-dna-sequence-int-array
- (make-array (char-lookup-array-length char-list))))
+ (make-array (char-lookup-array-length char-list)
+ :initial-element nil)))
(loop for c in char-list
for i from 0
do
(setf (aref simple-dna-sequence-int-array (char-code (char-upcase c))) i)
(setf (aref simple-dna-sequence-int-array (char-code (char-downcase c))) i))
- (defmethod char-to-seq-code ((seq simple-dna-sequence) char)
+ (defmethod char-to-seq-code ((seq 2-bit-dna-sequence-encoding) char)
(aref simple-dna-sequence-int-array (char-code char)))))
(defclass 2-bit-rna-sequence-encoding (sequence-encoding) ())
@@ -34,7 +35,8 @@
(let ((char-list (coerce *simple-rna-sequence-char-map* 'list)))
(let ((simple-rna-sequence-int-array
- (make-array (char-lookup-array-length char-list))))
+ (make-array (char-lookup-array-length char-list)
+ :initial-element nil)))
(loop for c in char-list
for i from 0
do
@@ -57,7 +59,8 @@
(let ((char-list (coerce *simple-aa-sequence-char-map* 'list)))
(let ((simple-aa-sequence-int-array
- (make-array (char-lookup-array-length char-list))))
+ (make-array (char-lookup-array-length char-list)
+ :initial-element nil)))
(loop for c in char-list
for i from 0
do
View
@@ -12,19 +12,19 @@
char-list)))))
(defun flexichain-to-list (fc)
- (loop for i below (nb-elements fc)
- collect (element* fc i)))
+ (loop for i below (flexichain:nb-elements fc)
+ collect (flexichain:element* fc i)))
(defun general-flexichain-to-string (fc)
- (coerce (loop for i below (nb-elements fc)
- append (let ((el (element* fc i)))
+ (coerce (loop for i below (flexichain:nb-elements fc)
+ append (let ((el (flexichain:element* fc i)))
(cond ((characterp el)
(list el))
((stringp el)
(coerce el 'list)))))
'string))
(defun vector-flexichain-to-string (fc)
- (coerce (loop for i below (nb-elements fc)
- collect (element* fc i))
+ (coerce (loop for i below (flexichain:nb-elements fc)
+ collect (flexichain:element* fc i))
'string))
View
@@ -1 +1 @@
-"0.0.1"
+"0.0.2"

0 comments on commit 2ff20a0

Please sign in to comment.