如何在 R Shiny 中的隐藏函数中包装 sliderInput

Posted 2023-02-14

【中文标题】如何在 R Shiny 中的隐藏函数中包装 sliderInput

【英文标题】：How to wrap up sliderInput inside hidden function in Rshiny

【发布时间】：2022-01-22 04:22:24

【问题描述】：

我希望应用程序的用户能够更改图表的宽度和高度。 但是，我希望滑块仅在绘制图表后出现。

为此，我创建了一个隐藏函数，然后我使用 observeEvent 调用该函数。但是，这不会改变应用程序的显示，因为滑块在调用绘图之前就已存在。

 # Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)

# Data
library(readxl)
library(dplyr)

# Plots
library(ggplot2)


# Create functions

not_sel <- "Not Selected"

# main page display in the shiny app where user will input variables and plots will be displayed
main_page <- tabPanel(
  title = "Plotter",
  titlePanel("Plotter"),
  sidebarLayout(
    sidebarPanel(
      title = "Inputs",
      fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
      selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
      selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
      uiOutput("factor"),
      br(),
      actionButton("run_button", "Run Analysis", icon = icon("play"))
    ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          title = "Plot",
          br(),
          plotOutput("plot_1"),
          br(),
          hidden(
            p(id = "sliders",
              sliderInput("height", "Height", min = 350, max = 520, value = 405),
              sliderInput("width", "Width", min = 350, max = 800, value = 500))
          #sliderInput("height", "Height", min = 350, max = 520, value = 405),
          #sliderInput("width", "Width", min = 350, max = 800, value = 500),
          )
        )
      )
    )
  )
)

# Function for printing the plots
draw_boxplot <- function(data_input, num_var_1, num_var_2)
  ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]])) +
  geom_boxplot() + 
  theme_bw()

################# --------------------------------------------------------------
# User interface
################# --------------------------------------------------------------

ui <- navbarPage(
  main_page
)

################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
server <- function(input, output)
  
  # Dynamic selection of the data 
  data_input <- reactive(
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    iris
  )
  
  # We update the choices available for each of the variables
  observeEvent(data_input(),
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
  )
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  
  observeEvent(input$run_button, 
    show("sliders")
  )
  
  ## BoxPlot -------------------------------------------------------------------
  plot_1 <- eventReactive(input$run_button,
    req(data_input())
    draw_boxplot(data_input(), num_var_1(), num_var_2())
  )
  
  
  output$plot_1 <- renderPlot(
    width = function() input$width,
    height = function() input$height,
    res = 96,
    
      plot_1()
    
  )

  


# Connection for the shinyApp
shinyApp(ui = ui, server = server)

【参考方案1】：

使用shinyjs::hidden()，将p()改为div()（因为p元素不能包含div元素）。

我使用iris.xlsx 作为虚拟数据。

shinyjs::hidden(
  div(id = "sliders",
      sliderInput("height", "Height", min = 350, max = 520, value = 405),
      sliderInput("width", "Width", min = 350, max = 800, value = 500))
)

应用程序：

# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)
library(shinyjs)

# Data
library(readxl)
library(dplyr)

# Plots
library(ggplot2)


# Create functions

# create some data
writexl::write_xlsx(iris, "iris.xlsx")

not_sel <- "Not Selected"

# main page display in the shiny app where user will input variables and plots will be displayed
main_page <- tabPanel(
  useShinyjs(),
  title = "Plotter",
  titlePanel("Plotter"),
  sidebarLayout(
    sidebarPanel(
      title = "Inputs",
      fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
      selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
      selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
      uiOutput("factor"),
      br(),
      actionButton("run_button", "Run Analysis", icon = icon("play"))
    ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          title = "Plot",
          br(),
          plotOutput("plot_1"),
          br(),
          shinyjs::hidden(
            div(
              id = "sliders",
              sliderInput("height", "Height", min = 350, max = 520, value = 405),
              sliderInput("width", "Width", min = 350, max = 800, value = 500)
            )
          )
        )
      )
    )
  )
)

# Function for printing the plots
draw_boxplot <- function(data_input, num_var_1, num_var_2) 
  ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]])) +
    geom_boxplot() +
    theme_bw()


################# --------------------------------------------------------------
# User interface
################# --------------------------------------------------------------

ui <- navbarPage(
  main_page
)

################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
server <- function(input, output) 

  # Dynamic selection of the data
  data_input <- reactive(
    # req(input$xlsx_input)
    # inFile <- input$xlsx_input
    # read_excel(inFile$datapath, 1)
    iris
  )

  # We update the choices available for each of the variables
  observeEvent(data_input(), 
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
  )

  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)

  observeEvent(input$run_button, 
    shinyjs::show("sliders")
  )

  ## BoxPlot -------------------------------------------------------------------
  plot_1 <- eventReactive(input$run_button, 
    req(data_input())
    draw_boxplot(data_input(), num_var_1(), num_var_2())
  )


  output$plot_1 <- renderPlot(
    width = function() input$width,
    height = function() input$height,
    res = 96,
    
      plot_1()
    
  )


# Connection for the shinyApp
shinyApp(ui = ui, server = server)