Browse Source

even better punnett squares

Samuel W. Flint 9 years ago
parent
commit
9162abf973
1 changed files with 5 additions and 3 deletions
  1. 5 3
      punnet-squares.lisp

+ 5 - 3
punnet-squares.lisp

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