Nothing
R/jamoviproportion.b.R
In esci: Estimation Statistics with Confidence Intervals
Defines functions
jamovi_proportion
# This file is a generated template, your changes will not be overwritten
jamoviproportionClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class(
"jamoviproportionClass",
inherit = jamoviproportionBase,
private = list(
.init = function() {
from_raw <- (self$options$switch == "from_raw")
# Get a handle for each table
tbl_overview <- self$results$overview
# 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,
lower = 75,
lower_inclusive = FALSE,
upper = 100,
upper_inclusive = FALSE,
my_value_name = "Confidence level"
)
jamovi_set_confidence(tbl_overview, conf_level)
width <- jamovi_sanitize(
my_value = self$options$es_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$es_plot_height,
return_value = 450,
convert_to_number = TRUE,
lower = 10,
lower_inclusive = TRUE,
upper = 4000,
upper_inclusive = TRUE
)
if (from_raw) {
level_count <- jamovi_sanitize(
my_value = length(self$options$outcome_variable),
return_value = 1,
convert_to_number = TRUE,
lower = 1,
lower_inclusive = TRUE
)
} else {
level_count <- 1
}
keys <- if (from_raw)
self$options$outcome_variable
else
jamovi_sanitize(
self$options$outcome_variable_name,
"My outcome variable",
na_ok = FALSE
)
for (my_key in keys) {
self$results$estimation_plots$addItem(key = my_key)
image <- self$results$estimation_plots$get(my_key)
image$setSize(width , height)
}
},
.run = function() {
from_raw <- (self$options$switch == "from_raw")
estimate <- jamovi_proportion(self)
# 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])
# Fill tables
#
# self$results$debug$setVisible(TRUE)
# self$results$debug$setContent(estimate$point_null)
jamovi_estimate_filler(self, estimate, TRUE)
# Deal with plots
keys <- if (from_raw)
self$options$outcome_variable
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)
}
if (length(keys) > 1) {
self$results$estimation_plots$setTitle(
paste(
self$results$estimation_plots$title,
"s",
sep = ""
)
)
}
},
.estimation_plots = function(image, ggtheme, theme, ...) {
if (is.null(image$state))
return(FALSE)
# Do analysis
estimate <- jamovi_proportion(
self,
outcome_variable = c(image$state)
)
if(is.null(estimate)) return(TRUE)
if(is(estimate, "try-error")) stop(estimate[1])
# self$results$debug$setContent(estimate)
# self$results$debug$setVisible(TRUE)
# return(TRUE)
# Basic plot
divider <- 4
notes <- NULL
args <- list()
args$estimate <- estimate
args$plot_possible <- self$options$plot_possible
#Hyothesis evaluation
interval_null <- FALSE
if (self$options$evaluate_hypotheses) {
args <- jamovi_arg_builder(
args,
"null_boundary",
my_value = self$options$null_boundary,
return_value = 0,
convert_to_number = TRUE,
lower = 0,
lower_inclusive = TRUE,
upper = 1,
upper_inclusive = TRUE,
my_value_name = "Hypothesis Evaluation: <i>H</i><sub>0</sub> boundary (+/-)"
)
args <- jamovi_arg_builder(
args,
"point_null",
my_value = self$options$null_value,
return_value = 0,
lower = 0,
lower_inclusive = TRUE,
upper = 1,
upper_inclusive = TRUE,
convert_to_number = TRUE,
my_value_name = "Hypothesis Evaluation: <i>H</i><sub>0</sub> value"
)
multiplier <- 1
args$rope <- c(
args$point_null - (args$null_boundary * multiplier),
args$point_null + (args$null_boundary * multiplier)
)
if (args$rope[[1]] != args$rope[[2]]) {
interval_null <- TRUE
}
# notes <- c(
# notes,
# names(args$point_null),
# names(args$null_boundary)
# )
args$warnings <- NULL
args$point_null <- NULL
args$null_boundary <- NULL
}
args$ggtheme <- ggtheme[[1]]
width <- jamovi_sanitize(
my_value = self$options$es_plot_width,
return_value = 300,
convert_to_number = TRUE,
lower = 10,
lower_inclusive = TRUE,
upper = 2000,
upper_inclusive = TRUE,
my_value_name = "Plot width"
)
height <- jamovi_sanitize(
my_value = self$options$es_plot_height,
return_value = 400,
convert_to_number = TRUE,
lower = 10,
lower_inclusive = TRUE,
upper = 4000,
upper_inclusive = TRUE,
my_value_name = "Plot height"
)
# Store notes from basic plot
notes <- c(
notes,
args$warnings,
names(width),
names(height)
)
args$warnings <- NULL
# Do basic plot
myplot <- do.call(
what = plot_proportion,
args = args
)
# Basic graph options --------------------
# Axis font sizes
axis.text.y <- jamovi_sanitize(
my_value = self$options$axis.text.y,
return_value = 14,
na_ok = FALSE,
convert_to_number = TRUE,
lower = 1,
lower_inclusive = TRUE,
upper = 97,
my_value_name = "Y axis: Tick font size"
)
axis.title.y <- jamovi_sanitize(
my_value = self$options$axis.title.y,
return_value = 15,
na_ok = FALSE,
convert_to_number = TRUE,
lower = 1,
lower_inclusive = TRUE,
upper = 97,
my_value_name = "Y axis: Label font size"
)
axis.text.x <- jamovi_sanitize(
my_value = self$options$axis.text.x,
return_value = 14,
na_ok = FALSE,
convert_to_number = TRUE,
lower = 1,
lower_inclusive = TRUE,
upper = 97,
my_value_name = "X axis: Tick font size"
)
axis.title.x <- jamovi_sanitize(
my_value = self$options$axis.title.x,
return_value = 15,
na_ok = FALSE,
convert_to_number = TRUE,
lower = 1,
lower_inclusive = TRUE,
upper = 97,
my_value_name = "X axis: Label font size"
)
myplot <- myplot + ggplot2::theme(
axis.text.y = ggtext::element_markdown(size = axis.text.y),
axis.title.y = ggtext::element_markdown(size = axis.title.y),
axis.text.x = ggtext::element_markdown(size = axis.text.x),
axis.title.x = ggtext::element_markdown(size = axis.title.x)
)
# Axis labels
xlab <- jamovi_sanitize(
my_value = self$options$xlab,
return_value = NULL,
na_ok = FALSE,
my_value_name = "X axis: Title"
)
ylab <- jamovi_sanitize(
my_value = self$options$ylab,
return_value = NULL,
na_ok = FALSE,
my_value_name = "Y axis: Title"
)
if (!(self$options$xlab %in% c("auto", "Auto", "AUTO"))) {
myplot <- myplot + ggplot2::xlab(xlab)
}
if (!(self$options$ylab %in% c("auto", "Auto", "AUTO"))) {
myplot <- myplot + ggplot2::ylab(ylab)
}
# Axis breaks
ymin <- jamovi_sanitize(
my_value = self$options$ymin,
return_value = ggplot2::layer_scales(myplot)$y$limits[[1]],
na_ok = TRUE,
lower = 0,
lower_inclusive = TRUE,
convert_to_number = TRUE,
my_value_name = "Y axis: Minimum"
)
ymax <- jamovi_sanitize(
my_value = self$options$ymax,
return_value = ggplot2::layer_scales(myplot)$y$limits[[2]],
na_ok = TRUE,
upper = 1,
upper_inclusive = TRUE,
convert_to_number = TRUE,
my_value_name = "Y axis: Maximum"
)
# Axis breaks
breaks <- jamovi_sanitize(
my_value = self$options$breaks,
return_value = 8,
na_ok = FALSE,
lower = 2,
lower_inclusive = TRUE,
upper = 200,
upper_inclusive = TRUE,
convert_to_number = TRUE,
my_value_name = "Y axis: Number of tick marks"
)
myplot <- myplot + ggplot2::scale_y_continuous(
limits = c(ymin, ymax),
n.breaks = breaks,
)
# myplot <- myplot + ggplot2::scale_y_continuous(
# limits = ggplot2::layer_scales(myplot)$y$limits,
# n.breaks = breaks
# )
#
#aesthetics
myplot <- myplot + ggplot2::scale_shape_manual(
values = c(
"summary" = self$options$shape_summary
)
)
myplot <- myplot + ggplot2::scale_color_manual(
values = c(
"summary" = self$options$color_summary
),
aesthetics = c("color", "point_color")
)
myplot <- myplot + ggplot2::scale_fill_manual(
values = c(
"summary" = self$options$fill_summary
),
aesthetics = c("fill", "point_fill")
)
myplot <- myplot + ggplot2::discrete_scale(
c("size", "point_size"),
"point_size_d",
function(n) return(c(
"summary" = as.numeric(self$options$size_summary)/divider
))
)
myplot <- myplot + ggplot2::discrete_scale(
c("alpha", "point_alpha"),
"point_alpha_d",
function(n) return(c(
"summary" = as.numeric(self$options$alpha_summary)
))
)
myplot <- myplot + ggplot2::scale_linetype_manual(
values = c(
"summary" = self$options$linetype_summary
)
)
if (self$options$evaluate_hypotheses) {
myplot$layers[["null_line"]]$aes_params$colour <- self$options$null_color
if (interval_null) {
try(myplot$layers[["null_interval"]]$aes_params$fill <- self$options$null_color)
try(myplot$layers[["ta_CI"]]$aes_params$size <- as.numeric(self$options$size_summary)/divider+1)
try(myplot$layers[["ta_CI"]]$aes_params$alpha <- as.numeric(self$options$alpha_summary))
try(myplot$layers[["ta_CI"]]$aes_params$colour <- self$options$color_summary)
try(myplot$layers[["ta_CI"]]$aes_params$linetype <- self$options$linetype_summary)
}
}
rope_upper <- jamovi_sanitize(
self$options$null_boundary,
na_ok = FALSE,
return_value = 0,
lower = 0,
lower_inclusive = TRUE,
upper = 1,
upper_inclusive = TRUE,
convert_to_number = TRUE,
my_value_name = "Hypothesis Evaluation: Null range (+/-)"
)
null_value <- jamovi_sanitize(
self$options$null_value,
na_ok = FALSE,
return_value = 0,
lower = -1,
lower_inclusive = TRUE,
upper = 1,
upper_inclusive = TRUE,
convert_to_number = TRUE,
my_value_name = "Hypothesis Evaluation: Null value"
)
notes <- c(
notes,
names(axis.text.y),
names(axis.title.y),
names(axis.text.x),
names(axis.title.x),
names(ymin),
names(ymax),
names(xlab),
names(ylab),
names(breaks),
names(rope_upper),
names(null_value)
)
self$results$magnitude_plot_warnings$setState(notes)
jamovi_set_notes(self$results$magnitude_plot_warnings)
print(myplot)
TRUE
})
)
jamovi_proportion <- function(self, outcome_variable = NULL) {
# Prelim -----------------------------------------------------
from_raw <- (self$options$switch == "from_raw")
notes <- c(NULL)
# Step 1 - Check if analysis basics are defined ---------------
args <- list()
if(from_raw) {
if (is.null(outcome_variable)) {
if (
is.null(self$options$outcome_variable) |
length(self$options$outcome_variable) == 0
) return(NULL)
}
} else {
case_label <- jamovi_sanitize(
self$options$case_label,
return_value = "Affected",
na_ok = FALSE
)
args$comparison_cases <- jamovi_required_numeric(
self$options$cases,
lower = 0,
lower_inclusive = TRUE,
integer_required = TRUE,
my_value_name = paste(
"Observations of ",
case_label,
sep = ""
)
)
args$not_cases <- jamovi_required_numeric(
self$options$not_cases,
lower = 0,
lower_inclusive = TRUE,
integer_required = TRUE,
my_value_name = paste(
"Observations of Not ",
case_label,
sep = ""
)
)
unfilled <- names(args[which(is.na(args))])
for (element in args) {
if (is.character(element)) {
notes <- c(notes, element)
}
}
if (length(unfilled) > 0) {
notes <- c(
paste(
"For summary data, please specify ",
length(unfilled),
" more counts (must be numeric).",
sep = ""
),
notes
)
} else {
if (args$comparison_cases < 0) {
notes <- c(
paste(
"Observations of ",
case_label,
" must be >= 0",
sep = ""
),
notes
)
}
if (args$not_cases < 0) {
notes <- c(
paste(
"Observations of Not ",
case_label,
" must be >= 0",
sep = ""
),
notes
)
}
if (args$comparison_cases + args$not_cases < 3) {
notes <- c(
"Error: For summary data, total observations must add up to > 2",
notes
)
}
}
if (length(notes) > 0) {
self$results$help$setState(notes)
return(NULL)
}
}
# Step 2: Get analysis properties-----------------------------
call <- esci::estimate_pdiff_one
args$reference_p <- jamovi_sanitize(
my_value = self$options$null_value,
return_value = 0,
convert_to_number = TRUE,
lower = 0,
lower_inclusive = TRUE,
upper = 1,
upper_inclusive = TRUE,
my_value_name = "Hypothesis Evaluation: Null value"
)
#notes <- c(notes, names(args$reference_p))
args$count_NA <- self$options$count_NA
conf_level <- jamovi_sanitize(
my_value = self$options$conf_level,
return_value = 95,
na_ok = FALSE,
convert_to_number = TRUE,
lower = 75,
lower_inclusive = FALSE,
upper = 100,
upper_inclusive = FALSE,
my_value_name = "Confidence level"
)
args$conf_level <- unname(conf_level)/100
notes <- c(notes, names(conf_level))
if(from_raw) {
args$data <- self$data
if (is.null(outcome_variable)) {
args$outcome_variable <- unname(self$options$outcome_variable)
} else {
args$outcome_variable <- unname(outcome_variable)
args$outcome_variable_name <- outcome_variable
}
} else {
args$comparison_n <- args$comparison_cases + args$not_cases
args$not_cases <- NULL
args$case_label <- jamovi_sanitize(
self$options$case_label,
return_value = "Affected",
na_ok = FALSE
)
args$outcome_variable_name <- jamovi_sanitize(
self$options$outcome_variable_name,
return_value = "My outcome variable",
na_ok = FALSE
)
for (element in args) {
notes <- c(notes, names(element))
}
}
# Do analysis, then post any notes that have emerged
estimate <- try(do.call(what = call, args = args))
if (!is(estimate, "try-error")) {
estimate <- jamovi_add_htest_pdiff(
self = self,
estimate = estimate
)
# self$results$debug$setVisible(TRUE)
# self$results$debug$setContent(estimate$point_null)
if (length(estimate$warnings) > 0) {
notes <- c(notes, estimate$warnings)
}
}
self$results$help$setState(notes)
return(estimate)
}
Try the esci package in your browser
Any scripts or data that you put into this service are public.
esci documentation built on April 3, 2025, 5:52 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions jamovi_proportion
# This file is a generated template, your changes will not be overwritten
jamoviproportionClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class(
"jamoviproportionClass",
inherit = jamoviproportionBase,
private = list(
.init = function() {
from_raw <- (self$options$switch == "from_raw")
# Get a handle for each table
tbl_overview <- self$results$overview
# 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,
lower = 75,
lower_inclusive = FALSE,
upper = 100,
upper_inclusive = FALSE,
my_value_name = "Confidence level"
)
jamovi_set_confidence(tbl_overview, conf_level)
width <- jamovi_sanitize(
my_value = self$options$es_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$es_plot_height,
return_value = 450,
convert_to_number = TRUE,
lower = 10,
lower_inclusive = TRUE,
upper = 4000,
upper_inclusive = TRUE
)
if (from_raw) {
level_count <- jamovi_sanitize(
my_value = length(self$options$outcome_variable),
return_value = 1,
convert_to_number = TRUE,
lower = 1,
lower_inclusive = TRUE
)
} else {
level_count <- 1
}
keys <- if (from_raw)
self$options$outcome_variable
else
jamovi_sanitize(
self$options$outcome_variable_name,
"My outcome variable",
na_ok = FALSE
)
for (my_key in keys) {
self$results$estimation_plots$addItem(key = my_key)
image <- self$results$estimation_plots$get(my_key)
image$setSize(width , height)
}
},
.run = function() {
from_raw <- (self$options$switch == "from_raw")
estimate <- jamovi_proportion(self)
# 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])
# Fill tables
#
# self$results$debug$setVisible(TRUE)
# self$results$debug$setContent(estimate$point_null)
jamovi_estimate_filler(self, estimate, TRUE)
# Deal with plots
keys <- if (from_raw)
self$options$outcome_variable
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)
}
if (length(keys) > 1) {
self$results$estimation_plots$setTitle(
paste(
self$results$estimation_plots$title,
"s",
sep = ""
)
)
}
},
.estimation_plots = function(image, ggtheme, theme, ...) {
if (is.null(image$state))
return(FALSE)
# Do analysis
estimate <- jamovi_proportion(
self,
outcome_variable = c(image$state)
)
if(is.null(estimate)) return(TRUE)
if(is(estimate, "try-error")) stop(estimate[1])
# self$results$debug$setContent(estimate)
# self$results$debug$setVisible(TRUE)
# return(TRUE)
# Basic plot
divider <- 4
notes <- NULL
args <- list()
args$estimate <- estimate
args$plot_possible <- self$options$plot_possible
#Hyothesis evaluation
interval_null <- FALSE
if (self$options$evaluate_hypotheses) {
args <- jamovi_arg_builder(
args,
"null_boundary",
my_value = self$options$null_boundary,
return_value = 0,
convert_to_number = TRUE,
lower = 0,
lower_inclusive = TRUE,
upper = 1,
upper_inclusive = TRUE,
my_value_name = "Hypothesis Evaluation: <i>H</i><sub>0</sub> boundary (+/-)"
)
args <- jamovi_arg_builder(
args,
"point_null",
my_value = self$options$null_value,
return_value = 0,
lower = 0,
lower_inclusive = TRUE,
upper = 1,
upper_inclusive = TRUE,
convert_to_number = TRUE,
my_value_name = "Hypothesis Evaluation: <i>H</i><sub>0</sub> value"
)
multiplier <- 1
args$rope <- c(
args$point_null - (args$null_boundary * multiplier),
args$point_null + (args$null_boundary * multiplier)
)
if (args$rope[[1]] != args$rope[[2]]) {
interval_null <- TRUE
}
# notes <- c(
# notes,
# names(args$point_null),
# names(args$null_boundary)
# )
args$warnings <- NULL
args$point_null <- NULL
args$null_boundary <- NULL
}
args$ggtheme <- ggtheme[[1]]
width <- jamovi_sanitize(
my_value = self$options$es_plot_width,
return_value = 300,
convert_to_number = TRUE,
lower = 10,
lower_inclusive = TRUE,
upper = 2000,
upper_inclusive = TRUE,
my_value_name = "Plot width"
)
height <- jamovi_sanitize(
my_value = self$options$es_plot_height,
return_value = 400,
convert_to_number = TRUE,
lower = 10,
lower_inclusive = TRUE,
upper = 4000,
upper_inclusive = TRUE,
my_value_name = "Plot height"
)
# Store notes from basic plot
notes <- c(
notes,
args$warnings,
names(width),
names(height)
)
args$warnings <- NULL
# Do basic plot
myplot <- do.call(
what = plot_proportion,
args = args
)
# Basic graph options --------------------
# Axis font sizes
axis.text.y <- jamovi_sanitize(
my_value = self$options$axis.text.y,
return_value = 14,
na_ok = FALSE,
convert_to_number = TRUE,
lower = 1,
lower_inclusive = TRUE,
upper = 97,
my_value_name = "Y axis: Tick font size"
)
axis.title.y <- jamovi_sanitize(
my_value = self$options$axis.title.y,
return_value = 15,
na_ok = FALSE,
convert_to_number = TRUE,
lower = 1,
lower_inclusive = TRUE,
upper = 97,
my_value_name = "Y axis: Label font size"
)
axis.text.x <- jamovi_sanitize(
my_value = self$options$axis.text.x,
return_value = 14,
na_ok = FALSE,
convert_to_number = TRUE,
lower = 1,
lower_inclusive = TRUE,
upper = 97,
my_value_name = "X axis: Tick font size"
)
axis.title.x <- jamovi_sanitize(
my_value = self$options$axis.title.x,
return_value = 15,
na_ok = FALSE,
convert_to_number = TRUE,
lower = 1,
lower_inclusive = TRUE,
upper = 97,
my_value_name = "X axis: Label font size"
)
myplot <- myplot + ggplot2::theme(
axis.text.y = ggtext::element_markdown(size = axis.text.y),
axis.title.y = ggtext::element_markdown(size = axis.title.y),
axis.text.x = ggtext::element_markdown(size = axis.text.x),
axis.title.x = ggtext::element_markdown(size = axis.title.x)
)
# Axis labels
xlab <- jamovi_sanitize(
my_value = self$options$xlab,
return_value = NULL,
na_ok = FALSE,
my_value_name = "X axis: Title"
)
ylab <- jamovi_sanitize(
my_value = self$options$ylab,
return_value = NULL,
na_ok = FALSE,
my_value_name = "Y axis: Title"
)
if (!(self$options$xlab %in% c("auto", "Auto", "AUTO"))) {
myplot <- myplot + ggplot2::xlab(xlab)
}
if (!(self$options$ylab %in% c("auto", "Auto", "AUTO"))) {
myplot <- myplot + ggplot2::ylab(ylab)
}
# Axis breaks
ymin <- jamovi_sanitize(
my_value = self$options$ymin,
return_value = ggplot2::layer_scales(myplot)$y$limits[[1]],
na_ok = TRUE,
lower = 0,
lower_inclusive = TRUE,
convert_to_number = TRUE,
my_value_name = "Y axis: Minimum"
)
ymax <- jamovi_sanitize(
my_value = self$options$ymax,
return_value = ggplot2::layer_scales(myplot)$y$limits[[2]],
na_ok = TRUE,
upper = 1,
upper_inclusive = TRUE,
convert_to_number = TRUE,
my_value_name = "Y axis: Maximum"
)
# Axis breaks
breaks <- jamovi_sanitize(
my_value = self$options$breaks,
return_value = 8,
na_ok = FALSE,
lower = 2,
lower_inclusive = TRUE,
upper = 200,
upper_inclusive = TRUE,
convert_to_number = TRUE,
my_value_name = "Y axis: Number of tick marks"
)
myplot <- myplot + ggplot2::scale_y_continuous(
limits = c(ymin, ymax),
n.breaks = breaks,
)
# myplot <- myplot + ggplot2::scale_y_continuous(
# limits = ggplot2::layer_scales(myplot)$y$limits,
# n.breaks = breaks
# )
#
#aesthetics
myplot <- myplot + ggplot2::scale_shape_manual(
values = c(
"summary" = self$options$shape_summary
)
)
myplot <- myplot + ggplot2::scale_color_manual(
values = c(
"summary" = self$options$color_summary
),
aesthetics = c("color", "point_color")
)
myplot <- myplot + ggplot2::scale_fill_manual(
values = c(
"summary" = self$options$fill_summary
),
aesthetics = c("fill", "point_fill")
)
myplot <- myplot + ggplot2::discrete_scale(
c("size", "point_size"),
"point_size_d",
function(n) return(c(
"summary" = as.numeric(self$options$size_summary)/divider
))
)
myplot <- myplot + ggplot2::discrete_scale(
c("alpha", "point_alpha"),
"point_alpha_d",
function(n) return(c(
"summary" = as.numeric(self$options$alpha_summary)
))
)
myplot <- myplot + ggplot2::scale_linetype_manual(
values = c(
"summary" = self$options$linetype_summary
)
)
if (self$options$evaluate_hypotheses) {
myplot$layers[["null_line"]]$aes_params$colour <- self$options$null_color
if (interval_null) {
try(myplot$layers[["null_interval"]]$aes_params$fill <- self$options$null_color)
try(myplot$layers[["ta_CI"]]$aes_params$size <- as.numeric(self$options$size_summary)/divider+1)
try(myplot$layers[["ta_CI"]]$aes_params$alpha <- as.numeric(self$options$alpha_summary))
try(myplot$layers[["ta_CI"]]$aes_params$colour <- self$options$color_summary)
try(myplot$layers[["ta_CI"]]$aes_params$linetype <- self$options$linetype_summary)
}
}
rope_upper <- jamovi_sanitize(
self$options$null_boundary,
na_ok = FALSE,
return_value = 0,
lower = 0,
lower_inclusive = TRUE,
upper = 1,
upper_inclusive = TRUE,
convert_to_number = TRUE,
my_value_name = "Hypothesis Evaluation: Null range (+/-)"
)
null_value <- jamovi_sanitize(
self$options$null_value,
na_ok = FALSE,
return_value = 0,
lower = -1,
lower_inclusive = TRUE,
upper = 1,
upper_inclusive = TRUE,
convert_to_number = TRUE,
my_value_name = "Hypothesis Evaluation: Null value"
)
notes <- c(
notes,
names(axis.text.y),
names(axis.title.y),
names(axis.text.x),
names(axis.title.x),
names(ymin),
names(ymax),
names(xlab),
names(ylab),
names(breaks),
names(rope_upper),
names(null_value)
)
self$results$magnitude_plot_warnings$setState(notes)
jamovi_set_notes(self$results$magnitude_plot_warnings)
print(myplot)
TRUE
})
)
jamovi_proportion <- function(self, outcome_variable = NULL) {
# Prelim -----------------------------------------------------
from_raw <- (self$options$switch == "from_raw")
notes <- c(NULL)
# Step 1 - Check if analysis basics are defined ---------------
args <- list()
if(from_raw) {
if (is.null(outcome_variable)) {
if (
is.null(self$options$outcome_variable) |
length(self$options$outcome_variable) == 0
) return(NULL)
}
} else {
case_label <- jamovi_sanitize(
self$options$case_label,
return_value = "Affected",
na_ok = FALSE
)
args$comparison_cases <- jamovi_required_numeric(
self$options$cases,
lower = 0,
lower_inclusive = TRUE,
integer_required = TRUE,
my_value_name = paste(
"Observations of ",
case_label,
sep = ""
)
)
args$not_cases <- jamovi_required_numeric(
self$options$not_cases,
lower = 0,
lower_inclusive = TRUE,
integer_required = TRUE,
my_value_name = paste(
"Observations of Not ",
case_label,
sep = ""
)
)
unfilled <- names(args[which(is.na(args))])
for (element in args) {
if (is.character(element)) {
notes <- c(notes, element)
}
}
if (length(unfilled) > 0) {
notes <- c(
paste(
"For summary data, please specify ",
length(unfilled),
" more counts (must be numeric).",
sep = ""
),
notes
)
} else {
if (args$comparison_cases < 0) {
notes <- c(
paste(
"Observations of ",
case_label,
" must be >= 0",
sep = ""
),
notes
)
}
if (args$not_cases < 0) {
notes <- c(
paste(
"Observations of Not ",
case_label,
" must be >= 0",
sep = ""
),
notes
)
}
if (args$comparison_cases + args$not_cases < 3) {
notes <- c(
"Error: For summary data, total observations must add up to > 2",
notes
)
}
}
if (length(notes) > 0) {
self$results$help$setState(notes)
return(NULL)
}
}
# Step 2: Get analysis properties-----------------------------
call <- esci::estimate_pdiff_one
args$reference_p <- jamovi_sanitize(
my_value = self$options$null_value,
return_value = 0,
convert_to_number = TRUE,
lower = 0,
lower_inclusive = TRUE,
upper = 1,
upper_inclusive = TRUE,
my_value_name = "Hypothesis Evaluation: Null value"
)
#notes <- c(notes, names(args$reference_p))
args$count_NA <- self$options$count_NA
conf_level <- jamovi_sanitize(
my_value = self$options$conf_level,
return_value = 95,
na_ok = FALSE,
convert_to_number = TRUE,
lower = 75,
lower_inclusive = FALSE,
upper = 100,
upper_inclusive = FALSE,
my_value_name = "Confidence level"
)
args$conf_level <- unname(conf_level)/100
notes <- c(notes, names(conf_level))
if(from_raw) {
args$data <- self$data
if (is.null(outcome_variable)) {
args$outcome_variable <- unname(self$options$outcome_variable)
} else {
args$outcome_variable <- unname(outcome_variable)
args$outcome_variable_name <- outcome_variable
}
} else {
args$comparison_n <- args$comparison_cases + args$not_cases
args$not_cases <- NULL
args$case_label <- jamovi_sanitize(
self$options$case_label,
return_value = "Affected",
na_ok = FALSE
)
args$outcome_variable_name <- jamovi_sanitize(
self$options$outcome_variable_name,
return_value = "My outcome variable",
na_ok = FALSE
)
for (element in args) {
notes <- c(notes, names(element))
}
}
# Do analysis, then post any notes that have emerged
estimate <- try(do.call(what = call, args = args))
if (!is(estimate, "try-error")) {
estimate <- jamovi_add_htest_pdiff(
self = self,
estimate = estimate
)
# self$results$debug$setVisible(TRUE)
# self$results$debug$setContent(estimate$point_null)
if (length(estimate$warnings) > 0) {
notes <- c(notes, estimate$warnings)
}
}
self$results$help$setState(notes)
return(estimate)
}
Try the esci package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.