r - 如何创建依赖于输出的滑块输入?

Question

深入研究闪亮的可能性，我再次面临无法克服的困难。所以寻求帮助:)

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

下面是一个示例：

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，带有一个反应式滑块输入，仅显示该国家/合作伙伴组合有数量的年份。

到目前为止，我已经设法创建了一个反应式的第二个 selecInput，它允许我在所选country的可能选择中选择一种partner，但我无法弄清楚如何使滑块输入成为反应式。

我已经尝试了很多事情，包括基于countryOutput或countryInput的observe语句，但它不起作用。在上面的示例中，这意味着安哥拉/法国的滑块输入应从 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的最小值和最大值。还为"合作伙伴输入"预选了一个项目以防止错误。