R/roc.b.R

In sbalci/ClinicoPathJamoviModule: Analysis for Clinicopathological Research

#' @title ROC Analysis
#'
#' @importFrom R6 R6Class
#' @import jmvcore
#'


rocClass <- if (requireNamespace("jmvcore")) R6::R6Class("rocClass", inherit = rocBase,
    private = list(.run = function() {

        # Error Message ----

        if (nrow(self$data) == 0) stop("Data contains no (complete) rows")



        if (is.null(self$options$measurement) || is.null(self$options$status) ) {

            # ToDo Message ----


            todo <- "
                <br>Welcome to ClinicoPath
                          <br><br>
                          This tool will help you form a ROC Curve.
                          "

            html <- self$results$todo
            html$setContent(todo)

        } else {

            todo <- ""
            html <- self$results$todo
            html$setContent(todo)



            #Errors ----


            if (nrow(self$data) == 0)
                stop('Data contains no (complete) rows')

            # Prepare Data ----


            varMeasure <- self$options$measurement
            varStatus <- self$options$status

            mydata <- jmvcore::select(self$data, c(varMeasure, varStatus))



            # Exclude NA ----

            excl <- self$options$excl

            if (excl) {mydata <- jmvcore::naOmit(mydata)}



            self$results$text$setContent(head(mydata))



            # plotROC
            #
            # http://sachsmc.github.io/plotROC/


            # plot <- mydata %>%
            #     ggplot2::ggplot(.,
            #                     ggplot2::aes(d = .data[[varStatus]], m = .data[[varMeasure]])
            #     ) +
            #     plotROC::geom_roc(
            #         labels = TRUE,
            #         n.cuts = 5,
            #         labelsize = 5,
            #         labelround = 2
            #     )


            # sty <- self$options$sty
            #
            # if (sty) {
            #
            #     plot <- plot +
            #         plotROC::style_roc(
            #             theme = theme_grey,
            #             xlab = "1 - Specificity"
            #         )
            #
            # }


            # quant <- self$options$quant
            # if (quant) {
            #     plot <- plot +
            #         plotROC::geom_rocci(
            #             sig.level = .01,
            #             ci.at = quantile(varMeasure, c(.1, .4, .5, .6, .9))
            #         )
            # }



            # label <- self$options$label
            #
            # if (label) {
            #     plot <-
            #         plotROC::direct_label(
            #             ggroc_p = plot,
            #             labels = "Biomarker",
            #             label.angle = 45,
            #             nudge_x = 0,
            #             nudge_y = -.1,
            #             size = 6
            #         )
            #     # +
            #     # plotROC::style_roc()
            #
            #
            # }


            # inter <- self$options$inter
            #
            # if (inter) {
            #
            # plot <- mydata %>%
            #     ggplot2::ggplot(.,
            #                     ggplot2::aes(d = .data[[varStatus]], m = .data[[varMeasure]])
            #     ) +
            #     plotROC::geom_roc(
            #         # labels = TRUE,
            #         # n.cuts = 5,
            #         # labelsize = 5,
            #         # labelround = 2
            #     )
            #
            #
            # # Interactive Plots
            #
            # plot <- plotROC::plot_interactive_roc(plot)
            #
            #
            # # opens in new html
            #
            #
            # # plot2 <- plotROC::export_interactive_roc(plot2)
            # # no output
            #
            #
            # # plot2 <- cat(plotROC::export_interactive_roc(plot2))
            # # no output
            #
            # # knitr::asis_output(plot2)
            #
            # }


            # plot <- knitr::asis_output(plot)


            # self$result$textplot$setContent(plot)



        # Prepare plot data

        # image <- self$results$plot
        # image$setState(plotData)


        # plot3 <- private$.plot2()
        # self$results$plot3$setContent(plot3)


}


    }

,

    .plot=function(image, ggtheme, theme, ...) {


        # Error Messages

        if (is.null(self$options$measurement) || is.null(self$options$status) )
            return()

        if (nrow(self$data) == 0)
            stop('Data contains no (complete) rows')

        # Prepare Data ----


        varMeasure <- self$options$measurement
        varStatus <- self$options$status

        mydata <- jmvcore::select(self$data, c(varMeasure, varStatus))



        # Exclude NA ----

        excl <- self$options$excl

        if (excl) {mydata <- jmvcore::naOmit(mydata)}



        # set.seed(2529)
        # D.ex <- rbinom(250, size = 1, prob = .5)
        # M1 <- rnorm(250, mean = D.ex, sd = .65)
        # M2 <- rnorm(250, mean = D.ex, sd = 1.5)
        #
        # plotData <- data.frame(D = D.ex,
        #                        D.str = c("Healthy", "Ill")[D.ex + 1],
        #                        M1 = M1,
        #                        M2 = M2,
        #                        stringsAsFactors = FALSE)

        plot <- mydata %>%
            ggplot2::ggplot(.,
                            ggplot2::aes(d = .data[[varStatus]], m = .data[[varMeasure]])
                            ) +
            plotROC::geom_roc(
                labels = TRUE,
                n.cuts = 5,
                labelsize = 5,
                labelround = 2
            )


        sty <- self$options$sty

        if (sty) {

            plot <- plot +
            plotROC::style_roc(
                theme = theme_grey,
                xlab = "1 - Specificity"
            )

        }


        quant <- self$options$quant

        if (quant) {
            plot <- plot +
            plotROC::geom_rocci(
                sig.level = .01,
                ci.at = quantile(varMeasure, c(.1, .4, .5, .6, .9))
            )
        }



        label <- self$options$label

        if (label) {
            plot <-
        plotROC::direct_label(
            ggroc_p = plot,
            labels = "Biomarker",
            label.angle = 45,
            nudge_x = 0,
            nudge_y = -.1,
            size = 6
            )
            # +
            # plotROC::style_roc()


        }




        print(plot)
        TRUE
    }


    ,

    .plot2=function(image, ggtheme, theme, ...) {



        # Error Messages

        if (is.null(self$options$measurement) || is.null(self$options$status) )
            return()

        if (nrow(self$data) == 0)
            stop('Data contains no (complete) rows')

        # Prepare Data ----


        varMeasure <- self$options$measurement
        varStatus <- self$options$status

        mydata <- jmvcore::select(self$data, c(varMeasure, varStatus))



        # Exclude NA ----

        excl <- self$options$excl

        if (excl) {mydata <- jmvcore::naOmit(mydata)}




        plot2 <- mydata %>%
            ggplot2::ggplot(.,
                            ggplot2::aes(d = .data[[varStatus]], m = .data[[varMeasure]])
            ) +
            plotROC::geom_roc(
                # labels = TRUE,
                # n.cuts = 5,
                # labelsize = 5,
                # labelround = 2
            )


    # Interactive Plots

        plot2 <- plotROC::plot_interactive_roc(plot2)


        # opens in new html


        # plot2 <- plotROC::export_interactive_roc(plot2)
        # no output


        # plot2 <- cat(plotROC::export_interactive_roc(plot2))
        # no output

        knitr::asis_output(plot2)

        # print(plot2)
        # TRUE


    }


    # Multiple ROC Curves
    # http://sachsmc.github.io/plotROC/

    # New Features

    # Advanced Options


    )
    )




# Other ROC Packages on CRAN
#
# AROC: Covariate-Adjusted Receiver Operating Characteristic Curve Inference
# https://cran.r-project.org/web/packages/AROC/index.html