| 1234567891011121314151617181920212223242526272829303132 |
- (ql:quickload :cl-who)
- (use-package 'cl-who)
- (defun punnett (parent-a parent-b &optional (type :mono))
- (declare (string parent-a parent-b)
- (keyword type))
- (case type
- (:mono
- (let* ((a (map 'list #'identity
- parent-a))
- (b (map 'list #'identity
- parent-b))
- (lena (length a))
- (lenb (length b)))
- (if (not (= lena lenb))
- (if (< lena lenb)
- (error "a < b, ~a < ~a" lena lenb)
- (error "a > b, ~a > ~a" lena lenb))
- (loop for from-b in b
- collect (loop for from-a in a
- collect (if (upper-case-p from-b)
- (format nil "~c~c" from-b from-a)
- (format nil "~c~c" from-a from-b)))))))))
- (defun punnett-html (string-a string-b &optional (type :mono))
- (declare (ignore type))
- (with-html-output-to-string (out)
- (:table
- (loop for line in (punnett string-a string-b)
- do (htm (:tr (loop for cell in line
- do (htm (:td (str cell))))))))))
|
