2017-07-06 62 views
1

我想添加工具提示/使用shinyBS包闪亮的应用程序包,但我有一个问题,由于标签没有输入/ ids。这阻止了工具提示的触发。有什么想法吗?添加工具提示到闪亮的标签

library(shiny) 
library(shinyBS) 

    shinyApp(
     ui = tagList(
     navbarPage(
      theme = "cerulean", # <--- To use a theme, uncomment this 
      "shinythemes", 
      tabPanel(id="test","Navbar 1", 
        bsTooltip("test", title="Test Title", trigger = "hover"), 
        sidebarPanel(
        fileInput("file", "File input:"), 
        textInput("txt", "Text input:", "general"), 
        sliderInput("slider", "Slider input:", 1, 100, 30), 
        tags$h5("Deafult actionButton:"), 
        actionButton("action", "Search"), 

        tags$h5("actionButton with CSS class:"), 
        actionButton("action2", "Action button", class = "btn-primary") 
        ), 
        mainPanel(
        tabsetPanel(
         tabPanel("Tab 1", 
           bsTooltip("Tab 1", title="Test Title"), 
           h4("Table"), 
           tableOutput("table"), 
           h4("Verbatim text output"), 
           verbatimTextOutput("txtout"), 
           h1("Header 1"), 
           h2("Header 2"), 
           h3("Header 3"), 
           h4("Header 4"), 
           h5("Header 5") 
         ), 
         tabPanel("Tab 2"), 
         tabPanel("Tab 3") 
        ) 
        ) 
     ), 
      tabPanel("Navbar 2"), 
      tabPanel("Navbar 3") 
     ) 
    ), 
     server = function(input, output) { 
     output$txtout <- renderText({ 
      paste(input$txt, input$slider, format(input$date), sep = ", ") 
     }) 
     output$table <- renderTable({ 
      head(cars, 4) 
     }) 
     } 
    ) 

附加是一个使用TabPanels和Tabset面板进行测试的测试应用程序。

回答

0

这里是一个小例子,增加了一个工具提示福斯特标签

library(shiny) 
library(shinyBS) 

shinyApp(
    ui = tagList(
    navbarPage(
     theme = "cerulean", # <--- To use a theme, uncomment this 
     "shinythemes", 
     tabPanel(id="test","Navbar 1", 
       bsTooltip("test", title="Test Title", trigger = "hover"), 
       sidebarPanel(
       fileInput("file", "File input:"), 
       textInput("txt", "Text input:", "general"), 
       sliderInput("slider", "Slider input:", 1, 100, 30), 
       tags$h5("Deafult actionButton:"), 
       actionButton("action", "Search"), 

       tags$h5("actionButton with CSS class:"), 
       actionButton("action2", "Action button", class = "btn-primary") 
       ), 
       mainPanel(
       tabsetPanel(
        tabPanel("Tab 1", 
          bsTooltip("Tab 1", title="Test Title"), 
          div(id = "my_id",      #changed 
           h4("Table"), 
           tableOutput("table"), 
           h4("Verbatim text output"), 
           verbatimTextOutput("txtout"), 
           h1("Header 1"), 
           h2("Header 2"), 
           h3("Header 3"), 
           h4("Header 4"), 
           h5("Header 5") 
          ),          # changed 
          bsTooltip('my_id','some text...')  # changed 
        ), 
        tabPanel("Tab 2"), 
        tabPanel("Tab 3") 
       ) 
       ) 
    ), 
     tabPanel("Navbar 2"), 
     tabPanel("Navbar 3") 
    ) 
), 
    server = function(input, output) { 
    output$txtout <- renderText({ 
     paste(input$txt, input$slider, format(input$date), sep = ", ") 
    }) 
    output$table <- renderTable({ 
     head(cars, 4) 
    }) 
    } 
) 

正如你可以看到,我只改变3行

  • 第一和第二线包装的内容物div中的第一个选项卡。该div有一个id my_id这将在后面使用
  • 第三行使用DIV ID

Basycally增加了提示,你应该能够换你想要的任何内容转换成一个div,给它一个ID然后添加一个弹出窗口。如果您遇到任何问题,请告诉我。

+0

感谢Gregor的想法。我发现在页面中间弹出了一个工具提示,但它显示整个标签页。我想知道如果该工具提示可以弹出tabPanel“Tab1”的div。当我尝试移动它时,我无法看到任何更改。 –

0

您可以使用HTML文件传递标签的标题。在这种情况下,我只是在一个范围内标题,并添加属性titlewhich是HTML使用鼠标悬停的默认属性。对我来说,这是试图通过shinyBS添加它更多sinpler。

library(shiny) 
library(shinyBS) 

shinyApp(
    ui = tagList(
    navbarPage(
     theme = "cerulean", # <--- To use a theme, uncomment this 
     "shinythemes", 
     tabPanel(id="test",span("Navbar 1",title="Test Title"), 
       sidebarPanel(
       fileInput("file", "File input:"), 
       textInput("txt", "Text input:", "general"), 
       sliderInput("slider", "Slider input:", 1, 100, 30), 
       tags$h5("Deafult actionButton:"), 
       actionButton("action", "Search"), 

       tags$h5("actionButton with CSS class:"), 
       actionButton("action2", "Action button", class = "btn-primary") 
       ), 
       mainPanel(
       tabsetPanel(
        tabPanel(span("Tab 1", title="Test Title"), 
          h4("Table"), 
          tableOutput("table"), 
          h4("Verbatim text output"), 
          verbatimTextOutput("txtout"), 
          h1("Header 1"), 
          h2("Header 2"), 
          h3("Header 3"), 
          h4("Header 4"), 
          h5("Header 5") 
        ), 
        tabPanel("Tab 2"), 
        tabPanel("Tab 3") 
       ) 
       ) 
    ), 
     tabPanel("Navbar 2"), 
     tabPanel("Navbar 3") 
    ) 
), 
    server = function(input, output) { 
    output$txtout <- renderText({ 
     paste(input$txt, input$slider, format(input$date), sep = ", ") 
    }) 
    output$table <- renderTable({ 
     head(cars, 4) 
    }) 
    } 
)