使反应性全局变量闪亮

Question

当用户在对象上单击（工具提示）时，我想将一些文本附加到ggvis图下面的面板中。这是来自单独工具提示的悬停消息的补充。目前的情况：

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')
)

据我所知，这应该通过runApp()调用，但我发现文本不可靠（至少在服务器首次运行时）出现在图表下方的面板中，并且如果在后续页面调用中确实显示它没有刷新新点击。 This shinyapps.io app demonstrates.

代码在使用shinyApp(ui, server)方法在单个脚本中以交互方式在RStudio中运行时起作用。但我无法获得在{shinyapps.io上托管所必需的runApp()执行方法。非常感谢您的帮助。

Answer 1

确定以下内容适用于shinyapps.io（即使用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

我不是100％你想要的但是这个吗？

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)