Using a reactive data in flexdashboard with updateDateRangeInput-CodePudding

I have a flexdashboard where I'm trying to make the date range inputs update based on which person is selected.

I have three people, each with a different date range. I can use updateDateRangeInput to manually change the start/end but not based on a reactive value.

Here is an example...

---
title: "Athlete Monitoring App"
output:
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: scroll
runtime: shiny

---


```{r setup, include=FALSE}

library(flexdashboard)
library(tidyverse)
library(shiny)
library(shinyWidgets)
# library(timetk)


athlete_data <- tibble(
  athlete = factor(c(rep("Bill",5), rep("Bob",5), rep("Sue",5))),
  date = lubridate::as_date(c("2022-05-01", "2022-05-02", "2022-05-03", "2022-05-04", "2022-05-05" ,"2022-05-06", "2022-05-07", "2022-05-08", "2022-05-09", "2022-05-10", "2022-05-11", "2022-05-12", "2022-05-13", "2022-05-14", "2022-05-15"))
)
  
```



Column {.sidebar}
-----------------------------------------------------------------------

```{r sidebar}
br()


pickerInput(inputId = "picker_names", 
            label = h4("Athlete"),
            choices = levels(athlete_data$athlete),
            selected = "Bill"
            )

br()
br()

single_athlete_dates <- reactive({
  athlete_data %>%
    filter(athlete == input$picker_names)
  })

br()

h4("Athlete min, max, and preferred start dates (last two days)")
athlete_min_date <- reactive({min(single_athlete_dates()$date)})
athlete_max_date <- reactive({max(single_athlete_dates()$date)})
athlete_start_date <- reactive({(max(single_athlete_dates()$date))-2})


renderPrint(athlete_min_date())   
renderPrint(athlete_max_date())
renderPrint(athlete_start_date())  # this is the start date I'd like to use


br()
br()

h4("I'd like this to change based on each person's available ranges")

dateRangeInput(
  inputId = "date_range",
  label   = h4("Date Range"),
  start   = min(athlete_data$date),
  end     = max(athlete_data$date),
  min     = min(athlete_data$date),
  max     = max(athlete_data$date),
  startview = "month")


# this works when i manually update it
observe({
    updateDateRangeInput(session, "date_range",
                         start = "2022-02-01", end = "2022-07-16", min = "2022-01-01", max = Sys.Date())
   })


# but when i try to use the athlete-specific starting date it doesn't work 

# observe({
#     updateDateRangeInput(session, "date_range",
#                          start = athlete_start_date, end = athlete_max_date, min = "2022-01-01", max = Sys.Date())
#    })
```

CodePudding user response：

There are tow issues with your code. First, as e.g. athlete_start_date is a reactive you have to do athlete_start_date() in the updateDateRangeInput. Second, the updating in the observer is fired when you start the app even if no selection has been made yet. To fix that I added an req(input$picker_names) in the observe. As a second option you could switch to an obeserveEvent which observes picker_names to trigger the updating of the date range.

---
title: "Athlete Monitoring App"
output:
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: scroll
runtime: shiny
---

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

athlete_data <- tibble(
  athlete = factor(c(rep("Bill", 5), rep("Bob", 5), rep("Sue", 5))),
  date = lubridate::as_date(c("2022-05-01", "2022-05-02", "2022-05-03", "2022-05-04", "2022-05-05", "2022-05-06", "2022-05-07", "2022-05-08", "2022-05-09", "2022-05-10", "2022-05-11", "2022-05-12", "2022-05-13", "2022-05-14", "2022-05-15"))
)
```

Column {.sidebar}
-----------------------------------------------------------------------

```{r sidebar}
pickerInput(
  inputId = "picker_names",
  label = h4("Athlete"),
  choices = levels(athlete_data$athlete),
  selected = "Bill"
)

single_athlete_dates <- reactive({
  athlete_data %>%
    filter(athlete == input$picker_names)
})
```

#### Athlete min, max, and preferred start dates (last two days)

```{r}

athlete_min_date <- reactive({
  min(single_athlete_dates()$date)
})
athlete_max_date <- reactive({
  max(single_athlete_dates()$date)
})
athlete_start_date <- reactive({
  (max(single_athlete_dates()$date)) - 2
})

renderPrint(athlete_min_date())
renderPrint(athlete_max_date())
renderPrint(athlete_start_date())
```

#### I'd like this to change based on each person's available ranges

```{r}
dateRangeInput(
  inputId = "date_range",
  label = h4("Date Range"),
  start = min(athlete_data$date),
  end = max(athlete_data$date),
  min = min(athlete_data$date),
  max = max(athlete_data$date),
  startview = "month"
)

observe({
  req(input$picker_names)
  updateDateRangeInput(session, "date_range",
    start = athlete_start_date(), end = athlete_max_date(), 
    min = as.Date("2022-01-01"), max = Sys.Date())
})
```