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")