Volker Holzendorf
Volker Holzendorf

Reputation: 247

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

Upvotes: 0

Views: 401

Answers (1)

lz100
lz100

Reputation: 7330

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

Upvotes: 1

Related Questions