inst/doc/New-TestStatistics.R

In gofreg: Bootstrap-Based Goodness-of-Fit Tests for Parametric Regression

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  comment = "#>",
  fig.width = 4
)

## ----echo = FALSE, message = FALSE--------------------------------------------
library(gofreg)

## -----------------------------------------------------------------------------
MEP_Stute97 <- R6::R6Class(
  classname = "MEP_Stute97",
  inherit = TestStatistic,
  public = list(
    calc_stat = function(data, model) {
      # check for correct shape of data and definedness of model params
      checkmate::assert_data_frame(data)
      checkmate::assert_names(names(data), must.include = c("x", "y"))
      checkmate::assert_matrix(as.matrix(x), ncols = 1)
      checkmate::assert_class(model, "ParamRegrModel")
      params <- model$get_params()
      if (anyNA(params)) {
        stop("Model first needs to be fitted to the data.")
      }
      
      # compute residuals and order them according to X
      res <- data$y - model$mean_yx(data$x)
      ord.id <- order(c(data$x))
      res.ord <- res[ord.id]
      
      # compute MEP (cumulative sum of the ordered residuals)
      proc <- cumsum(res.ord) / sqrt(n)

      # set private fields accordingly
      private$value <- max(abs(proc))
      private$plot.x <- c(data$x)[ord.id]
      private$plot.y <- proc
      invisible(self)
    }
  )
)

## -----------------------------------------------------------------------------
set.seed(123)
n  <- 100
x <- rnorm(n)
model <- NormalGLM$new()
params_true <- list(beta = 3, sd = 0.5)
y <- model$sample_yx(x^2, params_true)
data <- dplyr::tibble(x = x, y = y)
head(data)

## -----------------------------------------------------------------------------
model$fit(data, params_init = list(beta = 1, sd = 5), inplace = TRUE)
model$get_params()
gt <- GOFTest$new(data = data, model_fitted = model, test_stat = MEP_Stute97$new(), nboot = 100)
gt$get_pvalue()

## -----------------------------------------------------------------------------
gt$plot_procs()

## -----------------------------------------------------------------------------
data_x2 <- dplyr::tibble(x = data$x^2, y = data$y)
model$fit(data_x2, params_init = list(beta = 1, sd = 5), inplace = TRUE)
model$get_params()
gt <- GOFTest$new(data = data_x2, model_fitted = model, test_stat = MEP_Stute97$new(), nboot = 100)
gt$get_pvalue()

## -----------------------------------------------------------------------------
gt$plot_procs()