R/jjhistostats.b.R
#' @title Histogram
#' @importFrom R6 R6Class
#' @import jmvcore
#' @import ggplot2
jjhistostatsClass <- if (requireNamespace('jmvcore'))
R6::R6Class(
"jjhistostatsClass",
inherit = jjhistostatsBase,
private = list(
# init ----
.init = function() {
deplen <- length(self$options$dep)
self$results$plot$setSize(600, deplen * 450)
if (!is.null(self$options$grvar)) {
mydata <- self$data
grvar <- self$options$grvar
num_levels <- nlevels(
as.factor(mydata[[grvar]])
)
self$results$plot2$setSize(num_levels * 600, deplen * 450)
}
}
# run ----
,
.run = function() {
## Initial Message ----
if (is.null(self$options$dep)) {
## todo ----
todo <- glue::glue(
"<br>
Welcome to ClinicoPath
<br><br>
This tool will help you generate Histograms.
<br><br>
This function uses ggplot2 and ggstatsplot packages. See documentations <a href = 'https://indrajeetpatil.github.io/ggstatsplot/reference/gghistostats.html' target='_blank'>gghistostats</a> and <a href = 'https://indrajeetpatil.github.io/ggstatsplot/reference/grouped_gghistostats.html' target='_blank'>grouped_gghistostats</a>.
<br>
Please cite jamovi and the packages as given below.
<br><hr>"
)
self$results$todo$setContent(todo)
return()
} else {
todo <- glue::glue("<br>You have selected to make a histogram.<br><hr>")
self$results$todo$setContent(todo)
if (nrow(self$data) == 0)
stop('Data contains no (complete) rows')
}
}
,
.plot = function(image, ggtheme, theme, ...) {
# the plot function ----
## Error messages ----
if (is.null(self$options$dep))
return()
if (nrow(self$data) == 0)
stop('Data contains no (complete) rows')
## read data ----
mydata <- self$data
vars <- self$options$dep
for (var in vars)
mydata[[var]] <- jmvcore::toNumeric(mydata[[var]])
## Exclude NA ----
mydata <- jmvcore::naOmit(mydata)
dep <- self$options$dep
## arguments ----
binwidth <- NULL
if(self$options$changebinwidth) {
binwidth <- self$options$binwidth
}
typestatistics <- self$options$typestatistics
# gghistostats
# https://indrajeetpatil.github.io/ggstatsplot/reference/gghistostats.html
# originaltheme <- self$options$originaltheme
#
# selected_theme <- if (!originaltheme) ggtheme else ggstatsplot::theme_ggstatsplot()
## dep == 1 ----
if (length(self$options$dep) == 1) {
plot <-
ggstatsplot::gghistostats(
data = mydata,
x = !!rlang::sym(dep)
, type = typestatistics
, normal.curve = self$options$normalcurve
, results.subtitle = self$options$resultssubtitle
, centrality.plotting = self$options$centralityline
, binwidth = binwidth
)
# extracted_stats <- ggstatsplot::extract_stats(plot)
# extracted_subtitle <- ggstatsplot::extract_subtitle(plot)
# extracted_caption <- ggstatsplot::extract_caption(plot)
#
# self$results$e_stats$setContent(extracted_stats)
# self$results$e_subtitle$setContent(extracted_subtitle)
# self$results$e_caption$setContent(extracted_caption)
# originaltheme <- self$options$originaltheme
#
# if (!originaltheme) {
# plot <- plot + ggtheme
# } else {
# plot <- plot + ggstatsplot::theme_ggstatsplot()
# }
}
## dep > 1 ----
if (length(self$options$dep) > 1) {
dep2 <- as.list(self$options$dep)
dep2_symbols <- purrr::map(dep2, rlang::sym)
plotlist <-
purrr::pmap(
.l = list(
x = dep2_symbols,
messages = FALSE),
.f = function(x, messages) {
ggstatsplot::gghistostats(
data = mydata,
x = !!x,
messages = messages
, type = typestatistics
, normal.curve = self$options$normalcurve
, results.subtitle = self$options$resultssubtitle
, centrality.plotting = self$options$centralityline
, binwidth = binwidth
)
}
)
plot <-
ggstatsplot::combine_plots(
plotlist = plotlist,
plotgrid.args = list(ncol = 1)
)
}
# originaltheme <- self$options$originaltheme
#
# if (!originaltheme) {
# plot <- plot + ggtheme
# } else {
# plot <- plot + ggstatsplot::theme_ggstatsplot()
# # ggplot2::theme_bw()
# }
## Print Plot ----
print(plot)
TRUE
}
,
.plot2 = function(image, ggtheme, theme, ...) {
# the plot2 function ----
## Error messages ----
if (is.null(self$options$dep) ||
is.null(self$options$grvar))
return()
if (nrow(self$data) == 0)
stop('Data contains no (complete) rows')
## read data ----
mydata <- self$data
vars <- self$options$dep
for (var in vars)
mydata[[var]] <- jmvcore::toNumeric(mydata[[var]])
## Exclude NA ----
mydata <- jmvcore::naOmit(mydata)
## type of statistics ----
typestatistics <-
jmvcore::constructFormula(
terms = self$options$typestatistics)
dep <- self$options$dep
## arguments ----
binwidth <- NULL
if(self$options$changebinwidth) {
binwidth <- self$options$binwidth
}
# grouped_gghistostats
# https://indrajeetpatil.github.io/ggstatsplot/reference/grouped_gghistostats.html
grvar <- self$options$grvar
## dep = 1 ----
if (length(self$options$dep) == 1) {
plot2 <- ggstatsplot::grouped_gghistostats(
data = mydata,
x = !!rlang::sym(dep),
grouping.var = !!rlang::sym(grvar)
, type = typestatistics
, normal.curve = self$options$normalcurve
, results.subtitle = self$options$resultssubtitle
, centrality.plotting = self$options$centralityline
, binwidth = binwidth
)
}
## dep > 1 ----
if (length(self$options$dep) > 1) {
dep2 <- as.list(self$options$dep)
dep2_symbols <- purrr::map(dep2, rlang::sym)
plotlist <-
purrr::pmap(
.l = list(
x = dep2_symbols,
messages = FALSE),
.f = function(x, messages) {
ggstatsplot::grouped_gghistostats(
data = mydata,
x = !!x,
messages = messages,
grouping.var = !!rlang::sym(grvar)
, type = typestatistics
, normal.curve = self$options$normalcurve
, results.subtitle = self$options$resultssubtitle
, centrality.plotting = self$options$centralityline
, binwidth = binwidth
)
}
)
plot2 <-
ggstatsplot::combine_plots(
plotlist = plotlist,
plotgrid.args = list(ncol = 1)
)
}
## Print Plot 2 ----
print(plot2)
TRUE
}
)
)