Use href infobox as actionbutton - r

Question

I was building an App with Rshiny.
I have a couple of infoBoxand I would like to use the href option to make a pop-up when clicking on the infoBox.
I use shinyBS for the popup options.
here is what i tried :
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 = ""
)
But I figured out that the href option work perfectly if we want to link on an external web site like href = "http://stackoverflow.com/"
but I didn't know how to link in an internal link of the app.
EDIT
I make this edit because i found a solution which make the box clickable and make shiny think it was an action button, by adding two variable inside the valueBox output list.
- the class action-button
- The id which allow us to use observe or observeEvent to detect when the valuebox is clicked.
Here is a reproductible example
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

I decided to change the method. I have now include an actionbutton (or actionLink) inside the substile element of the value box and create a bsModal element linked to this actionButton.
If you are not familiar with the ShinyBS package it allow to make popover, tooltip etc features without including HTML or java.
I follow the #Mikko Martila advice Shiny: adding addPopover to actionLink and here is a reproductile example to show you my issue :
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))
I use the HTML() option to add my button inside the subtitle of value boxes.
It's not really what i wanted but it do the work.
You can do it with actionLink (it's look better) by using subtitle like this :
subtitle=HTML("<b>my subtitle</b><a id=\"button_box_05\" href=\"#\" class=\"action-button\">
<i class=\"fa fa-question-circle\"></i>
</a>")

Answer 2

I was stuck with the same problem and having gone through this link, just got it working, without adding a separate button, like this.
Hope this would help someone looking to solve a similar problem
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)

Answer 3

I know only bad variant
1) add function tags$script(HTML("function clickFunction(link){
Shiny.onInputChange('linkClicked',link);
}"))
2) edit href children of your valueBox
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,{..})