diff --git a/R/mark_prop.R b/R/mark_prop.R index 3b0ff5d96bf7ef30104d589b40786ff2825f24ab..a7b25081702197260eae3f8d3716411e42721528 100755 --- a/R/mark_prop.R +++ b/R/mark_prop.R @@ -15,9 +15,6 @@ #### mark_prop #### ## excludes markers depending on proportions of homo/hetorozygous 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 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){ mutate(exclude_prop=case_when(p_NA > na ~ 1, T ~ 0)) + #stock colnames to join + names <- colnames(tab) + #exclude with prop of homo/hetero if(is.na(pval)==TRUE){ #calculate proportion of each genotype @@ -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, T ~ exclude_prop )) - } #exclude with pval chisq.test - ## NEED TO ADD THIS FILTER IF CROSS = N2 - if(is.na(pval)==FALSE){ + } else 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) } diff --git a/vignettes/stuaRt.Rmd b/vignettes/stuaRt.Rmd index 48568f25bde86d655292635f2cf02bd343f03ae5..d156d334e5501588af609ec2dd196c00d77d8743 100755 --- a/vignettes/stuaRt.Rmd +++ b/vignettes/stuaRt.Rmd @@ -15,6 +15,8 @@ knitr::opts_chunk$set( ) ``` +# stuart + Marie Bourdon June 2021