r - 如何在 Shiny 的应用程序中添加条件 slider 输入？

Question

我正在使用世界卫生组织的自杀统计数据开发一个简单的网络应用程序，其中我允许某些用户输入。然后，应用程序使用这些输入来绘制图表和数据表。我的整个代码都可以工作，但我想添加另一件事。 第一个用户输入选项是选择 x 变量。它可以是年龄组或年份。我想要的是当用户选择年份作为 x 变量时添加额外的 slider 输入。我希望它仅在选择年份时出现，并且我希望它位于除 x 变量之外的其他两个输入下方。然后，我还必须更新我的服务器功能，以便在添加 slider 时做出相应 react ，并且仅绘制用户选择的年份。

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 中指定面板何时出现的条件，然后只需将所需的 slider 放入其中即可。

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)

编辑

根据您的评论进行编辑。

您可以简单地在服务器端使用类似的条件。

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)