Making a reactive global variable in shiny

Question

I want to append some text to a panel below a ggvis plot when the user clicks (tooltip) on an object. This is in addition to a hover message from a separate tooltip. As it stands:

server.R

require(ggvis); require(shiny)

pet_rep <<- ''

tooltip_headline = function(x) "Headline detail. Click to open full detail below"

tooltip_values = function(x){
  pet_rep <<- sample(LETTERS, 26) %>% paste(collapse=' ')
  return(pet_rep)
}

function(input, output, session) {
  output$petreport = renderUI({HTML(paste0('<h1>', pet_rep, '</h1>'))})
  observe({
    ggvis(mtcars, ~disp, ~mpg) %>% layer_points() %>%
      add_tooltip(tooltip_headline, 'hover') %>%
      add_tooltip(tooltip_values, 'click') %>% 
      bind_shiny('ggvis_plot', 'ggvis_ui')
  })
}

ui.R

require(ggvis); require(shiny)

fluidPage(
  makeReactiveBinding("pet_rep"),
  uiOutput("ggvis_ui"), ggvisOutput("ggvis_plot"),
  uiOutput('petreport')
)

As far as I can tell this should work via a runApp() call, but I find the text doesn't reliably (at least when server first runs it) appear in the panel below the plot, and if on subsequent page calls it does appear it doesn't refresh on new clicks. This shinyapps.io app demonstrates.

The code does however work when run interactively in RStudio in a single script using the shinyApp(ui, server) approach. But I cannot get the runApp() execution approach to work that is necessary for hosting on shinyapps.io. Most grateful for assistance.

Answer 1

OK so the following does work on shinyapps.io (ie single file approach with app.R ):

app.R

require(ggvis); require(shiny)

pet_rep <<- ''

tooltip_headline = function(x) "Headline detail. Click to open full detail below"

tooltip_values = function(x){
  pet_rep <<- sample(LETTERS, 26) %>% paste(collapse=' ')
  return(pet_rep)
}

server = function(input, output, session) {
  output$petreport = renderUI({HTML(paste0('<h1>', pet_rep, '</h1>'))})
  observe({
    ggvis(mtcars, ~disp, ~mpg) %>% layer_points() %>%
      add_tooltip(tooltip_headline, 'hover') %>%
      add_tooltip(tooltip_values, 'click') %>% 
      bind_shiny('ggvis_plot', 'ggvis_ui')
  })
}

ui = fluidPage(
  makeReactiveBinding("pet_rep"),
  uiOutput("ggvis_ui"), ggvisOutput("ggvis_plot"),
  uiOutput('petreport')
)

shinyApp(ui, server)

Answer 2

Im not 100% what you want but is this it?

require(ggvis); require(shiny)
pet_rep <<- ''
tooltip_headline = function(x) "Headline detail. Click to open full detail below"
tooltip_values = function(x){
  pet_rep <<- sample(LETTERS, 26) %>% paste(collapse=' ')
  return(pet_rep)
}

ui <- fluidPage(
  uiOutput("ggvis_ui"), 
  ggvisOutput("ggvis_plot"),
  uiOutput('petreport')
)

server <- function(input, output, session) {

  observe({
    makeReactiveBinding("pet_rep")
  })

  output$petreport = renderUI({
    HTML(paste0('<h1>', pet_rep, '</h1>'))})

  ggvis(mtcars, ~disp, ~mpg) %>% layer_points() %>%
    add_tooltip(tooltip_headline, 'hover') %>%
    add_tooltip(tooltip_values, 'click') %>% 
    bind_shiny('ggvis_plot', 'ggvis_ui')

}

runApp(shinyApp(ui, server), launch.browser = TRUE)