R/trans_pmml.R

In hongqi0314/PRAuto.PMML: User defined functions to output a PMML file that is to be implemented in S1

#' Return entire 'LocalTransformation' element in a PMML file
#'
#' Generate 'LocalTransformation' element in a PMML file by calling 'normCon_xml()'
#' and 'normDis_pmml()' respectively.
#'
#' @param featureNames String of characters indicating the variable that is
#'                     to be transformed.
#' @param transTypes String of characters indicating type of transformation,
#'                   "continuous" or "discrete".
#' @param transPurposes String of characters indicating purpose of the transformation.
#' @param transParams1 Parameters pass to 'normCon_pmml' and 'normDis_pmml'.
#' @param transParams2 Parameters pass to 'normCon_pmml'
#' @param newFieldNames String of characters indicating origin of transformed features.
#'
#' @return PMML element 'LocalTransformation'.
#' @export
#'
#' @examples
trans_pmml <- function(featureNames, transTypes, transPurposes, transParams1,
                       transParams2, newFieldNames = featureNames) {
  ## define root element 'LocalTransformation'
  topTrans <- newXMLNode("LocalTransformations", parent = pmmlRegMod)
  ## divide features into two categories, "continuous" and "discrete" based on 'transTypes'
  ## and then call 'normXML' and 'indicatorXML' respectively
  isTransCont <- ifelse(transTypes == "continuous", TRUE, FALSE)
  argsCont <- list( featureNames[isTransCont], transParams1[isTransCont],
                    transParams2[isTransCont], newFieldNames[isTransCont],
                    transPurposes[isTransCont])
  names(argsCont) <- c("featureName", "featureRange", "innerKnots", "newFieldName", "purpose")
  topCont <- argsCont %>%
    purrr::pmap(normCon_pmml)
  addChildren(node = topTrans, kids = purrr::map(topCont, xmlChildren))

  argsDisc <- list( featureNames[!isTransCont], transParams1[!isTransCont],
                    newFieldNames[!isTransCont], transPurposes[!isTransCont] )
  names(argsDisc) <- c("featureName", "featureLevel", "newFieldName", "purpose")
  topDisc <- argsDisc %>%
    purrr::pmap(normDis_pmml)
  addChildren(node = topTrans, kids = purrr::map(topDisc, xmlChildren))

  # return(topTrans)
}