CODEWITHSUNDEEP
rshinyggvis
geotheory
geotheory

Reputation: 23630

Making a reactive global variable in shiny

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.

Upvotes: 2

Views: 3591

Answers (2)

geotheory
geotheory

Reputation: 23630

OK so the following does work on shinyapps.io (i.e. 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)

Upvotes: 2

Pork Chop
Pork Chop

Reputation: 29387

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)

enter image description here

Upvotes: 1

Related Questions