1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
#' @export
predict.PLS <- function(object, newdata,
ncomp = NULL,
type = ifelse(object$isRegression, "response", "class"), ...)
{
if(is.null(ncomp) & !is.null(object$bestIter$.ncomp)) ncomp <- object$bestIter$.ncomp
if(is.null(ncomp)) stop("the number of components must be given")
# adapted from the pls package
if(object$isRegression & c(type %in% c("class", "prob")))
stop("cannot get a class estimate if the original y was not a factor")
if(!(type %in% c("response", "class", "prob")))
stop("type must be either response, class or prob")
if(missing(newdata)) newdata <- object$x
if(!is.matrix(newdata)) newdata <- as.matrix(newdata)
# from coef.mvr in pls package
B <- object$coefficients[, , 1:ncomp, drop = FALSE]
dB <- dim(B)
dB[1] <- dB[1] + 1
dnB <- dimnames(B)
dnB[[1]] <- c("(Intercept)", dnB[[1]])
BInt <- array(dim = dB, dimnames = dnB)
BInt[-1, , ] <- B
for (i in seq(along.with = 1:ncomp)) BInt[1, , i] <- object$Ymeans - object$Xmeans %*% B[, , i]
B <- BInt
# stop
# from predict.mvr in pls package
dPred <- dim(B)
dPred[1] <- dim(newdata)[1]
dnPred <- dimnames(B)
dnPred[1] <- dimnames(newdata)[1]
pred <- array(dim = dPred, dimnames = dnPred)
predY <- sweep(newdata %*% B[-1, , ncomp], 2, B[1, , ncomp], "+")
# stop
out <- switch(
type,
response = predY,
class =
{
classNum <- apply(predY, 1, which.max)
factor(object$yLevels[classNum], levels = object$yLevels)
},
# use softmax technique here
prob = t(apply(predY, 1, function(data) exp(data)/sum(exp(data)))))
out
}
|
