diff --git a/README.md b/README.md index 6fe7a60..7363d4f 100644 --- a/README.md +++ b/README.md @@ -1,148 +1,4 @@ -R shiny tricks (shinyjs - reset inputs, disable textinput when radio button is selected, loading..., state variables to use in ui - can be useful if want to use conditionalPanel with a variable that's calcualted in the server, global.R, splitting off big ui/server into files, shiny debugging such as add a `options(warn=2)` at top of UI and server if getting a "ERRORR: canot open the conenction" butyou have no clue where the error's happening or what file it's failing at, how to do toggle button (conditionalPanel with condition being input % 2 == 1) +R shiny tricks (shinyjs - reset inputs, disable, hide), global.R, +global.R, splitting off big ui/server into files -withBusyIndicator - -more breathing room in selectizeinput: - -``` -runApp(shinyApp( - ui = fluidPage( - tags$style(type='text/css', ".selectize-input { line-height: 40px; } .selectize-dropdown { line-height: 30px; }"), - selectInput("test","Test", 1:5) - ), - server = function(input, output, session) { - } -)) -``` - -fix uploaded file names - -``` -#' When files get uploaded, their new filenames are gibberish. -#' This function renames all uploaded files to their original names -#' @param x The dataframe returned from a shiny::fileInput -fixUploadedFilesNames <- function(x) { - if (is.null(x)) { - return() - } - - oldNames = x$datapath - newNames = file.path(dirname(x$datapath), - x$name) - file.rename(from = oldNames, to = newNames) - x$datapath <- newNames - x -} -``` - -show custom message when the'res an error in a reactive context - -``` -runApp(shinyApp( - ui = fluidPage( - tags$style(type="text/css", - ".shiny-output-error { visibility: hidden; }", - ".shiny-output-error:before { visibility: visible; content: 'An error occurred. Please contact the admin.'; }" - ), - textOutput("text") - ), - server = function(input, output, session) { - output$text <- renderText({ - stop("lalala") - }) - } -)) -``` - -prepopulate input fields when app loads - -``` -runApp(shinyApp( - ui = fluidPage( - textInput("name", "Name"), - numericInput("age", "Age", 25) - ), - server = function(input, output, session) { - observe({ - query <- parseQueryString(session$clientData$url_search) - if (!is.null(query[['name']])) { - updateTextInput(session, "name", value = query[['name']]) - } - if (!is.null(query[['age']])) { - updateNumericInput(session, "age", value = query[['age']]) - } - }) - } -)) -``` - -when developing shiny app , its annoying that when you close the browser window the app is still alive. - -``` -runApp(shinyApp( - ui = (), - server = function(input, output, session) { - session$onSessionEnded(function()stopApp()) - } -)) -``` - -click button to close the current window - -``` -library(shinyjs) -jscode <- "shinyjs.closewindow = function() { window.close(); }" - -runApp(shinyApp( - ui = tagList( - useShinyjs(), - extendShinyjs(text = jscode), - navbarPage( - "test", - id = "navbar", - tabPanel(title = "tab1"), - tabPanel(title = "", value = "Stop", icon = icon("power-off")) - ) - ), - server = function(input, output, session) { - observe({ - if (input$navbar == "Stop") { - js$closewindow(); - stopApp() - } - }) - } -)) -``` - -remove tooltip in ggvis - -``` -library(shiny) -library(ggvis) - -jscode <- -"$(function() { - $('#ggvis').click(function(){ $('#ggvis-tooltip').hide(); }); -}) -" - -shinyApp( - ui = fluidPage( - tags$script(jscode), - uiOutput("ggvis_ui"), - ggvisOutput("ggvis") - ), - server = function(input, output, session) { - mtcars %>% - ggvis(~wt, ~mpg) %>% - layer_points() %>% - add_tooltip(function(df) df$wt, on = "click") %>% - bind_shiny("ggvis", "ggvis_ui") - } -) -``` - -link to specific tab in app (simple vs complex: complex code is [here](https://github.com/rstudio/shiny/issues/772#issuecomment-112919149)) - -save all inputs in a shiny app and load them again (joe has a solution and ther's also shinyStore, but this is another solution) [here](http://stackoverflow.com/questions/32922190/saving-state-of-shiny-app-to-be-restored-later/32928505#32928505) (if using shinyjs reset, then it's safe to filter inputs by name, filter out ones with the prefix "shinyjs-") +show custom message when the'res an error in a reactive context \ No newline at end of file diff --git a/auto-kill-app/README.md b/auto-kill-app/README.md new file mode 100644 index 0000000..bef2abc --- /dev/null +++ b/auto-kill-app/README.md @@ -0,0 +1,7 @@ +# Automatically stop a Shiny app when closing the browser tab + +*Dean Attali, July 2015* + +When developing a Shiny app and running the app in the browser (as opposed to inside the RStudio Viewer), it can be annoying that when you close the browser window, the app is still running and you need to manually press "Esc" to kill it. By adding a single line to the server code `session$onSessionEnded(stopApp)`, a Shiny app will automatically stop whenever the browser tab (or any session) is closed. + +Note that this can be useful for local development, but you should be very careful not to deploy this code in a real server because you don't want your real Shiny app to stop every time a user leaves the app. \ No newline at end of file diff --git a/auto-kill-app/app.R b/auto-kill-app/app.R new file mode 100644 index 0000000..1f461e3 --- /dev/null +++ b/auto-kill-app/app.R @@ -0,0 +1,7 @@ +ui <- fluidPage() + +server <- function(input, output, session) { + session$onSessionEnded(stopApp) +} + +shinyApp(ui, server) \ No newline at end of file diff --git a/busy-indicator/app.R b/busy-indicator/app.R new file mode 100644 index 0000000..b8ad9e7 --- /dev/null +++ b/busy-indicator/app.R @@ -0,0 +1,98 @@ +library(shiny) +library(shinyjs) + +withBusyIndicatorServer <- function(buttonId, expr) { + loadingEl <- sprintf("[data-for-btn=%s] .btn-loading-indicator", buttonId) + doneEl <- sprintf("[data-for-btn=%s] .btn-done-indicator", buttonId) + errEl <- sprintf("[data-for-btn=%s] .btn-err", buttonId) + disable(buttonId) + show(selector = loadingEl) + hide(selector = doneEl) + hide(selector = errEl) + on.exit({ + enable(buttonId) + hide(selector = loadingEl) + }) + + tryCatch({ + value <- expr + show(selector = doneEl) + delay(2000, hide(selector = doneEl, anim = TRUE, animType = "fade", + time = 0.5)) + value + }, error = function(err) { errorFunc(err, buttonId) }) +} + +errorFunc <- function(err, buttonId) { + errEl <- sprintf("[data-for-btn=%s] .btn-err", buttonId) + errElMsg <- sprintf("[data-for-btn=%s] .btn-err-msg", buttonId) + cat(errElMsg) + errMessage <- gsub("^ddpcr: (.*)", "\\1", err$message) + html(html = errMessage, selector = errElMsg) + show(selector = errEl, anim = TRUE, animType = "fade") +} + +# Set up a button to have an animated loading indicator and a checkmark +# for better user experience +# Need to use with the corresponding `withBusyIndicator` server function +withBusyIndicatorUI <- function(button) { + id <- button[['attribs']][['id']] + div( + `data-for-btn` = id, + button, + span( + class = "btn-loading-container", + hidden( + img(src = "ajax-loader-bar.gif", class = "btn-loading-indicator"), + icon("check", class = "btn-done-indicator") + ) + ), + hidden( + div(class = "btn-err", + div(icon("exclamation-circle"), + tags$b("Error: "), + span(class = "btn-err-msg") + ) + ) + ) + ) +} + +ui <- fluidPage( + useShinyjs(debug=T), + tags$style(".btn-loading-container { + margin-left: 10px; + font-size: 1.2em; + } +.btn-done-indicator { + color: green; + } + + .btn-err { + margin-top: 10px; + color: red; + }"), + selectInput("select", "Select an option", + c("This one is okay" = "ok", + "This will give an error" = "error")), + withBusyIndicatorUI( + actionButton( + "uploadFilesBtn", + "Process data", + class = "btn-primary" + ) + ) +) + +server <- function(input, output, session) { + observeEvent(input$uploadFilesBtn, { + withBusyIndicatorServer("uploadFilesBtn", { + Sys.sleep(1) + if (input$select == "error") { + stop("choose another option") + } + }) + }) +} + +shinyApp(ui = ui, server = server) \ No newline at end of file diff --git a/busy-indicator/www/ajax-loader-bar.gif b/busy-indicator/www/ajax-loader-bar.gif new file mode 100644 index 0000000..09d621e Binary files /dev/null and b/busy-indicator/www/ajax-loader-bar.gif differ diff --git a/close-window/README.md b/close-window/README.md new file mode 100644 index 0000000..fcf3774 --- /dev/null +++ b/close-window/README.md @@ -0,0 +1,7 @@ +# Close the window (and stop the app) with a button click + +*Dean Attali, July 2015* + +This simple example shows how you can have a button that, when clicked, will close the current browser tab and stop the running Shiny app (you can choose to do only one of these two actions). + +This example makes use of the [shinyjs](https://github.com/daattali/shinyjs) package to call custom JavaScript functions. \ No newline at end of file diff --git a/close-window/app.R b/close-window/app.R new file mode 100644 index 0000000..8fae3a6 --- /dev/null +++ b/close-window/app.R @@ -0,0 +1,17 @@ +library(shinyjs) +jscode <- "shinyjs.closewindow = function() { window.close(); }" + +ui <- fluidPage( + useShinyjs(), + extendShinyjs(text = jscode), + actionButton("close", "Close window") +) + +server <- function(input, output, session) { + observeEvent(input$close, { + js$closewindow() + stopApp() + }) +} + +shinyApp(ui, server) \ No newline at end of file diff --git a/error-custom-message/app.R b/error-custom-message/app.R new file mode 100644 index 0000000..f460696 --- /dev/null +++ b/error-custom-message/app.R @@ -0,0 +1,19 @@ +ui <- fluidPage( + tags$style(type="text/css", + ".shiny-output-error { visibility: hidden; }", + ".shiny-output-error:before { visibility: visible; content: 'An error occurred. Please contact the admin.'; }" + ), + textOutput("text1"), + textOutput("text2") +) + +server <- function(input, output, session) { + output$text1 <- renderText({ + stop("Some error") + }) + output$text2 <- renderText({ + "Hello" + }) +} + +shinyApp(ui, server) \ No newline at end of file diff --git a/select-input-large/README.md b/select-input-large/README.md new file mode 100644 index 0000000..3679bf6 --- /dev/null +++ b/select-input-large/README.md @@ -0,0 +1,5 @@ +# Select input with more breathing room + +*Dean Attali, July 2015* + +One common CSS question in Shiny is how to make the select input dropdown menu have some more whitespace. It's actually very easy to do with just two CSS rules, as demonstrated in this example. \ No newline at end of file diff --git a/select-input-large/app.R b/select-input-large/app.R new file mode 100644 index 0000000..fbca47e --- /dev/null +++ b/select-input-large/app.R @@ -0,0 +1,15 @@ +css <- " +#large .selectize-input { line-height: 40px; } +#large .selectize-dropdown { line-height: 30px; }" + +ui <- fluidPage( + tags$style(type='text/css', css), + selectInput("select1", "Regular select", LETTERS), + div(id = "large", + selectInput("select2", "Large select", LETTERS) + ) +) + +server <- function(input, output, session) {} + +shinyApp(ui, server) \ No newline at end of file diff --git a/server-to-ui-variable/app.R b/server-to-ui-variable/app.R new file mode 100644 index 0000000..1f138e5 --- /dev/null +++ b/server-to-ui-variable/app.R @@ -0,0 +1,18 @@ +library(shiny) + +ui <- fluidPage( + selectInput("num", "Choose a number", 1:10), + conditionalPanel( + condition = "output.square", + "That's a perfect square!" + ) +) + +server <- function(input, output, session) { + output$square <- reactive({ + sqrt(as.numeric(input$num)) %% 1 == 0 + }) + outputOptions(output, 'square', suspendWhenHidden = FALSE) +} + +shinyApp(ui = ui, server = server) \ No newline at end of file diff --git a/shinydashboard-sidebar-hide/app.R b/shinydashboard-sidebar-hide/app.R index c0e08a3..9e62a70 100644 --- a/shinydashboard-sidebar-hide/app.R +++ b/shinydashboard-sidebar-hide/app.R @@ -14,10 +14,10 @@ ui <- dashboardPage( server <-function(input, output) { observeEvent(input$showSidebar, { - removeClass(selector = "body", class = "sidebar-collapse") + shinyjs::removeClass(selector = "body", class = "sidebar-collapse") }) observeEvent(input$hideSidebar, { - addClass(selector = "body", class = "sidebar-collapse") + shinyjs::addClass(selector = "body", class = "sidebar-collapse") }) } diff --git a/simple-toggle/README.md b/simple-toggle/README.md new file mode 100644 index 0000000..b173b4f --- /dev/null +++ b/simple-toggle/README.md @@ -0,0 +1,5 @@ +# Toggle a UI element (alternate between show/hide) with a button + +*Dean Attali, July 2015* + +Sometimes you want to toggle a section of the UI every time a button is clicked. Since each time a button is clicked, its value is increased by 1, you can use that to toggle an element: place the element inside a `conditionalPanel()`, and in the `condition`, check for the value of the button modulo 2 (to check if the button has been pressed an even or odd number of times). This is the most basic toggling behaviour. If you want anything more advanced, you can use the `toggle()` function from the [shinyjs](https://github.com/daattali/shinyjs) package. \ No newline at end of file diff --git a/simple-toggle/app.R b/simple-toggle/app.R new file mode 100644 index 0000000..a995f4f --- /dev/null +++ b/simple-toggle/app.R @@ -0,0 +1,14 @@ +library(shiny) + +ui <- fluidPage( + actionButton("toggle", "Toggle the following text"), + conditionalPanel( + condition = "input.toggle % 2 == 0", + "This text gets toggled on and off" + ) +) + +server <- function(input, output, session) { +} + +shinyApp(ui = ui, server = server) \ No newline at end of file diff --git a/upload-file-names/app.R b/upload-file-names/app.R new file mode 100644 index 0000000..3d7210c --- /dev/null +++ b/upload-file-names/app.R @@ -0,0 +1,35 @@ +library(shiny) + +fixUploadedFilesNames <- function(x) { + if (is.null(x)) { + return() + } + + oldNames = x$datapath + newNames = file.path(dirname(x$datapath), + x$name) + file.rename(from = oldNames, to = newNames) + x$datapath <- newNames + x +} + +ui <- fluidPage( + fileInput("file", "Choose files", multiple = TRUE), + h3("Original file input value"), + dataTableOutput("originalfiles"), + h3("New file input value"), + dataTableOutput("newfiles") +) + +server <- function(input, output, session) { + output$originalfiles <- renderDataTable( + input$file, + options = list(dom = "", searching = FALSE) + ) + output$newfiles <- renderDataTable( + fixUploadedFilesNames(input$file), + options = list(dom = "", searching = FALSE) + ) +} + +shinyApp(ui = ui, server = server) \ No newline at end of file diff --git a/url-inputs/README.md b/url-inputs/README.md new file mode 100644 index 0000000..684973f --- /dev/null +++ b/url-inputs/README.md @@ -0,0 +1,5 @@ +# Prepopulate Shiny inputs when an app loads based on URL parameters + +*Dean Attali, July 2015* + +This simple app demonstrates how you can fill out certain input fields when a Shiny app loads based on URL parameters. \ No newline at end of file diff --git a/url-inputs/app.R b/url-inputs/app.R new file mode 100644 index 0000000..4c304fa --- /dev/null +++ b/url-inputs/app.R @@ -0,0 +1,18 @@ +ui <- fluidPage( + textInput("name", "Name"), + numericInput("age", "Age", 25) +) + +server <- function(input, output, session) { + observe({ + query <- parseQueryString(session$clientData$url_search) + if (!is.null(query[['name']])) { + updateTextInput(session, "name", value = query[['name']]) + } + if (!is.null(query[['age']])) { + updateNumericInput(session, "age", value = query[['age']]) + } + }) +} + +shinyApp(ui, server) \ No newline at end of file