punnet-squares.lisp 979 B

12345678910111213141516171819202122232425
  1. (ql:quickload :cl-who)
  2. (import 'cl-who:with-html-output-to-string)
  3. (defun punnet (stringa stringb)
  4. (declare (string stringa stringb))
  5. (let* ((a (map 'list #'(lambda (x) (format nil "~c" x)) stringa))
  6. (b (map 'list #'(lambda (x) (format nil "~c" x)) stringb))
  7. (lena (length a))
  8. (lenb (length b)))
  9. (if (not (= lena lenb))
  10. (if (< lena lenb)
  11. (error "a < b, ~a < ~b" lena lenb)
  12. (error "a > b, ~a > ~b" lena lenb))
  13. (loop for index-b from 0 to (1- lena)
  14. collect (loop for index-a from 0 to (1- lena)
  15. collect (if (= index-b index-a)
  16. (nth index-b b)
  17. (nth index-a a)))))))
  18. (defun punnet-html (string-a string-b)
  19. (with-html-output-to-string (out)
  20. (:table
  21. (loop for line in (punnet string-a string-b)
  22. do (htm (:tr (loop for cell in line
  23. do (htm (:td (str cell))))))))))