R/CCPred_Class.R

In dominikkirchhoff/CCKriging: Kriging for Mixed Continuous and Categorical Input Variables

#' @title Make Object of Class \code{CCPred}
#'
#' @description A \code{CCPred} object contains one or more predictions of a
#'   \code{\link[=makeCCKriging]{CCKriging}} model for one or more new data points \code{x0}
#'   as well as the estimated uncertainties of the predictions.
#'
#' @param mean [\code{numeric}]\cr
#'   Predictions at new points \code{x0}.
#' @param sd [\code{numeric}]\cr
#'   Estimated uncertainties of the predictions.
#' @param x0 [\code{data.frame}]\cr
#'   The new data points.
#' @param model [\code{CCKriging}]\cr
#'   The \code{\link[=makeCCKriging]{CCKriging}} model the predictions were made with.
#'
#' @return [\code{CCPred}]
#' @export
makeCCPred = function(mean, sd, x0, model) {
  checkmate::assertNumeric(mean, any.missing = FALSE)
  checkmate::assertNumeric(sd, any.missing = FALSE)
  checkmate::assertDataFrame(x0)
  checkmate::assertClass(model, "CCKriging")
  checkmate::assertSetEqual(colnames(x0), colnames(model$x))
  if (is.null(model$par))
    stop("model$par must not be NULL.")
  if (length(mean) != length(sd) || length(mean) != nrow(x0))
    stop("Lengths of mean and sd must be equal to nrow(x0).")

  ## generate S3 object
  cc.pred = list(
    mean = mean,
    sd = sd,
    x0 = x0,
    model = model
  )
  class(cc.pred) = "CCPred"
  return(cc.pred)
}

#' @export
print.CCPred = function(x, ...) {
  x0 = x$x0
  if (nrow(x0) == 1) {
    rownames(x0) = "x0 =  "
    cat( 'New data point:\n')
    print(x0)
    BBmisc::catf('\n--- CCKriging Prediction ---')
    BBmisc::catf('  PREDICTION  :: %g', x$mean)
    BBmisc::catf('  UNCERTAINTY :: %g', x$sd)
  } else {
    BBmisc::catf('\n--- CCKriging Prediction ---\n')
    print(cbind(x0, data.frame(mean = x$mean, sd = x$sd)))
  }
  # r0 = as.data.frame(t(x$r0))
  # colnames(r0) = format(1:nrow(x$model$x))
  # rownames(r0) = "r0 =  "
}

#' @export
summary.CCPred = function(object, ...) {
  x = object
  cat.string = switch(x$model$cat.type,
    "EC"  = "EC  - Exchangeable Correlation",
    "MC"  = "MC  - Multiplicative Correlation",
    "UC"  = "UC  - Hypersphere-based Unrestrictive Correlation",
    "GK"  = "GK  - Gower Kriging",
    "CD"  = "CD  - Categorical Distances",
    "TMC" = "TMC - Toeplitz Matrix Multiplication-based Correlation",
    "GMC" = "GMC - General Matrix Multiplication-based Correlation")
  x0 = x$x0
  if (nrow(x0) == 1) {
    rownames(x0) = "x0 =  "
    cat( 'New data point:\n')
    print(x0)
    BBmisc::catf('\n--- CCKriging Prediction ---')
    BBmisc::catf('  PREDICTION  :: %g', x$mean)
    BBmisc::catf('  UNCERTAINTY :: %g', x$sd)
  } else {
    BBmisc::catf('\n--- CCKriging Prediction ---\n')
    print(cbind(x0, data.frame(pred = x$mean, s.square = x$sd)))
  }

  # r0 = as.data.frame(t(x$r0))
  # colnames(r0) = format(1:nrow(x$model$x))
  # rownames(r0) = "r0 =  "

  # cat( '\nCorrelation with design matrix:\n')
  # print(r0)

  cat( '\n--- CCKriging Model ---\n')
  BBmisc::catf('  CATEGORICAL :: %s', cat.string)
  BBmisc::catf('  CONTINUOUS  :: %s', x$model$cont.type)
}