如何使用 shiny 中的 actionButton 刷新或覆盖绘图
how to refresh or override plots using actionButton in shiny
我已经处理过关于一个，两个或全部的情节显示问题。
但现在我只想修改我的代码。
我的意思是我想每次点击第一个按钮时显示一个情节。然后我点击第二个按钮，新情节将出现在同一个地方，但 refresh/override 第一个或依次出现。然后，我点击第三个按钮，将显示两个图在一起。
我提到了但是没有效果或者我做错了什么。
这是我的示例代码。我需要你的帮助。不一而足。
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
# Prepare dataset.
# 1. Bind mean and sd data
# 2. Reshape
data <- bind_rows(list(
mean = mean_data,
sd = sd_data
), .id = "stat")
data_mean_sd1 <- data %>%
pivot_longer(-c(Name, stat), names_to = "Gene", values_to = "value") %>%
pivot_wider(names_from = "stat", values_from = "value")
###
ui <- fluidPage(
pageWithSidebar(
headerPanel("Gene_FPKM Value Barplot"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"Select Gene Symbol:",
choices = unique(data_mean_sd1$Gene),
multiple =F,
width = 400,
selected = "Igfbp7"
),
actionButton(inputId = "plot1", label = "FPKM"),
actionButton(inputId = "plot2", label = "logFC"),
actionButton(inputId = "all",label = "logFC&FPKM")
),
mainPanel(
uiOutput("all")
)
)
)
server <- function(input, output) {
plot_data1 <- reactive({
subset(data_mean_sd1, Gene %in% input$selectGeneSymbol)
})
plot_data2 <- reactive({
subset(data_mean_sd1, Gene %in% input$selectGeneSymbol)
})
global <- reactiveValues(out = NULL)
observeEvent(input$plot1, {
global$out <- plotOutput("plot1")
})
observeEvent(input$plot2, {
global$out <- plotOutput("plot2")
})
output$all <- renderUI({
global$out
})
output$plot1 <- renderPlot({
ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
output$plot2 <- renderPlot({
ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "logFC_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
output$all<-renderPlot({
list(
output$plot1,
output$plot2
)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
您当前的选择意味着 plot1 和 plot2 将完全相同。所以我放了第二个selectInput。您可以使用 gridExtra 包中的 grid.arrange() 来显示多个图。也许这符合您的需求：
编辑：使用eventReactive生成图表将确保图表不会在基因符号更改时更新。
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
# Prepare dataset.
# 1. Bind mean and sd data
# 2. Reshape
data <- bind_rows(list(
mean = mean_data,
sd = sd_data
), .id = "stat")
data_mean_sd1 <- data %>%
pivot_longer(-c(Name, stat), names_to = "Gene", values_to = "value") %>%
pivot_wider(names_from = "stat", values_from = "value")
###
ui <- fluidPage(
pageWithSidebar(
headerPanel("Gene_FPKM Value Barplot"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"Select Gene Symbol:",
choices = unique(data_mean_sd1$Gene),
multiple =F,
width = 400,
selected = 1 #"Igfbp7"
),
selectInput(
"selectGeneSymbol2",
"Select Gene Symbol2:",
choices = unique(data_mean_sd1$Gene),
multiple =F,
width = 400,
selected = 1 #"Igfbp7"
),
actionButton(inputId = "plot1", label = "FPKM"),
actionButton(inputId = "plot2", label = "logFC"),
actionButton(inputId = "all",label = "logFC&FPKM")
),
mainPanel(
uiOutput("all")
)
)
)
server <- function(input, output, session) {
plot_data1 <- reactive({
subset(data_mean_sd1, Gene %in% input$selectGeneSymbol)
})
plot_data2 <- reactive({
subset(data_mean_sd1, Gene %in% input$selectGeneSymbol2)
})
global <- reactiveValues(out = NULL)
observeEvent(input$plot1, {
global$out <- plotOutput("plot1", height=500)
})
observeEvent(input$plot2, {
global$out <- plotOutput("plot2", height=500)
})
observeEvent(input$all, {
global$out <- plotOutput("plot3", height=850)
})
output$all <- renderUI({
global$out
})
p1 <- eventReactive(list(input$plot1,
input$all), {
ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
p2 <- eventReactive(list(input$plot2,
input$all), {
ggplot(data = plot_data2(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol2, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
output$plot1 <- renderPlot({ p1() })
output$plot2 <- renderPlot({ p2() })
output$plot3 <- renderPlot({ grid.arrange(p1(),p2(), ncol=1) })
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
我已经处理过关于一个，两个或全部的情节显示问题。
但现在我只想修改我的代码。
我的意思是我想每次点击第一个按钮时显示一个情节。然后我点击第二个按钮，新情节将出现在同一个地方，但 refresh/override 第一个或依次出现。然后，我点击第三个按钮，将显示两个图在一起。
我提到了
这是我的示例代码。我需要你的帮助。不一而足。
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
# Prepare dataset.
# 1. Bind mean and sd data
# 2. Reshape
data <- bind_rows(list(
mean = mean_data,
sd = sd_data
), .id = "stat")
data_mean_sd1 <- data %>%
pivot_longer(-c(Name, stat), names_to = "Gene", values_to = "value") %>%
pivot_wider(names_from = "stat", values_from = "value")
###
ui <- fluidPage(
pageWithSidebar(
headerPanel("Gene_FPKM Value Barplot"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"Select Gene Symbol:",
choices = unique(data_mean_sd1$Gene),
multiple =F,
width = 400,
selected = "Igfbp7"
),
actionButton(inputId = "plot1", label = "FPKM"),
actionButton(inputId = "plot2", label = "logFC"),
actionButton(inputId = "all",label = "logFC&FPKM")
),
mainPanel(
uiOutput("all")
)
)
)
server <- function(input, output) {
plot_data1 <- reactive({
subset(data_mean_sd1, Gene %in% input$selectGeneSymbol)
})
plot_data2 <- reactive({
subset(data_mean_sd1, Gene %in% input$selectGeneSymbol)
})
global <- reactiveValues(out = NULL)
observeEvent(input$plot1, {
global$out <- plotOutput("plot1")
})
observeEvent(input$plot2, {
global$out <- plotOutput("plot2")
})
output$all <- renderUI({
global$out
})
output$plot1 <- renderPlot({
ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
output$plot2 <- renderPlot({
ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "logFC_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
output$all<-renderPlot({
list(
output$plot1,
output$plot2
)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
您当前的选择意味着 plot1 和 plot2 将完全相同。所以我放了第二个selectInput。您可以使用 gridExtra 包中的 grid.arrange() 来显示多个图。也许这符合您的需求：
编辑：使用eventReactive生成图表将确保图表不会在基因符号更改时更新。
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
# Prepare dataset.
# 1. Bind mean and sd data
# 2. Reshape
data <- bind_rows(list(
mean = mean_data,
sd = sd_data
), .id = "stat")
data_mean_sd1 <- data %>%
pivot_longer(-c(Name, stat), names_to = "Gene", values_to = "value") %>%
pivot_wider(names_from = "stat", values_from = "value")
###
ui <- fluidPage(
pageWithSidebar(
headerPanel("Gene_FPKM Value Barplot"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"Select Gene Symbol:",
choices = unique(data_mean_sd1$Gene),
multiple =F,
width = 400,
selected = 1 #"Igfbp7"
),
selectInput(
"selectGeneSymbol2",
"Select Gene Symbol2:",
choices = unique(data_mean_sd1$Gene),
multiple =F,
width = 400,
selected = 1 #"Igfbp7"
),
actionButton(inputId = "plot1", label = "FPKM"),
actionButton(inputId = "plot2", label = "logFC"),
actionButton(inputId = "all",label = "logFC&FPKM")
),
mainPanel(
uiOutput("all")
)
)
)
server <- function(input, output, session) {
plot_data1 <- reactive({
subset(data_mean_sd1, Gene %in% input$selectGeneSymbol)
})
plot_data2 <- reactive({
subset(data_mean_sd1, Gene %in% input$selectGeneSymbol2)
})
global <- reactiveValues(out = NULL)
observeEvent(input$plot1, {
global$out <- plotOutput("plot1", height=500)
})
observeEvent(input$plot2, {
global$out <- plotOutput("plot2", height=500)
})
observeEvent(input$all, {
global$out <- plotOutput("plot3", height=850)
})
output$all <- renderUI({
global$out
})
p1 <- eventReactive(list(input$plot1,
input$all), {
ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
p2 <- eventReactive(list(input$plot2,
input$all), {
ggplot(data = plot_data2(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol2, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
output$plot1 <- renderPlot({ p1() })
output$plot2 <- renderPlot({ p2() })
output$plot3 <- renderPlot({ grid.arrange(p1(),p2(), ncol=1) })
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)