add many readmes and a few more examples

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

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.

auto-kill-app/app.R

@@ -0,0 +1,7 @@
+ui <- fluidPage()
+
+server <- function(input, output, session) {
+  session$onSessionEnded(stopApp)
+}
+
+shinyApp(ui, server)

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)

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.

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)

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)

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.

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)

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)

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")
   })
 }
 

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.

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)