R/design_utils.R

Defines functions experimental_design_label get_timing_levels cr_experimental_design

Documented in cr_experimental_design

#' Create experimental design in AGROFIMS
#' 
#' @description create experimental design in agrofims through user interface inputs
#' @param design experimental design abbreviation.
#' @param rep replication
#' @param block blocks
#' @param trt treatments
#' @param ntrt number of treatments
#' @param fnames list of factors names
#' @param flevels list of levels according to previous factors
#' @param mplot main plot
#' @param splot sub plot
#' @param ssplot sub-sub plot
#' @param rowf row factor
#' @param colf col factor
#' @export

cr_experimental_design <- function(design, rep=2, block=2, trt=2, ntrt=NULL, 
                                   fnames=NULL,flevels=NULL,
                                   mplot=NULL, splot=NULL, ssplot=NULL,
                                   rowf=NULL, colf=NULL){
            
            block <-as.numeric(block)
            rep <- as.numeric(rep)
  
            if (design == "crd") {
              fb<- try(st4gi::cr.crd(geno = trt,nrep = rep)$book)
              names(fb)<- c("PLOT", "ROW","COL","TREATMENT")
            }
            
            if (design == "rcbd") {
              fb<- try(st4gi::cr.rcbd(geno = trt,nb = block)$book)
              names(fb) <- c("PLOT","BLOCK", "ROW","COL","TREATMENT")
            }
            
            if (design == "fcrd") { ##factorial crd
              fb <- try(st4gi::cr.f(fnames = fnames, flevels = flevels, design = "crd", nrep = rep)$book)
              names(fb)[1:4] <- c("PLOT","ROW","COL","TREATMENT") #rename first 4 cols
            }
            
            if (design == "frcbd") { ##factorial rcbd
              #print(fnames)
              #print(flevels)
              fb <- try(st4gi::cr.f(fnames = fnames, flevels = flevels, design = "rcbd", nrep = rep)$book)
              names(fb)[1:5] <- c("PLOT","BLOCK" ,"ROW","COL","TREATMENT")  #rename first 5 cols
            }
            
            if (design == "sprcbd") { #split plot rcbd
              fb <- try(st4gi::cr.spld(fnames = fnames ,flevels = flevels ,nb = block)$book )
              names(fb)[1:6] <- c("BLOCK" ,"PLOT","SUBPLOT","ROW","COL","TREATMENT")  #rename first 5 cols
              
            } #R.Eyzaguirre recommends just one Split Design
            
            if (design == "spsp") { #split-split plot
              fb <- try(st4gi::cr.spld(fnames = fnames ,flevels = flevels ,nb = block)$book )
              names(fb)[1:7]<- c("BLOCK" ,"PLOT","SUBPLOT","SUB-SUB-PLOT","ROW","COL","TREATMENT")
            }
            
            if (design == "strip") { #strip plot
              fb <- try(st4gi::cr.strd(A = flevels[[1]],B = flevels[[2]],nb = block)$book )
              names(fb)[1:7] <- c("PLOT", "BLOCK", "ROW","COL",fnames[1],fnames[2],"TREATMENT")
            }
            #print(fb)
            fb
          
}





## Get levels from desigin tab
# .data: reactiveTable
# index : vector of indexes
# factors: vector of factors
# design: design
# data dictionary: data dictionary for FACTOR_V10
# format: list (default)
# get_levels_design <- function(.data, index, indexEspLvl=NULL, factors, design="fcrd", 
#                               data_dictionary=NULL, format=c("list","data.frame")){
#   
#   format<- match.arg(format)
#   
#   factors <- stringr::str_replace_all(string = factors,pattern = "_f[:digit:]",replacement = "")
#   factors <- stringr::str_replace_all(string = factors,pattern = "_",replacement = " ")
#   #print(factors)
#   
#   lookup<- paste0("^",design,"_lvl_")
#   dt <- .data %>%   dplyr::filter(!str_detect(id, "add")) %>%
#                               dplyr::filter(!str_detect(id, "button")) %>%
#                               dplyr::filter(!str_detect(id, "unit")) %>% 
#                               dplyr::filter(!str_detect(id, "_sel_factor_")) %>%
#                               dplyr::filter(!str_detect(id, "-selectized")) %>%  
#                               dplyr::filter(str_detect(id, lookup))
#         
#       #Arrange by order
#       dt <- arrange_by_pattern(dt, pattern = index)
#       
#       out <- vector(mode="list",length = length(factors))
#       a<-u<-NULL
#         
#         for(i in 1:length(factors)){
#           
#           # For timing factors
#           if(stringr::str_detect(factors[i],pattern="timing")){
#             print("Timing factor")
#               # for(i in seq.int(factors)){
#                 out[[i]] <- get_timing_levels(.data, index= index[i], factors[i], design=design,
#                                               data_dictionary=data_dictionary)
#               #}
#           }
#           
#           else if(factors[i]=="Crop residue amount" || factors[i]== "Irrigation amount"){
#             
#             print("crop residue amount")
#             out[[i]] <- get_amountype_levels(.data, index= index[i], indexEspLvl = indexEspLvl,  factors[i], design=design,
#                                              data_dictionary=data_dictionary)
#             
#           }
#           
#           else if(stringr::str_detect(factors[i],pattern="type and amount")){
#             
#             print("type and amount factor")
#             
#             out[[i]] <- get_amountype_levels(.data, index= index[i], indexEspLvl = indexEspLvl,  factors[i], design=design,
#                                               data_dictionary=data_dictionary)
#             
#           }
#           #General cases
#           else {
#                  
#             out[[i]]<- dt %>% dplyr::filter(str_detect(id, paste0(lookup, index[i]))) %>% distinct()
#             if(factors[i]==""){
#               out[[i]] <- c("","","")
#             }
#             else {
#               temp <- data_dictionary %>% filter(FACTOR==factors[i]) 
#               
#               ## Si es un factor estadarizado, entonces temp debe tener al menos una fila ----------------
#               if(nrow(temp)>0){
#                 #When lenght(out) is equal to 1 ---> form is text input or combo.
#                 form<- data_dictionary %>% filter(FACTOR==factors[i]) %>% dplyr::select(FORM)
#                 form<- form$FORM   
#                 form <- stringi::stri_trim_both(str = form)
#                 
#                 if(form=="date"){
#                   out[[i]] <- out[[i]] %>%  dplyr::filter(str_detect(id,  "date" ))
#                   out[[i]] <-  out[[i]]$values
#                 } 
#                 else { 
#                   #Avoid _1_1 ---> "$"
#                   out[[i]]<- dt %>% dplyr::filter(str_detect(id, paste0(lookup, index[i],"$")))
#                   
#                   out[[i]] <- out[[i]] %>%  dplyr::filter(!str_detect(id,  "date" ))
#                   out[[i]] <-  out[[i]]$values
#                   out[[i]] <- strsplit(out[[i]],split= ",")[[1]]
#                   out[[i]] <- stringi::stri_trim_both(str = out[[i]])
#                   
#                   #Detect Others
#                   if( nrow(dt %>% dplyr::filter(str_detect(id, paste0(lookup,"other_", index[i] ))))>=1)  {
#                     
#                     a <- dt %>% dplyr::filter(str_detect(id, paste0(lookup,"other_",index[i])))
#                     a<- a$values
#                     a <- strsplit(a,split= ",")[[1]]
#                     a <- stringi::stri_trim_both(str = a)
#                     out[[i]]<- append(out[[i]], a)
#                     out[[i]]<- setdiff(out[[i]],"Other") #remove other value from vector
#                   }
#                   
#                   #Detect Units
#                   if( nrow(.data %>% dplyr::filter(str_detect(id, paste0(lookup,"unit_", index[i],"$" ))))>=1 ){
#                     
#                     u<- .data %>% dplyr::filter(!str_detect(id, "-selectized")) %>%
#                       dplyr::filter(str_detect(id,  paste0(lookup, "unit_",index[i],"$" ) ))
#                     u<- u$values
#                     out[[i]]<- paste0(out[[i]]," ",u) #quantity + whitespace + unit
#                   }
#                   
#                   #We place underscore in `pattern` because the factor's names include underscore
#                   if(stringr::str_detect(factors[i],pattern="_application_rate")){ #special case for product, nutrient and oxidzed
#                     # 95, 96 y 97 from FACTOR_V10-DRAFT
#                     print("application rate")
#                     fert<- .data %>% dplyr::filter(!str_detect(id, "-selectized")) %>%
#                     dplyr::filter(str_detect(id,  paste0(lookup, "fert_",index[i]) ))
#                     fert<- fert$values
#                     out[[i]]<- paste0(fert," ",out[[i]]) #quantity + whitespace + unit
#                     
#                   }
#                   
#                   
#                   if(nrow(.data %>% dplyr::filter(str_detect(id,  paste0("^",design,"factor","_crop_input",index[i],"$"))) )>=1)
#                   {
#                     print("crop in design")
#                     crop <- .data %>% dplyr::filter(str_detect(id,  paste0("^",design,"factor","_crop_input",index[i],"$"))) %>% 
#                                           dplyr::nth(2)
#                     #print(crop)
#                     
#                     if( length(crop) && crop!=""){
#                       #crop <- crop$values
#                       out[[i]] <- paste0(crop,"_",out[[i]])
#                     }else{
#                       out[[i]] <- out[[i]]
#                     }
#                     
#                   }
#                     
#                 }
#                 
#               } 
#               ## El factor no esta estandirizado cuando el factor no fue encontrado (no hay filas)
#               else { #Si no tiene al menos una fila, este debe ser un OTHER FACTOR
#                 othFacType <- .data %>% dplyr::filter(!str_detect(id, "-selectized")) %>%  
#                   dplyr::filter(str_detect(id, paste0("^",design,"_typeInput_",index[i])))  
#                 othFacType <- othFacType$values
#                 
#                 if(othFacType=="date"){
#                   out[[i]] <- out[[i]] %>%  dplyr::filter(str_detect(id,  "date" ))
#                   out[[i]] <-  out[[i]]$values
#                 }
#                 else{
#                   out[[i]] <- out[[i]] %>%  dplyr::filter(!str_detect(id,  "date" )) 
#                   out[[i]]<- strsplit(out[[i]]$values,split= ",")[[1]]
#                   out[[i]] <- stringi::stri_trim_both(str = out[[i]])
#                   
#                   #Detect Units
#                   if( nrow(.data %>% dplyr::filter(str_detect(id, paste0(lookup,"unit_", index[i] ))))>=1 ){
#                     
#                     u<- .data %>% dplyr::filter(!str_detect(id, "-selectized")) %>%
#                       dplyr::filter(str_detect(id,  paste0(lookup, "unit_",index[i] ) ))
#                     u<- u$values
#                     out[[i]]<- paste0(out[[i]]," ",u) #quantity + whitespace + unit
#                   }
#                   
#                 }
#                 
#               }
#             }
#             
#               
#            }
#           
#         }
#         
#       if(format=="data.frame"){
#           print("tranform to data.frame")
#       }
#         
#       out
#   
# }






# Get level for non-full factorial designs
# get_nonfactorial_levels <- function(input,design){
#   
#   if(design=="crd"){
#      n<- as.integer(input$crd_ntrt) 
#      out <- NULL
#      for(i in 1:n){
#        out[i]<- input[[paste0("ui_NFF_summ_crd_", i)]]  
#      }
#   }else{
#     n <- as.integer(input$rcbd_ntrt)
#     out <- NULL
#     for(i in 1:n){
#       out[i]<- input[[paste0("ui_NFF_summ_rcbd_", i)]]  
#     }
#   }
#   out
# }


# Get levels for special factors : timing and amount/type factors
# ADVICE: NOT VECTORIZED, should be included in the main class get_levels_design
get_timing_levels <- function(.data, index="1", factors, design="fcrd", 
                               data_dictionary=NULL){
  
  #Remove underscore from factors
  factors <- stringr::str_replace_all(string = factors,pattern = "_f[:digit:]",replacement = "")
  factors <- stringr::str_replace_all(string = factors,pattern = "_",replacement = " ")

  #Look up for pattern
    lookup<- paste0("^",design,"_lvltiming") #Timing factor case : _lvltiming_

  dt <- .data %>%   dplyr::filter(!str_detect(id, "add")) %>%
                        dplyr::filter(!str_detect(id, "button")) %>%
                        dplyr::filter(!str_detect(id, "unit")) %>% 
                        dplyr::filter(!str_detect(id, "_sel_factor_")) %>%
                        dplyr::filter(!str_detect(id, "-selectized")) %>%  
                        dplyr::filter(str_detect(id, lookup))
  
  out <- vector(mode="character",length = length(factors))
  tproc<- vector(mode="character",length = length(factors))
  

  #Type of timing procedure
  tproc <- .data %>% dplyr::filter(!str_detect(id, "-selectized")) %>%
                          dplyr::filter(str_detect(id,  paste0(lookup,"_",index,"$") ))
  tproc <- tproc$values
  
  
  ## Case: Days after plating, Grow stage, Frequency: -------------------------------------------------------------
  if(tproc!="Date"){
          ##Pattern: lookup_timing_index[i]_"1"
          out <-  dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"Value","_",index,"_1$") ))
          out<- strsplit(out$values,split= ",")[[1]]
          out <- stringi::stri_trim_both(str = out)
  } 
  else {
          #Number of dates
          numdate <- .data %>%  dplyr::filter(str_detect(id,  paste0("^",design, "_numLevelsTimingESP_",index,"$")))
          numdate <- as.integer(numdate$value)
          
          ## For date that includes number of dates -------------------------------------
          out_date <- character(numdate)
          for(j in seq.int(numdate)){
            res <-  dt %>% dplyr::filter(str_detect(id,  paste0(lookup, "Value_",index,"_",j,"$")))
            out_date[j] <- res$values
          }
          out<- out_date
  }

  #print(tproc)
  #print(out)
  out
}


# Get levels for amount and type factors
# ADVICE: NOT VECTORIZED, should be included in the main class get_levels_design
# .data: All input values from AGROFIMS sessions
# index: design-factor index. Only one value is allowed.
# indexLvl: index's levels 
# factors: factor names
# design: design 
# data_dictionary: data dictionary from AGROFIMS
# 
# get_amountype_levels <- function(.data, index, indexEspLvl=NULL, factors, design="fcrd", 
#                                  data_dictionary=NULL){
#   
#   #Factor's name
#   factors <- stringr::str_replace_all(string = factors,pattern = "_f[:digit:]",replacement = "")
#   factors <- stringr::str_replace_all(string = factors,pattern = "_",replacement = " ")
#   
#   #Filter index from special factors and levels
#   indexEspLvl <- filter_index_espLvl_design(index = index, indexEspLvl= indexEspLvl, design=design, designEspflvl="_lvl_espType_")
#   indexEspLvl <- get_index_espLvl_design(indexEspLvl, paste0("^",design,"_lvl_espType_",index,"_"))  #"frcbd_lvl_espType_2_")
#   
#   #Lookup design pattern
#   lookup <- paste0("^",design,"_")
#   dt <- .data %>% dplyr::filter(!str_detect(id, "add")) %>%
#                       dplyr::filter(!str_detect(id, "button")) %>%
#                       #dplyr::filter(!str_detect(id, "unit")) %>%  ##Contemplate Unit case
#                       dplyr::filter(!str_detect(id, "_sel_factor_")) %>%
#                       dplyr::filter(!str_detect(id, "-selectized")) %>%  
#                       dplyr::filter(str_detect(id, lookup))
#   
#   ## crop --------------------------------------------------------------------------------------------
#   #structure: design_factor_crop_input_index
#   crop <- .data %>% dplyr::filter(str_detect(id,  paste0("^",design,"factor","_crop_input",index,"$") )) 
#   if(nrow(crop)!=0){
#     crop <- crop$values  
#   }else{
#     crop<- ""
#   }
#   
#   ## number of evaluation for each element -----------------------------------------------------------
#   ## input structure: design_numLevelsESP_index
#   #numEval<- .data %>% dplyr::filter(str_detect(id,  paste0("^",design, "_numLevelsESP_",index,"$"))) %>% nth(2)
#   #numEval <- length(indexEspLvl)
#   numEval <- as.integer(length(indexEspLvl))
#   
#   eleType <- unit <-NULL
#   out <- list()
#   lvl <- NULL
#   for(j in seq.int(numEval)){
#     
#     ## level values. 
#     ## input structure: design_lvl_espType_index_numEval------------------------------------------------------------------------------
#     eleType <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"lvl_espType_",index,"_", indexEspLvl[j],"$"))) %>% nth(2) 
#     print(eleType) 
#     
#     ## levels + unit -----------------------------------------------------------------------------------------------
#     ## input structure:  #design_lvl_index_numEval
#     lvl <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup, "lvl_espLvl_",index,"_", indexEspLvl[j],"$")))  %>% nth(2)
#     lvl <-  strsplit(lvl,",")[[1]] %>% stringi::stri_trim_both()
#     print(lvl)
#     #unit  ----------------------------------------------------------------------------------------
#     ##  input strcucture: design_lvl_unit_index_numEval 
#     unit <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"lvl_espUnit_",index,"_", indexEspLvl[j],"$")))  %>% nth(2)
#     print(unit)
#     
#     
#     if(crop!=""){
#       out[[j]] <- paste0(crop,"_",eleType,"_",lvl,unit)
#       #print(out[j])
#     } else {
#       out[[j]] <- paste0(eleType,"_",lvl,unit)
#     }
#     #print(out[[j]])
#     
#   }
#   out <- unlist(out)
# }  


## Get experimental design label (or full name) based on abrreviations
experimental_design_label <- function(abbr_design = "frcbd"){
  
  abbr_design <- stringr::str_trim(abbr_design,side="both") %>% toupper()
  
  if(is.na(abbr_design))      {abbr_design <- ""; out <- ""}
  if(abbr_design == "UNDR")   {out <- "Unreplicated Design with No Randomization (UNDR)"  }
  if(abbr_design == "RCBD")   {out <- "Randomized Complete Block Design (RCBD)"}
  if(abbr_design == "CRD")    {out <- "Completely Randomized Design (CRD)" }
  if(abbr_design == "ABD")    {out <- "Augmented Block Design (ABD)"}
  if(abbr_design == "LSD")    {out <- "Latin Square Design (LSD)"}
  #if(abbr_design == "SPCRD") {out <- "Split Plot with Plots in CRD (SPCRD)"} #R.Eyzaguirre recommend to hide this line
  #if(abbr_design == "SPRCBD"){out <- "Split Plot with Plots in RCBD (SPRCBD)"}  #R.Eyzaguirre recommend to hide this line
  if(abbr_design == "SPRCBD") {out <- "Split Plot with Plots Design"} # #R.Eyzaguirre recommend to use just one split design under rcbd
  if(abbr_design == "SPSP")   {out <- "Split-Splot Plot Design"} # #R.Eyzaguirre recommend to use just one split design under rcbd
  if(abbr_design == "SPLSD")  {out <- "Split Plot with Plots in LSD (SPLSD)"}
  if(abbr_design == "STRIP")  {out <- "Strip Plot Design (STRIP)"}
  #if(abbr_design == "FCRD")   {out <- "Factorial with CRD"}
  #if(abbr_design == "FRCBD")  {out <- "Factorial with RCBD"}
  if(abbr_design == "FCRD")   {out <- "Full factorial Completely Randomized Design"}
  if(abbr_design == "FRCBD")  {out <- "Full factorial Randomized Complete Block Design"}
  
  if(abbr_design == "AD")     {out <- "Alpha Design(0,1) (AD)"}
  if(abbr_design == "WD")     {out <- "Westcott Design (AD)"}
  
  out
  
}


## Get index from ID (provided by the statistical design prefix)
#id: character vector. Ids generated by agrofims during user's session
#design: character vector. Statistical design abbreviation provided by Shiny
#
# get_index_design<- function(id, design){
#   
#  out<- stringr::str_replace_all(string = id,pattern =  paste0(design,"_"),replacement = "")
#  
# }

## Get index level from given ID (provided by the statistical design prefix)
#indexEspLvl: character vector (one or multiple values). Statistical design abbreviation + especial level prefix provided by Shiny. Ex "frcbd_lvl_espType_2_1"
#designEspflvl: statistical design abbreviation + especial level prefix: "frcbd_lvl_espType_"
#Ex.: get_index_espLvl_design("frcbd_lvl_espType_2_1", "frcbd_lvl_espType_")
# get_index_espLvl_design<- function(indexEspLvl, designEspflvl=NULL){
#   
#   if(!is.null(designEspflvl)){
#     out<- stringr::str_replace_all(string = indexEspLvl, pattern = designEspflvl, replacement = "")
#   } else {
#     out <- NULL
#   }
# 
# }

#FILTER SPECIAL LEVEL INDEX BY DESIGN AND FACTOR INDEX
#index: one-value character vector. Index provided by the factor id. Ex. index="1"
#indexEspLvl: character vector (one or multiple values). Ex.: "frcbd_lvl_espType_2_1"
#design: character. Statistical design abbreviation. Ex.: design="crd".
#designEspflvl: especial level prefix. Ex. designEspflvl="frcbd_lvl_espType_"
#Example:
#lvlIds <- c("frcbd_lvl_espType_1_1", "frcbd_lvl_espType_2_1" ,"frcbd_lvl_espType_2_2")
#index<- "1"
#res<-filter_index_espLvl_design(index ="2",lvlIds= lvlIds, design="frcbd", designEspflvl="_lvl_espType_")

# filter_index_espLvl_design <- function(index="1", indexEspLvl=NULL, design="frcbd", designEspflvl="_lvl_espType_"){
#   
#   if(!is.null(indexEspLvl)){
#     out <- indexEspLvl[str_detect(indexEspLvl,paste0("^",design,"_lvl_espType_",index))]
#   }
#   else {
#     out <- NULL
#   }  
#  
# }

#################### DESIGN Get Details for Nutrient and Fertilizers ##################################################3

# Get index level from given ID (provided by the statistical design prefix)
# .data: All input values from AGROFIMS sessions
# indexEspLvl: index's levels 
# design: design
# index: design-factor index. Only one value is allowed.
# indexEspLvl: character vector (one or multiple values). Statistical design abbreviation + especial level prefix provided by Shiny. Ex "frcbd_lvl_espType_2_1"
# Ex.: res<- get_nutrient_details(.data=.data, design=design, index =2, indexEspLvl = indexEspLvl)

# get_nutrient_details_design <- function(.data, design, index, indexEspLvl){
#   
#   #Filter by design and current factor index
#   #indexEspLvl<- filter_index_espLvl_design(index= index, indexEspLvl=indexEspLvl, design=design, designEspflvl="_lvl_espType_")
#   #Get index after filtering
#   #return: 2_1, 2_2, 2_3
#   indexEspLvl_subfix <- get_index_espLvl_design(indexEspLvl, paste0(design,"_lvl_espType_")) #"frcbd_lvl_espType_")
#   #Number of elements
#   #n <- length(get_amountype_levels(.data, index, indexEspLvl=indexEspLvl, factors="", design=design)) 
#   
#   
#   #Lookup design pattern
#   lookup <- paste0("^",design,"_")
#   dt <- .data %>% dplyr::filter(!str_detect(id, "add")) %>%
#     dplyr::filter(!str_detect(id, "button")) %>%
#     #dplyr::filter(!str_detect(id, "unit")) %>%  ##Contemplate Unit case
#     dplyr::filter(!str_detect(id, "_sel_factor_")) %>%
#     dplyr::filter(!str_detect(id, "-selectized")) %>%  
#     dplyr::filter(str_detect(id, lookup))
#   
#   dt <- arrange_nutfert(dt)
#   
#   nutAmount <- mNumTiming <- mNumTimingValue <- mTechnique <- mImplement <- mNutProduct <- NULL
#   nutrient_list<- list()
#   
#   for(i in seq.int(indexEspLvl_subfix) ){
#     
#     #nutAmount <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"outputNutLvlDT_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2)
#     
#     nutAmount <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"outputNutLvlDT_",indexEspLvl_subfix[i],"_")))  %>% nth(2)
#     
#     
#     #mNumTiming <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mNutTiming_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2)
#     mNumTiming <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mNutTiming_",indexEspLvl_subfix[i],"_")))  %>% nth(2)
#     if(length(mNumTiming)==0){ mNumTiming <- rep("", length(indexEspLvl_subfix))}
#     
#     #mNumTimingValue <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"NutTimingValue_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2) 
#     mNumTimingValue <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"NutTimingValue_",indexEspLvl_subfix[i],"_")))  %>% nth(2) 
#     if(length(mNumTimingValue)==0){ mNumTimingValue <- rep("", length(indexEspLvl_subfix))}
#     
#     #mTechnique <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mNutTechnique_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2)
#     mTechnique <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mNutTechnique_",indexEspLvl_subfix[i],"_")))  %>% nth(2)
#     if(length(mTechnique)==0){ mTechnique <- rep("", length(indexEspLvl_subfix))}
#     
#     #mImplement <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mNutImplement_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2)
#     mImplement <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mNutImplement_",indexEspLvl_subfix[i],"_"))) %>% nth(2)
#     if(length(mImplement)==0){ mImplement <- rep("", length(indexEspLvl_subfix))}
#     
#     
#     #TODO: GET the correct product amount according to number of rows
#     #mNutProduct <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mNutProduct_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2) 
#     mNutProduct <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mNutProduct_",indexEspLvl_subfix[i],"_"))) %>% nth(2) 
#     if(length(mNutProduct)==0){ mNutProduct <- rep("", length(indexEspLvl_subfix)) }
#     
#     mNutProduct<- rep(mNutProduct, each = length(mImplement)/length(mNutProduct))
#     
#     nutrient_list[[i]]<- data.table::data.table(nutAmount, mNumTiming, mNumTimingValue, mTechnique,mImplement,mNutProduct)
#     
#   }
#   output <- data.table::rbindlist(nutrient_list)
#   output
#   
# }


# Get index level from given ID (provided by the statistical design prefix)
# .data: All input values from AGROFIMS sessions
# indexEspLvl: index's levels 
# design: design
# index: design-factor index. Only one value is allowed.
# indexEspLvl: character vector (one or multiple values). Statistical design abbreviation + especial level prefix provided by Shiny. Ex "frcbd_lvl_espType_2_1"
# Ex.: res<- get_nutrient_details(.data=.data, design=design, index =2, indexEspLvl = indexEspLvl)

# get_fertilizer_details_design <- function(.data, design, index, indexEspLvl){
#   
#   
#   indexEspLvl_subfix <- get_index_espLvl_design(indexEspLvl, paste0(design,"_lvl_espType_")) #"frcbd_lvl_espType_")
#   #Number of elements
#   #n <- length(get_amountype_levels(.data, index, indexEspLvl=indexEspLvl, factors="", design=design)) 
#   
#   
#   #Lookup design pattern
#   lookup <- paste0("^",design,"_")
#   dt <- .data %>% dplyr::filter(!str_detect(id, "add")) %>%
#     dplyr::filter(!str_detect(id, "button")) %>%
#     #dplyr::filter(!str_detect(id, "unit")) %>%  ##Contemplate Unit case
#     dplyr::filter(!str_detect(id, "_sel_factor_")) %>%
#     dplyr::filter(!str_detect(id, "-selectized")) %>%  
#     dplyr::filter(str_detect(id, lookup))
#   
#   factorType<- mProdAmount<- mFerTiming<- mFerTimingValue<- mFerTechnique <- mFerImplement <- NULL
#   fertilizer_list<- list()
#  
#   for(i in seq.int(indexEspLvl_subfix) ){
#     
#     factorType <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"factorType_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2)
#     
#     mProdAmount <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mFerProductAmount_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2)
#     
#     mFerTiming <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mFerTiming_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2) 
#     if(length(mFerTiming)==0){ mFerTiming <- rep("", length(indexEspLvl_subfix))}
#     
#     mFerTimingValue <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"FerTimingValue_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2)
#     if(length(mFerTimingValue)==0){mFerTimingValue <- rep("", length(factorType))}
#     
#     mFerTechnique <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mFerTechnique_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2)
#     if(length(mFerTechnique)==0){ mFerTechnique <- rep("", length(factorType))}
#     
#     mFerImplement <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mFerImplement_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2)
#     if(length(mFerImplement)==0){ mFerImplement <- rep("", length(factorType))}
#     
#     #mFerImplement
#     #TODO: GET the correct product amount according to number of rows
#     #mNutProduct <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mNutProduct_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2) 
#     #mNutProduct<- rep(mNutProduct, each = length(mImplement)/length(mNutProduct))
#     
#     fertilizer_list[[i]]<- data.table::data.table(factorType, mProdAmount, mFerTiming, mFerTimingValue, mFerTechnique, mFerImplement)
#     
#   }
#   #Juntamos las 3 listas.
#   out <- data.table::rbindlist(fertilizer_list)
#   
#  
# }



#################### MANAGEMENT PRACT Get Details for Nutrient and Fertilizers ############################################3


# Get index level from given ID (provided by the statistical design prefix)
# .data: All input values from AGROFIMS sessions
# indexEspLvl: index's levels 
# design: design
# index: design-factor index. Only one value is allowed.
# indexEspLvl: character vector (one or multiple values). Statistical design abbreviation + especial level prefix provided by Shiny. Ex "frcbd_lvl_espType_2_1"
# Ex.: res<- get_nutrient_details(.data=.data, design=design, index =2, indexEspLvl = indexEspLvl)

#' get_nutrient_details_magm <- function(.data, addId){
#'   
#'  #Lookup design pattern
#'   #lookup <- paste0("^",design,"_")
#'   
#'   #.data <- .data #.data()
#'   indexSoilMagp<- getAddInputId(addId = addId, pattern= "mgp_nut_", replacement="")
#'   #out<<-get_nutrient_details_magm(.data, indexSoilMagp= nutIndexSoilMagp)
#'   
#'   
#'   dt <- .data %>% dplyr::filter(!str_detect(id, "add")) %>%
#'                       dplyr::filter(!str_detect(id, "button")) %>%
#'                       #dplyr::filter(!str_detect(id, "unit")) %>%  ##Contemplate Unit case
#'                       dplyr::filter(!str_detect(id, "_sel_factor_")) %>%
#'                       dplyr::filter(!str_detect(id, "-selectized")) #%>%  
#'                       #dplyr::filter(str_detect(id, lookup))
#'   
#'   splitApplicationTable <- mNumTiming <- mNumTimingValue <- mTechnique <- mImplement <- mNutProduct <- NULL
#'   nutrient_list<- list()
#'   
#'   sfNutUnit <- dt %>% dplyr::filter(str_detect(id,  paste0("sfNutUnit")))  %>% nth(2)
#'   
#'   for(i in seq.int(indexSoilMagp) ){
#'     
#'     #'TODO: Obtener las tablas "sfNutrientSplit_", con los valores de cada elemento
#'     #splitApplicationTable<- 
#'     #splitApplicationTable<- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"outputNutLvlDT_",indexEspLvl_subfix[i],"_")))  %>% nth(2)
#'     
#'     mNumTiming <- dt %>% dplyr::filter(str_detect(id,  paste0("sfNutrientTiming_",indexSoilMagp[i])))  %>% nth(2)
#'     if(length(mNumTiming)==0){ mNumTiming <- rep("", length(indexSoilMagp))}
#'     
#'     mNumTimingValue <- dt %>% dplyr::filter(str_detect(id,  paste0("sfNutTimingValue_",indexSoilMagp[i])))  %>% nth(2) 
#'     if(length(mNumTimingValue)==0){ mNumTimingValue <- rep("", length(indexSoilMagp))}
#'     
#'     mTechnique <- dt %>% dplyr::filter(str_detect(id,  paste0("sfNutrientTechnique_",indexSoilMagp[i])))  %>% nth(2)
#'     if(length(mTechnique)==0){ mTechnique <- rep("", length(indexSoilMagp))}
#'     
#'     mTraction <- dt %>% dplyr::filter(str_detect(id,  paste0("sfNutrientImplement_",indexSoilMagp[i]))) %>% nth(2)
#'     if(length(mTraction)==0){ mTraction <- rep("", length(indexSoilMagp))}
#'     
#'     mNutProduct <- dt %>% dplyr::filter(str_detect(id,  paste0("sfNutrientProduct_",indexSoilMagp[i]))) %>% nth(2) 
#'     if(length(mNutProduct)==0){ mNutProduct <- rep("", length(indexSoilMagp)) }
#'     mNutProduct<- rep(mNutProduct, each = length(mTraction)/length(mNutProduct))
#'     
#'     #Table of filtered values
#'     #TODO: GET the correct product amount according to number of rows
#'     #Filter table with "mNutProduct"
#'     
#'     nutrient_list[[i]]<- data.table::data.table(mNumTiming, mNumTimingValue, mTechnique, mTraction, mNutProduct)
#'     
#'   }
#'   nut_details <- data.table::rbindlist(nutrient_list)
#'   nut_details$Unit <- sfNutUnit
#'   nut_details$Split <- indexSoilMagp
#'   
#'   elements <- try({ get_nutrient_mgmt(.data, addId, calc=FALSE) })
#'   treatment <- elements$treatments
#'   fertilizer <- elements$fertilizers
#'   
#'   out <- list( nut_details = nut_details,  treatment=treatment, fertilizer=fertilizer )
#'   
#'   
#' }



# Get index level from given ID (provided by the statistical design prefix)
# .data: All input values from AGROFIMS sessions
# indexEspLvl: index's levels 
# design: design
# index: design-factor index. Only one value is allowed.
# indexEspLvl: character vector (one or multiple values). Statistical design abbreviation + especial level prefix provided by Shiny. Ex "frcbd_lvl_espType_2_1"
# Ex.: res<- get_nutrient_details(.data=.data, design=design, index =2, indexEspLvl = indexEspLvl)

#' get_fertilizer_details_magm <- function(.data, indexSoilMagp, indexProdSplit){
#'   
#'    dt <- .data %>% dplyr::filter(!str_detect(id, "add")) %>%
#'                       dplyr::filter(!str_detect(id, "button")) %>%
#'                       #dplyr::filter(!str_detect(id, "unit")) %>%  ##Contemplate Unit case
#'                       dplyr::filter(!str_detect(id, "_sel_factor_")) %>%
#'                       dplyr::filter(!str_detect(id, "-selectized")) #%>%  
#'   
#'   mProduct<- mFerTiming<- mFerTimingValue<- mFerTechnique <- mFerImplement <- NULL
#'   sfFerUnit <- dt %>% dplyr::filter(str_detect(id,  paste0("sfProUnit")))  %>% nth(2)
#'   fertilizer_list<- list()
#'   
#'   for(i in seq.int(indexSoilMagp) ){
#'     #sfProductProduct_1
#'     mProduct <- dt %>% dplyr::filter(str_detect(id,  paste0("sfProductProduct_",indexSoilMagp[i]))) %>% nth(2)
#'     
#'     #outputDTsfProProduct_1
#'     #TODO: OBTENER LOS VALORES DE LA TABLA AL FILTAR POR "mProduct"
#'     #mProduct <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"sfProductProduct_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2)
#'     
#'     mFerTiming <- dt %>% dplyr::filter(str_detect(id,  paste0("sfProductTiming_",indexSoilMagp[i])))  %>% nth(2) 
#'     if(length(mFerTiming)==0){ mFerTiming <- rep("", length(mProduct))}
#'     
#'     mFerTimingValue <- dt %>% dplyr::filter(str_detect(id,  paste0("sfProTimingValue_",indexSoilMagp[i]))) %>% nth(2)
#'     if(length(mFerTimingValue)==0){mFerTimingValue <- rep("", length(mProduct))}
#'     
#'     mFerTechnique <- dt %>% dplyr::filter(str_detect(id,  paste0("sfProductTechnique_",indexSoilMagp[i]))) %>% nth(2)
#'     if(length(mFerTechnique)==0){ mFerTechnique <- rep("", length(mProduct))}
#'     
#'     mFerTraction <- dt %>% dplyr::filter(str_detect(id,  paste0("sfProductImplement_",indexSoilMagp[i]))) %>% nth(2)
#'     if(length(mFerTraction)==0){ mFerTraction <- rep("", length(mProduct))}
#'     
#'     #'TODO Product Amount
#'     #txtsfProductValue_1_1 txtsfProductValue_1_2 txtsfProductValue_1_3
#'     mProductAmount <- dt %>% dplyr::filter(str_detect(id,  paste0("txtsfProductValue_",indexProdSplit[i]))) %>% dplyr::arrange(desc(values)) %>% nth(2)
#'     
#'     
#'     #mFerImplement
#'     #TODO: GET the correct product amount according to number of rows
#'     #mNutProduct <- dt %>% dplyr::filter(str_detect(id,  paste0(lookup,"mNutProduct_",indexEspLvl_subfix[i],"_"))) %>% dplyr::arrange(desc(values)) %>% nth(2) 
#'     #mNutProduct<- rep(mNutProduct, each = length(mImplement)/length(mNutProduct))
#'     
#'     fertilizer_list[[i]]<- data.table::data.table(mProduct, mFerTiming, mFerTimingValue, mFerTechnique, mFerTraction)
#'     
#'   }
#'   #Juntamos las 3 listas.
#'   fert_details <- data.table::rbindlist(fertilizer_list) %>%  as.data.frame(stringsAsFactors=FALSE)
#'   
#'   fert_details$Unit <- sfFerUnit
#'   fert_details$Split <- indexSoilMagp
#'   
#'   fert_details
#'   #out <- list( fert_details = out )
#'   
#' }
AGROFIMS/ragrofims documentation built on Jan. 23, 2021, 8:40 a.m.