Last active
November 28, 2017 22:14
-
-
Save sromano/795fcfcece8f96116647c4b1c9ddf119 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; Alleles | |
| (define greenColor (list "green" "R" true)) | |
| (define yellowColor (list "yellow" "r" false)) | |
| (define wrinkledShape (list "wrinkled" "Y" true)) | |
| (define inflatedShape (list "inflated" "y" false)) | |
| (define alleles (list greenColor yellowColor wrinkledShape inflatedShape)) | |
| ;;Accessors | |
| (define (alleleTrait a) (first a)) | |
| (define (alleleEncoding a) (second a)) | |
| (define (isDominant? a) (third a)) | |
| (define (isAllele? c) (lambda (a) (eq? (alleleEncoding a) c))) | |
| (define (charToAllele x) (first (filter (isAllele? x) alleles))) | |
| ;; Genotypes | |
| (define (genotype al1 al2) (list al1 al2)) | |
| (define (genotypeFromStr str) (genotype (charToAllele (string-slice str 0 1)) (charToAllele (string-slice str 1 2)))) | |
| (define genotypeA (list (genotypeFromStr "RR") (genotypeFromStr "Rr") (genotypeFromStr "rR") (genotypeFromStr "rr"))) | |
| (define genotypeB (list (genotypeFromStr "YY") (genotypeFromStr "Yy") (genotypeFromStr "yY") (genotypeFromStr "yy"))) | |
| ;;Note: trait works only on diploid species | |
| (define (trait gen) (if (isDominant? (first gen)) (alleleTrait (first gen)) (alleleTrait (second gen)))) | |
| ;;Display traits for both features A and B | |
| (define (bothTraits plant) (list (trait (first plant)) (trait (second plant)))) | |
| ;;Pea Plant | |
| (define (firstGeneration) (list (uniform-draw genotypeA) (uniform-draw genotypeB))) | |
| ;;Might need names to get insight | |
| ;;(define firstGeneration (mem (lambda (person) (list (uniform-draw genotypeA) (uniform-draw genotypeB))))) | |
| (define (cross parent1 parent2) (list | |
| (genotype (uniform-draw (first parent1)) | |
| (uniform-draw (first parent2))) | |
| (genotype (uniform-draw (second parent1)) | |
| (uniform-draw (second parent2))))) | |
| ;;Might need names to get insight | |
| ;;Note: Should use a unique name for each offspring so that it will remember it | |
| ;;(define offspring (lambda (name mother father) (cross father mother))) | |
| (define (crossMany n generation) (if (eq? n 0) | |
| generation | |
| (crossMany (- n 1) | |
| (append generation (list (cross | |
| (uniform-draw generation) | |
| (uniform-draw generation))))))) | |
| ;;Example | |
| (define generation1 (list (firstGeneration) (firstGeneration))) | |
| ;;Only traits are visible | |
| (display "Generation 1") | |
| (display (map bothTraits generation1)) | |
| (define generation2 (crossMany 1 generation1)) | |
| (display "Generation 2") | |
| (display (map bothTraits generation2)) | |
| (display "Generation 5") | |
| (define generation5 (crossMany 3 generation2)) | |
| (display (map bothTraits generation5)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment