addTooltip с динамическим заголовком

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

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)

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

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


r shiny shinybs
person zola25    schedule 19.12.2018    source источник

Ответы (1)


arrow_upward
1
arrow_downward

Хм, не очевидно. Вот как я нашел:

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)
person Stéphane Laurent    schedule 19.12.2018