addTooltip с динамическим заголовком - PullRequest
0 голосов
/ 19 декабря 2018

У меня блестящее приложение с ползунком ввода и таблицей вывода.Я хочу поместить всплывающую подсказку над выходной таблицей с текстом, который содержит входные данные из ползунка ввода, т.е. текст всплывающей подсказки динамически обновляется с изменением ползунка.Я не могу заставить его работать.

library(shiny)
library(shinyBS)


ui <- fluidPage(
  sliderInput(inputId="inputValue",label="Input Value", 0,100, value=90, step=1),

  tableOutput(outputId="outputTableId")
)


server <- function(input, output, session) {
  renderTables <- observe({
    browser()
    output$outputTableId<-renderTable({
      data.frame("Output" = c(1,2,3) * input$inputValue)  
    })
    addTooltip(session, id="outputTableId", title=paste0("Tooltip text with dynamic ",input$inputValue,"% prediction interval"), placement="right")

  })


}

shinyApp(ui = ui, server = server)

В моем главном приложении (слишком большом для размещения здесь) всплывающая подсказка работала и обновлялась, но только при каждом другом обновлении - при любом другом изменении ползунка подсказка вообще не отображалась, но в других случаях это будет работать с правильным динамическим значением.Это может быть связано с этим вопросом , который, возможно, является ошибкой.

Однако, пытаясь создать воспроизводимый пример для этого вопроса, я даже не могу заставить его работать вообще.

1 Ответ

0 голосов
/ 19 декабря 2018

Хм, не очевидно.Вот способ, который я нашел:

library(shiny)
library(shinyBS)

ui <- fluidPage(
  sliderInput(inputId="inputValue", label="Input Value", 0,100, value=90, step=1),
  div(
    id = "container",
    style = "display:inline-block",
    uiOutput("table")
  )
)


server <- function(input, output, session) {
  output$outputTableId <- renderTable({
    data.frame("Output" = c(1,2,3) * input$inputValue)  
  })

  output$table <- renderUI({
    tipify(
      tableOutput(outputId = "outputTableId"),
      title=paste0("Tooltip text with dynamic ", input$inputValue, "% prediction interval"),
      placement = "right",
      options = list(container = "#container"))
  })

}

shinyApp(ui = ui, server = server)
...