如何在 R Shiny 的隐藏函数中包装 sliderInput
How to wrap up sliderInput inside hidden function in Rshiny
我希望应用程序的用户能够更改图表的宽度和高度。
但是,我希望滑块仅在绘制图表后出现。
为此我创建了一个隐藏函数,然后我用 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)
使用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)
我希望应用程序的用户能够更改图表的宽度和高度。
但是,我希望滑块仅在绘制图表后出现。
为此我创建了一个隐藏函数,然后我用 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)
使用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)