R/jjhistostats.b.R

In sbalci/ClinicoPathJamoviModule: Analysis for Clinicopathological Research

#' @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

            }
        )
    )