R/subscreenshow.R

In subscreen: Systematic Screening of Study Data for Subgroup Effects

#' (ii) Visualization
#'
#' Start the Shiny based interactive visualization tool to show the subgroup results
#' generated by subscreencalc.
#' See and explore all subgroup results at one glance. Pick and chose a specific
#' subgroup, the level of combinations or a certain factor with its combinations.
#' Switch easily between different endpoint/target variables.
#'
#' @param scresults SubScreenResult object with results from a subscreencalc call
#' @param variable_importance variable importance object calculated via subscreenvi to unlock
#'        'variable importance'-tab in the app
#' @param host host name or IP address for Shiny display
#' @param port  port number for Shiny display
#' @param NiceNumbers list of numbers used for a 'nice' scale
#' @param windowTitle title which is shown for the browser tab
#' @param graphSubtitle subtitle for explorer plot
#' @param favour_label_verum_name verum name for label use in explorer graph
#' @param favour_label_comparator_name comparator name for label use in explorer graph
#'
#' @keywords subgroup analysis visualization
#' @import shiny
#' @importFrom methods is
#' @export subscreenshow

subscreenshow <- function (
    scresults = NULL,
    variable_importance = NULL,
    host = NULL,
    port = NULL,
    NiceNumbers = c(1, 1.5, 2, 4, 5, 6, 8, 10),
    windowTitle = "Subgroup Explorer",
    graphSubtitle = NULL,
    favour_label_verum_name = NULL,
    favour_label_comparator_name = NULL
  ){

  ####.. warnings ####
  if (!is.null(scresults)) {
    if (is(scresults) != "SubScreenResult") {
      cat("Error: subscreenshow requires results of class 'SubScreenResult'")
      stop()
    }
  }
  if (!requireNamespace("shiny", quietly = TRUE)) {
    cat("Error: subscreenshow requires the package shiny to be installed")
    stop()
  }
  if (!requireNamespace("shinyjs", quietly = TRUE)) {
    cat("Error: subscreenshow requires the package shinyjs to be installed")
    stop()
  }
  if (!requireNamespace("bsplus", quietly = TRUE)) {
    cat("Error: subscreenshow requires the package bsplus to be installed")
    stop()
  }
  if (!requireNamespace("colourpicker", quietly = TRUE)) {
    cat("Error: subscreenshow requires the package colourpicker to be installed")
    stop()
  }
  if (!requireNamespace("DT", quietly = TRUE)) {
    cat("Error: subscreenshow requires the package DT to be installed")
    stop()
  }
  if (!requireNamespace("dplyr", quietly = TRUE)) {
    cat("Error: subscreenshow requires the package dplyr to be installed")
    stop()
  }

  appDir <- system.file("shiny-app", "subscreen",  "app.R", package = "subscreen")
  if (appDir == "") {
    stop("Could not find Shiny app directory. Please try to re-install `subscreen`.", call. = FALSE)
  }

  apppars <- list(
    scresults = scresults,
    scresults_name = deparse(substitute(scresults)),
    variable_importance = variable_importance,
    NiceNumbers = NiceNumbers
  )

  ui <- server <- NULL

  source(appDir, local=TRUE)
  server_env <- environment(server)

  server_env$apppars <- apppars

  app <- shiny::shinyApp(ui, server)

  shiny::runApp(app, display.mode = "normal", host = host, port = port)

}