Project: s41467-024-52548-3 | Function: goodness_of_fit (r)

system: You are an expert R programmer implementing algorithms from scientific papers.
Complete the masked function based on the algorithm description.
Follow R best practices and maintain consistent code style.
Return **only** the complete R function code.

user: Complete this R function:

**DESCRIPTION:** Performs goodness-of-fit testing using bootstrap-based bias correction and p-value calculation for model validation. Implements custom statistical testing procedure.

**KEY TERMS:** {
  "slopes_level1": "first-level bootstrap slopes",
  "slopes_level2": "second-level bootstrap slopes",
  "pv_gof": "goodness-of-fit p-value"
}

**CONTEXT CODE:** #' This functions perform the goodness of fit test on the data created by the functions
#' [`simulate_slopes_for_GOF`] or [`combine_simulated_slopes`]. The justification and formal
#' description of the test are given in the Appendix S1 of our Supplementary Material.
#'
#' @param slopes_obj an object returned by [`simulate_slopes_for_GOF`] or [`combine_simulated_slopes`]
#'
#' @return a tibble with the information about the scenario and the computed p-values
#' @export
#' @seealso [`simulate_slopes_for_GOF`], [`combine_simulated_slopes`]
#' @examples
#' # See ?twinR
#'
#' Perform the goodness of fit test of simulation scenario(s)
#'
#' This function performs the goodness-of-fit test on data created by 
#' `simulate_slopes_for_GOF` or `combine_simulated_slopes`. The procedure 
#' involves computing the Pearson correlation between first-level and second-level 
#' bootstrap slopes and comparing it to a distribution obtained through permutation.
#'
#' @param slopes_obj An object containing the slopes from two levels of bootstrapping.
#' @return A tibble with the scenario information and computed p-values.
#' @export
#' @seealso `simulate_slopes_for_gof`, `combine_simulated_slopes`

compute_pv <- function(x, y, B = 1000) {
  if (length(x) < 2 || length(y) < 2 || var(x) == 0 || var(y) == 0) {
    return(NA_real_)
  }

  T_obs <- cor(x, y)
  if (is.na(T_obs)) {
    return(NA_real_)
  }

  T_perm <- replicate(B, {
    y_perm <- sample(y)
    r_perm <- cor(x, y_perm)
    r_perm
  })

  T_perm <- T_perm[!is.na(T_perm)]
  if (length(T_perm) == 0) {
    return(NA_real_)
  }

  count <- sum(T_perm >= T_obs)
  p_val <- (count + 1) / (B + 1)
  p_val
}

goodness_of_fit <- function(slopes_obj) {
  stop("Function implementation has been masked")
}

Complete the function implementation replacing "stop("Not implemented")".