# S3 methods for GauPro_kernel_model, which has class GauPro
# plot, print, and format are automatically dispatched, all others must be added
#' Predict for class GauPro
#'
#' @param object Object of class GauPro
#' @param XX new points to predict
#' @param se.fit Should standard error be returned (and variance)?
#' @param covmat Should the covariance matrix be returned?
#' @param split_speed Should the calculation be split up to speed it up?
#' @param ... Additional parameters
#'
#' @return Prediction from object at XX
#' @export
#'
#' @examples
#' n <- 12
#' x <- matrix(seq(0,1,length.out = n), ncol=1)
#' y <- sin(2*pi*x) + rnorm(n,0,1e-1)
#' gp <- GauPro(X=x, Z=y, parallel=FALSE)
#' predict(gp, .448)
predict.GauPro <- function(object, XX, se.fit=F, covmat=F, split_speed=T, ...) {
object$predict(XX=XX, se.fit=se.fit, covmat=covmat, split_speed=split_speed)
}
#' Summary for GauPro object
#'
#' @param object GauPro R6 object
#' @param ... Additional arguments passed to summary
#'
#' @return Summary
#' @export
summary.GauPro <- function(object, ...) {
object$summary(...)
}
#' Print summary.GauPro
#'
#' @param x summary.GauPro object
#' @param ... Additional args
#' @importFrom stats binom.test
#'
#' @return prints, returns invisible object
#' @export
print.summary.GauPro <- function(x, ...) {
# Formula
cat("Formula:\n")
cat("\t", x$formula, "\n\n")
# Residuals
cat("Residuals:\n")
print(summary(x$residualsLOO))
# Importance
cat("\nFeature importance:\n")
print(x$importance)
# AIC
cat("\nAIC:", x$AIC, "\n")
# R-squared, Adj R-squared
cat("\nPseudo leave-one-out R-squared :")
cat(" ", x$r.squaredLOO, "\n")
cat("Pseudo leave-one-out R-squared (adj.):")
cat(" ", x$r.squared.adjLOO, "\n")
# Coverage
pval68 <- signif(binom.test(x$coverage68LOO*x$N, x$N, .68)$p.value, 4)
pval95 <- signif(binom.test(x$coverage95LOO*x$N, x$N, .95)$p.value, 4)
cat("\nLeave-one-out coverage on", x$N,
"samples (small p-value implies bad fit):\n")
coverage68LOO <- signif(x$coverage68LOO, 4)
coverage95LOO <- signif(x$coverage95LOO, 4)
pvalchar <- 2 + max(nchar(format(coverage68LOO)),
nchar(format(coverage95LOO)))
cat("\t68%: ", format(coverage68LOO, width=pvalchar),
" p-value: ", pval68, "\n")
cat("\t95%: ", format(coverage95LOO, width=pvalchar),
" p-value: ", pval95, "\n")
# Return invisible self
invisible(x)
}
#' Kernel sum
#'
#' @param k1 First kernel
#' @param k2 Second kernel
#'
#' @return Kernel which is sum of two kernels
#' @export
#'
#' @examples
#' k1 <- Exponential$new(beta=1)
#' k2 <- Matern32$new(beta=0)
#' k <- k1 + k2
#' k$k(matrix(c(2,1), ncol=1))
'+.GauPro_kernel' <- function(k1, k2) {
if (is.numeric(k1) && k1==0) {
return(k2)
}
if (is.numeric(k2) && k2==0) {
return(k1)
}
if (!("GauPro_kernel" %in% class(k1))) {
stop("Can only add GauPro kernels with other kernels")
}
if (!("GauPro_kernel" %in% class(k2))) {
stop("Can only add GauPro kernels with other kernels")
}
kernel_sum$new(k1=k1, k2=k2)
}
#' Kernel product
#'
#' @param k1 First kernel
#' @param k2 Second kernel
#'
#' @return Kernel which is product of two kernels
#' @export
#'
#' @examples
#' k1 <- Exponential$new(beta=1)
#' k2 <- Matern32$new(beta=0)
#' k <- k1 * k2
#' k$k(matrix(c(2,1), ncol=1))
'*.GauPro_kernel' <- function(k1, k2) {
if (is.numeric(k1) && k1==1) {
return(k2)
}
if (is.numeric(k2) && k2==1) {
return(k1)
}
if (!("GauPro_kernel" %in% class(k1))) {
stop("Can only multiply GauPro kernels with other kernels")
}
if (!("GauPro_kernel" %in% class(k2))) {
stop("Can only multiply GauPro kernels with other kernels")
}
kernel_product$new(k1=k1, k2=k2)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.