2016-09-09 5 views
1

ИдеяDynamic поповера или подсказка в shinyBS

Я имею в блестящем приложении на box(). box() включает аргумент title (который, в свою очередь, включает в себя icon) и элемент selectInput(). На пылесосе над icon я хотел иметь всплывающую подсказку (используя tipify()) или popover (используя popify()), который должен был бы генерировать аргумент title или content (или оба) в зависимости от ввода selectInput().

Проблема

tipify() Ни ни popify() correcctly реализовать textOutput() как их title или content аргумента. Им нужна строка символов, поэтому я попытался использовать элемент reactiveValues() в качестве аргумента функции, но он также потерпел неудачу.

Вопрос

Может всплывающую подсказку или содержание поповер быть динамическим, используя только r? Как это можно сделать?

Я подозреваю, что это можно сделать с помощью JavaScript, но я мало знаю об этом.

Код

Попытка 1 - не удалось - отображает код не фактический текст

library("shiny") 
library("shinydashboard") 
library("shinyBS") 

ui <- fluidPage(
box(
    title = span("My box", 
       tipify(el = icon(name = "info-circle", lib = "font-awesome"), title = textOutput("TIP"))), 
    selectInput(
    inputId = "SELECT", 
    label = NULL, 
    choices = c("Option1" = "Option1", 
       "Option2" = "Option2" 
    ), 
    multiple = FALSE 
    ) 
) 
) 
server <- function(input, output, session){ 
    output$TIP <- renderText({"Helo world!"}) 
} 
shinyApp(ui, server) 

Попытка 2 - не удалось - не может создать пользовательский интерфейс, как TIP (reactiveValues()) еще не определен

library("shiny") 
library("shinydashboard") 
library("shinyBS") 

ui <- fluidPage(
box(
    title = span("My box", 
       tipify(el = icon(name = "info-circle", lib = "font-awesome"), title = TIP$a)), 
    selectInput(
    inputId = "SELECT", 
    label = NULL, 
    choices = c("Option1" = "Option1", 
       "Option2" = "Option2" 
    ), 
    multiple = FALSE 
    ) 
) 
) 
server <- function(input, output, session){ 
    TIP <- reactiveValues(a = "Hello world!") 
} 
shinyApp(ui, server) 

Here - аналогичный вопрос, но он не решает проблему, описанную здесь.

ответ

2

Что можно сделать, это создание названия целиком на стороне сервера. Таким образом, у вас нет проблем с динамикой. Это может привести к такому приложению:

library("shiny") 
library("shinydashboard") 
library("shinyBS") 

ui <- fluidPage(
    box(
    title = uiOutput("title"), 
    selectInput(
     inputId = "SELECT", 
     label = NULL, 
     choices = c("Option1" = "Option1", 
        "Option2" = "Option2" 
    ), 
     multiple = FALSE 
    ) 
) 
) 
server <- function(input, output, session){ 
    TIP <- reactiveValues() 
    observe({ 
    TIP$a <- ifelse(input$SELECT =="Option1","Hello World","Hello Mars") 
    }) 


    output$title <- renderUI({span("My box", 
        tipify(el = icon(name = "info-circle", lib = "font-awesome"), title = TIP$a))}) 


} 
shinyApp(ui, server) 

Надеюсь, это поможет.

+0

Это странно, но если вы выберете опцию1 и посмотрите на всплывающую подсказку, а затем измените на option2, ничего не отображается в toolip (может быть, это только в моем R) – Batanichek

+0

Вам нужно подождать некоторое время, так как обновление выполняется с помощью 'watch ({}) '. Но это определенно работает в моем Р. Не могли бы вы повторить и подтвердить плз? – Romain

+0

Код действительно работает и, следовательно, является решением проблемы. Действительно, он относительно медленный, который все еще оставляет место для улучшения. Спасибо за ваш ответ. – Siemkowski