R/cfp_pfres.R

In valentingar/ConFluxPro: A toolkit for soil gas analysis

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

cfp_pfres <- function(x,y){

  stopifnot(inherits(x,"cfp_pfmod"))
  x$PROFLUX <- y

  x<-
  structure(x,
            class = c("cfp_pfres",class(x)))
  x <- validate_cfp_pfres(x)
  x
}

validate_cfp_pfres <- function(x){

  select_cols <- c("sp_id", "step_id")

  a <- x$PROFLUX[,select_cols] %>% data.frame() %>% dplyr::distinct() %>%
    dplyr::arrange(.data$sp_id, .data$step_id)
  b <- x$soilphys[,select_cols] %>% data.frame()%>%
    dplyr::arrange(.data$sp_id, .data$step_id)


  stopifnot("PROFLUX and soilphys must have the same structure!" =
              all.equal(a,
                        b
              ))
  x
}



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

##### IDENTIFICATION #####
is_cfp_pfres <- function(x){
  inherits(x, "cfp_pfres")
}



##### EXTRACTION ######
# @rdname get_PROFLUX
# @keywords internal
# @export
get_PROFLUX <- function(x){
  UseMethod("get_PROFLUX")
}
#' @export
get_PROFLUX.cfp_dat <- function(x){
  PROFLUX <- x$PROFLUX
  profiles <- x$profiles

  x <-
    join_with_profiles(PROFLUX, profiles, cfp_id_cols(x))[[1]] %>%
    cfp_profile(id_cols = cfp_id_cols(x))

  x
}



###### PRINTING #######
#' @exportS3Method
print.cfp_pfres <- function(x, ...){
  RMSE <- x$PROFLUX %>%
    dplyr::select(prof_id,RMSE) %>%
    dplyr::distinct() %>%
    dplyr::pull(RMSE)
  mean_RMSE <- round(mean(RMSE, na.rm = TRUE), digits = 6)
  n_NA <- length(RMSE[is.na(RMSE) == TRUE])

  cat("\nA cfp_pfres pro_flux model result. \n")
  cat("mean RMSE achieved: ", mean_RMSE, "\n")
  cat("number of failed fits: ", n_NA,"\n")
  NextMethod()
}