обновить значение диапазона ползунка на основе значения selectInput - PullRequest
Новая
       7

обновить значение диапазона ползунка на основе значения selectInput

0 голосов
/ 06 сентября 2018

У меня есть flexdashboard с блестящим приложением. Я хочу обновить value объекта sliderInput с именем agerange, основываясь на значении selectInput в agecat. Используя приведенный ниже код, я могу изменить нижнее значение выбранного диапазона с 15 на 20, когда выберу категорию 20-24 года, но верхнее значение останется 99 и не изменится на 20. 

---
title: "test"
output: 
  flexdashboard::flex_dashboard:
    theme: bootstrap
runtime: shiny
---

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

```{r global, include=FALSE}
  set.seed(1)
  dat <- data.frame(age = sample(15:99, 100, replace=TRUE),
                    y = runif(100))
```

Sidebar {.sidebar}
=====================================

```{r}
# age
  sliderInput("agerange", label = "Age", 
              min = 15, 
              max = 99, 
              value = c(15, 99),
              step=10)

# age category
  selectInput("agecat", label = "Age Category", 
    choices = list("All" = 1,
                   "15-19" = 2, 
                   "20-24" = 3), 
    selected = 1)

   observe({
        updateSliderInput(session, "agerange", 
                          value = ifelse(input$agecat==2, c(15,19),
                                  ifelse(input$agecat==3, c(20,24),
                                  input$agerange)))
      })

```

Page 1
=====================================

Column 
-----------------------------------------------------------------------

### Chart A

```{r}
renderPlot({
  dat %>%
    filter(age >= input$agerange[1] & age <= input$agerange[2]) %>%
    ggplot(., aes(y)) +
      geom_histogram()
})
```

1 Ответ

0 голосов
/ 06 сентября 2018

Основная проблема связана с ifelse, который возвращал только одно значение (из-за размера условия input$agecat) вместо двух значений. В приведенном ниже коде я создал новую переменную range со значением по умолчанию, которая изменяется в зависимости от observeEvent 

---
title: "test"
output: 
  flexdashboard::flex_dashboard:
  theme: bootstrap
runtime: shiny
---

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

```{r global, include=FALSE}
set.seed(1)
dat <- data.frame(age = sample(15:99, 100, replace=TRUE),
                  y = runif(100))
```

Sidebar {.sidebar}
=====================================

  ```{r}
# age
sliderInput("agerange", label = "Age", 
            min = 15, 
            max = 99, 
            value = c(15, 99),
            step=10)

# age category
selectInput("agecat", label = "Age Category", 
            choices = list("All" = 1,
                           "15-19" = 2, 
                           "20-24" = 3), 
            selected = 1)
observeEvent(input$agecat,{

  range = c(15,99)

  if(input$agecat == 2) {
    range = c(15,19)
  } 
  else if(input$agecat == 3) {
    range = c(20,24)
  }
  else {
    input$agecat
  }
  updateSliderInput(session, "agerange", 
                    value = range,
                    min = min(range),
                    max = max(range),
                    step = 1)
})

```

Page 1
=====================================

  Column 
-----------------------------------------------------------------------

  ### Chart A

  ```{r}
renderPlot({
  dat %>%
    filter(age >= input$agerange[1] & age <= input$agerange[2]) %>%
    ggplot(., aes(y)) +
    geom_histogram()
})
```
...