#' Predict method for kernelFactory objects
#'
#' Prediction of new data using kernelFactory.
#'
#' @param object An object of class \code{kernelFactory}, as created by the function \code{kernelFactory}
#' @param newdata A data frame with the same predictors as in the training data.
#' @param predict.all TRUE or FALSE. If TRUE and rp and cp are 1 then the individual predictions of the random forest are returned. If TRUE and any of rp and cp or bigger than 1 then the predictions of all the members are returned.
#' @param ... Not used currently.
#'
#' @examples
#' #Credit Approval data available at UCI Machine Learning Repository
#' data(Credit)
#' #take subset (for the purpose of a quick example) and train and test
#' Credit <- Credit[1:100,]
#' train.ind <- sample(nrow(Credit),round(0.5*nrow(Credit)))
#'
#' #Train Kernel Factory on training data
#' kFmodel <- kernelFactory(x=Credit[train.ind,names(Credit)!= "Response"],
#' y=Credit[train.ind,"Response"], method=random)
#'
#' #Deploy Kernel Factory to predict response for test data
#' predictedresponse <- predict(kFmodel, newdata=Credit[-train.ind,names(Credit)!= "Response"])
#' @references Ballings, M. and Van den Poel, D. (2013), Kernel Factory: An Ensemble of Kernel Machines. Expert Systems With Applications, 40(8), 2904-2913.
#' @seealso \code{\link{kernelFactory}}
#' @return A vector containing the response probabilities.
#' @author Authors: Michel Ballings and Dirk Van den Poel, Maintainer: \email{Michel.Ballings@@GMail.com}
#' @method predict kernelFactory
#' @keywords classification
predict.kernelFactory <-
function(object,
newdata=NULL, predict.all=FALSE, ... )
{
newdata <- newdata[,!object$constants]
#ERROR HANDLING
if (!inherits(object, "kernelFactory")) stop("object not of class kernelFactory")
if (is.null(object)) stop("You must provide the name of the model through object.")
if (is.null(newdata)) {
stop("Data cannot be NULL.")
}else if (any(is.na(newdata))){
stop("NAs not permitted.")
}
if(all(colnames(object$trn[,names(object$trn)!= "Y"]) %in% colnames(newdata))==FALSE ) stop("Column names have to be equal in data and new data.")
#STEP1 ### SCALING
numericcolumns <- newdata[,object$nmDtrn]
numericcolumns <- data.frame(base::scale(numericcolumns,center=FALSE,scale=object$rngs))
#add factor variables
facID <- sapply(newdata,is.factor)
if (sum(facID) >= 1){
newdata <- data.frame(numericcolumns,newdata[,facID])
# in case there is only 1 factor: set colnames
colnames(newdata) <- c(colnames(numericcolumns),names(facID)[facID])
} else {
newdata <- data.frame(numericcolumns)
}
rm(numericcolumns)
## ORDER VARIABLES ACCORDING TO TRAINING SET
newdata <- newdata[,colnames(object$trn[,names(object$trn)!= "Y"])]
#STEP3 ### CREATE PARTITIONS
testlist <- list()
colparts <- object$cpr
rowparts <- object$rpr
startcol <- 1
counter <- 0
#HANDLE UNEVEN NUMBER OF VARIABLES
if (ncol(newdata)%%colparts > 0) {
numbercols <- ncol(newdata)-(ncol(newdata)%%colparts )
} else {
numbercols <- ncol(newdata)
}
for (i in 1:colparts ){
endcol <-(i/colparts )*numbercols
if (i==colparts ) endcol <- ncol(newdata)
startrow <- 1
for (j in 1:rowparts) {
counter = counter + 1
testlist[[counter]] <- newdata[,c(startcol:endcol)]
}
startcol <- endcol + 1
}
#STEP4 ### SCORING
#STEP 5.1 PREPARING
predicted <- list()
resultsKIRFScored <- list()
for (i in 1:object$cntr) {
if (is.null(testlist[[i]][,sapply(testlist[[i]],is.numeric)]) == FALSE) {
#Extract split variables for all trees: these are observation numbers from the trainingdata: split observations
trainobs <- object$trnlst[[i]][,sapply(object$trnlst[[i]],is.numeric)]
#compute dot product per split observation from training data with all validation observations: This results in 1 column per split observation
resultsKIRFScored[[i]] <- data.frame(data.frame(kernelMatrix(object$rbfstre[[i]], as.matrix(testlist[[i]][,sapply(testlist[[i]],is.numeric)]),as.matrix(trainobs))),
data.frame(testlist[[i]]))
colnames(resultsKIRFScored[[i]]) <- colnames(object$rbfmtrX[[i]])
#STEP 5.2 ACTUAL PREDICTION
if (predict.all && object$cpr==1 && object$rpr==1 ) { # predict.all
predicted[[i]] <- data.frame(sapply(data.frame(predict(object$rsltsKF[[i]],
resultsKIRFScored[[i]],type="prob",
predict.all=TRUE)$individual,
stringsAsFactors=FALSE),
as.integer,
simplify=FALSE)
)
} else { #combined prediction
predicted[[i]] <- predict(object$rsltsKF[[i]],resultsKIRFScored[[i]],type="prob")[,2]
}
} else {
if (predict.all && object$cpr==1 && object$rpr==1 ) { #predict.all
predicted[[i]] <- data.frame(sapply(data.frame(predict(object$rsltsKF[[i]],
testlist[[i]],type="prob",
predict.all=TRUE)$individual,
stringsAsFactors=FALSE),
as.integer,
simplify=FALSE)
)
} else { #combined prediction
predicted[[i]] <- predict(object$rsltsKF[[i]],testlist[[i]],type="prob")[,2]
}
}
}
if (predict.all && object$cpr==1 && object$rpr==1 ) {
return(predicted[[1]])
} else {
#STEP 5.3 COLLECTING PREDICTIONS
final <- data.frame(matrix(nrow=nrow(newdata),ncol=(object$cntr)))
for (i in 1:object$cntr) {
final[,i] <- predicted[[i]]
}
#STEP 5.4 APPLYING WEIGHTS
res <- t(as.numeric(object$wghts) * t(final))
if (predict.all) {
return(data.frame(final))
} else {
return(rowSums(res))
}
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.