在 R Shiny 中创建第二个 UI 元素

Question

我在创建第二个 UI 元素时遇到了问题。这是一个新的复选框，它根据 REM 睡眠变量更改点的不透明度，如果单击不透明度复选框，则滑块将其最小值更改为 3（因此可以看到不透明度的变化）。如果未单击该复选框，则最小值将返回 1。

最终的APP应该和网站上显示的一样：https://shiny.stat.ncsu.edu/jbpost2/Dynamic_UI/

library(ggplot2)

shinyUI(fluidPage(
  
  # Application title
  titlePanel("Investigation of Mammal Sleep Data"),
  
  # Sidebar with options for the data set
  sidebarLayout(
    sidebarPanel(
      h3("Select the mammal's biological order:"),
      selectizeInput("vore", "Vore", selected = "omni", choices = levels(as.factor(msleep$vore))),
      br(),
      sliderInput("size", "Size of Points on Graph",
                  min = 1, max = 10, value = 5, step = 1),
      checkboxInput("conservation", h4("Color Code Conservation Status", style = "color:red;"))
    ),
    
    # Show outputs
    mainPanel(
      plotOutput("sleepPlot"),
      textOutput("info"),
      tableOutput("table")
      )
  )
))

library(shiny)
library(dplyr)
library(ggplot2)

shinyServer(function(input, output, session) {
  
    getData <- reactive({
        newData <- msleep %>% filter(vore == input$vore)
    })
    
  #create plot
  output$sleepPlot <- renderPlot({
    #get filtered data
    newData <- getData()
    
    #create plot
    g <- ggplot(newData, aes(x = bodywt, y = sleep_total))
    
    if(input$conservation){
        g + geom_point(size = input$size, aes(col = conservation))
    } else {
        g + geom_point(size = input$size)
    }
  })

  #create text info
  output$info <- renderText({
    #get filtered data
    newData <- getData()
    
    paste("The average body weight for order", input$vore, "is", 
          round(mean(newData$bodywt, na.rm = TRUE), 2), 
          "and the average total sleep time is", 
          round(mean(newData$sleep_total, na.rm = TRUE), 2), sep = " ")
  })
  
  #create output of observations    
  output$table <- renderTable({
        getData()
  })
  
})

Answer 1

您可以使用observeEvent 将滑块更新为updateSliderInput，并在ggplot 的aes 中添加alpha = rem：

library(shiny)
library(dplyr)
library(ggplot2)

ui <- fluidPage(
  
  # Application title
  titlePanel("Investigation of Mammal Sleep Data"),
  
  # Sidebar with options for the data set
  sidebarLayout(
    sidebarPanel(
      h3("Select the mammal's biological order:"),
      selectizeInput("vore", "Vore", selected = "omni", choices = levels(as.factor(msleep$vore))),
      br(),
      sliderInput("size", "Size of Points on Graph",
                  min = 1, max = 10, value = 5, step = 1),
      checkboxInput("conservation", h4("Color Code Conservation Status", style = "color:red;")),
      checkboxInput("rem", "REM")
    ),
    
    # Show outputs
    mainPanel(
      plotOutput("sleepPlot"),
      textOutput("info"),
      tableOutput("table")
    )
  )
)



server <- function(input, output, session) {
  
  # update the slider
  observeEvent(input$rem, {
    if (input$rem) {
    updateSliderInput(session,
                      inputId = "size",
                      min = 3)
    } else {
      updateSliderInput(session,
                        inputId = "size",
                        min = 1)
    }
  })
  
  getData <- reactive({
    newData <- msleep %>% filter(vore == input$vore) %>% 
      mutate(rem = (sleep_rem - min(sleep_rem, na.rm = TRUE)) / (max(sleep_rem, na.rm = TRUE) - min(sleep_rem, na.rm = TRUE)))
  })
  
  #create plot
  output$sleepPlot <- renderPlot({
    #get filtered data
    newData <- getData()
    
    #create plot
    g <- ggplot(newData, aes(x = bodywt, y = sleep_total))
    
    if(input$conservation){
      if (input$rem) {
      g + geom_point(size = input$size, aes(col = conservation, alpha = rem))
      } else {
        g + geom_point(size = input$size, aes(col = conservation))
      }
    } else {
      if (input$rem) {
        g + geom_point(aes(alpha = rem), size = input$size)
      } else {
        g + geom_point(size = input$size)
      }
    }
  })
  
  #create text info
  output$info <- renderText({
    #get filtered data
    newData <- getData()
    
    paste("The average body weight for order", input$vore, "is", 
          round(mean(newData$bodywt, na.rm = TRUE), 2), 
          "and the average total sleep time is", 
          round(mean(newData$sleep_total, na.rm = TRUE), 2), sep = " ")
  })
  
  #create output of observations    
  output$table <- renderTable({
    getData()
  })
  
}

shinyApp(ui, server)