R/PLTblder.R

Defines functions SVRModel

Documented in SVRModel

#' Build support vector regression result
#'
#' @description Return a table with continuous values for eta and xi, based on prediction built by support vector
#' regression model (SVR). The kernel function in SVR is radial basis.
#' @param x The calculation result returned from the function \code{\link[TPMplt:DMMprocess]{DMMprocess}}.
#' @param seqby A numeric value to specify the grid density. Default value is 80, namely the default mesh for
#' original plot uses 80*80.
#'
#' @import e1071
#' @return A data frame including continuous values for eta and xi, calculated based on the discrete values for
#' eta and xi returned from \code{\link[TPMplt:DMMprocess]{DMMprocess}}. The strain condition in current calculation
#' is also included.
#' @export SVRModel
#' @seealso \code{\link[TPMplt:DMMprocess]{DMMprocess}}
#'
#' @examples
#' epstable <- epsExtract(TPMdata, 0.7, 2, 3)
#' DMM <- DMMprocess(epstable)
#' PLTbd <- SVRModel(DMM)
#' PLTbd
#' @keywords PLTbuilder SVRModel
SVRModel <- function(x, seqby=80){
  # input data check
  if(class(x)!="DMMresult"){
    stop("the input data should be TPMdata generated by SRTprocess() function.", call. = FALSE)
  }

  etaM <- etatidy(x)
  xiM <- xitidy(x)

  predictor <- MakeGrid(x, seqby = seqby)
  len <- length(predictor[,1])
  len1 <- length(etaM[,1])

  etatable <- matrix(NA, nrow = len1, ncol = 4)
  xitable <- etatable
  etatable <- as.data.frame(etaM[,1:2])
  xitable <- as.data.frame(xiM[,1:2])

  vartable <- as.data.frame(predictor[,-3])
  etavalue <- as.vector(etaM[,3])
  xivalue <- as.vector(xiM[,3])

  modeleta <- svm(etatable, etavalue, kernel = "radial", type = "eps")
  modelxi <- svm(xitable, xivalue, kernel = "radial", type = "eps")

  predeta <- as.vector(predict(modeleta, vartable))
  maxeta <- max(predeta)
  mineta <- min(predeta)

  #Modification for the values of eta
  highscale <- rep(c(1,maxeta),2)
  lowscale <- rep(c(0,mineta), each=2)
  trun_scale <- min(highscale - lowscale)

  if (trun_scale == 1 | maxeta <= 0 | mineta >= 1) {
    predeta <- (predeta - mineta)/(maxeta - mineta)
  } else if (maxeta < 1 & mineta > 0) {
    predeta <- predeta
  } else if (maxeta >= 1 & mineta < 1 ) {
    predeta <- ((predeta - mineta)/(maxeta - mineta))*trun_scale + mineta
  } else if (maxeta > 0 & mineta <= 0) {
    predeta <- ((predeta - mineta)/(maxeta - mineta))*trun_scale
  }

  predxi <- as.vector(predict(modelxi, vartable))

  etaresult <- cbind(vartable, rep("eta", len), predeta)
  xiresult <- cbind(vartable, rep("xi", len), predxi)

  colname <- c("T", "lgSR", "group", "value")
  colnames(etaresult) <- colname
  colnames(xiresult) <- colname

  pltresult <- rbind(etaresult, xiresult)
  result <- list(data=pltresult, SR=x$MaterialCoefficients$epsilon.strain)
  class(result) <- c("PLTbuilder", class(result))
  return(result)
}

Try the TPMplt package in your browser

Any scripts or data that you put into this service are public.

TPMplt documentation built on Oct. 2, 2019, 1:03 a.m.