R/class_esci_estimate.R

In rcalinjageman/esci2: Effect Sizes and Confidence Intervals

# Check for class estimate
# This function checks if x is an esci_estimate
is.estimate <- function(x)  {
  is(x, "esci_estimate")
}


#' Print an esci_estimate
#' 
#' Pretties up the printing of a complex esci_estimate object.
#' 
#' @param x - object to print; must be of class esci_estimate
#' @param ... S3 signature for generic plot function.
#' @param verbose - optional logical print all details; defaults to false
#' 
#' @exportS3Method print esci_estimate
print.esci_estimate <- function(x, ..., verbose = FALSE) {
  
  estimate <- x

  # Summary
  summary_text <- if(estimate$properties$data_type == "Summary")
    "Analysis of summary data:\n"
  else
    "Analysis of raw data:\n"
  if(!is.null(estimate$properties$data_source)) {
    summary_text <- paste(
      summary_text,
      "Data frame = ",
      estimate$properties$data_source,
      "\n",
      sep = ""
    )
  }
  if(!is.null(estimate$properties$outcome_variable_name)) {
    summary_text <- paste(
      summary_text, 
      "Outcome variable(s) = ",
      paste(estimate$properties$outcome_variable_name, collapse = ", "),
      "\n",
      sep = ""
      )
  }
  if(!is.null(estimate$properties$grouping_variable_name)) {
    summary_text <- paste(
      summary_text,
      "Grouping variable(s) = ",
      estimate$properties$grouping_variable_name,
      "\n",
      sep = ""
    )
  }
  
  cat(summary_text)
  
  
  # Print overview table
  #  when verbose is FALSE, only prints key columns
  if (!is.null(estimate$overview)) {
    if (verbose) {
      overview_columns <- c(1:ncol(estimate$overview))
    } else {
      overview_columns <- c(
        "outcome_variable_name",
        "group",
        "m",
        "lower",
        "upper",
        "s",
        "n",
        "missing"
        )
    }
    overview_columns <- overview_columns[
      overview_columns 
      %in% 
        names(estimate$overview)
    ]
    cat("\n---Overview---\n")
    print(estimate$overview[ , overview_columns])
  }
  
  # Print effect size table, again limiting to key columns when verbose=FALSE
  if (!is.null(estimate$effect_sizes)) {
    if(verbose) {
      effect_size_columns <- c(1:ncol(estimate$effect_sizes))
    } else {
      effect_size_columns <- c(
        "outcome_variable_name",
        "type",
        "effect",
        "effect_size",
        "lower",
        "upper"
      )
    }
    effect_size_columns <- effect_size_columns[
      effect_size_columns 
      %in% 
        names(estimate$effect_sizes)
    ]
    cat("\n\n---Effect Size Estimates---\n")
    print(estimate$effect_sizes[ , effect_size_columns])
  }
  
  # And finally, standardized effect size table
  if (!is.null(estimate$standardized_effect_sizes)) {
    if(verbose) {
      effect_size_columns <- c(1:ncol(estimate$effect_sizes))
    } else {
      effect_size_columns <- c(
        "outcome_variable_name",
        "effect",
        "effect_size",
        "lower",
        "upper"
      )
    }
    effect_size_columns <- effect_size_columns[
      effect_size_columns 
      %in% 
      names(estimate$standardized_effect_sizes)
    ]
    
    cat("\n\n---Standardized Effect Size Estimates---\n")
    print(estimate$standardized_effect_sizes[ , effect_size_columns])
    cat("\n")
    print(estimate$standardized_effect_size_properties$message)
  }
  
  # Note about CI width
  ci_message <- paste(
    "\n\nNote: lower and upper are boundaries of confidence intervals with ", 
    estimate$properties$conf_level*100,
    "% expected coverage.",
    sep = ""
  )
  
  cat(ci_message)
}



# This function rolls up an esci_estimate
# It takes a list of esci_estimates, and consolidates their 
# properties and data tables so that they are accessible from the
# top level of the object
esci_estimate_consolidate <- function(estimate_list) {
  
  # Cycle through the list
  for (estimate in estimate_list) {
    # Check if the current list item is an estimate
    if (class(estimate) == "esci_estimate") {
      
      # Handle warnings, consolidating with outcome variable name
      if(length(estimate$warnings) > 0 ) {
        estimate_list$warnings <- c(
          estimate_list$warnings, 
          paste(
            estimate$properties$outcome_variable_name,
            ": ",
            estimate$warnings,
            sep = ""
          )
        )
      }
      
      # Merge properties
      if (is.null(estimate_list$properties)) {
        estimate_list$properties <- estimate$properties
      } else {
        estimate_list$properties$outcome_variable_name <-
          c(estimate_list$properties$outcome_variable_name,
            estimate$properties$outcome_variable_name)
      }
      
      # Merge properties for standardized effect size, if available
      if (is.null(estimate_list$standardized_effect_size_properties)) {
        if(!is.null(estimate$standardized_effect_size_properties)) {
          estimate_list$standardized_effect_size_properties <-
            estimate$standardized_effect_size_properties
        }
      } else {
        if(!is.null(estimate$standardized_effect_size_properties)) {
    estimate_list$standardized_effect_size_properties$outcome_variable_name <-
      c(estimate_list$standardized_effect_size_properties$outcome_variable_name,
      estimate$standardized_effect_size_properties$outcome_variable_name
      )
        }
      }
  
      # Merge each table in the current estimate, setting outcome variable
      for(mytbl in names(estimate)) {
          if (is.data.frame(estimate[[mytbl]])) {
            estimate_list[[mytbl]] <- rbind(
              estimate_list[[mytbl]], 
              cbind(
                outcome_variable_name = estimate$properties$outcome_variable_name,
                estimate[[mytbl]]
              )
            )
          }
      }  # End cycling through tables
    } # End if testing if current list item is an estimate
  } # End cycling through the list that was passed
  
  return(estimate_list)
}