Punnette.ml

type genotype =
  { dominant   : char
  ; recessive : char
  }

and punnette =
  { lower_left  : char * char
  ; upper_left  : char * char
  ; lower_right : char * char
  ; upper_right : char * char
  }

let new_genotype dom recc = 
  { dominant  = dom
  ; recessive = recc
  }

let new_punnette ll ul lr ur =
  { lower_left  = ll
  ; upper_left  = ul
  ; lower_right = lr
  ; upper_right = ur
  }

let calculate_punnette_ratio pun =
  let { lower_left  = ll
      ; upper_left  = ul
      ; lower_right = lr 
      ; upper_right = ur 
      } = pun 
  in
  let quad1 = (ll, ul) in
  let quad2 = (ll, ur) in
  let quad3 = (ur, ll) in
  let quad4 = (lr, ul) in
  let ratios = [| 0 
                ; 0
                ; 0
                ; 0
               |]
  in
  let rec aux quads =
    if List.length quads = 0
    then ()
    else 
      begin
        match List.hd quads with
        | quad1 -> Array.set ratios 0 (ratios.(0) + 1); aux (List.tl quads)
        | quad2 -> Array.set ratios 1 (ratios.(1) + 1); aux (List.tl quads)
        | quad3 -> Array.set ratios 2 (ratios.(2) + 1); aux (List.tl quads)
        | quad4 -> Array.set ratios 3 (ratios.(3) + 1); aux (List.tl quads)
      end
  in
  aux [ quad1 ; quad2 ; quad3; quad4 ];
  Printf.sprintf "%d:%d:%d:%d" ratios.(0) ratios.(1) ratios.(2) ratios.(3)


let punnette_square genotype1 genotype2 =
  let { dominant = dom1 ; recessive = recc1 } = genotype1 in
  let { dominant = dom2 ; recessive = recc2 } = genotype2 in
  let pun = new_punnette (dom1, recc2) (recc2, dom1) (dom2, recc1) (recc1, dom1) in
  Printf.printf "Ratio: %s" (calculate_punnette_ratio pun)


let () =
  let argv = Sys.argv in
  assert (Array.length argv = 5);
  let dom1 = Array.get argv 1 in
  let recc1 = Array.get argv 2 in
  let dom2 = Array.get argv 3 in
  let recc2 = Array.get argv 4 in
  let genotype1 = { dominant = dom1.[0] ; recessive = recc1.[0] } in
  let genotype2 = { dominant = dom2.[0] ; recessive = recc2.[0] } in
  punnette_square genotype1 genotype2