R/experimental_design.R

Defines functions get_fertilizer_details_magm get_nutrient_details_magm get_fertilizer_details_design get_nutrient_details_design filter_index_espLvl_design get_index_espLvl_design get_index_design experimental_design_label get_amountype_levels get_timing_levels get_nonfactorial_levels get_levels_design get_factors_design fbdesign_agrofims

Documented in get_fertilizer_details_magm get_nutrient_details_magm

# 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

fbdesign_agrofims <- 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 factors from design tab ############################################################
get_factors_design <- function(allinputs, index=NULL, design="fcrd",duplicate= TRUE){
  
  
  #Look up patterns for factors
  lookup <- paste0("^", design,"_sel_factor_")
  
  #Filter information to find out factors
  dt <- allinputs %>%  filter(!str_detect(id, "button")) %>%
                        filter(!str_detect(id, "-selectized")) %>%
                        filter(!str_detect(id, "other")) %>%
                        filter(str_detect(id, lookup))
  if(!is.null(index)){
    #Arrange by order
    dt <- arrange_by_pattern(dt, pattern = index)
  }
  
  
  #Other factor 
  out<- dt$values
  
  #Replace other factor by the ones that users type in
  for(i in 1:length(out)){
    if(out[i]=="Other"){
      of <- allinputs %>%  filter(str_detect(id, paste0(lookup,"other_",index[i])))
      out[i]<- of$values
    }
  }
  
  if(duplicate){
    out<- paste0(out,"_f", 1:length(out))
    out <- stringr::str_replace_all(out,pattern = "[[:space:]]",replacement = " ")
  }
  
  out
}


## Get levels from desigin tab
# allinputs: 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(allinputs, 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 <- allinputs %>%   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(allinputs, 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(allinputs, 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(allinputs, 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(allinputs %>% dplyr::filter(str_detect(id, paste0(lookup,"unit_", index[i],"$" ))))>=1 ){
                    
                    u<- allinputs %>% 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<- allinputs %>% 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(allinputs %>% dplyr::filter(str_detect(id,  paste0("^",design,"factor","_crop_input",index[i],"$"))) )>=1)
                  {
                    print("crop in design")
                    crop <- allinputs %>% 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 <- allinputs %>% 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(allinputs %>% dplyr::filter(str_detect(id, paste0(lookup,"unit_", index[i] ))))>=1 ){
                    
                    u<- allinputs %>% 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(allinputs, 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 <- allinputs %>%   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 <- allinputs %>% 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 <- allinputs %>%  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
# allinputs: 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(allinputs, 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 <- allinputs %>% 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 <- allinputs %>% 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<- allinputs %>% 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)
# allinputs: 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(allinputs=allinputs, design=design, index =2, indexEspLvl = indexEspLvl)

get_nutrient_details_design <- function(allinputs, 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(allinputs, index, indexEspLvl=indexEspLvl, factors="", design=design)) 
  
  
  #Lookup design pattern
  lookup <- paste0("^",design,"_")
  dt <- allinputs %>% 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)
# allinputs: 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(allinputs=allinputs, design=design, index =2, indexEspLvl = indexEspLvl)

get_fertilizer_details_design <- function(allinputs, 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(allinputs, index, indexEspLvl=indexEspLvl, factors="", design=design)) 
  
  
  #Lookup design pattern
  lookup <- paste0("^",design,"_")
  dt <- allinputs %>% 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)
# allinputs: 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(allinputs=allinputs, design=design, index =2, indexEspLvl = indexEspLvl)

get_nutrient_details_magm <- function(allinputs, addId){
  
 #Lookup design pattern
  #lookup <- paste0("^",design,"_")
  
  #allinputs <- allinputs #AllInputs()
  indexSoilMagp<- getAddInputId(addId = addId, pattern= "mgp_nut_", replacement="")
  #out<<-get_nutrient_details_magm(allinputs, indexSoilMagp= nutIndexSoilMagp)
  
  
  dt <- allinputs %>% 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(allinputs, 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)
# allinputs: 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(allinputs=allinputs, design=design, index =2, indexEspLvl = indexEspLvl)

get_fertilizer_details_magm <- function(allinputs, indexSoilMagp, indexProdSplit){
  
   dt <- allinputs %>% 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/agdesign documentation built on June 11, 2020, 12:02 p.m.