如何创建依赖于输出的sliderInput?

时间:2019-06-04 11:52:46

标签: r shiny

深入研究“闪亮”的可能性,我再次面临着我无法克服的困难。因此,寻求帮助:)

我有一个包含多个country的数据集,每个数据集都有一组或多或少不同的partner国家/地区。对于countrypartner的每个组合,我有一个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))

我想创建一个闪亮的应用程序,在其中可以为所选partner选择一个country,并使用反应性的SliderInput仅显示该国家/地区存在数量的年份/合作伙伴组合。

到目前为止,我已经成功创建了一个反应性第二个selecInput,它使我可以为所选partner的可能选项中选择一个country,但是我不知道该如何制作。 slideInput反应式。

我尝试了很多事情,包括基于observecountryOutput的{​​{1}}语句,但是它不起作用。在上面的示例中,这意味着对于安哥拉/法国,sliderInput应该从1996年到2003年;对于安哥拉/爱尔兰等,应该是2000年到2003年。

关于如何进行这项工作的任何想法?

谢谢:)

到目前为止,这是我的代码:

countryInput

1 个答案:

答案 0 :(得分:0)

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预选了一项,以防止发生错误。