-
Notifications
You must be signed in to change notification settings - Fork 0
/
predict.hfr.R
65 lines (53 loc) · 1.57 KB
/
predict.hfr.R
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
56
57
58
59
60
61
62
63
64
65
#' @name predict.hfr
#' @title Model predictions
#' @description Predict values using a fitted \code{hfr} model
#'
#' @details Predictions are made by multiplying the \code{newdata} object with the estimated coefficients.
#'
#' @param object Fitted 'hfr' model.
#' @param newdata Matrix or data.frame of new values for \code{x} at which predictions are to be made.
#' @param ... additional methods passed to \code{predict}.
#' @return A vector of predicted values.
#' @author Johann Pfitzinger
#'
#' @examples
#' x = matrix(rnorm(100 * 20), 100, 20)
#' y = rnorm(100)
#' fit = hfr(x, y, kappa = 0.5)
#' predict(fit)
#'
#' @export
#'
#' @seealso \code{\link{hfr}}, \code{\link{cv.hfr}} and \code{\link{coef}} methods
#'
#' @importFrom stats coef
#' @importFrom stats fitted
predict.hfr <- function(
object,
newdata = NULL,
...
) {
if (!class(object) %in% c('hfr'))
stop("object must be of class 'hfr'")
if (is.null(newdata))
return(stats::fitted(object))
if (is.null(dim(newdata))) {
newdata <- matrix(newdata, nrow = 1)
}
if (is.null(nobs <- nrow(newdata)))
stop("'newdata' must be a matrix")
if (nobs == 0L)
stop("0 (non-NA) cases")
nvars <- ncol(newdata)
if (nvars != length(stats::coef(object)) - object$intercept)
stop("incorrect number of columns in 'newdata'")
if (any(is.na(newdata)))
stop("'NA' values in 'newdata'")
newdata <- data.matrix(newdata)
if (object$intercept) {
newdata <- cbind(1, newdata)
}
ix <- which(!is.na(stats::coef(object)))
pred <- as.numeric(newdata[, ix] %*% stats::coef(object)[ix])
return(pred)
}