使用href信息框作为动作按钮

Chr*_* D. 6 r infobox shiny shinydashboard action-button

我是建设一个AppRshiny.

我有几个,infoBox我想使用该href选项在点击时弹出一个infoBox.

我使用shinyBS作为弹出选项.这是我试过的:

valueBox(value=entry_01, icon = icon("users","fa-lg",lib="font-awesome"),href=shinyInput(actionLink,id='button_01',len=1,class="btn btn-default action-button",label=""),
        width=NULL,color = "light-blue",subtitle = ""
)
Run Code Online (Sandbox Code Playgroud)

但我发现,href如果我们想在外部网站上链接,href = "http://stackoverflow.com/" 但我不知道如何链接应用程序的内部链接,该选项可以正常工作.

编辑

我做了这个编辑,因为我发现了一个解决方案,通过在valueBox输出列表中添加两个变量,使框可点击并使闪亮认为它是一个动作按钮.
- 类action-button
- id允许我们使用observe或observeEvent来检测单击valuebox的时间.

这是一个可重复的例子

require(shiny)
require(shinydashboard)


header <- dashboardHeader(title="ReproductibleExample")
sidebar <- dashboardSidebar(disable=T)
body <- dashboardBody(valueBoxOutput("box_01"),
                      textOutput("print"))

ui <- dashboardPage(header, sidebar, body)


server<-shinyServer(function(input, output,session) {

  output$box_01 <- renderValueBox({
  entry_01<-20
  box1<-valueBox(value=entry_01
                 ,icon = icon("users",lib="font-awesome")
                 ,width=NULL
                 ,color = "blue"
                 ,href="#"
                 ,subtitle=HTML("<b>Test click on valueBox</b>")
                 )
    box1$children[[1]]$attribs$class<-"action-button"
    box1$children[[1]]$attribs$id<-"button_box_01"
    return(box1)
  })

  output$print<-renderText({
    print(input$button_box_01)
  })
})



shinyApp(ui,server)
Run Code Online (Sandbox Code Playgroud)

Chr*_* D. 4

我决定改变方法。现在,我在值框的 substile 元素内包含了一个 actionbutton(或 actionLink),并创建了一个链接到该 actionButton 的 bsModal 元素。
如果您不熟悉ShinyBS包,它允许制作弹出窗口、工具提示等功能,而不包含 HTML 或 java。

我遵循 @Mikko Martila 建议Shiny:将 addPopover 添加到 actionLink,这是一个可重现的示例来向您展示我的问题:

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

header <- dashboardHeader(title = "reporductible example")

body <- dashboardBody(valueBoxOutput("box_01"),
                      bsModal("modal", "foo", trigger = "", "bar"))
sidebar <- dashboardSidebar()
ui <- dashboardPage(header,sidebar,body,skin="green")
server = function(input, output, session) {
  # ----- First info box synthesis menu
  output$box_01 <- renderValueBox({
    entry_01 <- "BlaBla"
    valueBox(value=entry_01, icon = icon("users",lib="font-awesome"),
                    width=NULL,color = "blue",subtitle = HTML("<b>my substitle</b> <button id=\"button\" type=\"button\" class=\"btn btn-default action-button\">Show modal</button>")
    )
  })

  observeEvent(input$button, {
    toggleModal(session, "modal", "open")
  })
}

runApp(list(ui = ui, server = server))
Run Code Online (Sandbox Code Playgroud)

我使用该HTML()选项在值框的副标题内添加按钮。

这不是我真正想要的,但它确实有效。

你可以通过使用像这样的字幕来使用actionLink(它看起来更好)来做到这一点:

subtitle=HTML("<b>my subtitle</b><a id=\"button_box_05\" href=\"#\" class=\"action-button\">
     <i class=\"fa fa-question-circle\"></i>

       </a>")
Run Code Online (Sandbox Code Playgroud)