Просмотр исходного кода

wrote punnet square calculator

Samuel W. Flint 10 лет назад
Родитель
Сommit
0467c6c801
1 измененных файлов с 25 добавлено и 0 удалено
  1. 25 0
      punnet-squares.lisp

+ 25 - 0
punnet-squares.lisp

@@ -0,0 +1,25 @@
+(ql:quickload :cl-who)
+(import 'cl-who:with-html-output-to-string)
+
+(defun punnet (stringa stringb)
+  (declare (string stringa stringb))
+  (let* ((a (map 'list #'(lambda (x) (format nil "~c" x)) stringa))
+         (b (map 'list #'(lambda (x) (format nil "~c" x)) stringb))
+         (lena (length a))
+         (lenb (length b)))
+    (if (not (= lena lenb))
+        (if (< lena lenb)
+            (error "a < b, ~a < ~b" lena lenb)
+            (error "a > b, ~a > ~b" lena lenb))
+        (loop for index-b from 0 to (1- lena)
+           collect (loop for index-a from 0 to (1- lena)
+                      collect (if (= index-b index-a)
+                                 (nth index-b b)
+                                 (nth index-a a)))))))
+
+(defun punnet-html (string-a string-b)
+  (with-html-output-to-string (out)
+    (:table
+     (loop for line in (punnet string-a string-b)
+        do (htm (:tr (loop for cell in line
+                          do (htm (:td (str cell))))))))))