将弹出窗口添加到闪亮的应用程序？

Question

我想在小部件的标题旁边添加一个 (?)，以便用户可以将鼠标悬停或单击它并获得额外信息，并且 link 他们可以单击。

这是我现在拥有的：

## app.R ##
library(shiny)
library(shinydashboard)
library(shinyBS)
# Header
header <- dashboardHeader()
# Sidebar
sidebar <- dashboardSidebar(fileInput("chosenfile", label = h4("File input"), 
                                      accept = ".csv"),
                            bsButton("q1", label = "", icon = icon("question"),
                                     style = "info", size = "extra-small"),
                            bsPopover(id = "q1", title = "Tidy data",
                                      content = paste0("You should read the ", 
                                                       a("tidy data paper", 
                                                         href = "http://vita.had.co.nz/papers/tidy-data.pdf",
                                                         target="_blank")),
                                      placement = "right", 
                                      trigger = "click", 
                                      options = list(container = "body")
                                      )
                            )
# Body
body <- dashboardBody()
# ui
ui <- dashboardPage(header, sidebar, body)
# server
server <- function(input, output) {

}
# run
shinyApp(ui, server)

但它远非完美。例如，(?) 的位置不在 "File input" 旁边，要关闭弹出窗口，您必须再次单击问号，而不是在弹出窗口中放置 (x)。

Answer 1

我对 JS 也不太了解，但是 this post 在 'styling' shinyapps 方面帮了我很多。

在同一行显示小部件的一种方法是将每个小部件放在 div 和 'style:inline-block' 中。因为fileInput太大，(?)一直移到下一行，所以可以用'width: somepercetage%'或'width: somepixels px'强行判断fileInput会占用多少space。

按照这些想法，代码将如下所示：

div(
  div(
    # edit1
    style="width:80%; display:inline-block; vertical-align: middle;",
    fileInput("chosenfile", label = h4("File input"), 
              accept = ".csv")
  ),
  div(
    # edit2
    style="display:inline-block; vertical-align: middle;",
    bsButton("q1", label = "", icon = icon("question"),
             style = "info"),
    bsPopover(id = "q1", title = "Tidy data",
              content = paste0("You should read the ", 
                               a("tidy data paper", 
                               href = "http://vita.had.co.nz/papers/tidy-data.pdf",
                                 target="_blank")),
              placement = "right", 
              trigger = "click", 
              options = list(container = "body")
    )
  )
)

Answer 2

这个答案可能不是您最初想要的，但它可能仍然适合您。

你说你想要标签旁边的工具提示问号，所以我把它放到了标签中。正确对齐。其次，您希望在再次单击按钮之前不打开工具提示，因为这很烦人。弹出选项 "focus" 那么可能适合您。

## app.R ##
library(shiny)
library(shinydashboard)
library(shinyBS)
# Header
header <- dashboardHeader()
# Sidebar
sidebar <- dashboardSidebar(
  fileInput("chosenfile", 
    label = h4("File input ",
              tags$style(type = "text/css", "#q1 {vertical-align: top;}"),
              bsButton("q1", label = "", icon = icon("question"), style = "info", size = "extra-small")
            ),
    accept = ".csv"),
  bsPopover(id = "q1", title = "Tidy data",
    content = paste0("You should read the ", 
                a("tidy data paper", 
                  href = "http://vita.had.co.nz/papers/tidy-data.pdf",
                  target="_blank")
                ),
    placement = "right", 
    trigger = "focus", 
    options = list(container = "body")
  )
)
# Body
body <- dashboardBody()
# ui
ui <- dashboardPage(header, sidebar, body)
# server
server <- function(input, output) {}
# run
shinyApp(ui, server)

将弹出窗口添加到闪亮的应用程序？

add popovers to shiny app?

r

twitter-bootstrap

shiny

shinybs