10

I would like to use the reactiveValue, observe, observeEvent framework in shiny and shinydashboard to be able to reactively change the colour of an infoBox when clicked.

I would also like it to display an image with some text in a popup box when hovering over the infoBox.

As a basis of code as a reproducible example, please see this

But the code is availible below:

 library(shinydashboard)

  ui <- dashboardPage(
    dashboardHeader(title = "Info boxes"),
    dashboardSidebar(),
    dashboardBody(
      # infoBoxes with fill=FALSE
      fluidRow(
        # A static infoBox
        infoBox("New Orders", 10 * 2, icon = icon("credit-card")),
        # Dynamic infoBoxes
        infoBoxOutput("progressBox"),
        infoBoxOutput("approvalBox")
      ),

      # infoBoxes with fill=TRUE
      fluidRow(
        infoBox("New Orders", 10 * 2, icon = icon("credit-card"), fill = TRUE),
        infoBoxOutput("progressBox2"),
        infoBoxOutput("approvalBox2")
      ),

      fluidRow(
        # Clicking this will increment the progress amount
        box(width = 4, actionButton("count", "Increment progress"))
      )
    )
  )

  server <- function(input, output) {
    output$progressBox <- renderInfoBox({
      infoBox(
        "Progress", paste0(25 + input$count, "%"), icon = icon("list"),
        color = "purple"
      )
    })
    output$approvalBox <- renderInfoBox({
      infoBox(
        "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
        color = "yellow"
      )
    })

    # Same as above, but with fill=TRUE
    output$progressBox2 <- renderInfoBox({
      infoBox(
        "Progress", paste0(25 + input$count, "%"), icon = icon("list"),
        color = "purple", fill = TRUE
      )
    })
    output$approvalBox2 <- renderInfoBox({
      infoBox(
        "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
        color = "yellow", fill = TRUE
      )
    })
  }

  shinyApp(ui, server)

Is that possible?

Jaffer Wilson
  • 7,029
  • 10
  • 62
  • 139
h.l.m
  • 13,015
  • 22
  • 82
  • 169
  • Hi h.l.m.Sure it is possible. In the end Shiny is producing html and you can add as much HTML / Javascript / JQuery / CSS as you like. As long as you do not run it with the Shiny Server that claims a lot of that for itself leaving you almost empty handed. See for instance: http://stackoverflow.com/questions/23599268/include-a-javascript-file-in-shiny-app or http://chrisbeeley.net/?p=481 but be ready for a deep dive or stick to the SHINY way. – irJvV Jun 03 '15 at 19:12

1 Answers1

12

What you want to do can be completely done with CSS and JavaScript, not shiny. Here is one possible solution (there are many ways to achieve what you want).

Any info box you hover over will change to gray and when you click it will change to a different gray. The first info box (top-left) will also show a popup with an image in it when you hover over it. To address the question of how to change the background colour on hover/click, I just added a bit of CSS. To have a popup on hover that shows an image, I used Bootstrap's popover. It's fairly simple, hope it helps

library(shinydashboard)

mycss <- "
.info-box:hover,
.info-box:hover .info-box-icon {
  background-color: #aaa !important;
}
.info-box:active,
.info-box:active .info-box-icon {
  background-color: #ccc !important;
}
"

withPopup <- function(tag) {
  content <- div("Some text and an image",
                 img(src = "http://thinkspace.com/wp-content/uploads/2013/12/member-logo-rstudio-109x70.png"))
  tagAppendAttributes(
    tag,
    `data-toggle` = "popover",
    `data-html` = "true",
    `data-trigger` = "hover",
    `data-content` = content
  )
}

ui <- dashboardPage(
  dashboardHeader(title = "Info boxes"),
  dashboardSidebar(),
  dashboardBody(
    tags$head(tags$style(HTML(mycss))),
    tags$head(tags$script("$(function() { $(\"[data-toggle='popover']\").popover(); })")),
    # infoBoxes with fill=FALSE
    fluidRow(
      # A static infoBox
      withPopup(infoBox("New Orders", 10 * 2, icon = icon("credit-card"))),
      # Dynamic infoBoxes
      infoBoxOutput("progressBox"),
      infoBoxOutput("approvalBox")
    ),

    # infoBoxes with fill=TRUE
    fluidRow(
      infoBox("New Orders", 10 * 2, icon = icon("credit-card"), fill = TRUE),
      infoBoxOutput("progressBox2"),
      infoBoxOutput("approvalBox2")
    ),

    fluidRow(
      # Clicking this will increment the progress amount
      box(width = 4, actionButton("count", "Increment progress"))
    )
  )
)

server <- function(input, output) {
  output$progressBox <- renderInfoBox({
    infoBox(
      "Progress", paste0(25 + input$count, "%"), icon = icon("list"),
      color = "purple"
    )
  })
  output$approvalBox <- renderInfoBox({
    infoBox(
      "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
      color = "yellow"
    )
  })

  # Same as above, but with fill=TRUE
  output$progressBox2 <- renderInfoBox({
    infoBox(
      "Progress", paste0(25 + input$count, "%"), icon = icon("list"),
      color = "purple", fill = TRUE
    )
  })
  output$approvalBox2 <- renderInfoBox({
    infoBox(
      "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
      color = "yellow", fill = TRUE
    )
  })
}

shinyApp(ui, server)
DeanAttali
  • 25,268
  • 10
  • 92
  • 118
  • That looks really good thanks! Few things... How come the hover over only works with the top left infoBox?, and can different images occur for different infoboxes? The hoverover change colour to gray looks good, but is there a way such that when you click the infobox it permanently changes colour or increments the values in the infoBox? – h.l.m Jun 04 '15 at 08:31
  • In regards to the first few questions: if you read the code and look at what changed between my version and yours you'll see why only the top left box has the click effect. If you look at all the calls to `infoBox`, you'll see that for the first one I wrap it around a call to `withPopup` (which is a function that I defined in the code). Yes you can do diff images, right now the `withPopup` uses a hardcoded image, you can just pass the image source as a parameter instead. If you want the colour to permanently change or increment the value you'd need some Javascript quite a bit more complex... – DeanAttali Jun 04 '15 at 08:55
  • It looks like you're trying to do some things that require some basic javascript and CSS knowledge. I would highly suggest taking a few hours to learn JS and CSS basics and you'll be able to make apps a lot more powerful and flexible. – DeanAttali Jun 04 '15 at 08:56