Commit f6809a82 authored by mariefbourdon's avatar mariefbourdon
Browse files

change version

parent 2054450f
tab <- tab %>% mutate(n_geno = tab %>% select(n_HM1,n_HM2,n_HT) %>% rowSums(na.rm=TRUE))
#calculate proportion of each genotype
tab <- tab %>% mutate(p_HM1 = n_HM1/n_geno)
tab <- tab %>% mutate(p_HM2 = n_HM2/n_geno)
tab <- tab %>% mutate(p_HT = n_HT/n_geno)
tab <- tab %>% mutate(p_NA = n_NA/(n_geno+n_NA))
#stop if cross != "F2" or "N2"
if(!cross %in% c("F2","N2")){
stop("Cross must be F2 or N2")
}
#stop of homo&hetero or pval not specified
if((is.na(homo)==TRUE & is.na(hetero)==TRUE) | is.na(pval)==TRUE){
stop("Arguments homo and hetero or argument pval must be specified")
}
# #stop if no value for "homo" for F2 cross
# if(cross=="F2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for F2 crosses")
# }
#
# #stop if no value for "homo" and "hetero" for N2 cross
# if(cross=="N2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for N2 crosses")
# }
#exclude markers according to proportion of na
tab <- tab %>% mutate(exclude_prop=case_when(p_NA > na ~ 1, #exclude markers according to proportion of na
cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous individuals for F2 cross
cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous and heterozygous individuals for N2 cross
T ~ 0))
tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
return(tab)
}
tab2 <- mark_prop(tab2,cross="F2",homo=0.1,hetero=0.1)
mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
#calculate total number of individuals genotyped for each marker
tab <- tab %>% mutate(n_geno = tab %>% select(n_HM1,n_HM2,n_HT) %>% rowSums(na.rm=TRUE))
#calculate proportion of each genotype
tab <- tab %>% mutate(p_HM1 = n_HM1/n_geno)
tab <- tab %>% mutate(p_HM2 = n_HM2/n_geno)
tab <- tab %>% mutate(p_HT = n_HT/n_geno)
tab <- tab %>% mutate(p_NA = n_NA/(n_geno+n_NA))
#stop if cross != "F2" or "N2"
if(!cross %in% c("F2","N2")){
stop("Cross must be F2 or N2")
}
#stop of homo&hetero or pval not specified
if((is.na(homo)==TRUE | is.na(hetero)==TRUE) & is.na(pval)==TRUE){
stop("Arguments homo and hetero or argument pval must be specified")
}
# #stop if no value for "homo" for F2 cross
# if(cross=="F2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for F2 crosses")
......@@ -55,23 +7,19 @@ stop("Arguments homo and hetero or argument pval must be specified")
# if(cross=="N2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for N2 crosses")
# }
#exclude markers according to proportion of na
tab <- tab %>% mutate(exclude_prop=case_when(p_NA > na ~ 1, #exclude markers according to proportion of na
cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous individuals for F2 cross
cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous and heterozygous individuals for N2 cross
T ~ 0))
tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
return(tab)
# #exclude markers according to proportion of na
# tab <- tab %>% mutate(exclude_prop=case_when(p_NA > na ~ 1, #exclude markers according to proportion of na
# cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous individuals for F2 cross
# cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous and heterozygous individuals for N2 cross
# T ~ 0))
# tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
# return(tab)
}
tab2 <- mark_prop(tab2,cross="F2",homo=0.1,hetero=0.1)
tab2 <- mark_prop(tab2,cross="F2",na=0.05)
tab2 <- mark_prop(tab2,cross="F2",pval=0.05)
tab2 <- mark_prop(tab2,cross="F2",homo=0.05)
tab2 <- mark_prop(tab2,cross="F2",hetero=0.05)
tab2 <- mark_prop(tab2,cross="F2",pval=0.05)
test_tab <- tab2[1:20,]
tab3 <- mark_prop(test_tab,cross="F2",pval=0.05)
mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
#calculate total number of individuals genotyped for each marker
tab <- tab %>% mutate(n_geno = tab %>% select(n_HM1,n_HM2,n_HT) %>% rowSums(na.rm=TRUE))
tab <- tab %>% mutate(n_geno = (n_HM1 + n_HM2 + n_HT))
#calculate proportion of each genotype
tab <- tab %>% mutate(p_HM1 = n_HM1/n_geno)
tab <- tab %>% mutate(p_HM2 = n_HM2/n_geno)
......@@ -100,47 +48,35 @@ T ~ exclude_prop
}
#stop with pval chisq.test
if(is.na(pval)==FALSE){
#block pval result if all missing genotypes
tab <- tab %>% mutate(chi_pval=case_when(p_HM1=0 & p_HM2 = 0 & p_HT = 0 ~ NA,
tab2 <- mark_prop(tab2,cross="F2",pval=0.05)
mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
#calculate total number of individuals genotyped for each marker
tab <- tab %>% mutate(n_geno = tab %>% select(n_HM1,n_HM2,n_HT) %>% rowSums(na.rm=TRUE))
#calculate proportion of each genotype
tab <- tab %>% mutate(p_HM1 = n_HM1/n_geno)
tab <- tab %>% mutate(p_HM2 = n_HM2/n_geno)
tab <- tab %>% mutate(p_HT = n_HT/n_geno)
tab <- tab %>% mutate(p_NA = n_NA/(n_geno+n_NA))
#stop if cross != "F2" or "N2"
if(!cross %in% c("F2","N2")){
stop("Cross must be F2 or N2")
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)
}
#stop of homo&hetero or pval not specified
if((is.na(homo)==TRUE | is.na(hetero)==TRUE) & is.na(pval)==TRUE){
stop("Arguments homo and hetero or argument pval must be specified")
}
#stop with prop of na
tab <- tab %>%
mutate(exclude_prop=case_when(p_NA > na ~ 1,
T ~ 0))
#stop with prop of homo/hetero
if(is.na(pval)==TRUE){
tab <- tab %>%
mutate(exclude_prop=case_when(p_NA > na ~ 1,
cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1,
cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1,
T ~ exclude_prop
))
print(tab)
# #stop if no value for "homo" for F2 cross
# if(cross=="F2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for F2 crosses")
# }
#
# #stop if no value for "homo" and "hetero" for N2 cross
# if(cross=="N2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for N2 crosses")
# }
# #exclude markers according to proportion of na
# tab <- tab %>% mutate(exclude_prop=case_when(p_NA > na ~ 1, #exclude markers according to proportion of na
# cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous individuals for F2 cross
# cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous and heterozygous individuals for N2 cross
# T ~ 0))
# tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
# return(tab)
}
#stop with pval chisq.test
if(is.na(pval)==FALSE){
#block pval result if all missing genotypes
tab <- tab %>% mutate(chi_pval=case_when(p_HM1=0 & p_HM2 = 0 & p_HT = 0 ~ NA,
tab2 <- mark_prop(tab2,cross="F2",pval=0.05)
mark_prop(tab2,cross="F2",pval=0.05)
test_tab <- tab2[1:20,]
tab3 <- mark_prop(test_tab,cross="F2",pval=0.05)
View(tab3)
mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
#calculate total number of individuals genotyped for each marker
tab <- tab %>% mutate(n_geno = tab %>% select(n_HM1,n_HM2,n_HT) %>% rowSums(na.rm=TRUE))
tab <- tab %>% mutate(n_geno = (n_HM1 + n_HM2 + n_HT))
#calculate proportion of each genotype
tab <- tab %>% mutate(p_HM1 = n_HM1/n_geno)
tab <- tab %>% mutate(p_HM2 = n_HM2/n_geno)
......@@ -169,47 +105,36 @@ T ~ exclude_prop
}
#stop with pval chisq.test
if(is.na(pval)==FALSE){
#block pval result if all missing genotypes
tab <- tab %>% mutate(chi_pval=case_when(p_HM1=0 & p_HM2 = 0 & p_HT = 0 ~ NA,
tab2 <- mark_prop(tab2,cross="F2",pval=0.05)
mark_prop(tab2,cross="F2",pval=0.05)
mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
#calculate total number of individuals genotyped for each marker
tab <- tab %>% mutate(n_geno = tab %>% select(n_HM1,n_HM2,n_HT) %>% rowSums(na.rm=TRUE))
#calculate proportion of each genotype
tab <- tab %>% mutate(p_HM1 = n_HM1/n_geno)
tab <- tab %>% mutate(p_HM2 = n_HM2/n_geno)
tab <- tab %>% mutate(p_HT = n_HT/n_geno)
tab <- tab %>% mutate(p_NA = n_NA/(n_geno+n_NA))
#stop if cross != "F2" or "N2"
if(!cross %in% c("F2","N2")){
stop("Cross must be F2 or N2")
}
#stop of homo&hetero or pval not specified
if((is.na(homo)==TRUE | is.na(hetero)==TRUE) & is.na(pval)==TRUE){
stop("Arguments homo and hetero or argument pval must be specified")
#stock colnames to join
names <- colnames(tab)
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=names)
}
#stop with prop of na
tab <- tab %>%
mutate(exclude_prop=case_when(p_NA > na ~ 1,
T ~ 0))
#stop with prop of homo/hetero
if(is.na(pval)==TRUE){
tab <- tab %>%
mutate(exclude_prop=case_when(p_NA > na ~ 1,
cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1,
cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1,
T ~ exclude_prop
))
print(tab)
# #stop if no value for "homo" for F2 cross
# if(cross=="F2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for F2 crosses")
# }
#
# #stop if no value for "homo" and "hetero" for N2 cross
# if(cross=="N2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for N2 crosses")
# }
# #exclude markers according to proportion of na
# tab <- tab %>% mutate(exclude_prop=case_when(p_NA > na ~ 1, #exclude markers according to proportion of na
# cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous individuals for F2 cross
# cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous and heterozygous individuals for N2 cross
# T ~ 0))
# tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
# return(tab)
}
#stop with pval chisq.test
if(is.na(pval)==FALSE){
#block pval result if all missing genotypes
tab <- tab %>% mutate(chi_pval=case_when(p_HM1=0 & p_HM2 = 0 & p_HT = 0 ~ NA,
tab2 <- mark_prop(tab2,cross="F2",pval=0.05)
test_tab <- tab2[1:20,]
tab3 <- mark_prop(test_tab,cross="F2",pval=0.05)
mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
#calculate total number of individuals genotyped for each marker
tab <- tab %>% mutate(n_geno = tab %>% select(n_HM1,n_HM2,n_HT) %>% rowSums(na.rm=TRUE))
tab <- tab %>% mutate(n_geno = (n_HM1 + n_HM2 + n_HT))
#calculate proportion of each genotype
tab <- tab %>% mutate(p_HM1 = n_HM1/n_geno)
tab <- tab %>% mutate(p_HM2 = n_HM2/n_geno)
......@@ -238,11 +163,36 @@ T ~ exclude_prop
}
#stop with pval chisq.test
if(is.na(pval)==FALSE){
#block pval result if all missing genotypes
tab <- tab %>% mutate(chi_pval=case_when(p_HM1=0 & p_HM2 = 0 & p_HT = 0 ~ NA,
#stock colnames to join
names <- colnames(tab)
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=names)
}
print(tab)
# #stop if no value for "homo" for F2 cross
# if(cross=="F2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for F2 crosses")
# }
#
# #stop if no value for "homo" and "hetero" for N2 cross
# if(cross=="N2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for N2 crosses")
# }
# #exclude markers according to proportion of na
# tab <- tab %>% mutate(exclude_prop=case_when(p_NA > na ~ 1, #exclude markers according to proportion of na
# cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous individuals for F2 cross
# cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous and heterozygous individuals for N2 cross
# T ~ 0))
tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
return(tab)
}
test_tab <- tab2[1:20,]
tab3 <- mark_prop(test_tab,cross="F2",pval=0.05)
mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
#calculate total number of individuals genotyped for each marker
tab <- tab %>% mutate(n_geno = tab %>% select(n_HM1,n_HM2,n_HT) %>% rowSums(na.rm=TRUE))
tab <- tab %>% mutate(n_geno = (n_HM1 + n_HM2 + n_HT))
#calculate proportion of each genotype
tab <- tab %>% mutate(p_HM1 = n_HM1/n_geno)
tab <- tab %>% mutate(p_HM2 = n_HM2/n_geno)
......@@ -271,11 +221,13 @@ T ~ exclude_prop
}
#stop with pval chisq.test
if(is.na(pval)==FALSE){
#block pval result if all missing genotypes
tab <- tab %>% mutate(chi_pval=case_when(p_HM1==0 & p_HM2 == 0 & p_HT == 0 ~ NA,
T ~ 0))
#stock colnames to join
names <- colnames(tab)
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=names)
}
print(tab)
# #stop if no value for "homo" for F2 cross
# if(cross=="F2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for F2 crosses")
......@@ -290,13 +242,15 @@ print(tab)
# cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous individuals for F2 cross
# cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous and heterozygous individuals for N2 cross
# T ~ 0))
# tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
# return(tab)
tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
return(tab)
}
tab2 <- mark_prop(tab2,cross="F2",pval=0.05)
test_tab <- tab2[1:20,]
tab3 <- mark_prop(test_tab,cross="F2",pval=0.05)
tab3 <- mark_prop(tab2,cross="F2",pval=0.05)
mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
#calculate total number of individuals genotyped for each marker
tab <- tab %>% mutate(n_geno = tab %>% select(n_HM1,n_HM2,n_HT) %>% rowSums(na.rm=TRUE))
tab <- tab %>% mutate(n_geno = (n_HM1 + n_HM2 + n_HT))
#calculate proportion of each genotype
tab <- tab %>% mutate(p_HM1 = n_HM1/n_geno)
tab <- tab %>% mutate(p_HM2 = n_HM2/n_geno)
......@@ -325,11 +279,15 @@ T ~ exclude_prop
}
#stop with pval chisq.test
if(is.na(pval)==FALSE){
#block pval result if all missing genotypes
tab <- tab %>% mutate(chi_pval=case_when(p_HM1==0 & p_HM2 == 0 & p_HT == 0 ~ 1,
T ~ 0))
#stock colnames to join
names <- colnames(tab)
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=names)
tab <- tab %>% mutate(exclude_prop=case_when(chi_pval < pval ~ 1,
T ~ exclude_prop))
}
print(tab)
# #stop if no value for "homo" for F2 cross
# if(cross=="F2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for F2 crosses")
......@@ -344,13 +302,13 @@ print(tab)
# cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous individuals for F2 cross
# cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous and heterozygous individuals for N2 cross
# T ~ 0))
# tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
# return(tab)
tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
return(tab)
}
tab2 <- mark_prop(tab2,cross="F2",pval=0.05)
tab3 <- mark_prop(tab2,cross="F2",pval=0.05)
mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
#calculate total number of individuals genotyped for each marker
tab <- tab %>% mutate(n_geno = tab %>% select(n_HM1,n_HM2,n_HT) %>% rowSums(na.rm=TRUE))
tab <- tab %>% mutate(n_geno = (n_HM1 + n_HM2 + n_HT))
#calculate proportion of each genotype
tab <- tab %>% mutate(p_HM1 = n_HM1/n_geno)
tab <- tab %>% mutate(p_HM2 = n_HM2/n_geno)
......@@ -379,11 +337,15 @@ T ~ exclude_prop
}
#stop with pval chisq.test
if(is.na(pval)==FALSE){
#block pval result if all missing genotypes
tab <- tab %>% mutate(chi_pval=case_when(p_NA==1 ~ 1,
T ~ 0))
#stock colnames to join
names <- colnames(tab)
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=names)
tab <- tab %>% mutate(exclude_prop=case_when(chi_pval < pval ~ 1,
T ~ exclude_prop))
}
print(tab)
# #stop if no value for "homo" for F2 cross
# if(cross=="F2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for F2 crosses")
......@@ -398,13 +360,13 @@ print(tab)
# cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous individuals for F2 cross
# cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous and heterozygous individuals for N2 cross
# T ~ 0))
# tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
# return(tab)
tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno,chi_pval))
return(tab)
}
tab2 <- mark_prop(tab2,cross="F2",pval=0.05)
tab3 <- mark_prop(tab2,cross="F2",pval=0.05)
mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
#calculate total number of individuals genotyped for each marker
tab <- tab %>% mutate(n_geno = tab %>% select(n_HM1,n_HM2,n_HT) %>% rowSums(na.rm=TRUE))
tab <- tab %>% mutate(n_geno = (n_HM1 + n_HM2 + n_HT))
#calculate proportion of each genotype
tab <- tab %>% mutate(p_HM1 = n_HM1/n_geno)
tab <- tab %>% mutate(p_HM2 = n_HM2/n_geno)
......@@ -433,32 +395,19 @@ T ~ exclude_prop
}
#stop with pval chisq.test
if(is.na(pval)==FALSE){
#block pval result if all missing genotypes
tab <- tab %>% mutate(chi_pval=case_when(p_NA==1 ~ NA_integer_,
T ~ 0))
#stock colnames to join
names <- colnames(tab)
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=names)
tab <- tab %>% mutate(exclude_prop=case_when(chi_pval < pval ~ 1,
T ~ exclude_prop))
}
print(tab)
# #stop if no value for "homo" for F2 cross
# if(cross=="F2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for F2 crosses")
# }
#
# #stop if no value for "homo" and "hetero" for N2 cross
# if(cross=="N2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for N2 crosses")
# }
# #exclude markers according to proportion of na
# tab <- tab %>% mutate(exclude_prop=case_when(p_NA > na ~ 1, #exclude markers according to proportion of na
# cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous individuals for F2 cross
# cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous and heterozygous individuals for N2 cross
# T ~ 0))
# tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
# return(tab)
}
tab2 <- mark_prop(tab2,cross="F2",pval=0.05)
T ~ 0))
mark_prop <- function(tab,cross,homo=NA,hetero=NA,pval=NA,na=0.5){
#calculate total number of individuals genotyped for each marker
tab <- tab %>% mutate(n_geno = tab %>% select(n_HM1,n_HM2,n_HT) %>% rowSums(na.rm=TRUE))
tab <- tab %>% mutate(n_geno = (n_HM1 + n_HM2 + n_HT))
#calculate proportion of each genotype
tab <- tab %>% mutate(p_HM1 = n_HM1/n_geno)
tab <- tab %>% mutate(p_HM2 = n_HM2/n_geno)
......@@ -487,26 +436,77 @@ T ~ exclude_prop
}
#stop with pval chisq.test
if(is.na(pval)==FALSE){
#block pval result if all missing genotypes
tab <- tab %>% mutate(chi_pval=case_when(p_NA==1 ~ NA_real_,
T ~ 0))
}
print(tab)
# #stop if no value for "homo" for F2 cross
# if(cross=="F2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for F2 crosses")
# }
#
# #stop if no value for "homo" and "hetero" for N2 cross
# if(cross=="N2" & (is.na(homo)==TRUE | is.na(hetero)==TRUE)){
# stop("Arguments homo and hetero must be specified for N2 crosses")
# }
# #exclude markers according to proportion of na
# tab <- tab %>% mutate(exclude_prop=case_when(p_NA > na ~ 1, #exclude markers according to proportion of na
# cross=="F2" & (p_HM1 < homo | p_HM2 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous individuals for F2 cross
# cross=="N2" & (p_HM1 < homo | p_HT < hetero) ~ 1, #exclude markers according to proportion of homozygous and heterozygous individuals for N2 cross
# T ~ 0))
# tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno))
# return(tab)
#stock colnames to join
names <- colnames(tab)
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=names)
tab <- tab %>% mutate(exclude_prop=case_when(chi_pval < pval ~ 1,
T ~ exclude_prop))
}
tab <- tab %>% select(-c(p_HM1,p_HM2,p_HT,p_NA,n_geno,chi_pval))
return(tab)
}
tab2 <- mark_prop(tab2,cross="F2",pval=0.05)
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
library(dplyr)
library(stuart)
annot_mini <- read.csv(url("https://raw.githubusercontent.com/kbroman/MUGAarrays/master/UWisc/mini_uwisc_v2.csv"))
data(genos)
summary(genos)
data(phenos)
summary(phenos)
strains <- geno_strains(ref=annot_mini,geno=genos,par1=c("StrainsA_1","StrainsA_2"),par2=c("StrainsB_1","StrainsB_2"),name1="parent1",name2="parent2")
head(strains)
genos <- genos %>% filter(!Sample.ID %in% c("StrainsA_1", "StrainsA_2", "StrainsB_1","StrainsB_2"))
data(stuart_tab)
summary(stuart_tab)
tab2 <- mark_match(stuart_tab,ref=strains)
tab2 %>% filter(exclude_match==1)
tab2 <- mark_poly(tab2)
head(tab2)
tab2 <- mark_prop(tab2,cross="F2",pval=0.05)
devtools::build(path=".",vignettes = FALSE)
devtools::build_vignettes()
devtools::build_vignettes()
devtools::build(path=".",vignettes = FALSE)
devtools::build_vignettes()
devtools::build(path=".",vignettes = FALSE)
devtools::build_vignettes()
library(dplyr)
library(stuart)
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
annot_mini <- read.csv(url("https://raw.githubusercontent.com/kbroman/MUGAarrays/master/UWisc/mini_uwisc_v2.csv"))
data(genos)
summary(genos)
data(phenos)
summary(phenos)
strains <- geno_strains(ref=annot_mini,geno=genos,par1=c("StrainsA_1","StrainsA_2"),par2=c("StrainsB_1","StrainsB_2"),name1="parent1",name2="parent2")
head(strains)
genos <- genos %>% filter(!Sample.ID %in% c("StrainsA_1", "StrainsA_2", "StrainsB_1","StrainsB_2"))
data(stuart_tab)
summary(stuart_tab)
tab2 <- mark_match(stuart_tab,ref=strains)
tab2 %>% filter(exclude_match==1)
tab2 <- mark_poly(tab2)
head(tab2)
tab2 <- mark_prop(tab2,cross="F2",homo=0.1,hetero=0.1)
head(tab2)
tab2 <- mark_allele(tab=tab2,ref=strains,par1="parent1",par2="parent2")
tab2 %>% arrange(desc(exclude_allele)) %>% head()
strains %>% filter(marker %in% c("gJAX00038569","gJAX00425031","gUNC12245354","gUNC15530876","gUNC21555204","gUNC21596600")) %>% arrange(marker) %>% select(marker,parent1,parent2)
rqtl_file <- write_rqtl(geno=genos,pheno=phenos,tab=tab2,ref=strains,par1="parent1",par2="parent2",prefix="ind_",pos="cM_cox")
rqtl_file[1:10,1:7]
devtools::build_vignettes()
devtools::build_vignettes()
devtools::build_vignettes()
devtools::build_vignettes()
devtools::build_vignettes()
devtools::build_vignettes()
{
"path" : "~/stuart_package/stuart",
"path" : "~/Documents/PhD/stuart_R/stuart",
"sortOrder" : [
{
"ascending" : true,
......
{
"activeTab" : 1
"activeTab" : 0
}
\ No newline at end of file
{
"left" : {
"panelheight" : 583,
"splitterpos" : 244,
"topwindowstate" : "MAXIMIZE",
"windowheight" : 621
"panelheight" : 783,
"splitterpos" : 327,
"topwindowstate" : "NORMAL",
"windowheight" : 821
},
"right" : {
"panelheight" : 1271,
"splitterpos" : 803,
"panelheight" : 783,
"splitterpos" : 494,
"topwindowstate" : "NORMAL",
"windowheight" : 1309
"windowheight" : 821
}
}
\ No newline at end of file
/private/var/folders/dn/j71yz2tn5_gdffs8fqxhddrr0000gn/T/Rtmp3VMULh/preview-1ced414f7aab.dir/stuaRt.html
/private/var/folders/dn/j71yz2tn5_gdffs8fqxhddrr0000gn/T/RtmpZZZ4WE/preview-31873a42c16d.dir/stuaRt.html
/private/var/folders/dn/j71yz2tn5_gdffs8fqxhddrr0000gn/T/Rtmp3VMULh/preview-1ced48fe920c.dir/stuaRt.html
/private/var/folders/dn/j71yz2tn5_gdffs8fqxhddrr0000gn/T/RtmpNme5vw/preview-4c4321234d03.dir/stuaRt.html
/private/var/folders/dn/j71yz2tn5_gdffs8fqxhddrr0000gn/T/RtmpZZZ4WE/preview-3187564b41ab.dir/stuaRt.html
{
"cursorPosition" : "70,29",
"scrollLine" : "40"
"cursorPosition" : "48,24",
"scrollLine" : "0"
}
\ No newline at end of file