swh:1:snp:3a44eb759780145deea094ac2a25c5049546a085
Tip revision: c52ce072e457ea91212cea8cbcace0daa866910b authored by Han Lin Shang on 07 October 2018, 07:10:02 UTC
version 5.1
version 5.1
Tip revision: c52ce07
fplsrPI.R
fplsrPI <- function(X, Y, Xtest, order, method = c("delta", "boota"), alpha = 0.05, B = 1000, weight, beta = 0.1,
adjust = c(FALSE, TRUE), backh = 10)
{
p = dim(Y)[1]
n = ncol(Y)
method = match.arg(method)
if (method == "delta"){
output = plsrPIs(X, Y, Xtest, ncomp1 = 1, ncomp = order, alpha, weight = weight, beta = beta)
}
else {
if (adjust == FALSE){
output = plsrPIsboot(X, Y, Xtest, ncomp = order, B, alpha, weight = weight, beta = beta)
}
if (adjust == TRUE){
q = matrix(, p, backh)
p = dim(Y)[1]
if (weight == FALSE) {
for (i in 1:backh) {
j = (n - backh - 1) + i
pred = t(Y[, 1:(j - 1)])
resp = t(Y[, 2:j])
mresp = apply(resp, 2, mean)
mod = plsr(pred, resp, Xtest = Y[, j], ncomp = order,
type = "simpls")
q[, i] = mod$Ypred[, , ]
}
}
if (weight == TRUE){
for (i in 1:backh){
j = (n - backh - 1) + i
pred = t(Y[, 1:(j - 1)])
resp = t(Y[, 2:j])
mresp = apply(resp, 2, mean)
mod = plsr(pred, resp, Xtest = Y[, j], ncomp = order,
type = "simpls", weight = TRUE, beta = beta)
q[, i] = mod$Ypred[, , ]
}
}
up = up1 = down = down1 = matrix(, p, 1)
for (i in 1:p) {
up[i, ] = quantile(q[i, ], 1 - alpha/2, na.rm = TRUE)
down[i, ] = quantile(q[i, ], alpha/2, na.rm = TRUE)
up1[i, ] = quantile(Y[i, (n - backh):n], 1 - alpha/2,
na.rm = TRUE)
down1[i, ] = quantile(Y[i, (n - backh):n], alpha/2,
na.rm = TRUE)
}
lbadj = down1/down
ubadj = up1/up
oldoutput = plsrPIsboot(X, Y, Xtest, ncomp = order, B, alpha, weight = weight, beta = beta)
lbnew = oldoutput$lb * lbadj
ubnew = oldoutput$ub * ubadj
output = list(lb = oldoutput$lb, ub = oldoutput$ub, lbadj = lbnew, ubadj = ubnew,
lbadjfactor = lbadj, ubadjfactor = ubadj)
}
}
return(output)
}