Commit 7f522196 authored by Marie Bourdon's avatar Marie Bourdon
Browse files

mark_prop chisq backcross

parent c5d45686
...@@ -15,9 +15,6 @@ ...@@ -15,9 +15,6 @@
#### mark_prop #### #### mark_prop ####
## excludes markers depending on proportions of homo/hetorozygous ## excludes markers depending on proportions of homo/hetorozygous
mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){ mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
#stock colnames to join
names <- colnames(tab)
#calculate total number of individuals genotyped for each marker #calculate total number of individuals genotyped for each marker
tab <- tab %>% mutate(n_geno = (n_HM1 + n_HM2 + n_HT)) tab <- tab %>% mutate(n_geno = (n_HM1 + n_HM2 + n_HT))
...@@ -42,6 +39,9 @@ mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){ ...@@ -42,6 +39,9 @@ mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
mutate(exclude_prop=case_when(p_NA > na ~ 1, mutate(exclude_prop=case_when(p_NA > na ~ 1,
T ~ 0)) T ~ 0))
#stock colnames to join
names <- colnames(tab)
#exclude with prop of homo/hetero #exclude with prop of homo/hetero
if(is.na(pval)==TRUE){ if(is.na(pval)==TRUE){
#calculate proportion of each genotype #calculate proportion of each genotype
...@@ -56,19 +56,33 @@ mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){ ...@@ -56,19 +56,33 @@ mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1, cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1,
T ~ exclude_prop T ~ exclude_prop
)) ))
}
#exclude with pval chisq.test #exclude with pval chisq.test
## NEED TO ADD THIS FILTER IF CROSS = N2 } else if(is.na(pval)==FALSE){
if(is.na(pval)==FALSE){
#if cross F2
if(cross=="F2"){
tab <- tab %>% filter(p_NA != 1) %>% rowwise() %>%
mutate(.,chi_pval = tibble(n_HM1,n_HM2,n_HT) %>%
chisq.test(p=c(0.25,0.25,0.5)) %>% .$p.value) %>%
full_join(.,tab,by=all_of(names))
tab <- tab %>% mutate(exclude_prop=case_when(chi_pval < pval ~ 1,
T ~ exclude_prop))
#if cross N2
} else if(cross=="N2"){
tab <- tab %>% filter(p_NA != 1) %>% rowwise() %>%
mutate(.,chi_pval = tibble(n_HM1,n_HT) %>%
chisq.test(p=c(0.5,0.5)) %>% .$p.value) %>%
full_join(.,tab,by=all_of(names))
tab <- tab %>% mutate(exclude_prop=case_when(chi_pval < pval ~ 1,
T ~ exclude_prop))
}
tab <- tab %>% filter(p_NA != 1) %>% rowwise() %>%
mutate(.,chi_pval = tibble(n_HM1,n_HM2,n_HT) %>%
chisq.test(p=c(0.25,0.25,0.5)) %>% .$p.value) %>%
full_join(.,tab,by=all_of(names))
tab <- tab %>% mutate(exclude_prop=case_when(chi_pval < pval ~ 1,
T ~ exclude_prop))
} }
tab <- tab %>% select(all_of(names),exclude_prop) tab <- tab %>% select(all_of(names)) %>% select(-c(n_geno,p_NA))
return(tab)
} }
...@@ -15,6 +15,8 @@ knitr::opts_chunk$set( ...@@ -15,6 +15,8 @@ knitr::opts_chunk$set(
) )
``` ```
# stuart
Marie Bourdon Marie Bourdon
June 2021 June 2021
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment