使反應性全局變量閃亮

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()調用，但我發現文本不可靠（至少在服務器第一次運行它時）出現在圖下面的面板中，如果在后續頁面調用它看起來它不會刷新新點擊。 這個shinyapps.io應用程序演示。

但是，當使用shinyApp(ui, server)方法在單個腳本中以交互方式在RStudio中運行時，代碼可以正常工作。 但我無法獲得runApp()執行方法，以便在shinyapps.io上進行托管。 非常感謝您的幫助。

Answer 1

OK所以下面做工作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)