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

Question

我正在用 Rshiny 构建一个 App。

我有几个 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 = ""
)

但我发现如果我们想 link 在像 href = "http://whosebug.com/" 这样的外部网站上，href 选项工作得很好但我不知道如何在应用程序的内部 link 中 link。

编辑

我进行此编辑是因为我找到了一个解决方案，通过在 valueBox 输出列表中添加两个变量，使框可点击并使 shiny 认为它是一个操作按钮。
- class action-button
- id 允许我们使用 observe 或 observeEvent 来检测值框何时被单击。

这是一个可重现的例子

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)

Answer 1

我只知道不好的变体

1) 添加功能tags$script(HTML("function clickFunction(link){ Shiny.onInputChange('linkClicked',link); }"))

2) 编辑 valueBox 的 href 子项

aa=valueBox(value="22", icon = icon("users","fa-lg",lib="font-awesome"),href="www", width=NULL,color = "light-blue",subtitle = "" ) aa$children[[1]]=a(href="#","onclick"=paste0("clickFunction('","click","'); return false;"),aa$children[[1]]$children)

3) observeEvent(input$linkClicked,{..})

Answer 2

我决定换个方法。我现在在值框的 substile 元素中包含了一个 actionbutton（或 actionLink），并创建了一个链接到这个 actionButton 的 bsModal 元素。
如果您不熟悉 ShinyBS 包，它允许在不包括 HTML 或 java.[=15= 的情况下制作弹出窗口、工具提示等功能]

我听从了@Mikko Martila 的建议Shiny: adding addPopover to 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))

我使用 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>")

Answer 3

我遇到了同样的问题并经历了这个 link，只是让它工作，没有添加单独的按钮，就像这样。希望这对寻求解决类似问题的人有所帮助

require(shiny)
require(shinydashboard)
require(shinyBS)


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

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)
  })
 observeEvent(input$button_box_01, {
  toggleModal(session,"mod","open")
  output$print<-renderText({
    print(input$button_box_01)
  })})
})

shinyApp(ui,server)

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

Use href infobox as actionbutton

r

infobox

shiny

shinydashboard

action-button

编辑

这是一个可重现的例子