Как создать sliderInput, зависящий от вывода?

Погружаясь глубже в блестящие возможности, я снова сталкиваюсь с трудностью, которую не могу преодолеть. Так что ищу помощи :)

У меня есть набор данных с несколькими 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))

Я хотел бы создать блестящее приложение, в котором я мог бы выбрать partner для выбранного country, с реактивным ползунком ввода, который показывает только годы, для которых есть количество для этой комбинации страны / партнера.

Пока мне удалось создать реактивный второй selecInput, который позволяет мне выбрать partner среди возможных для выбранного country, но я не могу понять, как сделать sliderInput реактивным.

Я попытался сделать несколько вещей, в том числе выражение observe, основанное на countryOutput или countryInput, но это не сработало. В приведенном выше примере это означает, что 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)

person Fred-LM    schedule 04.06.2019    source источник


Ответы (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, чтобы предотвратить ошибку.

person DSGym    schedule 04.06.2019
comment
Ого! Это здорово, большое спасибо. Это работает очень хорошо, и единственная проблема, которую я вижу, заключается в том, что список partnerInput включает все из них, а не только те, которые возможны для выбранного country. Можно ли основывать как choices, так и selected на фактическом выходе? - person Fred-LM; 04.06.2019
comment
да, с помощью той же техники создайте фрейм данных, условный фильтр для этого фрейма данных и используйте renderUI для создания ввода на стороне сервера. рендеринг на стороне сервера довольно хорош для выполнения зависимых вещей :-) - person DSGym; 04.06.2019
comment
Спасибо! Я попробую :) - person Fred-LM; 04.06.2019
comment
удачи, если вам нужна помощь, не стесняйтесь открывать новый вопрос. Я часто здесь, чтобы помочь - person DSGym; 04.06.2019