Как создать выходной в зависимости от sliderInput? - PullRequest
Новая
       4

Как создать выходной в зависимости от sliderInput?

0 голосов
/ 04 июня 2019

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

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

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

До сих пор мне удалось создать реактивный второй 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)

1 Ответ

0 голосов
/ 04 июня 2019 
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, чтобы предотвратить ошибку.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...