# R/Class_permtest.R In xnet: Two-Step Kernel Ridge Regression for Network Predictions

#### Documented in print.permtest

```#' Class permtest
#'
#'
#' @slot orig_loss a numeric value with the original loss of
#' the model.
#' @slot perm_losses a numeric vector with the losses of the
#' different permutations.
#' @slot n the number of permutations
#' @slot loss_function the function used to calculate the losses.
#' @slot exclusion a character value indicating the exclusion
#' setting used for the test
#' @slot replaceby0 a locigal value that indicates whether the
#' @slot permutation a character value that indicats in which
#' kernel matrices were permuted.
#' @slot pval a p value indicating how likely it is to find a
#' smaller loss than the one of the model based on a normal
#' approximation.
#' @slot exact a logical value indicating whether the P value was
#' calculated exactly or approximated by the normal distribution.
#'
#' @seealso
#'  * the function \code{\link{permtest}} for the actual test.
#'  * the function \code{\link{loo}} for the leave one out
#'  procedures
#'  * the function \code{\link{t.test}} for the actual test
#' @md
#'
#' @include all_generics.R
#'
#' @rdname permtest-class
#' @name permtest-class
#' @exportClass permtest
setClass("permtest",
slots = c(orig_loss = "numeric",
perm_losses = "numeric",
n = "numeric",
loss_function = "function",
exclusion = "character",
replaceby0 = "logical",
permutation = "character",
pval = "numeric",
exact = "logical"))

# Validity testing
validPermtest <- function(object){
if(length(object@orig_loss) != 1)
return("orig_loss should be a single value.")
if(length(object@pval) != 1)
return("pval should be a single value.")
if(length(object@perm_losses) != object@n)
return("perm_losses doesn't have a length of n.")
if(length(object@exact)!= 1)
return("exact should be a single value.")

}

setValidity("permtest", validPermtest)

# internal

.make_res_table <- function(perm_losses, orig_loss, pval){
avg <- mean(perm_losses)
sd <- sd(perm_losses)
# results
res <- matrix(
c(orig_loss, avg, sd, pval),
nrow = 1,
dimnames = list(
" ",
c("Loss", "Avg. loss", "St.dev", "Pr(X < loss)")
)
)
}

# Show method
#' @param digits the number of digits shown in the output
#' @rdname permtest
#' @export
print.permtest <- function(x,
digits = max(3L, getOption("digits") - 3),
...){

if(identical(x@loss_function, loss_mse))
loss_name <- "Mean Squared Error (loss_mse)"
else if(identical(x@loss_function, loss_auc))
loss_name <- "Area under curve (loss_auc)"
else
loss_name <- "custom function by user"

excl <- x@exclusion
if(x@replaceby0) excl <- paste(excl,"(values replaced by 0)")

loss_name <- paste("  Loss function:",loss_name,"\n")
excl <- paste("  Exclusion:", excl, "\n")
perm <- paste0("  Permutations: ", x@n," (direction: ",x@permutation,")\n")

res <- .make_res_table(x@perm_losses,
x@orig_loss,
x@pval)

cat("\n")
cat(strwrap("Permutation test for a tskrr model", prefix = "\t"))
cat("\n")
cat("Using:\n")
cat(loss_name)
cat(excl)
cat(perm)
cat("\n")
printCoefmat(res, digits = digits)
cat("\n")
if(!x@exact)
cat("P value is approximated based on a normal distribution.\n\n")
invisible(res)

}

setMethod("show",
"permtest",
function(object){
print.permtest(object)
})
```

## Try the xnet package in your browser

Any scripts or data that you put into this service are public.

xnet documentation built on Feb. 4, 2020, 9:10 a.m.