代码之家  ›  专栏  ›  技术社区  ›  Eric Green

基于selectInput值更新滑块范围值

  •  0
  • Eric Green  · 技术社区  · 7 年前

    value 一个名为“agerange”的sliderInput,基于“agecat”中的selectInput值。使用下面的代码,当我选择20-24岁类别时,我可以得到所选范围的下限值,从15变为20,但是上限值仍然是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 回复  |  直到 7 年前
        1
  •  1
  •   amrrs    7 年前

    主要问题是 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()
    })
    ```
    
    推荐文章