在 Shiny 中使用 checkboxGroupInput 以 plot_grid 从一个 tibble 中制作可选择的图
Use checkboxGroupInput in Shiny to make selectable plots from one tibble with plot_grid
我正在尝试制作一个 Shiny 应用程序，该应用程序将采用上传的 CSV 文件并将其转换为 tibble，然后制作一系列具有相同 X 但对 Y 数据使用不同列的图，每个图一个。我希望用户能够使用复选框 select 他们想要显示哪些图并使用 plot_grid.
绘制结果
到目前为止，我设法让脚本按照我想要的方式渲染绘图，如果我手动命名它们，则可以从 plot_grid 即时绘制它们。我在将 checkboxGroupInput 输出作为 plot_grid 的输入时遇到问题，返回的特征向量不能用作 grob 对象。这是相关代码：
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
#Select which plots will be displayed
checkboxGroupInput(inputId = "whichPlot",
label = "Select data to plot",
choices = c("Temperature" = "tempChart()",
"Pressure" = "pressureChart()",
"Dissolved Oxygen" = "airsat()",
"pH" = "phChart()",
"Air flow" = "airChart()",
"Oxygen flow" = "O2Chart()"),
selected = "Temperature"),
#Select time scale
selectInput("timeScale",
"Choose time scale to plot",
choices = c("Minutes",
"Hours",
"Days"),
selected = "Minutes"),
#Apply button to make graphs
actionButton("DoIt", "Plot data"),
br(),
),
mainPanel(
plotOutput("plot"),
#the outputs below are not necessary, I just use them to see if I'm going in the right direction
textOutput("tableTitle"),
tableOutput("table"),
textOutput("selection"),
tableOutput("dataSummary")
)
)
)
server <- function(input, output) {
#A dummy tibble that I use for testing. will be replaced by Load button
dataDF <- tibble(date = c("01/01/2021","01/01/2021","01/01/2021","01/01/2021"), time = c("10:51:02","10:52:02","10:53:02","10:54:02"),
temp = c(20.000,22.000,23.000,24.000), pressure = c(50.000,50.000,50.000,50.000),
pH = c(7.000, 7.230, 7.100, 7.040), pO2 = c(100.000, 90.000, 80.000, 70.000),
airflow = c(1.000,1.000,1.000,1.000), O2flow = c(1.000,1.000,1.000,1.000), user = c("user","user","user","user"),
level = c(3,3,3,3), acid = c("00:00:00","00:00:00","00:00:00","00:00:00"), base =c("00:00:00","00:00:00","00:00:00","00:00:00"),
mins = c(0,2,3,4), hrs = c(0,60,180,360), dys = c(0,15,25,35))
output$table <- renderTable(head(dataDF))
#This changes the X axis scale and works well
colsel <- reactive({
switch(input$timeScale,
"Minutes" = 13,
"Hours" = 14,
"Days" = 15)
})
dataT <- reactive({
df <-dataDF[, 3:8]
df$runTime = pull(dataDF, colsel())
df
})
#A control table output to make sure tibble transformation worked (it works!)
output$dataSummary <- renderTable({
head(dataT())})
#Create a list of plots to be drawn from the checkboxes
plots <- reactive({
paste(input$whichPlot, sep = ",")
})
#save all the plots to individual objects to be chosen from later
airChart <- reactive({
ggplot(dataT(), aes(x = runTime, y = airflow))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "Air flow [L/min]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0, 1)
})
tempChart <- reactive({
ggplot (dataT(), aes(runTime, temp))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = expression(paste("Temperature [", degree, "C]")))+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(15, 45)
})
airsat <- reactive({
ggplot(dataT(), aes(runTime, pO2))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "%O2 saturation")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(80, 100)
})
phChart <- reactive({
ggplot(dataT(), aes(runTime, pH))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "pH")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(1,15)
})
O2Chart <- reactive({
ggplot(dataT(), aes(runTime, O2flow))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "O2 flow [L/min]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0,10)
})
pressureChart <- reactive({
ggplot(dataT(), aes(runTime, pressure))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "Pressure [mbar]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0,220)
})
#Plot my charts
observeEvent(input$DoIt,{
output$plot <- renderPlot({
(plot_grid(plots(), ncol = 2, labels = "auto"))
})
})
}
shinyApp(ui = ui, server = server)
当我尝试使用它时，出现错误
Warning in as_grob.default(plot) :
Cannot convert object of class character into a grob.
Warning in grid.echo.recordedplot(dl, newpage, prefix) :
No graphics to replay
如果我将最后一行替换为
output$plot <- renderPlot({
(plot_grid(tempChart(), airsat(), O2Chart(), pressureChart(), ncol = 2, labels = "auto"))
它工作得很好。我不确定是否有办法绕过角色来解决问题，或者我是否让它变得不必要地太困难了。我用 if （我不完全理解）查看了其他解决方案，但我认为他们不会在这里提供帮助。第一次接触Shiny，请不要太苛刻
检查这是否有帮助
library(shiny)
library(tidyverse)
ui <- fluidPage(
checkboxGroupInput("grp", "Select", choices = NULL),
plotOutput("plot")
)
server <- function(input, output, session) {
tibble(x = 1:10,
y1 = sample(1:10),
y2 = sample(1:10),
y3 = sample(1:10),
y4 = sample(1:10)) %>%
pivot_longer(-x) -> df
observe({
updateCheckboxGroupInput(session, "grp", "Select",
choices = unique(df$name),
selected = unique(df$name)[1])
})
output$plot <- renderPlot({
df %>%
filter(name == req(input$grp)) %>%
ggplot(aes(x, value)) +
geom_col() +
facet_wrap(~name, ncol = 1)
})
}
shinyApp(ui, server)
我会在这里使用不同的策略。您可以将它们全部存储在一个列表中，而不是将每个图单独存储在 reactive 中。在这里，我使用了一个 reactiveValues 对象，该对象通过 observeEvent 进行更新。 （原则上，您甚至可以使用一个简单的列表来存储绘图，因为在您的情况下，反应性来自 observeEvent。使用 reactiveValues 允许您在 cowplot 之外使用具有反应性的单个绘图。）
然后您可以使用 input$whichPlot 来索引地块列表。此外，将 output$plot <- renderPlot 放在 observeEvent 中通常不被认为是好的做法，因为 renderPlot 本身已经具有反应性。
为了仅在按下 input$DoIt 时更新剧情，我使用了全新 shiny 1.6.0.
中的 bindEvent
library(shiny)
library(cowplot)
library(ggplot2)
library(scales)
library(dplyr)
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
#Select which plots will be displayed
checkboxGroupInput(inputId = "whichPlot",
label = "Select data to plot",
choices = c("Temperature" = "temperature",
"Pressure" = "pressure",
"Dissolved Oxygen" = "dissolved_oxygen",
"pH" = "ph",
"Air flow" = "air_flow",
"Oxygen flow" = "oxygen_flow"),
selected = "Temperature"),
#Select time scale
selectInput("timeScale",
"Choose time scale to plot",
choices = c("Minutes",
"Hours",
"Days"),
selected = "Minutes"),
#Apply button to make graphs
actionButton("DoIt", "Plot data"),
br(),
),
mainPanel(
plotOutput("plot"),
#the outputs below are not necessary, I just use them to see if I'm going in the right direction
textOutput("tableTitle"),
tableOutput("table"),
textOutput("selection"),
tableOutput("dataSummary")
)
)
)
server <- function(input, output) {
#A dummy tibble that I use for testing. will be replaced by Load button
dataDF <- tibble(date = c("01/01/2021","01/01/2021","01/01/2021","01/01/2021"), time = c("10:51:02","10:52:02","10:53:02","10:54:02"),
temp = c(20.000,22.000,23.000,24.000), pressure = c(50.000,50.000,50.000,50.000),
pH = c(7.000, 7.230, 7.100, 7.040), pO2 = c(100.000, 90.000, 80.000, 70.000),
airflow = c(1.000,1.000,1.000,1.000), O2flow = c(1.000,1.000,1.000,1.000), user = c("user","user","user","user"),
level = c(3,3,3,3), acid = c("00:00:00","00:00:00","00:00:00","00:00:00"), base =c("00:00:00","00:00:00","00:00:00","00:00:00"),
mins = c(0,2,3,4), hrs = c(0,60,180,360), dys = c(0,15,25,35))
output$table <- renderTable(head(dataDF))
#This changes the X axis scale and works well
colsel <- reactive({
switch(input$timeScale,
"Minutes" = 13,
"Hours" = 14,
"Days" = 15)
})
dataT <- reactive({
df <-dataDF[, 3:8]
df$runTime = pull(dataDF, colsel())
df
})
#A control table output to make sure tibble transformation worked (it works!)
output$dataSummary <- renderTable({
head(dataT())})
# initialise reactiveValues object
plots <- reactiveValues(
temperature = NULL,
pressure = NULL,
dissolved_oxygen = NULL,
ph = NULL,
air_flow = NULL,
oxygen_flow = NULL
)
# the plots only change when dataT or input$timeScale changes
observeEvent(c(dataT(), input$timeScale), {
plots$temperature <- ggplot (dataT(), aes(runTime, temp))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = expression(paste("Temperature [", degree, "C]")))+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(15, 45)
plots$pressure <- ggplot(dataT(), aes(runTime, pressure))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "Pressure [mbar]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0,220)
plots$dissolved_oxygen <- ggplot(dataT(), aes(runTime, pO2))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "%O2 saturation")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(80, 100)
plots$ph <- ggplot(dataT(), aes(runTime, pH))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "pH")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(1,15)
plots$air_flow <- ggplot(dataT(), aes(x = runTime, y = airflow))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "Air flow [L/min]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0, 1)
plots$oxygen_flow <- ggplot(dataT(), aes(runTime, O2flow))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "O2 flow [L/min]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0,10)
})
output$plot <- renderPlot({
premade_plots <- reactiveValuesToList(plots)
do.call("plot_grid", c(premade_plots[input$whichPlot],
ncol = 2, labels = "auto"))
}) %>%
bindEvent(input$DoIt)
}
shinyApp(ui = ui, server = server)
我正在尝试制作一个 Shiny 应用程序，该应用程序将采用上传的 CSV 文件并将其转换为 tibble，然后制作一系列具有相同 X 但对 Y 数据使用不同列的图，每个图一个。我希望用户能够使用复选框 select 他们想要显示哪些图并使用 plot_grid.
绘制结果到目前为止，我设法让脚本按照我想要的方式渲染绘图，如果我手动命名它们，则可以从 plot_grid 即时绘制它们。我在将 checkboxGroupInput 输出作为 plot_grid 的输入时遇到问题，返回的特征向量不能用作 grob 对象。这是相关代码：
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
#Select which plots will be displayed
checkboxGroupInput(inputId = "whichPlot",
label = "Select data to plot",
choices = c("Temperature" = "tempChart()",
"Pressure" = "pressureChart()",
"Dissolved Oxygen" = "airsat()",
"pH" = "phChart()",
"Air flow" = "airChart()",
"Oxygen flow" = "O2Chart()"),
selected = "Temperature"),
#Select time scale
selectInput("timeScale",
"Choose time scale to plot",
choices = c("Minutes",
"Hours",
"Days"),
selected = "Minutes"),
#Apply button to make graphs
actionButton("DoIt", "Plot data"),
br(),
),
mainPanel(
plotOutput("plot"),
#the outputs below are not necessary, I just use them to see if I'm going in the right direction
textOutput("tableTitle"),
tableOutput("table"),
textOutput("selection"),
tableOutput("dataSummary")
)
)
)
server <- function(input, output) {
#A dummy tibble that I use for testing. will be replaced by Load button
dataDF <- tibble(date = c("01/01/2021","01/01/2021","01/01/2021","01/01/2021"), time = c("10:51:02","10:52:02","10:53:02","10:54:02"),
temp = c(20.000,22.000,23.000,24.000), pressure = c(50.000,50.000,50.000,50.000),
pH = c(7.000, 7.230, 7.100, 7.040), pO2 = c(100.000, 90.000, 80.000, 70.000),
airflow = c(1.000,1.000,1.000,1.000), O2flow = c(1.000,1.000,1.000,1.000), user = c("user","user","user","user"),
level = c(3,3,3,3), acid = c("00:00:00","00:00:00","00:00:00","00:00:00"), base =c("00:00:00","00:00:00","00:00:00","00:00:00"),
mins = c(0,2,3,4), hrs = c(0,60,180,360), dys = c(0,15,25,35))
output$table <- renderTable(head(dataDF))
#This changes the X axis scale and works well
colsel <- reactive({
switch(input$timeScale,
"Minutes" = 13,
"Hours" = 14,
"Days" = 15)
})
dataT <- reactive({
df <-dataDF[, 3:8]
df$runTime = pull(dataDF, colsel())
df
})
#A control table output to make sure tibble transformation worked (it works!)
output$dataSummary <- renderTable({
head(dataT())})
#Create a list of plots to be drawn from the checkboxes
plots <- reactive({
paste(input$whichPlot, sep = ",")
})
#save all the plots to individual objects to be chosen from later
airChart <- reactive({
ggplot(dataT(), aes(x = runTime, y = airflow))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "Air flow [L/min]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0, 1)
})
tempChart <- reactive({
ggplot (dataT(), aes(runTime, temp))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = expression(paste("Temperature [", degree, "C]")))+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(15, 45)
})
airsat <- reactive({
ggplot(dataT(), aes(runTime, pO2))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "%O2 saturation")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(80, 100)
})
phChart <- reactive({
ggplot(dataT(), aes(runTime, pH))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "pH")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(1,15)
})
O2Chart <- reactive({
ggplot(dataT(), aes(runTime, O2flow))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "O2 flow [L/min]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0,10)
})
pressureChart <- reactive({
ggplot(dataT(), aes(runTime, pressure))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "Pressure [mbar]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0,220)
})
#Plot my charts
observeEvent(input$DoIt,{
output$plot <- renderPlot({
(plot_grid(plots(), ncol = 2, labels = "auto"))
})
})
}
shinyApp(ui = ui, server = server)
当我尝试使用它时，出现错误
Warning in as_grob.default(plot) : Cannot convert object of class character into a grob. Warning in grid.echo.recordedplot(dl, newpage, prefix) : No graphics to replay
如果我将最后一行替换为
output$plot <- renderPlot({
(plot_grid(tempChart(), airsat(), O2Chart(), pressureChart(), ncol = 2, labels = "auto"))
它工作得很好。我不确定是否有办法绕过角色来解决问题，或者我是否让它变得不必要地太困难了。我用 if （我不完全理解）查看了其他解决方案，但我认为他们不会在这里提供帮助。第一次接触Shiny，请不要太苛刻
检查这是否有帮助
library(shiny)
library(tidyverse)
ui <- fluidPage(
checkboxGroupInput("grp", "Select", choices = NULL),
plotOutput("plot")
)
server <- function(input, output, session) {
tibble(x = 1:10,
y1 = sample(1:10),
y2 = sample(1:10),
y3 = sample(1:10),
y4 = sample(1:10)) %>%
pivot_longer(-x) -> df
observe({
updateCheckboxGroupInput(session, "grp", "Select",
choices = unique(df$name),
selected = unique(df$name)[1])
})
output$plot <- renderPlot({
df %>%
filter(name == req(input$grp)) %>%
ggplot(aes(x, value)) +
geom_col() +
facet_wrap(~name, ncol = 1)
})
}
shinyApp(ui, server)
我会在这里使用不同的策略。您可以将它们全部存储在一个列表中，而不是将每个图单独存储在 reactive 中。在这里，我使用了一个 reactiveValues 对象，该对象通过 observeEvent 进行更新。 （原则上，您甚至可以使用一个简单的列表来存储绘图，因为在您的情况下，反应性来自 observeEvent。使用 reactiveValues 允许您在 cowplot 之外使用具有反应性的单个绘图。）
然后您可以使用 input$whichPlot 来索引地块列表。此外，将 output$plot <- renderPlot 放在 observeEvent 中通常不被认为是好的做法，因为 renderPlot 本身已经具有反应性。
为了仅在按下 input$DoIt 时更新剧情，我使用了全新 shiny 1.6.0.
bindEvent
library(shiny)
library(cowplot)
library(ggplot2)
library(scales)
library(dplyr)
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
#Select which plots will be displayed
checkboxGroupInput(inputId = "whichPlot",
label = "Select data to plot",
choices = c("Temperature" = "temperature",
"Pressure" = "pressure",
"Dissolved Oxygen" = "dissolved_oxygen",
"pH" = "ph",
"Air flow" = "air_flow",
"Oxygen flow" = "oxygen_flow"),
selected = "Temperature"),
#Select time scale
selectInput("timeScale",
"Choose time scale to plot",
choices = c("Minutes",
"Hours",
"Days"),
selected = "Minutes"),
#Apply button to make graphs
actionButton("DoIt", "Plot data"),
br(),
),
mainPanel(
plotOutput("plot"),
#the outputs below are not necessary, I just use them to see if I'm going in the right direction
textOutput("tableTitle"),
tableOutput("table"),
textOutput("selection"),
tableOutput("dataSummary")
)
)
)
server <- function(input, output) {
#A dummy tibble that I use for testing. will be replaced by Load button
dataDF <- tibble(date = c("01/01/2021","01/01/2021","01/01/2021","01/01/2021"), time = c("10:51:02","10:52:02","10:53:02","10:54:02"),
temp = c(20.000,22.000,23.000,24.000), pressure = c(50.000,50.000,50.000,50.000),
pH = c(7.000, 7.230, 7.100, 7.040), pO2 = c(100.000, 90.000, 80.000, 70.000),
airflow = c(1.000,1.000,1.000,1.000), O2flow = c(1.000,1.000,1.000,1.000), user = c("user","user","user","user"),
level = c(3,3,3,3), acid = c("00:00:00","00:00:00","00:00:00","00:00:00"), base =c("00:00:00","00:00:00","00:00:00","00:00:00"),
mins = c(0,2,3,4), hrs = c(0,60,180,360), dys = c(0,15,25,35))
output$table <- renderTable(head(dataDF))
#This changes the X axis scale and works well
colsel <- reactive({
switch(input$timeScale,
"Minutes" = 13,
"Hours" = 14,
"Days" = 15)
})
dataT <- reactive({
df <-dataDF[, 3:8]
df$runTime = pull(dataDF, colsel())
df
})
#A control table output to make sure tibble transformation worked (it works!)
output$dataSummary <- renderTable({
head(dataT())})
# initialise reactiveValues object
plots <- reactiveValues(
temperature = NULL,
pressure = NULL,
dissolved_oxygen = NULL,
ph = NULL,
air_flow = NULL,
oxygen_flow = NULL
)
# the plots only change when dataT or input$timeScale changes
observeEvent(c(dataT(), input$timeScale), {
plots$temperature <- ggplot (dataT(), aes(runTime, temp))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = expression(paste("Temperature [", degree, "C]")))+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(15, 45)
plots$pressure <- ggplot(dataT(), aes(runTime, pressure))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "Pressure [mbar]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0,220)
plots$dissolved_oxygen <- ggplot(dataT(), aes(runTime, pO2))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "%O2 saturation")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(80, 100)
plots$ph <- ggplot(dataT(), aes(runTime, pH))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "pH")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(1,15)
plots$air_flow <- ggplot(dataT(), aes(x = runTime, y = airflow))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "Air flow [L/min]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0, 1)
plots$oxygen_flow <- ggplot(dataT(), aes(runTime, O2flow))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "O2 flow [L/min]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0,10)
})
output$plot <- renderPlot({
premade_plots <- reactiveValuesToList(plots)
do.call("plot_grid", c(premade_plots[input$whichPlot],
ncol = 2, labels = "auto"))
}) %>%
bindEvent(input$DoIt)
}
shinyApp(ui = ui, server = server)