Как добавить условный ввод слайдера в блестящее приложение?

Question

Я работаю над простым веб-приложением, использующим статистику ВОЗ по самоубийствам, в котором я допускаю определенные пользовательские данные. Затем приложение использует эти входные данные для построения графиков и таблиц данных. У меня весь код работает, но я хотел добавить еще одну вещь. Первый вариант пользовательского ввода - выбрать переменную x. Это может быть либо возрастная группа, либо год. Я хочу добавить дополнительный ползунок, когда пользователь выбирает год в качестве переменной x. Я хочу, чтобы это отображалось только тогда, когда выбран год, и я хочу, чтобы оно было ниже двух других входных данных, которые у меня есть, кроме переменной x один. Затем мне также необходимо обновить функцию сервера, чтобы он реагировал соответствующим образом при добавлении ползунка и отображал только годы, выбранные пользователем.

library(shiny)
library(dplyr)
library(ggplot2)
library(DT)
library(readr)
library(tools)


setwd("C:\\Users\\Lenovoi7\\Shrewsbury School\\IT\\Coursework")

who<-data.frame(read.csv("who.csv",  stringsAsFactors = TRUE))
dput(head(who))
countries<-sort(unique(who$country))
countries<-union(countries, c("World"))


ui<-fluidPage(

  titlePanel("Suicide statistics"),

  br(),

  sidebarLayout(
  sidebarPanel(

    h3("Plotting"),

    selectInput(
      inputId="x",
      label="Please choose the x variable",
      choices=c(
                "Age group"="age",
                "Year"="year")),


      selectInput( 

        inputId = "gender",
        label = "Please specify the gender characteristics", 
        choices = c("Gender neutral" = "gender_neutral",
                    "Gender specific" = "gender_specific"),
        selected = NULL), 


        selectInput(
          inputId = "country",
          label = "Select a country:", 
          choices = countries,
          selected = "Bosnia and Herzegovina")),


    mainPanel(

      tabsetPanel( 

        type="tabs",
        id="tabsetpanel",

        tabPanel(

          title="Graph",
          plotOutput(outputId = "graph"),
          br()),

        tabPanel(

          title="Data Table",
          br(),
          DT::dataTableOutput(outputId = "country_table")
        )
      )
    )
  )
)


server <- function(input, output) {

  x<-reactive({input$x})

  gender<-reactive({input$gender})

  country<-reactive({input$country})

  country_table<-reactive({subset(who, country==input$country)})

  output$country_table <- DT::renderDataTable(

    DT::datatable(
      data=country_table(),
      options=list(pageLength=10),
      rownames=FALSE
    )


  )





  output$graph <- renderPlot(

    #x axis = age group 

    if (x()=="age"){

      if (gender()=="gender_neutral"){

        if (country()=="World"){

          ggplot(data=who, aes(x=age)) + geom_bar(aes(weights=suicides_no), position="dodge")}

        else {

          #create a new subset of data that will be used??
          who_subset<-subset(who, country == input$country)

          ggplot(data=who_subset, aes(x=age)) + geom_bar(aes(weights=suicides_no))}}

      else if (gender()=="gender_specific"){

        if (country()=="World"){

          ggplot(data=who, aes(x=age)) + geom_bar(aes(weights=suicides_no, fill=sex), position="dodge")}

        else {

          #create a new subset of data that will be used??
          who_subset<-subset(who, country==input$country)

          ggplot(data=who_subset, aes(x=age)) + geom_bar(aes(weights=suicides_no, fill=sex), position="dodge")}}}

    else if (x()=="year"){

      if (gender()=="gender_neutral"){

        if (country()=="World"){

          who_all <- who %>% 
            group_by(year) %>% 
            summarize(suicides_no = sum(suicides_no),
                      population = sum(population)) %>%
            mutate(rate = 100000 * suicides_no/population)

          ggplot() + 
            geom_line(data = who_all, aes(year, rate))

        }

        else {

          who_subset<-subset(who, country==input$country)

          who_subset <- who_subset %>% 
            group_by(year) %>% 
            summarize(suicides_no = sum(suicides_no),
                      population = sum(population)) %>%
            mutate(rate = 100000 * suicides_no/population)

          ggplot() + 
            geom_line(data = who_subset, aes(year, rate)) 

        }}

      else if (gender()=="gender_specific"){

        if (country()=="World"){

          who_all <- who %>% 
            group_by(year) %>% 
            summarize(suicides_no = sum(suicides_no),
                      population = sum(population)) %>%
            mutate(rate = 100000 * suicides_no/population)

          ggplot() + 
            geom_line(data = who_all, aes(year, rate)) 


        }

        else {

          #create a new subset of data that will be used??
          who_subset<-subset(who, country==input$country)

          who_sub_sex <- who_subset %>% 
            group_by(year, sex) %>% 
            summarize(suicides_no = sum(suicides_no),
                      population = sum(population)) %>%
            mutate(rate = 100000 * suicides_no / population)

          ggplot() + 
            geom_line(data = who_sub_sex, aes(year, rate, color = sex))}

      }

    }
)}

# Create a Shiny app object
shinyApp(ui = ui, server = server)

Может кто-нибудь сказать, пожалуйста, как с этим бороться? Я попытался с добавлением условных панелей, но это не помогло мне, так как оно продолжало выдавать ошибки, и я не мог исправить ошибку. Спасибо.

Answer 1

Вы можете достичь этого с помощью conditionalPanel.Вы указываете условие в JavaScript , когда панель должна появиться, затем просто поместите в нее нужный ползунок.

library(shiny)

ui <- fluidPage(
  selectInput("selection", "Select something", choices = c("group", "year")),
  conditionalPanel(
    "input.selection == 'year'",
    sliderInput("slider", "Year slider", min = 1, max = 10, value = 5)
  )
)

server <- function(input, output, session) {

}

shinyApp(ui, server)

РЕДАКТИРОВАТЬ

Редактироватьпосле вашего комментария.

Вы можете просто использовать аналогичные условия на стороне server.

library(shiny)
library(ggplot2)

data <- data.frame(
  x = 1:10,
  y = runif(10)
)

ui <- fluidPage(
  selectInput("selection", "Select something", choices = c("group", "year")),
  conditionalPanel(
    "input.selection == 'year'",
    sliderInput("slider", "Year slider", min = 1, max = 10, value = 5)
  ),
  plotOutput("plot")
)

server <- function(input, output, session) {
  output$plot <- renderPlot({

    df <- data

    if(input$selection == "year")
      df <- dplyr::filter(data, x < input$slider)

    ggplot(df, aes(x = x, y = y)) + 
      geom_line()
  })
}

shinyApp(ui, server)