############################ SPS New Tab Functions ############################
# #' Create a new SPS tab
# #' @description Functions to create a new SPS tab. It is recommended to create
# #' the data tab first then its linked plot tabs.
# #' @param tab_id character string, length 1, must start with "*plot_*" for plot
# #' tabs and "*data_*" for data tabs. Must be a unique value. use
# #' [spsTabInfo(app_path = "YOUR_APP_PATH")][spsTabInfo()] to see current tab
# #' IDs.
# #' @param tab_displayname character string, length 1, the name to be displayed
# #' on side navigation bar list and tab title
# #' @param desc character string, length 1 in markdown format. Tab description
# #' and instructions. You can make type it in multiple lines but in only one
# #' string (one pair of quotes). e.g.
# #' ```
# #' "
# #' # some desc
# #' ## second line,
# #' - bullet 1
# #' - bullet 2
# #' "
# #' ```
# #' @param img realtive path, ideally a plot screenshot of users expect
# #' to see when they make the plot. It can be a internet link or a local
# #' link which uses the *www* folder asthe root.
# #' e.g. drop your image *plot.png* inside *www/plot_list*, then the
# #' link here is "plot_list/plot.png". Only needed for plot tabs.
# #' @param plot_control_ui additional UI components you want to
# #' add to control plotting options, like additional slider bar, some on/off
# #' switches, text input etc. If more than one components, put them in a
# #' [shiny::tagList]
# #' @param plot_expr the plot expression, like all other expression in other
# #' shiny reactive expressions. e.g for more than one line use *{}*. Only to be
# #' used for plot tabs. default is
# #' ```
# #' plotly::ggplotly(
# #' ggplot2::ggplot(mydata$data,
# #' ggplot2::aes_string(names(mydata$data)[1],
# #' names(mydata$data)[2])
# #' ) +
# #' ggplot2::geom_point(aes(
# #' color = seq_len(nrow(mydata$data))
# #' ))
# #' )
# #' ```
# #'
# #' @param pkgs which packages you require users to install, list. specify
# #' CRAN, bioconductor or github packages in a vector. see
# #' [shinyCheckPkg]
# #' ```
# #' list(
# #' cran_pkg = c("base"),
# #' bioc_pkg = c(""),
# #' github = c("")
# #' )
# #' ```
# #' @param plot_data a list of *makePlotData()* results, see [makePlotData] for
# #' details.
# #' ```
# #' list(
# #' makePlotData("plot_1", ...),
# #' makePlotData("plot_2", ...),
# #' ...
# #' )
# #' ```
# #' @param plot_out_func the plot output function to use on UI,
# #' like [shiny::plotOutput], just the function name without quotes
# #' and without *()*. default is [plotly::plotlyOutput].
# #' @param plot_render_func The render plot function to use on server. No quotes,
# #' no *()*. Must be **paired** with *plot_out_func*. e.g
# #' If [plotly::plotlyOutput] is used on UI, server must use
# #' [plotly::renderPlotly]. If you use [shiny::renderPlot],
# #' plot will not show up.
# #' @param app_path string, app directory, default is current directory
# #' @param out_folder_path string, which directory to write the new tab file,
# #' default is the *R* folder in the SPS project
# #' @param plugin character string, if you are building a tab for a plugin, you
# #' can specify the plugin name here.
# #' @param author character string, or a vector of strings. authors of the tab
# #' @param empty bool, for **advanced developers**, if you don't want to
# #' use SPS default tab UI and server structure, you can use turn this to *TRUE*.
# #' A very simple template will be generated and you need to write all UI and
# #' server parts by yourself. In this case, only `tab_id`, `display_name`,
# #' `author` are needed, other
# #' tab args can be ignored, system args are still working, like `verbose`,
# #' `preview`, `style`, `colorful`
# #' @param preview bool, *TRUE* will print the new tab code to console and will
# #' not write the file and will not register the tab
# #' @param use_string bool, sometimes parsing an expression in R may not be
# #' totally accurate. To aviod this problem, turn this to *TRUE* and for
# #' *plot_control_ui*, *plot_expr*, *p_out_func*, *p_render_func*, wrap your
# #' expression in a quoted string. What you have provided in the string will be
# #' what on the new tab file, no expression parsing will happen. Can only be
# #' controlled as a group, which means use string for all of them or none of
# #' them in plot tabs. For data tab, the affected argument is *common_validation*
# #' . When turn this to *TRUE*, be careful with quotes in your expression,
# #' escape or use alternative of single/double quotes.
# #' ```
# #' newTabPlot(
# #' ...
# #' use_string = TRUE,
# #' plot_control_ui = "
# #' tagList(clearableTextInput('id1', 'label')), h5('this title')
# #' ",
# #' plot_expr = "
# #' plotly::ggplotly(
# #' ggplot2::ggplot(mydata$data,
# #' ggplot2::aes_string(names(mydata$data)[1],
# #' names(mydata$data)[2])) +
# #' ggplot2::geom_point(aes(
# #' color = seq_len(nrow(mydata$data))
# #' ))
# #' )
# #' ",
# #' p_out_func = "plotly::plotlyOutput"
# #' ...
# #' )
# #' ```
# #' @param reformat bool, whether to use [styler::style_file] reformat the code
# #' @param open_file bool, if Rstudio is detected, open the new tab file?
# #' @param verbose bool, default follows the project verbosity level.
# #' *TRUE* will give you more information on progress and debugging
# #' @param colorful bool, whether the message will be colorful or not
# #' @details
# #' - Must use this function inside a SPS project, use [spsInit()] if
# #' there is no project.
# #' - For a new data tab, different preprocessing methods, their
# #' pre-prequirements and what plotting options available after each
# #' preprocess is controlled by the [makePrepro()] function. Each call from
# #' [makePrepro] function specify one preprocessing method.
# #' All preprocess methods should be provided in a list
# #' and passed to the *prepro_methods* argument.
# #' - A new plot tab can have more than one data set as the input. For example a
# #' plot can require a metadata table and a log transformed table as inputs.
# #' There can also be multiple data tabs can preprocess and produce the same log table.
# #' So you need to specify how many data inputs this plot requires; for each
# #' input which data tab(s) this plot tab can receive data from; for each input
# #' data type, what validations (data format checks) you want to do. All of these
# #' are controlled by [makePlotData] and return(s) of this function should be
# #' provided in a list to the *plot_data* argument.
# #' - Different reprocess methods in a data tab
# #' is controlled by the [makePrepro] function. Each call from
# #' this function specify one preprocessing method. All preprocess methods
# #' should be provided in a list to the *prepro_methods* argument.
# #' - One of the steps in creating a plot tab is to specify incoming data source.
# #' This is controlled by `receive_datatab_ids` argument in [makePlotData()].
# #' It requires the data tab IDs exist in the
# #' config file *config/tabs.csv*. So, it is best to create all required data
# #' tabs first. Or specify it to any existing data tab like 'data_example' and
# #' when the template is created, manually change it.
# #' @return a tab file in R folder and tab info registered on config/tabs.csv
# #' @export
# #' @importFrom rlang enquo
# #' @examples
# #' spsInit(change_wd = FALSE, overwrite = TRUE)
# #' newTabData(
# #' tab_id = "data_new",
# #' tab_displayname = "my first data tab",
# #' prepro_methods = list(makePrepro(label = "do nothing",
# #' plot_options = "plot_new")),
# #' app_path = glue::glue("SPS_{format(Sys.time(), '%Y%m%d')}")
# #' )
# #' newTabPlot(
# #' tab_id = "plot_new1",
# #' tab_displayname = "my first plot tab",
# #' plot_data = list(
# #' makePlotData(dataset_label = "Data from my new tab",
# #' receive_datatab_ids = "data_new",
# #' app_path = glue::glue("SPS_{format(Sys.time(), '%Y%m%d')}"))
# #' ),
# #' app_path = glue::glue("SPS_{format(Sys.time(), '%Y%m%d')}")
# #' )
# #' newTabData(
# #' tab_id = "data_empty",
# #' tab_displayname = "my first empty data tab",
# #' empty = TRUE,
# #' app_path = glue::glue("SPS_{format(Sys.time(), '%Y%m%d')}")
# #' )
# #' newTabPlot(
# #' tab_id = "plot_empty",
# #' tab_displayname = "my first empty plot tab",
# #' empty = TRUE,
# #' app_path = glue::glue("SPS_{format(Sys.time(), '%Y%m%d')}")
# #' )
# newTabPlot <- function(tab_id = "plot_id1",
# tab_displayname = "Plot Tab Title",
# desc = "default",
# img = "",
# plot_expr = plotly::ggplotly(
# ggplot2::ggplot(
# mydata$data,
# ggplot2::aes_string(names(mydata$data)[1], names(mydata$data)[2])) +
# ggplot2::geom_point(ggplot2::aes(
# color = seq_len(nrow(mydata$data))
# ))
# ),
# pkgs = list(
# cran_pkg = c("base"),
# bioc_pkg = c(""),
# github = c("")
# ),
# plot_data = list(makePlotData(app_path = app_path)),
# plot_out_func = plotly::plotlyOutput,
# plot_render_func = plotly::renderPlotly,
# app_path = getwd(),
# out_folder_path = file.path(app_path, "R"),
# plot_control_ui = tagList(h3("Some plotting options")),
# author = "",
# plugin = "",
# empty = FALSE,
# preview = FALSE,
# use_string = FALSE,
# reformat = TRUE,
# open_file = TRUE,
# verbose = spsOption("verbose"),
# colorful = spsOption("use_crayon")){
# msg("This function is suspended in version >= 1.1, use 'spsNewTab' instead.", "NOTICE", "orange")
# verbose_old <- spsOption('verbose')
# colorful_old <- spsOption('use_crayon')
# spsOption('verbose', verbose)
# spsOption('use_crayon', colorful)
# spsinfo("Asserting tab ID")
# spsinfo(glue("Asserting info for tab {tab_id}"))
# out_p <- file.path(out_folder_path, glue("tab_vs_{tab_id}.R"))
# .newtabAsserts(tab_id = tab_id, tab_displayname = tab_displayname,
# desc = desc, author = author,
# out_folder_path = out_folder_path,
# out_p = out_p, app_path = app_path,
# plot_data = plot_data,
# reformat = reformat, open_file = open_file,
# type_sub = "plot", preview = preview, img = img)
# spsinfo("Creates descrption")
# if(desc == "default") desc <- "
# #### Some Description of this data in markdown
# - you should ...
# 1. eg 1.
# 2. eg 2.
# - **Notice**: ...`this` ...
#
#
# ```
# some code demo ...
# ```
# "
# spsinfo("Parsing plot `data` methods")
# pt_data <- .collectPlotData(plot_data)
# pg_title <- pt_data[['pg_title']]
# pg_id <- pt_data[['pg_id']]
# hreftab <- pt_data[['hreftab']]
# select_input <- pt_data[['select_input']]
# getdata <- pt_data[['getdata']]
# vd <- pt_data[['vd']]
# spsinfo("Parsing plot expression")
# plot_expr <- .expr2string(rlang::enquo(plot_expr), use_string)
# spsinfo("Parsing plot output and render function")
# p_out_func <- .expr2string(rlang::enquo(plot_out_func), use_string)
# p_render_func <- .expr2string(rlang::enquo(plot_render_func), use_string)
# spsinfo("Parsing plot UI control HTML")
# control_ui <- .expr2string(rlang::enquo(plot_control_ui), use_string)
# spsinfo("Parsing package requirements")
# pkgs <- .resolveTabPkg(pkgs)
# spsinfo("Parsing author(s)")
# author <- glue_collapse(author, sep = ", ")
# spsinfo("Ensure all template replacements are length 1 strings")
# list(tab_id, tab_displayname, desc,
# pg_id, pg_title, select_input,
# getdata, vd, plot_expr,
# p_out_func, p_render_func, author,
# pkgs, hreftab, control_ui) %>%
# {
# check_names <- c("tab Id", "display name", "description",
# "progress data ID", "progress data title",
# "data input selection", "get data expr",
# "data validation expr", "plot expression",
# "plot output func", "plot render func",
# "author", "Package requirements",
# "data href tab", "plot control UI")
# mapply(function(x, name){
# if(length(x) != 1){
# spserror(glue("Injection {name} is not a length 1 string:
# {glue_collapse(x, '\n---\n')}"))
# }
# }, x = ., name = check_names)
# }
# spsinfo("Start to inject to template...")
# crt_date <- Sys.time()
# tmp_file <- if(!empty)"plot_tab_template.R" else "plot_tab_template_empty.R"
# tmp <- readLines(
# system.file(file.path("app", "templates", tmp_file),
# package = "systemPipeShiny")
# ) %>%
# glue_collapse(sep = '\n') %>%
# glue(.open = "#@", .close = "@#")
# if(preview) return(cat(tmp))
# spsinfo(glue("Write to file {out_p}"), TRUE)
# writeLines(tmp, out_p)
# # reformat
# .reformatTab(reformat, out_p)
# # register tab
# .registerTabWrapper(type_sub = "plot", img, tab_id, tab_displayname,
# app_path, out_p, open_file, plugin = plugin)
# # reset verbose to whatever before the function runs
# spsOption('verbose', verbose_old)
# msg("New tab created!", "SPS-SUCCESS", "green")
# spsOption('use_crayon', colorful_old)
# return(invisible())
# }
#
#
# #' @rdname newTabPlot
# #' @param common_validation expression, use '\{\}' to wrap around multiple line
# #' expressions. Usually a [spsValidate] object. You can use shiny's built in
# #' [shiny::req] or [shiny::validate] for a simpler version.
# #' @param prepro_methods a list of [makePrepro] method returns, read help for
# #' that function for details
# #' @param eg_path example data set path. Each data tab requires an example data
# #' set to be displayed when users don't have anything to upload. Usually this
# #' data file is a tabular file and stored in the *data* folder in a SPS
# #' project
# #' @export
# #' @importFrom rlang enquo
# newTabData <- function(tab_id = "data_id1",
# tab_displayname = "Data Tab Title",
# desc = "default",
# pkgs = list(
# cran_pkg = c("base"),
# bioc_pkg = c(""),
# github = c("")
# ),
# common_validation = spsValidate({"pass"}, "common"),
# prepro_methods = list(
# makePrepro("nothing", "do nothing"),
# makePrepro("md1", "method1",
# vd_expr = {nrow(data_filtered) > 1})
# ),
# app_path = getwd(),
# out_folder_path = file.path(app_path, "R"),
# eg_path = file.path(app_path, "data", "iris.csv"),
# plugin = "",
# author = "",
# empty = FALSE,
# preview = FALSE,
# reformat = TRUE,
# open_file = TRUE,
# use_string = FALSE,
# verbose = spsOption("verbose"),
# colorful = spsOption("use_crayon")){
# msg("This function is suspended in version >= 1.1, use 'spsNewTab' instead.", "NOTICE", "orange")
# verbose_old <- spsOption('verbose')
# colorful_old <- spsOption('use_crayon')
# spsOption('verbose', verbose)
# spsOption('use_crayon', colorful)
# spsinfo("Asserting tab ID")
# spsinfo(glue("Asserting info for tab {tab_id}"))
# out_p <- file.path(out_folder_path, glue("tab_vs_{tab_id}.R"))
# .newtabAsserts(tab_id = tab_id, tab_displayname = tab_displayname,
# desc = desc, author = author,
# out_folder_path = out_folder_path,
# out_p = out_p, app_path = app_path,
# prepro_methods = prepro_methods,
# reformat = reformat, open_file = open_file,
# type_sub = "data", preview = preview)
# spsinfo("Creates descrption")
# if(desc == "default") desc <- "
# #### Some Description of this data in markdown
# - you should ...
# 1. eg 1.
# 2. eg 2.
# - **Notice**: ...`this` ...
#
#
# ```
# some code demo ...
# ```
# "
# spsinfo("Parsing common validation")
# common_validation <- .expr2string(rlang::enquo(common_validation), use_string)
# spsinfo("Parsing preprocess methods")
# prepro <- .collectPrepro(prepro_methods)
# choices <- prepro[['choices']]
# vds <- prepro[['vds']]
# pre <- prepro[['pres']]
# pt_options <- prepro[['pt_opts']]
# spsinfo("Parsing package requirements")
# pkgs <- .resolveTabPkg(pkgs)
# spsinfo("Parsing author(s)")
# author <- glue_collapse(author, sep = ", ")
# eg_path = eg_path = normalizePath(eg_path, winslash = "/")
# spsinfo("Ensure all template replacements are length 1 strings")
# list(tab_id, tab_displayname, desc, common_validation,
# choices, vds, pre, author, eg_path, pkgs) %>%
# {check_names <- c("tab Id", "display name", "description",
# "common validation expressions",
# "preprocess choices", "preprocess validation",
# "preprocess method", "author", "example file",
# "Package requirements")
# mapply(function(x, name){
# if(length(x) != 1){
# spserror(glue("Injection {x} is not a length 1 string"))
# }
# }, x = ., name = check_names)
# }
# spsinfo("Start to inject to template...")
# crt_date <- Sys.time()
# tmp_file <- if(!empty)"data_tab_template.R" else "data_tab_template_empty.R"
# tmp <- readLines(
# system.file(file.path("app", "templates", tmp_file),
# package = "systemPipeShiny")
# ) %>%
# glue_collapse(sep = '\n') %>%
# glue(.open = "#@", .close = "@#")
# if(preview) return(cat(tmp))
# spsinfo(glue("Write to file {out_p}"), TRUE)
# writeLines(tmp, out_p)
# # reformat
# .reformatTab(reformat, out_p)
# # register tab
# .registerTabWrapper(type_sub = "data", img = "", tab_id, tab_displayname,
# app_path, out_p, open_file, plugin = plugin)
# # reset verbose to whatever before the function runs
# # reset verbose to whatever before the function runs
# spsOption('verbose', verbose_old)
# msg("New tab created!", "SPS-SUCCESS", "green")
# spsOption('use_crayon', colorful_old)
# return(invisible())
# }
#
#
# #' Create data receiving methods for plot tabs
# #' @description This function specify for each input data type in a plot tab,
# #' 1. where the data is coming from, 2. how to validate incoming data.
# #' To use this function, make sure there is a SPS project and
# #' *config/tabs.csv* exists.
# #' @param dataset_id string, length 1, a unique ID within this plot
# #' tab.
# #' @param dataset_label string, length 1, what label to display on UI for this
# #' type of input data
# #' @param receive_datatab_ids a vector of tab IDs: for this kind of data input,
# #' which data tabs that can be used as input source(s). For example, if this
# #' plot tab requires a dataframe and can be produced from "data_df1" or
# #' "data_df2", *receive_datatab_ids = c("data_df1", "data_df2")*. These options
# #' are later rendered as a drop down menu for users to choose where
# #' they have prepared the required data from.
# #' @param app_path path, SPS project folder
# #' @param vd_expr what expression to validate(check) the incoming data set.
# #' Usually it is a [spsValidate] object
# #' @param use_string bool, if you don't want to parse *vd_expr*, use quoted
# #' string for *vd_expr* and turn this to TRUE. See the same argument in
# #' [newTabPlot]
# #'
# #' @return a special list that stores one type of data input info
# #' @export
# #' @details For the validation expression, the incoming data is stored in a
# #' reactive values object, and you can access this data object
# #' by *mydata$dataset_id*,
# #' e.g. the dataset_id is "raw_data", then when the time you validate this
# #' type of incoming data set, a variable *mydata$raw_data* is accessible. So you
# #' can directly use `mydata$raw_data` in *vd_expr*.
# #'
# #' It is recommended to create data tabs first before running this function,
# #' because *receive_datatab_ids* required data tab id exists in the *tabs.csv*
# #' file.
# #' @seealso [newTabPlot]
# #' @importFrom rlang enquo
# #' @examples
# #' spsInit(change_wd = FALSE, overwrite = TRUE, project_name = "SPS_plotdata")
# #' newTabData("data_df1", "df 1",
# #' app_path = "SPS_plotdata",
# #' open_file = FALSE)
# #' newTabData("data_df2", "df 2",
# #' app_path = "SPS_plotdata",
# #' open_file = FALSE)
# #' plotdata_raw <- makePlotData("raw", "raw data",
# #' receive_datatab_ids = "data_df1",
# #' vd_expr = spsValidate({
# #' if(!is.data.frame(mydata$raw))
# #' stop("Input raw data need to be a dataframe")
# #' }, vd_name = "Validate raw data"),
# #' app_path = "SPS_plotdata")
# #' plotdata_meta <- makePlotData("meta", "meta data",
# #' receive_datatab_ids = c("data_df1", "data_df2"),
# #' vd_expr = spsValidate({
# #' if(!is.data.frame(mydata$meta))
# #' stop("Input raw data need to be a dataframe")
# #' if(nrow(mydata$meta) < 1)
# #' stop("Input raw data need to have at least one row")
# #' }, vd_name = "Validate meta data"),
# #' app_path = "SPS_plotdata")
# #' newTabPlot("plot_test1",
# #' app_path = "SPS_plotdata",
# #' plot_data = list(plotdata_raw, plotdata_meta))
# makePlotData <- function(dataset_id = "data",
# dataset_label = "Raw data",
# receive_datatab_ids = "data_example",
# vd_expr = spsValidate({
# if(is.data.frame(mydata$data)) TRUE
# else stop("Data xx needs to be a dataframe or tibble")
# }),
# app_path = getwd(),
# use_string = FALSE){
# msg("This function is suspended in version >= 1.1, use 'spsNewTab' instead.", "NOTICE", "orange")
# stopifnot(is.character(dataset_id) & length(dataset_id) == 1)
# stopifnot(is.character(dataset_label) & length(dataset_label) == 1)
# stopifnot(is.character(receive_datatab_ids))
# spsinfo(glue("Creates plot data method for {dataset_id}"))
# rec_tab_labels <- lapply(
# receive_datatab_ids,
# function(x){
# label <- findTabInfo(
# x, force_reload = TRUE,
# tab_file =
# file.path(app_path, "config", "tabs.csv"))[['tab_labels']]
# if(nchar(label) == 0){
# as.character(x)
# } else label
# }
# ) %>% unlist()
# vd_expr_parsed <- .expr2string(rlang::enquo(vd_expr), use_string)
# structure(
# list(id = dataset_id,
# dataset_label = dataset_label,
# receive_datatab_ids = receive_datatab_ids,
# rec_tab_labels = rec_tab_labels,
# vd = vd_expr_parsed
# ),
# class = c("sps-plotdata")
# )
# }
#
#
# #' Create data tab preprocess methods
# #' @description On a data tab, given the same uploaded data set,
# #' users can choose different ways to preprocess the data and therefore
# #' different preprocessing methods will lead to different plot tab options.
# #' Every call of this function defines a preprocess method: 1. data
# #' validation expression before preprocess; 2. actual preprocess expression; 3.
# #' plot options after preprocess.
# #' @param method_id string, length 1, a unique ID within this data tab.
# #' @param label string, length 1, what label to display on UI for users to
# #' choose as a preprocess option
# #' @param vd_expr expression, usually a [spsValidate] object. Before preprocess
# #' if there is any additional validation that is special to this preprocess
# #' method, you can specify here
# #' @param pre_expr The actual preprocess expression. You should use
# #' a pre-created variable called *data_filtered* to start and this is the
# #' object that contains filtered data after users filtering on the UI. In the
# #' end of this expression, you should return a preprocessed dataframe or
# #' whatever object type that can be accepted by the desired plot tab. It is
# #' recommended to write the preprocess method into a function and directly call
# #' the function here, e.g.
# #' ```
# #' myPreprocess <- function(data){
# #' if(is.numeric(data[ ,1]))
# #' data[ ,1] <- data[ ,1] + 1
# #' return(data)
# #' }
# #' makePrepro(
# #' ...,
# #' pre_expr = myPreprocess(data_filtered),
# #' ...
# #' )
# #' ```
# #' @param plot_options plot tab IDs: if data is preprocessed by this method,
# #' what kind of plots it can make, specify plot tab IDs in a vector. Note:
# #' unlike the *receive_datatab_ids* argument in [makePlotData] that requires
# #' the *config/tabs.csv* exists, this argument doesn't require the config file
# #' or the plot tab to be existing. You can use any ID(s) here. The ID checking
# #' is postponed when the [genGallery] function runs on app start. "default"
# #' means all possible plot tabs, the same as *type = 'plot'* in [genGallery].
# #' @param use_string same as the argument in [newTabPlot], controls
# #' *vd_expr* and *pre_expr* in this function
# #' @return a special list that contains all info for a preprocess method
# #' @export
# #' @details for *vd_expr*, *pre_expr* a variable called *data_filtered* is
# #' accessible and is the object where data stored. One should use this
# #' object to do validation or preprocess. See examples.
# #' @importFrom rlang enquo
# #' @examples
# #' spsInit(change_wd = FALSE, overwrite = TRUE, project_name = "SPS_prepro")
# #' # first preprocess method
# #' prepro_log <- makePrepro(
# #' "log", "take log of first column",
# #' vd_expr = spsValidate({
# #' if(!is.data.frame(data_filtered))
# #' stop("Input input data need to be a dataframe")
# #' }, vd_name = "log method pre-checks"),
# #' pre_expr = {
# #' if(is.numeric(data_filtered[ ,1]))
# #' {if(all(data_filtered[ ,1] > 0)){
# #' data_filtered[ ,1] <- log(data_filtered[ ,1])}
# #' }
# #' data_filtered
# #' },
# #' plot_options = c("plot_xx1", "plot_xx2")
# #' )
# #' ## remember to save these helper functions in a R scripts under the R
# #' ## folder. They will be automatically sourced when app starts.
# #' myPreprocess <- function(data){
# #' if(is.numeric(data[ ,1]))
# #' data[ ,1] <- data[ ,1] + 1
# #' return(data)
# #' }
# #' myVd <- function(data, vd_name){
# #' spsValidate({
# #' if(!is.data.frame(data))
# #' stop("Input input data need to be a dataframe")
# #' }, vd_name = vd_name)
# #' }
# #' # second preprocess method
# #' prepro_addone <- makePrepro(
# #' "addone", "add one to first column",
# #' vd_expr = myVd(data_filtered, "add one method pre-checks"),
# #' pre_expr = myPreprocess(data_filtered),
# #' plot_options = c("plot_xx1")
# #' )
# #' # Combine two methods and make a new data tab
# #' newTabData("data_test1", "test 1",
# #' app_path = "SPS_prepro",
# #' prepro_methods = list(prepro_log, prepro_addone)
# #' )
# makePrepro <- function(method_id = "md1",
# label = "New method1",
# vd_expr = spsValidate(is.data.frame(data_filtered)),
# pre_expr ={data_filtered},
# plot_options = "default",
# use_string = FALSE){
# msg("This function is suspended in version >= 1.1, use 'spsNewTab' instead.", "NOTICE", "orange")
# stopifnot(is.character(method_id))
# stopifnot(is.character(label))
# stopifnot(is.character(plot_options))
# spsinfo(glue("Creates preprocess method for {method_id}"))
# vd_expr_parsed <- .expr2string(rlang::enquo(vd_expr), use_string)
# pre_expr_parsed <- .expr2string(rlang::enquo(pre_expr), use_string)
# if(plot_options[1] == 'default'){
# p_option <- ("type = 'plot'")
# } else if(length(plot_options) == 1){
# p_option <- glue("c('{plot_options}')")
# } else if(length(plot_options) > 1){
# p_option <- glue_collapse(plot_options, sep = "', '") %>%
# {glue("c('{.}')")}
# } else if(!emptyIsFalse(plot_options)) {
# spserror("plot_options can't be empty")
# }
# structure(
# list(id = method_id,
# label = label,
# vd = vd_expr_parsed,
# pre = pre_expr_parsed,
# pt_opts = p_option
# ),
# class = c("sps-prepro")
# )
# }
#' Remove a SPS tab
#' @description Remove a tab R file and remove from the tabs.csv config file
#' @param tab_id tab ID, string, length 1, supports regular expressions, so
#' be careful. If more than one tabs are matched, stop by default
#' @param force bool, whether to ask for confirmation
#' @param app_path app directory
#' @param multiple bool, if matched more than one tab, turn this to *TRUE* can
#' remove more than one tab at a time. Be careful.
#' @param verbose bool, follows project setting, but can be overwrite.
#' *TRUE* will give you more information
#' @param colorful bool, whether the message will be colorful?
#' @return remove the tab file and register info in *tabs.csv*
#' @export
#' @importFrom dplyr slice pull filter
#' @importFrom rlang enquo
#' @importFrom vroom vroom
#' @importFrom utils menu
#' @examples
#' spsInit(change_wd = FALSE, overwrite = TRUE)
#' spsNewTab("vs_new", app_path = glue::glue("SPS_{format(Sys.time(), '%Y%m%d')}"))
#' removeSpsTab("vs_new", force = TRUE,
#' app_path = glue::glue("SPS_{format(Sys.time(), '%Y%m%d')}"))
removeSpsTab <- function(tab_id="none", force = FALSE,
app_path = getwd(), multiple = FALSE,
verbose = spsOption('verbose'),
colorful = spsOption('use_crayon')){
assert_that(is.character(tab_id) & length(tab_id) == 1)
assert_that(is.logical(multiple))
assert_that(is.logical(verbose))
assert_that(is.logical(force))
spsinfo("checking tabs.csv and R folder", verbose)
if(multiple) msg("You are allowing to remove more than 1 tabs at a time!",
"SPS-DANGER", "red")
tab_file_path <- file.path(app_path, "config", "tabs.csv")
if(!dir.exists(file.path(app_path, "R"))){
spserror(glue("{file.path(app_path, 'R')} does not exist"))
}
if(!file.exists(tab_file_path)){
spserror(glue("tabs.csv does not exist under config folder"))
}
spsinfo("Reading tabs.csv", verbose)
tabs <- readLines(tab_file_path)
header <- tabs[str_which(tabs, "^#")]
tab_info <- suppressMessages(
vroom::vroom(tab_file_path, comment = "#", na = character(),
altrep = FALSE))
spsinfo("Check matching", verbose)
matched_rows <- str_which(tab_info[['tab_id']], tab_id)
matched_ids <- dplyr::slice(tab_info, matched_rows) %>%
dplyr::pull(tab_id)
if(length(matched_rows) == 0){
return(spswarn("No row matched"))
} else if(length(matched_rows) > 1 & !multiple){
glue_collapse(tab_info[['tab_id']][matched_rows], sep = ", ") %>%
{spswarn(glue("matched more than one: {.}"))}
spserror("Remove multiple is FALSE, abort")
}
glue_collapse(matched_ids, sep = ", ") %>% {
spsinfo(glue("Matched tab(s): {.}"), TRUE)
}
if(!force){
switch(utils::menu(c("YES", "NO"), title = "Continue?"),
{},
return(spsinfo("Abort", TRUE))
)
}
dplyr::slice(tab_info, matched_rows) %>%
dplyr::filter(type %in% c("core", "wf")) %>%
dplyr::pull(tab_id) %>%
{if(length(.) > 0){
glue_collapse(., sep = ", ") %>%{
spserror(glue("Core and workflow tabs are not allowed to remove,
match: {.}"))}
}}
spsinfo("Saving back to tabs.csv", verbose)
tabs_left <- dplyr::slice(tab_info, -matched_rows)
c(header, names(tab_info) %>% glue_collapse(sep = ","),
apply(tabs_left, 1, paste, collapse = ",")) %>%
writeLines(tab_file_path)
spsinfo(glue("{length(matched_rows)} tabs removed from tabs.csv"), TRUE)
spsinfo("Now remove tab R files", verbose)
remove_paths <- dplyr::slice(tab_info, matched_rows) %>%
dplyr::pull(tab_file_name) %>%
file.path(app_path, "R", .)
for(i in remove_paths){
spsinfo(glue("Now remove file {i}"), TRUE)
shinyCatch(file.remove(i), shiny = FALSE)
}
msg("Removal complete", "SPS-SUCCESS", "green")
return(invisible())
}
## Internal
# deparse rlang quotes to strings
#' @importFrom rlang eval_tidy
.expr2string <- function(quo_expr, use_string = FALSE){
if(!use_string){
quo_expr %>%
rlang::expr_deparse() %>%
remove_ANSI() %>%
str_remove("^\\^") %>%
glue_collapse(sep = "\n")
} else{
try(rlang::eval_tidy(quo_expr), silent = TRUE) %>% {
if(!is.character(.))
spserror(c("use_string is TRUE but input is not a string ",
"or an expression that returns a string"))}
glue_collapse(rlang::eval_tidy(quo_expr), sep = "\n")
}
}
# register a tab to config file
.tabRegister <- function(tab_id, display_name = "tab_title", app_path = ".",
type="vs", type_sub = "", image = "",
displayed = 1,
tab_file_name = glue("tab_{tab_id}.R"),
plugin = ""){
tab_path <- file.path(app_path, "config", "tabs.csv")
write_info <- glue_collapse(c(tab_id, display_name, type,
type_sub, image, displayed,
tab_file_name, plugin), sep = ",")
write(write_info, tab_path, append = TRUE)
return(TRUE)
}
#' @importFrom rstudioapi isAvailable navigateToFile
#' @noRd
.registerTabWrapper <- function(type_sub = "plot", img = "", tab_id,
tab_displayname, app_path, out_p,
open_file, plugin){
spsinfo("Now register your new tab to config/tab.csv", TRUE)
register_result <- shinyCatch(
.tabRegister(tab_id, tab_displayname, app_path,
type = "vs", type_sub = type_sub, image = img,
displayed = 1, plugin = plugin),
shiny = FALSE
)
if(is.null(register_result)){
spswarn("Can't register your tab, delete created R file")
file.remove(out_p)
spserror("Abort")
}
if(open_file){
spsinfo("Now open the file for you")
if(rstudioapi::isAvailable() & open_file)
rstudioapi::navigateToFile(out_p)
}
}
# must be used within main tab function
#' @importFrom styler style_file tidyverse_style
#' @noRd
.reformatTab <- function(reformat, out_p){
if(reformat){
spsinfo("reformat output R file")
reformat_result <- shinyCatch(styler::style_file(
normalizePath(out_p),
transformers =
styler::tidyverse_style(indent_by = 4,
scope = "line_breaks")
), shiny = FALSE)
if(!emptyIsFalse(reformat_result[['changed']])){
spswarn("Can't reformat your R file, delete created R file")
file.remove(out_p)
spserror("Abort")
}
}
}
# prechecks before create a new tab
.newtabAsserts <- function(tab_id, tab_displayname, desc, author,
out_folder_path, out_p,
app_path, prepro_methods = list(),
plot_data = list(),
reformat, open_file,
type_sub, preview, img = ""){
assert_that(is.character(tab_id) & length(tab_id) == 1)
assert_that(is.character(img) & length(img) == 1)
stopifnot(is.character(author))
stopifnot(is.character(tab_displayname))
stopifnot(is.character(out_folder_path))
stopifnot(is.logical(reformat))
stopifnot(is.logical(open_file))
stopifnot(is.logical(preview))
spsinfo("checking tab ID")
switch (type_sub,
'data' = {
if(!str_detect(tab_id, "^data_"))
spserror("Tab ID must start with 'data_'")
},
'plot' = {
if(!str_detect(tab_id, "^plot_"))
spserror("Tab ID must start with 'plot_'")
}
)
spsinfo("checking output path")
if(file.exists(out_p))
spserror(glue("File {out_p} exists."))
if(str_detect(string = tab_displayname, ",")){
spserror("comma ',' detected in display name, not allowed")
}
stopifnot(is.character(desc))
stopifnot(inherits(prepro_methods, "list"))
stopifnot(inherits(plot_data, "list"))
spsinfo("checking tab ID in tabs.csv")
err <- try(findTabInfo(glue("{type_sub}_{tab_id}"),
tab_file = file.path(app_path, "config", "tabs.csv"),
force_reload = TRUE),
silent = TRUE)
if(inherits(err, "sps-tabinfo")){
spserror(glue("Id '{tab_id}' exists, see your tabs.csv"))
} else if(inherits(err, "try-error")){
if(str_detect(
err[[1]],
glue(".*SPS-ERROR.*{glue('{type_sub}_{tab_id}')}"))){
spsinfo("Tab id no conflict, continue.")
} else spserror(err[[1]])
}
spsinfo("checking R folder")
assert_that(dir.exists(file.path(app_path, "R")),
msg = glue('folder {file.path(app_path, "R")} is not there'))
}
.resolveTabPkg <- function(pkgs){
assert_that(is.list(pkgs))
cran_pkg <- if(is.null(pkgs[['cran_pkg']])) "" else pkgs[['cran_pkg']]
bioc_pkg <- if(is.null(pkgs[['bioc_pkg']])) "" else pkgs[['bioc_pkg']]
github <- if(is.null(pkgs[['github']])) "" else pkgs[['github']]
assert_that(is.character(cran_pkg))
assert_that(is.character(bioc_pkg))
assert_that(is.character(github))
lapply(github, function(x){
if(str_detect(x, "/") | !emptyIsFalse(github)){
if(str_split(x, "/", simplify = TRUE) %>% length >1 &
!emptyIsFalse(github)){
spserror(glue("github pkgs should has only one '/', find {x}"))
}
} else spserror(glue("github pkgs should be 'owner/repo', find {x}"))
})
cran_text <- glue_collapse(cran_pkg, sep = "', '") %>%
{glue("'{.}'")} %>% {glue("cran_pkg = c({.}),")}
bioc_text <- glue_collapse(bioc_pkg, sep = "', '") %>%
{glue("'{.}'")} %>% {glue("bioc_pkg = c({.}),")}
github_text <- glue_collapse(github, sep = "', '") %>%
{glue("'{.}'")} %>% {glue("github = c({.})")}
glue_collapse(c(cran_text, bioc_text, github_text), sep='\n')
}
#' Create a new SPS tab
#' @description create custom tabs in newer (> 1.1) version of SPS. The old
#' creation functions will be deprecated by next Bioconductor major release.
#' @param tab_id character string, length 1, must be unique. Use
#' [spsTabInfo(app_path = "YOUR_APP_PATH")][spsTabInfo()] to see current tab
#' IDs.
#' @param tab_displayname character string, length 1, the name to be displayed
#' on side navigation bar list and tab title
#' @param img realtive path, an image representation of the new plot. It can be
#' a internet link or a local link which uses the *www* folder as the root.
#' e.g. drop your image *plot.png* inside *www/plot_list*, then the
#' link here is "plot_list/plot.png". You will see these images on "Custom Tabs"
#' main page. If no provided, a warning will be given on app start and an empty
#' image will show up on "Custom Tabs".
#' @param app_path string, app directory, default is current directory
#' @param out_folder_path string, which directory to write the new tab file,
#' default is the *R* folder in the SPS project. If you write the file other than
#' *R*, this file will not be automatically loaded by SPS or Shiny. You must source
#' it manually.
#' @param author character string, or a vector of strings. authors of the tab
#' @param template one of "simple" or "full", default "simple". "simple" gives a
#' tab file with minimum Shiny code, you can only focus on you R plotting code.
#' "full" gives the full tab code, so you can modify everything on the tab.
#' @param preview bool, *TRUE* will print the new tab code to console and will
#' not write the file and will not register the tab
#' @param reformat bool, whether to use [styler::style_file] reformat the code
#' @param open_file bool, if Rstudio is detected, open the new tab file?
#' @param verbose bool, default follows the project verbosity level.
#' *TRUE* will give you more information on progress and debugging
#' @param colorful bool, whether the message will be colorful or not
#'
#' @return returns a new tab file
#' @export
#' @details
#' - template "simple": hides the UI and server code and use [spsEzUI] and [spsEzServer] instead.
#' - template "full": full tab code. You need to know some Shiny development knowledge.
#' @examples
#' spsInit(change_wd = FALSE, overwrite = TRUE)
#' spsNewTab("vs_newtab_ez", app_path = glue::glue("SPS_{format(Sys.time(), '%Y%m%d')}"))
#' spsNewTab("vs_newtab_full", template = "full",
#' app_path = glue::glue("SPS_{format(Sys.time(), '%Y%m%d')}"))
#' spsNewTab("vs_newtab_pre", preview = TRUE,
#' app_path = glue::glue("SPS_{format(Sys.time(), '%Y%m%d')}"))
spsNewTab <- function(tab_id = "vs_mytab",
tab_displayname = "My custom plotting tab",
img = "",
app_path = getwd(),
out_folder_path = file.path(app_path, "R"),
author = "",
template = c("simple", "full"),
preview = FALSE,
reformat = FALSE,
open_file = TRUE,
verbose = spsOption("verbose"),
colorful = spsOption("use_crayon")){
#set up color and verbose
verbose_old <- spsOption('verbose')
colorful_old <- spsOption('use_crayon')
spsOption('verbose', verbose)
spsOption('use_crayon', colorful)
# assertions
assert_that(is.character(tab_id) & length(tab_id) == 1)
assert_that(is.character(img) & length(img) == 1)
stopifnot(is.character(author))
stopifnot(is.character(tab_displayname))
stopifnot(is.character(out_folder_path))
template <- match.arg(template, c("simple", "full"))
stopifnot(is.logical(reformat))
stopifnot(is.logical(open_file))
stopifnot(is.logical(preview))
# check output folder
spsinfo("checking R folder")
assert_that(dir.exists(file.path(app_path, "R")),
msg = glue('folder {file.path(app_path, "R")} is not there'))
# check output path
out_p <- file.path(out_folder_path, glue("tab_{tab_id}.R"))
if(file.exists(out_p)) spserror(glue("File {out_p} exists."))
if(str_detect(string = tab_displayname, ",")) spserror("comma ',' detected in display name, not allowed")
# check tab id is in config
err <- try(findTabInfo(tab_id,
tab_file = file.path(app_path, "config", "tabs.csv"),
force_reload = TRUE),
silent = TRUE)
if(inherits(err, "sps-tabinfo")){
spserror(glue("Id '{tab_id}' exists, see your tabs.csv"))
} else if(inherits(err, "try-error")){
if(str_detect(
err[[1]],
glue(".*SPS-ERROR.*{tab_id}"))){
spsinfo("Tab id no conflict, continue.")
} else spserror(err[[1]])
}
# add creation time
crt_date <- Sys.time()
# parse info
spsinfo("Asserting tab ID")
spsinfo(glue("Asserting info for tab {tab_id}"))
spsinfo("Parsing author(s)")
author <- glue_collapse(author, sep = ", ")
# make sure every injection is length 1
list(tab_id, tab_displayname, author, crt_date) %>%
{
check_names <- c("tab Id", "display name", "author", "creation date")
mapply(function(x, name){
if(length(x) != 1){
spserror(glue("Injection {name} is not a length 1 string:
{glue_collapse(x, '\n---\n')}"))
}
}, x = ., name = check_names)
}
# tab creation starts
spsinfo("Start to inject to template...")
temp_path <- if(template == "simple") system.file("app", "templates", "tab_template_ez.R", package = "systemPipeShiny")
else system.file("app", "templates", "tab_template_full.R", package = "systemPipeShiny")
tmp <- readLines(temp_path) %>%
glue_collapse(sep = '\n') %>%
glue(.open = "#@", .close = "@#")
# preview early return
if(preview) return(cat(tmp))
# write file
spsinfo(glue("Write to file {out_p}"), TRUE)
writeLines(tmp, out_p)
# reformat
.reformatTab(reformat, out_p)
# register tab
.registerTabWrapper(type_sub = "plot", img, tab_id, tab_displayname,
app_path, out_p, open_file, plugin = "")
# finish and reset verbose to whatever before the function runs
msg("New tab created!", "SPS-SUCCESS", "green")
msg(glue('To load this new tab: `sps(tabs = c("{tab_id}")`'), "SPS", "green")
spsOption('verbose', verbose_old)
spsOption('use_crayon', colorful_old)
return(invisible())
}
#' Easy and simple UI and server for a SPS custom tab
#' @description SPS custom tab simple UI and server , [spsEzUI] must use together
#' with the [spsEzServer] function. The easiest way to use is to
#' use [spsNewTab] function to create both.
#' @param desc character string, length 1 in markdown format. Tab description
#' and instructions. You can make type it in multiple lines but in only one
#' string (one pair of quotes). e.g.
#' ```
#' "
#' # some desc
#' ## second line,
#' - bullet 1
#' - bullet 2
#' "
#' ```
#' @param tab_title string, tab title
#' @param plot_title string, plot title
#' @param plot_control some Shiny components (UI) to control the plot, like plot
#' title, x,y labels, color, font size, etc. Group all components in a shiny
#' `tagList`.
#'
#' @return `spsEzUI` returns a shiny module UI function, `spsEzServer` returns
#' the server function
#' @seealso [spsNewTab]
#' @export
#'
#' @examples
#' # use `spsInit()` to create an SPS project and use `spsNewTab("Your_tabID", template = "easy")`
#' # to create a new tab file. The specified use of these two functions is in that file.
spsEzUI <- function(desc="", tab_title = "Tab Title",
plot_title = "My Plot",
plot_control = shiny::tagList()){
plot_control <- rlang::enexpr(plot_control)
function(id){
ns <- NS(id)
plot_control <- rlang::eval_tidy(plot_control)
assert_that(inherits(plot_control, "shiny.tag.list"))
tagList(
tabTitle(tab_title),
if(emptyIsFalse(desc)) renderDesc(id = ns("desc"), desc) else "",
## Progress
h3("Confirm dataset", class = "text-center text-info"),
spsTimeline(
ns("df_status"),
up_labels = c("1", "2"),
down_labels = c("Dataset", "Data Ready"),
icons = list(
icon("table"),
icon("check")
),
completes = c(TRUE, FALSE)
),
bsplus::bs_accordion(id = ns("main_panel")) %>%
bsplus::bs_set_opts(panel_type = "info") %>%
bsplus::bs_append(
title = "1. Confirm to use example table or upload a new one",
fluidRow(
h3("Load table"),
column(
3,
box(
closable = FALSE, width = 12,
radioGroupButtons(
inputId = ns("source_df"),
label = "Choose your file source:",
selected = "eg",
choiceNames = c("Upload", "Example"),
choiceValues = c("upload", "eg"),
justified = TRUE, status = "primary",
checkIcon = list(
yes = icon("ok", lib = "glyphicon"),
no = "")
),
dynamicFile(id = ns("df_upload")),
selectizeInput(
inputId = ns("df_delim"),
label = "File delimiter",
choices = c(`,`=",", Tab="\t", space=" ",
`|`="|", `:`=":", `;`=";"),
options = list(style = "btn-primary")
),
clearableTextInput(
ns("df_comment"), "File comments", value = "#")
),
box(
closable = FALSE, width = 12,
title = "Confirm to use this table",
actionButton(ns("add_df"), "Confirm")
)
),
box(
closable = FALSE, width = 9,
DT::DTOutput(ns("df_out"))
)
)
)%>%
bsplus::bs_append(
title = "2. Make a plot",
fluidRow(
div(
id = ns("plot_container"),
style = "display: none;",
column(
3,
div(
class = "panel panel-info",
id = ns("panel_left"),
style = "min-height: 500px;",
div(
id = "",
class = "panel-heading",
h4(class = "panel-title", "Plot control")
),
div(
class = "panel-body",
style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
fluidRow(
style = 'margin-top: 25px;',
class = "text-center",
canvasBtn(ns("plot_main"))
),
spsHr(),
plot_control
)
)
),
column(
9,
div(
class = "panel panel-info",
id = ns("panel_right"),
style = "min-height: 500px;",
div(
id = "",
class = "panel-heading",
h4(class = "panel-title", plot_title)
),
div(
class = "panel-body",
id = ns("plot_container"),
style = "overflow-y: auto; height: Calc(100% - 38.5px); margin: 0 10px;",
shinyjqui::jqui_resizable(plotOutput(ns("plot_main")))
),
)
),
heightMatcher(ns("panel_left"), ns("panel_right")),
),
div(
id = ns("plot_disable"),
h3("Confirm to use a data table first",
class = "text-center text-warning")
)
)
),
spsHr(),
hexPanel(ns("poweredby"), "THIS TAB IS POWERED BY:",
hex_imgs = c(
"img/sps_small.png"
),
hex_titles = c("SystemPipeShiny"),
hex_links = c(
"https://github.com/systemPipeR/systemPipeShiny/"
),
ys = c("-20"),
xs = c("-10")
)
)
} %>%
return()
}
#' @param plot_code some R code to make the plot.
#' @param example_data_path example dataset path, this dataset will be loaded on
#' app start to display
#' @param other_server_code optional, other server R code to run for this tab
#' @rdname spsEzUI
#' @export
spsEzServer <- function(
plot_code,
example_data_path = system.file(package = "systemPipeShiny", "app", "data", "iris.csv"),
other_server_code = ""){
stopifnot(file.exists(example_data_path))
plot_code <- rlang::enexpr(plot_code)
other_server_code <- rlang::enexpr(other_server_code)
function(id, shared) {
module <- function(input, output, session) {
ns <- session$ns
tab_id <- id
mydata <- reactiveValues(data = NULL)
# load table ----
df_path <- dynamicFileServer(input, session, id = "df_upload")
observeEvent(input$source_df, {
shinyjs::toggleElement(id = "df_upload", condition = input$source_df =="upload", anim = TRUE)
})
data_df <- reactive({
loadDF(
choice = input$source_df,
upload_path = df_path()$datapath,
delim = input$df_delim,
data_init = data.frame(),
comment = input$df_comment,
eg_path = example_data_path
)
})
# render table ----
output$df_out <- DT::renderDT({
DT::datatable(
data_df(),
style = "bootstrap",
class = "compact", filter = "top",
extensions = c( 'Scroller'),
options = list(
deferRender = TRUE,
scrollY = 200, scrollX = TRUE, scroller = TRUE,
columnDefs = list(list(className = 'dt-center',
targets = "_all"))
)
)
})
# confirm table ----
observeEvent(input$add_df, {
# clear status on click start
updateSpsTimeline(session, "df_status", 2, FALSE)
shinyjs::removeCssClass("main_panel-0", "panel-success")
shinyjs::addCssClass("main_panel-0", "panel-info")
shinyjs::removeCssClass("main_panel-1", "panel-success")
shinyjs::addCssClass("main_panel-1", "panel-info")
shinyjs::hide("plot_container")
shinyjs::show("plot_disable")
# check
df_filter <- data_df()[input$df_out_rows_all, ]
spsValidate(verbose = FALSE, {
if(!not_empty(df_filter))
stop("Table is empty")
if(!nrow(df_filter) > 0)
stop("Table has fewer than 1 row")
if(nrow(df_filter) < 5)
warning("You table has very a few rows, consider to add more")
TRUE
})
# add data
mydata$data <- df_filter
# send success
shinyWidgets::confirmSweetAlert(
session = session,
inputId = ns("confirm_to_plot"),
title = "Table added!",
closeOnClickOutside = FALSE,
html = TRUE,
type = "success",
text = div(
h3("Continue to make plots?"),
HTML("Or manually click <span class='text-info'>2. Make a plot</span> panel")
)
)
updateSpsTimeline(session, "df_status", 2, TRUE)
shinyjs::removeCssClass("main_panel-0", "panel-info")
shinyjs::addCssClass("main_panel-0", "panel-success")
shinyjs::removeCssClass("main_panel-1", "panel-info")
shinyjs::addCssClass("main_panel-1", "panel-success")
shinyjs::show("plot_container")
shinyjs::hide("plot_disable")
}, ignoreInit = TRUE)
# jump to plotting
observeEvent(input$confirm_to_plot, {
req(input$confirm_to_plot)
shinyjs::runjs(paste0("$('#", ns(""), "main_panel-1-heading > h4').trigger('click');"))
})
output$plot_main <- renderPlot({
req(mydata$data)
rlang::eval_tidy(plot_code)
})
rlang::eval_tidy(other_server_code)
}
moduleServer(id, module)
} %>%
return()
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.