reattivamente cambiare colore di un infobox, su uno scatto o soffermarsi su

Question

Vorrei utilizzare il quadro reactiveValue, observe, observeEvent in shiny e shinydashboard per essere in grado di cambiare in modo reattivo il colore di un infobox quando si fa clic.

Vorrei anche che visualizzasse un'immagine con del testo in una finestra popup quando si passa il mouse sopra l'infoBox.

Come base di codice come ad esempio riproducibili, vedere this

Ma il codice è availible di seguito:

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) 

è possibile?

Answer 1

Quello che vuoi fare può essere completamente fatto con CSS e JavaScript, non lucido. Ecco una possibile soluzione (ci sono molti modi per ottenere ciò che vuoi).

Qualsiasi casella di informazioni passata sopra passa a grigio e quando si fa clic su di esso si passa a un diverso grigio. La prima casella informativa (in alto a sinistra) mostrerà anche un popup con un'immagine al suo interno al passaggio del mouse su di esso. Per rispondere alla domanda su come cambiare il colore di sfondo su hover/click, ho aggiunto solo un po 'di CSS. Per avere un popup al passaggio del mouse che mostra un'immagine, ho usato il popover di Bootstrap. È abbastanza semplice, spero che aiuti

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)