stumpwm/bioinf.lisp @ 97e37a4c1138 default tip
More
| author | Steve Losh <steve@stevelosh.com> |
|---|---|
| date | Tue, 13 Oct 2026 10:31:54 -0400 |
| parents | 581345d6b360 |
| children | (none) |
(in-package :stumpwm-user) (defun random-rna-base () (random-elt "GCAU")) (defun random-dna-base () (random-elt "GCAT")) (defun random-phred () (random-elt "?@ABCDEFGHIJKLMNOPQR")) (defun random-phred-string (n) (let ((result (make-string n))) (dotimes (i n) (setf (char result i) (random-phred))) result)) (defun random-rna-string (n) (let ((result (make-string n))) (dotimes (i n) (setf (char result i) (random-rna-base))) result)) (defcommand random-rna (n) ((:integer "Length: ")) (pbcopy (random-rna-string n))) (defun random-dna-string (n) (let ((result (make-string n))) (dotimes (i n) (setf (char result i) (random-dna-base))) result)) (defcommand random-dna (n) ((:integer "Length: ")) (pbcopy (random-dna-string n))) (defun random-fasta-string (entries entry-length) (str:join #\newline (loop :for i :from 0 :below entries :collect (format nil ">seq ~D" i) :collect (random-dna-string entry-length)))) (defcommand random-fasta (entries entry-length) ((:integer "Entries: ") (:integer "Entry Length: ")) (check-type entries (integer 1 *)) (check-type entry-length (integer 1 *)) (pbcopy (random-fasta-string entries entry-length))) (defun random-fastq-string (entries entry-length) (str:join #\newline (loop :for i :from 0 :below entries :collect (format nil "@seq_~D" i) :collect (random-dna-string entry-length) :collect "+" :collect (random-phred-string entry-length)))) (defcommand random-fastq (entries entry-length) ((:integer "Entries: ") (:integer "Entry Length: ")) (check-type entries (integer 1 *)) (check-type entry-length (integer 1 *)) (pbcopy (random-fastq-string entries entry-length))) (defun kmers-of (k seq) (loop :for start :from 0 :for end :from k :to (length seq) :collect (subseq seq start end))) (defun kmerized-string (k seq) (with-output-to-string (s) (loop :for i :from 0 :for kmer :in (kmers-of k seq) :do (format s "~,,V,@A~%" i kmer)))) (defcommand kmerize (k) ((:integer "k: ")) (pbcopy (kmerized-string k (pbpaste)))) (defun dna-complement (seq) (map 'string (lambda (base) (case base (#\A #\T) (#\C #\G) (#\G #\C) (#\T #\A) (#\N #\N) (#\a #\t) (#\c #\g) (#\g #\c) (#\t #\a) (#\n #\n) (t #\?))) seq)) (defun rna-complement (seq) (map 'string (lambda (base) (case base (#\A #\U) (#\C #\G) (#\G #\C) (#\U #\A) (#\N #\N) (#\a #\u) (#\c #\g) (#\g #\c) (#\t #\u) (#\n #\n) (t #\?))) seq)) (defun bio-complement (seq) (if (or (position #\U seq) (position #\u seq)) (rna-complement seq) (dna-complement seq))) (defun reverse-complement (seq) (nreverse (bio-complement seq))) (defcommand revcomp () () (pbcopy (reverse-complement (pbpaste)))) (defcommand comp () () (pbcopy (bio-complement (pbpaste)))) (defcommand rev () () (pbcopy (reverse (pbpaste)))) (defun align/ref% (ref) (alexandria:write-string-into-file (pbpaste) "~/scratch/query.fastx" :if-exists :supersede) (run-shell-command (format nil "st -- sav ~A ~~/scratch/query.fastx" ref))) (defcommand align/l1 () () (align/ref% "~/src/dotfiles/refs/l1-ont.fasta")) (defcommand align/aluya () () (align/ref% "~/src/dotfiles/refs/aluya-ont.fasta")) (defcommand align/aluyb () () (align/ref% "~/src/dotfiles/refs/aluyb-ont.fasta")) (defcommand align/barcodes1 () () (align/ref% "~/src/dotfiles/refs/ont-barcodes-1.fasta")) (defcommand align/barcodes2 () () (align/ref% "~/src/dotfiles/refs/ont-barcodes-2.fasta")) #; Scratch -------------------------------------------------------------------- (random-fasta-string 10 100) (format nil "~,,99,@A" "hello") (kmers-of 3 "ACTTAC")