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
|
### mvr_wrappers.R: plsr, pls and pcr wrappers for mvr
#' @rdname mvr
#' @export
plsr <- function(..., method = pls.options()$plsralg) {
cl <- match.call()
cl$method <- match.arg(method, c("kernelpls", "widekernelpls", "simpls",
"oscorespls", "model.frame"))
cl[[1]] <- quote(pls::mvr)
res <- eval(cl, parent.frame())
## Fix call component
if (cl$method != "model.frame") res$call[[1]] <- as.name("plsr")
if (missing(method)) res$call$method <- NULL
res
}
#' @rdname mvr
#' @export
pcr <- function(..., method = pls.options()$pcralg) {
cl <- match.call()
cl$method <- match.arg(method, c("svdpc", "model.frame"))
cl[[1]] <- quote(pls::mvr)
res <- eval(cl, parent.frame())
## Fix call component
if (cl$method != "model.frame") res$call[[1]] <- as.name("pcr")
if (missing(method)) res$call$method <- NULL
res
}
#' @rdname mvr
#' @export
cppls <- function(..., Y.add, weights, method = pls.options()$cpplsalg) {
cl <- match.call()
cl$method <- match.arg(method, c("cppls", "model.frame"))
cl[[1]] <- quote(pls::mvr)
res <- eval(cl, parent.frame())
## Fix call component
if (cl$method != "model.frame") res$call[[1]] <- as.name("cppls")
if (missing(method)) res$call$method <- NULL
res
}
|
