Search code examples
rloopsshinyr-markdownflexdashboard

Loop valueboxes in R-Flexdashboards


Happy Easter!

I wonder if there is any smart programming for looping value boxes (or even better: whole r-markdown-code) in R-flexdashboards using R-shiny.

My problem is:

I have data, which is updated every day. Every day I can display several keyfigueres. I do this with value-boxes, becaus it is very easy to add special colors for different treshholds.

I want to show the data of the last week (7-days), see image, widch show the data for 4 days:

example of the presentation of my data

Is there a possibility to loop my code day by day?

My executable code example is only for two days an the valuebox for date (1st column in the image):

---
title: "Test for Loop value boxes"
author: StatistiVolker
output: 
  flexdashboard::flex_dashboard:
    
    orientation: rows
    vertical_layout: fill
runtime: shiny
---

```{r setup, include=FALSE}
require(shiny)
require(flexdashboard)
require(tidyverse)
```

<!-- C19J_Summary.Rmd -->

Testcode
=======================================================================

Sidebar {.sidebar}
-----------------------------------------------------------------------
  
### Settings

```{r}
sliderInput("sliderSumDate",
            "Datum",
            min = as.Date("2020-03-01"),  #min(C19JKInz()$datI),
            max = Sys.Date()-1,
            value = Sys.Date()-1,
            animate = TRUE)

```

```{r}   
# Date
selSumDate <- reactive({
  input$sliderSumDate
})

```

<!-- Is it possible to loop this Code? -->


Row 
-----------------------------------------------------------------------
<!-- actual day -->

###  {.value-box}

```{r}   
# Emit the download count
renderValueBox({
  valueBox(format(as.Date(selSumDate()-0),"%d.%m.%Y (%a)"), 
           caption = "Datum",
           # icon = "fa-calendar", 
           color = "cornflowerblue")
})

``` 

<!-- Next Code is almost the same as above, except one day earlier -->
<!-- Is it possible to loop this Code? -->

Row 
-----------------------------------------------------------------------
<!-- day before -->

###  {.value-box}

```{r}   
# Emit the download count
renderValueBox({
  valueBox(format(as.Date(selSumDate()-1),"%d.%m.%Y (%a)"), 
           caption = "Datum",
           # icon = "fa-calendar", 
           color = "cornflowerblue")
})

```  

Thank you for any idea to solve my problem.

PS: This was not useful, because it is not possible to control the colors for different treshholds


Solution

  • you have found an Easter egg:

    ---
    title: "Test for Loop value boxes"
    author: StatistiVolker
    output: 
      flexdashboard::flex_dashboard:
        
        orientation: rows
        vertical_layout: fill
    runtime: shiny
    ---
    
    ```{r setup, include=FALSE}
    require(shiny)
    require(flexdashboard)
    require(tidyverse)
    ```
    
    <!-- C19J_Summary.Rmd -->
    # Sidebar {.sidebar data-width=350}
      
    ### Settings
    
    ```{r}
    sliderInput("sliderSumDate",
                "Datum",
                min = as.Date("2020-03-01"),  #min(C19JKInz()$datI),
                max = Sys.Date()-1,
                value = Sys.Date()-1,
                animate = TRUE)
    
    ```
    
    ```{r}   
    # Date
    selSumDate <- reactive({
      input$sliderSumDate
    })
    
    ```
    
    <!-- Is it possible to loop this Code? -->
    ```{r}
    myValueBox <- function(title, caption="", color="cornflowerblue", myicon="", fontsize="25px"){
        div(
            class = "value-box level3",
            style = glue::glue(
                '
                background-color: @{color}@;
                height: 106px;
                width: 18%;
                display: inline-block;
                overflow: hidden;
                word-break: keep-all;
                text-overflow: ellipsis;
                ', .open = '@{', .close = '}@'
            ),
            div(
                class = "inner",
                p(class = "value", title, style = glue::glue("font-size:{fontsize}")),
                p(class = "caption", caption)
            ),
            div(class = "icon", myicon)
        )
    }
    ```
    
    
    Testcode
    =======================================================================
    <!-- actual day -->
    ```{r}
    uiOutput("el")
    ```
    
    
    
    
    ```{r}   
    # Emit the download count
    colors = c("#8b0000", "#000000", "#228b22", "#ffd700")
    output$el <- renderUI({
        lapply(0:-6, function(x) {
            div(
                myValueBox(format(as.Date(selSumDate()-x),"%d.%m.%Y (%a)"), "Datum", myicon = icon("calendar")),
                myValueBox(sample(1000, 1), "Infizierte", color = sample(colors, 1)),
                myValueBox(sample(1000, 1), "Aktiv erkrankt", color = sample(colors, 1)),
                myValueBox(sample(1000, 1), "Genesene", color = sample(colors, 1)),
                myValueBox(sample(1000, 1), "Verstorbene", color = sample(colors, 1))
            )
        })
    })
    ``` 
    
    
    • Impossible to create what you want with original {flexdashboard} package, no way to control row/column layout automatically. However, we can create our own value box.
    • Works the best on bigger screens (> 1000px width), also works on mobile (<670px), different styles will apply on small screens. Medium screens (670-1000) may have some problems, try to change width: 18%; to a number you want.
    • overflow text due to screen size issues are trimmed off. Change the fontsize argument may also help.

    Bigger screen

    enter image description here

    Mobile

    enter image description here