R/jamovi_mdiff_functions.R

In rcalinjageman/esci2: Effect Sizes and Confidence Intervals

jamovi_mdiff_initialize <- function(self, grouping_variable = TRUE) {
  
  # Set some variables for convenience -----------------------
  #   Is analysis from summary data or raw?
  #   Are we evaluating a hypothesis?
  #   Is this a contrast?
  from_raw <- (self$options$switch == "from_raw")
  evaluate_h <- self$options$evaluate_hypotheses
  contrast <- TRUE
  
  # Get a handle for each table
  tbl_overview <- self$results$overview
  tbl_es <- self$results$effect_sizes
  tbl_ses <- self$results$standardized_effect_sizes
  tbl_eval <- self$results$evaluate_summary
  
  
  # Prep output -------------------------------------------
  # Set CI and MoE columns to reflect confidence level
  conf_level <- jamovi_sanitize(
    my_value = self$options$conf_level,
    return_value = 95,
    na_ok = FALSE,
    convert_to_number = TRUE
  )
  
  jamovi_set_confidence(tbl_overview, conf_level)
  jamovi_set_confidence(tbl_es, conf_level)
  jamovi_set_confidence(tbl_ses, conf_level)
  jamovi_set_confidence(tbl_eval, conf_level)
  
  
  # Calculations for filling tables and adjusting plots ----------
  # 3 rows needed for interval null; 1 for point null
  eval_base <- if(self$options$null_boundary != 0) {
    3
  } else {
    1
  }    
  
  # Outcomes: 1 if from summary, length of outcome_variables if raw
  outcome_count <- if(from_raw) {
    length(self$options$outcome_variables)
  } else {
    1
  }
  
  # For now, only 1 contrast can be specified
  contrast_count <- 1
  
  # How many levels?  
  #  For raw, check grouping_variable
  #  For summary, check group_labels 
  if (grouping_variable) {
    if (from_raw) {
      level_source <- self$options$grouping_variable
    } else {
      level_source <- self$options$group_labels
    }
    level_count <- length(levels(as.factor(self$data[, level_source])))
  } else {
    level_count <- 1
  }  
  
  # Rows needed for each table -------------------------------
  overview_rows <- level_count * outcome_count
  es_rows <- contrast_count * outcome_count * 3
  ses_rows <- contrast_count * outcome_count
  eval_rows <- eval_base * contrast_count * outcome_count
  
  jamovi_init_table(tbl_overview, overview_rows)
  jamovi_init_table(tbl_es, es_rows, breaks = 3)
  jamovi_init_table(tbl_ses, ses_rows)
  jamovi_init_table(
    tbl_eval,
    eval_rows, 
    breaks = if(eval_base == 1) NULL else eval_base
  )
  
  
  # Set up array of estimation plots
  # Let the user set the base width and height of the plot, but 
  # Scale horizontally or vertically depending on how many variables
  # are being analyzed
  keys <- if (from_raw)
    self$options$outcome_variables
  else
    jamovi_sanitize(
      self$options$outcome_variable_name,
      "My outcome variable",
      na_ok = FALSE
    )
  
  width <- jamovi_sanitize(
    my_value = self$options$es_plot_width, 
    return_value = 200, 
    convert_to_number = TRUE,
    lower = 10,
    lower_inclusive = TRUE,
    upper = 2000,
    upper_inclusive = TRUE
  )
  height <- jamovi_sanitize(
    my_value = self$options$es_plot_height,
    return_value = 550,
    convert_to_number = TRUE,
    lower = 10,
    lower_inclusive = TRUE,
    upper = 4000,
    upper_inclusive = TRUE
  )
  
  for (my_key in keys) {
    self$results$estimation_plots$addItem(key = my_key)
    image <- self$results$estimation_plots$get(my_key)
    image$setSize(width * level_count, height)
  }
  
  
  # Scale evaluation plot -----------------------------------
  image <- self$results$evaluation_plot
  width <- jamovi_sanitize(
    my_value = self$options$eval_plot_width, 
    return_value = 300, 
    convert_to_number = TRUE,
    lower = 10,
    lower_inclusive = TRUE,
    upper = 2000,
    upper_inclusive = TRUE
  )
  height <- jamovi_sanitize(
    my_value = self$options$eval_plot_height, 
    return_value = 450, 
    convert_to_number = TRUE,
    lower = 10,
    lower_inclusive = TRUE,
    upper = 4000,
    upper_inclusive = TRUE
  )
  image$setSize(
    width * (outcome_count+1),
    height * contrast_count
  )
  
}


jamovi_mdiff_run <- function(self, filler_function) {
  
  # First, do the analysis ----------------------------------
  args <- list()
  args$self = self
  args$outcome_variables = self$options$outcome_variables
  args$save_raw_data = FALSE
  
  estimate <- do.call(
    what = filler_function,
    args = args
  )

  # Print any notes that emerged from running the analysis
  jamovi_set_notes(self$results$help)
  
  
  # Check to see if the analysis ran
  #  If null, return
  #  If error, return the error
  if(is.null(estimate)) return(TRUE)
  if(is(estimate, "try-error")) stop(estimate[1])
  
  if(estimate$properties$effect_size_category == "Difference") {
    completed_analysis <- TRUE
  } else {
    completed_analysis <- FALSE
  }
  
  
  # Set some variables for convenience ---------------------------
  #   Is analysis from summary data or raw?
  #   Are we evaluating a hypothesis?
  #   Is this a contrast?
  from_raw <- (self$options$switch == "from_raw")
  evaluate_h <- self$options$evaluate_hypotheses
  contrast <- TRUE
  
  # Get a handle for each table
  tbl_overview <- self$results$overview
  tbl_es <- self$results$effect_sizes
  tbl_ses <- self$results$standardized_effect_sizes
  tbl_eval <- self$results$evaluate_summary
  
  
  # Report results ---------------------------------------------
  # Fill each table
  jamovi_table_filler(tbl_overview, estimate$overview, expand = TRUE)
  jamovi_table_filler(tbl_es, estimate$effect_sizes)
  jamovi_table_filler(tbl_ses, estimate$standardized_effect_sizes)
  
  
  # Set note for standardized effect size table
  
  if (!is.null(estimate$standardized_effect_sizes)) {
    mynote <- estimate$standardized_effect_size_properties$message_html 
    tbl_ses$setNote(
      key = "dtable",
      note = mynote,
      init = FALSE
    )
    
    # Set columns for standardized effect size tables
    d_title <- estimate$standardized_effect_size_properties$d_name_html
    biased_name <- gsub("</sub>", ".biased</sub>", d_title)
    d_cor <- estimate$standardized_effect_size_properties$bias_corrected
    
    tbl_ses$getColumn("d_biased")$setTitle(biased_name)
    tbl_ses$getColumn("effect_size")$setTitle(d_title)
    tbl_ses$getColumn("d_biased")$setVisible(d_cor)
  }            
  
  
  # Hypothesis test? --------------------------------------------
  # If evaluating a hypothesis, get these results and fill table
  if(evaluate_h & completed_analysis) {
    # Test results
    test_results <- try(
      test_mdiff_contrast_bs(
        estimate,
        rope_lower = self$options$null_boundary*-1,
        rope_upper = self$options$null_boundary,
        rope_units = self$options$rope_units,
        alpha = jamovi_sanitize(
          my_value = self$options$alpha,
          return_value = .05,
          na_ok = FALSE,
          convert_to_number = TRUE,
          lower = 0,
          lower_inclusive = FALSE,
          upper = 1,
          upper_inclusive = FALSE
        )
      )
    )
    
    # Fill table
    jamovi_table_filler(
      tbl_eval, 
      test_results$hypothesis_evaluations
    )
  }
  
  
  # Deal with plots ----------------------------------------
  # Set up array of estimation plots
  keys <- if (from_raw)
    self$options$outcome_variables
  else
    jamovi_sanitize(
      self$options$outcome_variable_name,
      "My outcome variable",
      na_ok = FALSE
    )
  
  for (my_key in keys) {
    image <- self$results$estimation_plots$get(key=my_key)
    image$setState(my_key)
  }
  
}

jamovi_mdiff_helper_plot <- function(self) {
  need_helper <- self$options$aesthetics_helper
  if(!need_helper) return(TRUE)
  myplot <- esci_color_examples()
  print(myplot)
  TRUE

}


jamovi_mdiff_evaluation_plot <- function(self, filler_function) {
  
  evaluate_h <- self$options$evaluate_hypotheses
  if (!evaluate_h) return(TRUE)
  
  args <- list()
  args$self = self
  args$outcome_variables = self$options$outcome_variables
  args$save_raw_data = FALSE
  
  estimate <- do.call(what = filler_function, args = args)
  
  if(!is(estimate, "esci_estimate")) return(TRUE)
  if (estimate$properties$effect_size_category != "Difference") {
    return(TRUE)
  }
  
  myplot <- plot_esci_test(
    estimate,
    rope_lower = self$options$null_boundary*-1,
    rope_upper = self$options$null_boundary,
    rope_units = self$options$rope_units,
    alpha = self$options$alpha
  )
  
  print(myplot)
  TRUE
  
}


jamovi_mdiff_estimation_plots <- function(
  self,
  filler_function,
  image,
  ggtheme,
  theme
) {
  
  if (is.null(image$state))
    return(FALSE)
  
  # Do the analysis again
  args <- list()
  args$self = self
  args$outcome_variables = c(image$state)
  args$save_raw_data = TRUE
  
  estimate <- do.call(what = filler_function, args = args)
  
  if(!is(estimate, "esci_estimate"))
    return(TRUE)
  
  # self$debug$setContent(paste(estimate))
  
  
  # Fill in plot properties, copy forward data attribs to summary
  plot_attributes <- jamovi_plot_attributes_filler(self$options)
  notes <- plot_attributes$warnings
  plot_attributes <- esci_plot_attributes(check = plot_attributes)
  notes <- c(plot_attributes$warnings, notes)
  
  # Build up the arguments to pass to the plot function
  #  We do this because when a value turns out to be null
  #   it will not be entered in the list, and that way it is not
  #   passed and we instead obtain the default value from the function
  args <- list()
  args$data_layout <- jamovi_sanitize(self$options$data_layout)
  args$data_spread <- jamovi_sanitize(
    self$options$data_spread,
    return_value = 0.25,
    lower = 0,
    lower_inclusive = TRUE,
    upper = 10,
    upper_inclusive = TRUE,
    my_value_name = "Data: Spread",
    convert_to_number = TRUE
  )
  args$error_layout <- jamovi_sanitize(self$options$error_layout)
  args$error_scale <- jamovi_sanitize(
    self$options$error_scale,
    return_value = 0.25,
    lower = 0,
    lower_inclusive = TRUE,
    upper = 5,
    upper_inclusive = TRUE,
    my_value_name = "Distributions: Width",
    convert_to_number = TRUE
  )
  args$error_nudge <- jamovi_sanitize(
    self$options$error_nudge, 
    return_value = 0.4,
    lower = 0,
    lower_inclusive = TRUE,
    upper = 5,
    upper_inclusive = TRUE,
    my_value_name = "Distributions: Offset from data",
    convert_to_number = TRUE
  )
  args$error_normalize <- "all"
  ylim <- c(
    jamovi_sanitize(
      self$options$ymin, 
      return_value = NA, 
      na_ok = TRUE,
      convert_to_number = TRUE,
      my_value_name = "y-axis: Min"
    ),
    jamovi_sanitize(
      self$options$ymax, 
      return_value = NA,
      na_ok = TRUE,
      convert_to_number = TRUE,
      my_value_name = "y-axis: Max"
    )
  )
  notes <- c(notes, names(ylim))
  args$ylim <- ylim
  args$breaks <- jamovi_sanitize(
    self$options$breaks, 
    convert_to_number = TRUE,
    return_value = 12,
    lower = 2,
    lower_inclusive = TRUE,
    upper = 100,
    upper_inclusive = TRUE,
    my_value_name = "y-axis: Num. tick marks"
  )
  args$difference_axis_units <- self$options$difference_axis_units
  args$difference_axis_breaks <- jamovi_sanitize(
    self$options$difference_axis_breaks,
    return_value = 5,
    convert_to_number = TRUE,
    lower = 2,
    lower_inclusive = TRUE,
    upper = 100,
    upper_inclusive = TRUE,
    my_value_name = "Difference axis: Num. tick marks"
  )
  args$y.axis.text <- jamovi_sanitize(
    self$options$y.axis.text,
    return_value = 10,
    convert_to_number = TRUE,
    lower = 1,
    lower_inclusive = TRUE,
    upper = 100,
    upper_inclusive = TRUE,
    my_value_name = "y-axis: Tick font size"
  )
  args$y.axis.title <- jamovi_sanitize(
    self$options$y.axis.title, 
    return_value = 12,
    convert_to_number = TRUE,
    lower = 1,
    lower_inclusive = TRUE,
    upper = 100,
    upper_inclusive = TRUE,
    my_value_name = "y-axis: Label font size"
  )
  args$x.axis.text <- jamovi_sanitize(
    self$options$x.axis.text,
    return_value = 10,
    convert_to_number = TRUE,
    lower = 1,
    lower_inclusive = TRUE,
    upper = 100,
    upper_inclusive = TRUE,
    my_value_name = "x-axis: Tick font size"
  )
  args$x.axis.title <- jamovi_sanitize(
    self$options$x.axis.title, 
    return_value = 12,
    convert_to_number = TRUE,
    lower = 1,
    lower_inclusive = TRUE,
    upper = 100,
    upper_inclusive = TRUE,
    my_value_name = "x-axis: Label font size"
  )
  args$ylab <- jamovi_sanitize(
    self$options$ylab,
    return_value = NULL
  )
  args$xlab <- jamovi_sanitize(
    self$options$xlab,
    return_value = NULL
  )
  
  for (myarg in args) {
    if (!is.null(names(myarg))) {
      notes <- c(notes, names(myarg))
    }
  }
  
  width <- jamovi_sanitize(
    my_value = self$options$es_plot_width, 
    return_value = 200, 
    convert_to_number = TRUE,
    lower = 10,
    lower_inclusive = TRUE,
    upper = 2000,
    upper_inclusive = TRUE,
    my_value_name = "Estimation plot width"
  )
  height <- jamovi_sanitize(
    my_value = self$options$es_plot_height,
    return_value = 450,
    convert_to_number = TRUE,
    lower = 10,
    lower_inclusive = TRUE,
    upper = 4000,
    upper_inclusive = FALSE,
    my_value_name = "Estimation plot height"
  )
  notes <- c(notes, names(width), names(height))
  
  self$results$estimation_plot_warnings$setState(notes)
  jamovi_set_notes(self$results$estimation_plot_warnings)
  
  args$plot_attributes <- plot_attributes
  args$ggtheme <- ggtheme[[1]]
  args$estimate <- estimate[[image$state]]
  
  plot <- do.call(
    what = plot_mdiff_contrast_bs,
    args = args
  )
  
  print(plot)
  TRUE
  
}



jamovi_mdiff_mean_one_result_filler <- function(
  self,
  outcome_variables = NULL,
  save_raw_data = FALSE
) {
  
  
  # This function will build the analysis and then return
  #   - the estimate (class esci_estimate)
  #   - an error (class try-error)
  #   - or NULL (representing analysis not ready)
  
  
  # Prelim --------------------------
  from_raw <- (self$options$switch == "from_raw")
  evaluate_h <- self$options$evaluate_hypotheses
  run_analysis <- TRUE
  contrast <- TRUE
  
  # Initialize vector of notes for the user
  notes <- c(NULL)
  
  
  # Step 1 - Check if analysis basics are defined ----- 
  if(from_raw) {
    if(is.null(outcome_variables) | length(outcome_variables) == 0) {
      return(NULL)
    }
  } else {
    
    comparison_means <- jamovi_sanitize(
      self$options$means,
      convert_to_number = TRUE
    )
    comparison_sds <- jamovi_sanitize(
      self$options$sds,
      convert_to_number = TRUE,
      lower = 0,
      lower_inclusive = FALSE
    )
    comparison_ns <- jamovi_sanitize(
      self$options$ns,
      convert_to_number = TRUE,
      lower = 0,
      lower_inclusive = FALSE
    )
    
    specify <- c(
      if (is.null(comparison_means)) "mean (m)" else NULL,
      if (is.null(comparison_sds)) "standard deviation (s)" else NULL,
      if (is.null(comparison_ns)) "size (N)" else NULL
    )

    if (length(specify) > 0) {
      notes <- paste(
        "To analyze summary data, specify sample ", 
        paste0(
          specify,
          sep = ", ",
          collapse = " and "
        ),
        sep = ""
      )
      self$results$help$setState(notes)
      return(NULL)
    }
    
  }
  
  
  # Step 2 - Prep arguments ----------------------------
  args <- list()
  args$population_m <- jamovi_sanitize(
    self$options$reference_mean,
    return_value = NA,
    convert_to_number = TRUE
  )
  args$population_s <- jamovi_sanitize(
    self$options$reference_sd,
    return_value = NULL,
    convert_to_number = TRUE,
    lower = 0,
    lower_inclusive = FALSE
  )
  args$conf_level <- jamovi_sanitize(
    my_value = self$options$conf_level,
    return_value = 95,
    na_ok = FALSE,
    convert_to_number = TRUE,
    lower = 0,
    lower_inclusive = FALSE,
    upper = 100,
    upper_inclusive = FALSE,
    my_value_name = "Confidence level"
  )/100
  
  notes <- c(
    notes, 
    names(args$conf_level),
    names(args$population_s),
    names(args$population_m)
  )
  
  
  if (from_raw) {
    args$data <- self$data
    args$outcome_variable <- outcome_variables
    call <- estimate_mdiff_one.jamovi 
  } else {
    args$comparison_m <- comparison_means
    args$comparison_s <- comparison_sds
    args$comparison_n <- comparison_ns
    outcome_variable_name <- jamovi_sanitize(
      self$options$outcome_variable_name,
      return_value = "My outcome variable",
      na_ok = FALSE
    )
    args$outcome_variable_name <- outcome_variable_name
    notes <- c(notes, names(outcome_variable_name))
    call <- estimate_mean_one.summary
  }
  
  
  # Step 3: Do the analysis ------------------
  
  # Do analysis, then post any notes that have emerged
  estimate <- try(do.call(what = call, args = args))
  
  # For summary data, store in a list based on outcome_variable_name
  if (!is(estimate, "try-error")) {
    notes <- c(notes, estimate$warnings)
    self$results$help$setState(notes)
    if(!from_raw) {
      estimate_list <- list()
      key <- outcome_variable_name
      estimate_list[[key]] <- estimate
      class(estimate_list) <- "esci_estimate"
      estimate <- esci_estimate_consolidate(estimate_list)
    }
  }
  
  return(estimate)
  
}



jamovi_mdiff_contrastindependent <- function(
  self,
  outcome_variables = NULL, 
  save_raw_data = FALSE
) {
  # This function will build the analysis and then return
  #   - the estimate (class esci_estimate)
  #   - an error (class try-error)
  #   - or NULL (representing analysis not ready)
  
  
  # Prelim -----------------------------------------------------
  from_raw <- (self$options$switch == "from_raw")
  notes <- c(NULL)
  
  
  # Step 1 - Check if analysis basics are defined ---------------
  #  if not, return NULL
  if(from_raw) {
    if (
      is.null(self$options$grouping_variable) |
      is.null(outcome_variables) |
      length(outcome_variables) == 0  
    ) return(NULL)
  } else {
    if(
      is.null(self$options$means) |
      is.null(self$options$sds) |
      is.null(self$options$ns) |
      is.null(self$options$group_labels)
    ) return(NULL)
  }
  
  # Step 2: Check on the contrast --------------------------------
  clabels <- self$options$comparison_labels
  rlabels <- self$options$reference_labels
  
  
  if(from_raw) {
    level_source <- self$options$grouping_variable
    valid_levels <- levels(as.factor(self$data[, level_source])) 
    multiplier <- length(self$options$outcome_variables) 
  } else {
    level_source <- self$options$group_labels
    valid_levels <- self$data[
      which(!is.na(self$data[, self$options$group_labels])), 
      level_source
    ]
    multiplier <- 1
  }
  
  
  # This function checks if the contrast is valid or not
  reference_result <- jamovi_check_contrast(
    labels = rlabels,
    valid_levels = valid_levels,
    level_source = level_source,
    group_type = "Reference",
  )
  
  # Same, but with comparison labels
  comparison_result <- jamovi_check_contrast(
    labels = clabels,
    valid_levels = valid_levels,
    level_source = level_source,
    group_type = "Comparison",
    sequential = !is.null(reference_result$error_string)
  )
  
  notes <- c(notes,
             reference_result$error_string,
             comparison_result$error_string
  )
  
  overlap <- reference_result$label %in% comparison_result$label
  if (length(reference_result$label[overlap]) != 0) {
    next_note <- glue::glue(
      "<b>Error</b>: Reference and comparison groups must be distinct, but 
{reference_result$label[overlap]} has been entered in both"
    )
    notes <- c(notes, next_note)
  }
  
  
  contrast <- if(length(notes) > 0) 
    NULL
  else
    jamovi_create_contrast(
      reference_result$label,
      comparison_result$label
    )
  
  # Step 3: Run analysis ------------------------------------------
  # Fill in analysis properties
  
  # If from summary:
  # get outcome and grouping variable names
  # and set notes if they have been replaced
  if(!from_raw) {
    outcome_variable_name <- jamovi_sanitize(
      self$options$outcome_variable_name,
      return_value = "My outcome variable",
      na_ok = FALSE
    )
    grouping_variable_name <- jamovi_sanitize(
      self$options$grouping_variable_name,
      return_value = "My grouping variable",
      na_ok = FALSE
    )
    notes <- c(
      notes,
      names(outcome_variable_name),
      names(grouping_variable_name)
    )
  }
  
  args <- list()
  conf_level <- jamovi_sanitize(
    my_value = self$options$conf_level,
    return_value = 95,
    na_ok = FALSE,
    convert_to_number = TRUE,
    lower = 0,
    lower_inclusive = FALSE,
    upper = 100,
    upper_inclusive = FALSE,
    my_value_name = "Confidence level"
  )
  notes <- c(notes, names(conf_level))
  args$conf_level <- conf_level/100
  args$assume_equal_variance <- self$options$assume_equal_variance
  args$contrast <- contrast
  
  # Set args for summary and raw data cases
  if (from_raw) {
    # Analysis from raw data
    args$data <- self$data
    args$grouping_variable <- self$options$grouping_variable
    args$outcome_variable <- outcome_variables
    call <- estimate_mdiff_contrast_bs.jamovi
  } else {
    # Analysis from summary data
    group_labels <- self$data[, self$options$group_labels]
    valid_rows <- which(!is.na(group_labels))
    
    if(length(valid_rows) != length(group_labels)) {
      msg <- glue::glue("
There are {length(group_labels) - length(valid_rows)} empty values
in {self$options$group_labels}.  Rows with empty group labels have been 
**dropped** from the analysis
                    ")
      notes <- c(notes, msg)
    }
    
    args$means <- self$data[valid_rows, self$options$means]
    args$sds <- self$data[valid_rows, self$options$sds]
    args$ns <- self$data[valid_rows, self$options$ns]
    args$group_labels <- as.character(group_labels[valid_rows])
    args$outcome_variable_name <- outcome_variable_name
    args$grouping_variable_name <- grouping_variable_name
    call <- estimate_mdiff_contrast_bs
  }
  
  
  # Do analysis, then post any notes that have emerged
  estimate <- try(do.call(what = call, args = args))
  
  # For summary data, store in a list based on outcome_variable_name
  if (!is(estimate, "try-error")) {
    notes <- c(notes, estimate$warnings)
    self$results$help$setState(notes)
    if(!from_raw) {
      estimate_list <- list()
      key <- outcome_variable_name
      estimate_list[[key]] <- estimate
      class(estimate_list) <- "esci_estimate"
      estimate <- esci_estimate_consolidate(estimate_list)
    }
  }
  
  return(estimate)
}