R/cfp_fgres.R

In valentingar/ConFluxPro: A toolkit for soil gas analysis

#' @title Model result of fg_flux
#'
#'@description A function to create an object of class cfp_fgres. This is the
#' central result class generated by running \code{fg_flux()}. Intended for
#' internal use only.
#'
#' @param x A valid \code{cfp_fgmod} object
#' @param y The corresponding FLUX \code{data.frame}.
#'
#' @family model frames
#'
#' @returns A \code{cfp_fgres} object. This inherits from [cfp_fgmod()].
#'
#' @examplesIf interactive()
#' FLUX <- fg_flux(ConFluxPro::base_dat)
#' cfp_fgres(
#'   cfp_fgmod(ConFluxPro::base_dat),
#'   FLUX$FLUX
#' )
#'
#'
#' @export
cfp_fgres <- function(x,y){

  stopifnot(inherits(x,"cfp_fgmod"))
  x$FLUX <- y

  x<-
    structure(x,
              class = c("cfp_fgres",class(x)))
  x <- validate_cfp_fgres(x)
  x
}

validate_cfp_fgres <- function(x){
  x
}



# methods ------------

##### IDENTIFICATION #####
is_cfp_fgres <- function(x){
  inherits(x, "cfp_fgres")
}

####### PRINTING ######

#' @exportS3Method
print.cfp_fgres <- function(x, ...){
  R2 <- x$FLUX %>%
    dplyr::select(dplyr::any_of(c(cfp_id_cols(x), "r2", "mode" ))) %>%
    dplyr::distinct() %>%
    dplyr::pull("r2")
  mean_R2 <- round(mean(R2, na.rm = TRUE), digits = 6)
  n_NA <- length(R2[is.na(R2) == TRUE])

  cat("\nA cfp_fgres fg_flux model result. \n")
  cat("mean R2 achieved: ", mean_R2, "\n")
  cat("number of failed fits: ", n_NA,"\n")
  NextMethod()
}