|
@@ -6,9 +6,9 @@
|
|
|
(keyword type))
|
|
(keyword type))
|
|
|
(case type
|
|
(case type
|
|
|
(:mono
|
|
(:mono
|
|
|
- (let* ((a (map 'list #'(lambda (x) (format nil "~c" x))
|
|
|
|
|
|
|
+ (let* ((a (map 'list #'identity
|
|
|
parent-a))
|
|
parent-a))
|
|
|
- (b (map 'list #'(lambda (x) (format nil "~c" x))
|
|
|
|
|
|
|
+ (b (map 'list #'identity
|
|
|
parent-b))
|
|
parent-b))
|
|
|
(lena (length a))
|
|
(lena (length a))
|
|
|
(lenb (length b)))
|
|
(lenb (length b)))
|
|
@@ -18,7 +18,9 @@
|
|
|
(error "a > b, ~a > ~a" lena lenb))
|
|
(error "a > b, ~a > ~a" lena lenb))
|
|
|
(loop for from-b in b
|
|
(loop for from-b in b
|
|
|
collect (loop for from-a in a
|
|
collect (loop for from-a in a
|
|
|
- collect (concatenate 'string from-a from-b))))))))
|
|
|
|
|
|
|
+ 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))
|
|
(defun punnett-html (string-a string-b &optional (type :mono))
|
|
|
(declare (ignore type))
|
|
(declare (ignore type))
|
