modif mark_prop chi

.Rproj.user/shared/notebooks/4D49CCFD-stuaRt/1/9DAE699039B546A6/chunks.json → .Rproj.user/shared/notebooks/C3675061-stuaRt/1/s/chunks.json

-{"chunk_definitions":[{"chunk_id":"cugiprfbptcaw","chunk_label":"unnamed-chunk-1","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","include":false,"label":"unnamed-chunk-1"},"row":15,"row_count":1,"visible":true},{"chunk_id":"csetup_chunk","chunk_label":"setup","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","include":false,"label":"setup"},"row":31,"row_count":1,"visible":true},{"chunk_id":"cvmghh26lmpwd","chunk_label":"annot","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"annot"},"row":45,"row_count":1,"visible":true},{"chunk_id":"cystga685ux9r","chunk_label":"load","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"load"},"row":60,"row_count":1,"visible":true},{"chunk_id":"cc71rfo54vvou","chunk_label":"strains","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"strains"},"row":73,"row_count":1,"visible":true},{"chunk_id":"coar8mvardv1z","chunk_label":"no_parent","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"no_parent"},"row":78,"row_count":1,"visible":true},{"chunk_id":"cyqo4jk1414tp","chunk_label":"tab_mark","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"tab_mark"},"row":91,"row_count":1,"visible":true},{"chunk_id":"ci1zg9xosgth8","chunk_label":"mark_match","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"mark_match"},"row":100,"row_count":1,"visible":true},{"chunk_id":"c4j6ei29p4187","chunk_label":"mark_poly ex","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"mark_poly ex"},"row":109,"row_count":1,"visible":true},{"chunk_id":"cndnl4vh4xyj8","chunk_label":"mark_prop ex","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"mark_prop ex"},"row":116,"row_count":1,"visible":true},{"chunk_id":"cgrscnwnyajvi","chunk_label":"mark_allele","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"mark_allele"},"row":123,"row_count":1,"visible":true},{"chunk_id":"c45rvmci4gaoy","chunk_label":"mark_allele-strains","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"mark_allele-strains"},"row":129,"row_count":1,"visible":true},{"chunk_id":"cv6d9nrsrzqfm","chunk_label":"write_qtl","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"write_qtl"},"row":139,"row_count":1,"visible":true}],"default_chunk_options":{},"doc_write_time":1622642681,"working_dir":null}
\ No newline at end of file
+{"chunk_definitions":[{"chunk_id":"culdjhv7njxmo","chunk_label":"unnamed-chunk-1","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","include":false,"label":"unnamed-chunk-3"},"row":15,"row_count":1,"visible":true},{"chunk_id":"csetup_chunk","chunk_label":"setup","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","include":false,"label":"setup"},"row":31,"row_count":1,"visible":true},{"chunk_id":"cvrfzlkmsnd5m","chunk_label":"annot","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"annot"},"row":45,"row_count":1,"visible":true},{"chunk_id":"c0s26bf1pu5ys","chunk_label":"load","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"load"},"row":60,"row_count":1,"visible":true},{"chunk_id":"cxuyx1brxodqv","chunk_label":"strains","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"strains"},"row":73,"row_count":1,"visible":true},{"chunk_id":"ccbr8kr5rmfiz","chunk_label":"no_parent","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"no_parent"},"row":78,"row_count":1,"visible":true},{"chunk_id":"ceekbogybpgbx","chunk_label":"tab_mark","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"tab_mark"},"row":91,"row_count":1,"visible":true},{"chunk_id":"cgfik6q17v45t","chunk_label":"mark_match","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"mark_match"},"row":100,"row_count":1,"visible":true},{"chunk_id":"c4gkr1xb8o1a9","chunk_label":"mark_poly ex","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"mark_poly ex"},"row":109,"row_count":1,"visible":true},{"chunk_id":"cp87d27x07m61","chunk_label":"mark_prop ex","document_id":"96AB3736","expansion_state":0,"options":{"engine":"r","label":"mark_prop ex"},"row":116,"row_count":1,"visible":true}],"default_chunk_options":{},"doc_write_time":1623085296,"working_dir":null}
\ No newline at end of file

.Rproj.user/shared/notebooks/C3675061-stuaRt/1/s/cp87d27x07m61/000022.csv

+"0","tab2 <- mark_prop(tab2,cross=""F2"",pval=0.05)
+"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"
+"2","Chi-squared approximation may be incorrect"

.Rproj.user/shared/notebooks/paths

 /Users/mariebourdon/Documents/PhD/stuart_R/stuart/vignettes/stuaRt.Rmd="C3675061"
+/Users/mariebourdon/stuart_package/stuart_old/R/mark_prop.R="5087875"

R/mark_prop.R

@@ -14,10 +14,9 @@
 
 #### mark_prop ####
 ## excludes markers depending on proportions of homo/hetorozygous
-## to modify with chisq.test
-mark_prop <- function(tab,cross,homo=NA,hetero=NA,na=0.5){
+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)
@@ -25,27 +24,50 @@ mark_prop <- function(tab,cross,homo=NA,hetero=NA,na=0.5){
   tab <- tab %>% mutate(p_HT = n_HT/n_geno)
   tab <- tab %>% mutate(p_NA = n_NA/(n_geno+n_NA))
 
+  #stock colnames to join
+  names <- colnames(tab)
+
+
   #stop if cross != "F2" or "N2"
   if(!cross %in% c("F2","N2")){
     stop("Cross must be F2 or N2")
   }
 
-  #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 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" 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")
+
+
+  #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
+      ))
   }
 
-  #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))
+  #stop with pval chisq.test
+  ## NEED TO ADD THIS FILTER IF CROSS = N2
+  if(is.na(pval)==FALSE){
+
+    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))
+  tab <- tab %>% select(names)
   return(tab)
 }