R/sel_resist.R

In PROSPER: Simulation of Weed Population Dynamics

#' @title Calculating resistance values
#' @seealso \code{\link{sel_herb}} \code{\link{intern_herbicide}}
#' @description Calculates the phenotypic resistance value (Renton et al. 2011) for each genotype in \code{dfgenotype}.
#' @export

#' @template epis
#' @template dom
#' @template Rmx


#' @details This function is used in \code{struc_preparation2} to calculate the resistance value using the following term:
#' \deqn{  1 + (Rmx - 1) * (sum(dom)/n\_loci)^{2^{epis}}). }
#' Resistance values range from 1 to Rmx. The higher the resistance value is, the less the plant is susceptible to the herbicide.
#' \code{sel_resist} is only used by \code{\link{struc_preparation2}}.

#' @return \code{numeric vector} with resistance values

#' @references Renton, M.; Diggle, A.; Manalil, S. & Powles, S. (2011): Does cutting herbicide rates threaten the sustainability of weed management in cropping systems? Journal of Theoretical Biology, 283, 14-27.

#' @examples 
#' #dfgenotype is usually generated by the function 'struc_preparation2'.
#' #Here, a simple example is done by hand.

#' var1 <- c("00","01","02","10","11","12","20","21","21")
#' var2 <- c(0,0,0,1,1,1,2,2,2)
#' var3 <- c(0,1,2,0,1,2,0,1,2)
#' dfgenotype <- data.frame(genotype=var1,l1=var2,l2=var3, stringsAsFactors = TRUE)
#' sel_resist(Rmx=10, epis=0, dom=1)


sel_resist <-
function(Rmx, epis, dom){    

dfgenotype <- get0("dfgenotype", envir = parent.frame(n = 1))
#n_loci <- nchar(as.character(dfgenotype[,1][1]))
n_loci <- length(dom)
locus_value <- data.frame(matrix(ncol=n_loci,as.numeric(unlist(strsplit(as.character(dfgenotype[,1]), split=NULL))),byrow=TRUE), stringsAsFactors = TRUE)
#if(length(dom)!=n_loci) dom <- c(rep(dom,n_loci)[seq(len=n_loci)])


for (i in seq(len=n_loci)){
  locus_value[i][locus_value[i]==1] <- dom[i]
  locus_value[i][locus_value[i]==2] <- 1
}#END for(i)



dominance_sum  <- rowSums(locus_value)

resist <- 1 + (Rmx - 1) * (dominance_sum/n_loci)^2^epis
return(resist)
}