R/Class_tskrr.R

In xnet: Two-Step Kernel Ridge Regression for Network Predictions

#' Class tskrr
#'
#' The class tskrr represents a two step kernel ridge regression fitting
#' object, and is normally generated by the function \code{\link{tskrr}}.
#' This is a superclass so it should not be instantiated directly.
#'
#' @slot y the matrix with responses
#' @slot k the eigen decomposition of the kernel matrix for the rows
#' @slot lambda.k the lambda value used for k
#' @slot pred the matrix with the predictions
#' @slot has.hat a logical value indicating whether the kernel hat matrices
#' are stored in the object.
#' @slot Hk the kernel hat matrix for the rows.
#' @slot labels a list with two character vectors, \code{k} and
#' \code{g}, containing the labels for the rows resp. columns. See
#' \code{\link{tskrrHomogeneous}} and
#' \code{\link{tskrrHeterogeneous}} for more details.
#'
#' @seealso the classes \code{\link{tskrrHomogeneous}} and
#' \code{\link{tskrrHeterogeneous}} for the actual classes.
#'
#' @importFrom utils str
#'
#' @rdname tskrr-class
#' @name tskrr-class
#' @exportClass tskrr
setOldClass("eigen")

setClass("tskrr",
         slots = c(y = "matrix",
                   k = "eigen",
                   lambda.k = "numeric",
                   pred = "matrix",
                   has.hat = "logical",
                   Hk = "matrix",
                   labels = "list"),
         prototype = list(y = matrix(0),
                          k = structure(list(vectors = matrix(0),
                                             values = numeric(1)),
                                        class = "eigen"
                                        ),
                          lambda.k = 1e-4,
                          pred = matrix(0),
                          has.hat = FALSE,
                          Hk = matrix(0),
                          labels = list(k = NA_character_,
                                        g = NA_character_)))

validTskrr <- function(object){

  if(!all(is.numeric(object@y),
          is.numeric(object@pred)))
    return("y and pred should be a numeric matrix.")

  else if(length(object@lambda.k) != 1)
    return("lambda.k should be a single value.")

  else if(length(object@labels) != 2)
    return("labels should be a list with 2 elements")

  else if(any(names(object@labels) != c("k","g")))
    return("The elements in labels should be called k and g")

  else if(!all(sapply(object@labels, is.character)))
    return("The elements in labels should be character vectors")

  else
    return(TRUE)
}

setValidity("tskrr", validTskrr)
################################################
# SHOW METHOD

.show_tskrr <- function(object, homogeneous){
  dims <- paste(dim(object@y), collapse = " x ")
  cat("Dimensions:", dims,"\n")
  cat("Lambda:\n")
  print(lambda(object))

  labs <- labels(object)
  if(homogeneous)
    cat("\nLabels:")
  else
    cat("\nRow Labels:")

  str(labs$k, give.length = FALSE, give.head = FALSE,
      width = getOption("width") - 11)
  if(!homogeneous){
    cat("Col Labels:")
    str(labs$g, give.length = FALSE, give.head = FALSE,
        width = getOption("width") - 11)
  }
}

setMethod("show",
          "tskrr",
          function(object){
            ishomog <- is_homogeneous(object)
            type <- ifelse(ishomog,"Homogeneous","Heterogeneous")
            tl   <- ifelse(ishomog,"----------","------------")
            cat(paste(type,"two-step kernel ridge regression"),
                paste(tl,"--------------------------------",sep="-"),
                sep = "\n")

            .show_tskrr(object, ishomog)

          })