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

Posted 2023-03-24

【中文标题】在 R Shiny 中创建第二个 UI 元素

【英文标题】：Create a second UI element in R Shiny

【发布时间】：2020-11-10 03:04:49

【问题描述】：

我在创建第二个 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()
  )
  
)

【参考方案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)