如何创建依赖于输出的滑块输入？

Question

深入了解 Shiny 的可能性，我再次面临无法克服的困难。所以寻求帮助:)

我有一个包含许多country 的数据集，每个数据集都有或多或少不同的partner 国家/地区集。对于country 和partner 的这些组合中的每一个，我都有一个quantity 分配给多个year。

这是一个示例：

data <- data.frame(country = c("Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde"), 
                   partner = c("France", "France", "France", "France", "France", "France", "France", "France", "Ireland", "Ireland", "Ireland", "Ireland", "Netherlands", "Netherlands", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain"),
                   year = c(1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2000, 2001, 2002, 2003, 2002, 2003, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 1997, 1998, 1999, 2001, 2002, 2003, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 1997, 1998, 1999, 2001, 2002, 2003, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 1997, 1998, 1999, 2001, 2002, 2003, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017),
                   quantity = c(9, 9, 9, 7, 14, 7, 6, 6, 4, 2, 1, 1, 1, 1, 2, 2, 2, 5, 10, 5, 4, 4, 10, 10, 10, 31, 62, 31, 23, 23, 27, 27, 27, 25, 25, 25, 17, 17, 17, 17, 17, 16, 16, 16, 16, 16, 16, 16, 11, 11, 11, 12, 12, 12, 7, 7, 7, 7, 7, 9, 9, 9, 9, 9, 9, 9, 38, 38, 38, 80, 80, 80, 60, 60, 60, 60, 60, 49, 49, 49, 46, 46, 46, 46))

我想创建一个闪亮的应用程序，我可以在其中为选定的country 选择一个partner，并带有一个反应式滑块输入，它只显示这个国家/合作伙伴组合的数量。

到目前为止，我已经设法创建了一个反应式第二个 selectInput，它允许我在可能的 partner 中选择一个 country，但我不知道如何使 sliderInput 反应式。

我尝试了很多方法，包括基于countryOutput 或countryInput 的observe 语句，但它不起作用。在上面的示例中，这意味着对于安哥拉/法国，sliderInput 应该从 1996 年到 2003 年，对于安哥拉/爱尔兰等地应该从 2000 年到 2003 年。

你知道如何进行这项工作吗？

谢谢:)

到目前为止，这是我的代码：

library(shiny)
library(ggplot2)
library(dplyr)


# Define UI for application that draws time-series
ui <- fluidPage(

  # Application title
titlePanel("Dummy shiny"),

# Create filters 
fluidRow(

  column(3,
         selectInput("countryInput", label = h4("Select country:"), 
                     as.character(unique(data$country)))),
  column(3,
         uiOutput("partnerOutput")),
  column(6,
         sliderInput("dateInput", label = h4("Select time range:"),
                     min = min(data$year), 
                     max = max(data$year), 
                     value = c(min(data$year), max(data$year), step = 1),
                     sep = "")
  )
),
plotOutput("distPlot")
)

# Define server logic required to draw the wanted time-series
server <- function(input, output) {
output$partnerOutput <- renderUI({
  selectInput("partnerInput", label = h4("Pick partner:"), choices = as.character(data[data$country==input$countryInput,"partner"]))
})

filtered <- reactive({
  data %>%
    filter(country == input$countryInput,
           partner == input$partnerInput,
           year >= input$dateInput[1],
           year <= input$dateInput[2]
    )
})

  output$distPlot <- renderPlot({
  ggplot(filtered(), aes(x = year, y = quantity)) +
    geom_point() +
    geom_smooth() +
    labs(x = "", y = "") +
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0))
})
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

library(shiny)
library(ggplot2)
library(dplyr)


data <- data.frame(country = c("Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Angola", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde", "Cabo Verde"), 
                   partner = c("France", "France", "France", "France", "France", "France", "France", "France", "Ireland", "Ireland", "Ireland", "Ireland", "Netherlands", "Netherlands", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "France", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain"),
                   year = c(1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2000, 2001, 2002, 2003, 2002, 2003, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 1997, 1998, 1999, 2001, 2002, 2003, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 1997, 1998, 1999, 2001, 2002, 2003, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 1997, 1998, 1999, 2001, 2002, 2003, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017),
                   quantity = c(9, 9, 9, 7, 14, 7, 6, 6, 4, 2, 1, 1, 1, 1, 2, 2, 2, 5, 10, 5, 4, 4, 10, 10, 10, 31, 62, 31, 23, 23, 27, 27, 27, 25, 25, 25, 17, 17, 17, 17, 17, 16, 16, 16, 16, 16, 16, 16, 11, 11, 11, 12, 12, 12, 7, 7, 7, 7, 7, 9, 9, 9, 9, 9, 9, 9, 38, 38, 38, 80, 80, 80, 60, 60, 60, 60, 60, 49, 49, 49, 46, 46, 46, 46))

peryear = data %>%
    group_by(country, partner) %>%
    summarise(min = min(year), max = max(year))
peryear

# Define UI for application that draws time-series
ui <- fluidPage(

    # Application title
    titlePanel("Dummy shiny"),

    # Create filters 
    fluidRow(

        column(3,
               selectInput("countryInput", label = h4("Select country:"), 
                           as.character(unique(data$country)))),
        column(3,
               uiOutput("partnerOutput")),
        column(6,
               uiOutput("dynamicdates")
        )
    ),
    plotOutput("distPlot")
)

# Define server logic required to draw the wanted time-series
server <- function(input, output) {
    output$partnerOutput <- renderUI({
        print(as.character(data[data$country==input$countryInput,"partner"]))
        selectInput("partnerInput", label = h4("Pick partner:"), choices = unique(data$partner), selected = unique(data$partner)[1])
    })

    filtered <- reactive({
        data %>%
            filter(country == input$countryInput,
                   partner == input$partnerInput,
                   year >= input$dateInput[1],
                   year <= input$dateInput[2]
            )
    })

    output$dynamicdates <- renderUI({

        if(is.null(input$partnerInput)) {
            return(NULL)
        }

        filterdf <- peryear %>%
            filter(country == input$countryInput) %>%
            filter(partner == input$partnerInput)

        sliderInput("dateInput", label = h4("Select time range:"),
                    min = filterdf$min, 
                    max = filterdf$max,
                    value = c(filterdf$min, filterdf$max, step = 1),
                    sep = "")
    })

    output$distPlot <- renderPlot({
        ggplot(filtered(), aes(x = year, y = quantity)) +
            geom_point() +
            geom_smooth() +
            labs(x = "", y = "") +
            scale_x_continuous(expand = c(0, 0)) +
            scale_y_continuous(expand = c(0, 0))
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

使用renderUI 来做到这一点。我创建了一个分组的 data.frame 来检查每个合作伙伴每年的最大值和最小值，并将其作为sliderInput 的最小值和最大值。还为 PartnerInput 预选了一项以防止出错。