r-如何在shinyapp中的不同锥中通过操作按钮刷新绘图

Question

我创建了一个shinyapp，其中有三个重要按钮。

这三个按钮运行良好

点击3可以输出绘图和表格。

现在，在我的应用程序中，它们只是互相刷新，但每次只有表仍然保留

我的问题是现在我想修改一些部件，我希望：

plot1和plot2不会刷新click3(plot3和表格(，click3不会刷新plot1或plot2。

#########编辑：2021-04-22 21:09:43

很抱歉，我没有澄清我的问题。

现在p1(),p2(), myPlot可以互相刷新。

但我希望myPlot和myTable能一直呆到新的click3刷新它们自己。p1() and p2()可以相互刷新，但不会影响myPlot和myTable使CCD_ 8与CCD_ 9和CCD_。

我在这里的可复制代码和数据：

library(shiny)
library(ggplot2)
##  load("04.21_3.RData")
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))

############
ui <- fluidPage(
sidebarPanel(
selectizeInput(
"selectGeneSymbol", 
"Select:", 
choices = NULL,
multiple =F,
width = 400,
selected = NULL,
options = list(placeholder = 'e.g. gene here',create = F)
),
actionButton("plot1", "click1"),
actionButton("plot2", "click2"),
actionButton("dataTable", "click3")
),

mainPanel(
uiOutput("all"),
#    plotOutput("myPlot"),
tableOutput("myTable")
)
)
server <- function(input, output, session) {

updateSelectizeInput(session, "selectGeneSymbol", choices = colnames(mean_data[,-1]), server = TRUE)

global <- reactiveValues(out = NULL,
p1 = NULL,
p2 = NULL)
plotdata <- eventReactive(input$plot1,{ 
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
output$all <- renderUI({                      ##
global$out
})

observeEvent(input$plot1, {
global$out <- plotOutput("plot1")
})
##
observeEvent(input$plot2, {
global$out <- plotOutput("plot2")
myData(NULL)
})

observeEvent(input$dataTable, {
global$out <- plotOutput("myPlot")
myData(NULL)
})
####
myPlot = reactiveVal()
myData = reactiveVal()

observeEvent(input$dataTable, {
data_cor<-mean_data[,-1]
tm <- corr.test(data_cor[,input$selectGeneSymbol,drop=FALSE],
y = data_cor, use = "pairwise", "spearman", adjust="none", 
alpha=0.05, ci=F, minlength=5)
res <-setNames(as.data.frame(t(do.call(rbind, tm[c("r", "p")]))), c("Correlation", "P_value"))
res<-res[-which(rownames(res)== input$selectGeneSymbol),]
res<-data.frame(Gene=rownames(res),res)
res
##############
data_correlation=t(mean_data[, -1])
data_subset=data_correlation[c(input$selectGeneSymbol, as.vector(head(res$Gene, 10))), ]
myPlot(
pheatmap(log2(data_subset+1), show_colnames = F,fontsize_row =12,
cluster_rows = F, cluster_cols = F, gaps_row = 1)
)
myData(res)
})

output$myPlot = renderPlot({
myPlot()
})

output$myTable = renderTable({
myData()
})

####
p1 <- eventReactive(input$plot1,
{
ggplot(data =plotdata(), aes(x = Name, y = .data[[as.name(input$selectGeneSymbol)]])) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
theme(legend.position = "none") +
labs(title = paste(input$selectGeneSymbol), x = NULL, y = "666666")                      })

p2 <- eventReactive(input$plot2,
{
ggplot(data = plotdata(), aes(x = Name, y = .data[[as.name(input$selectGeneSymbol)]], fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
theme(legend.position = "none") +
labs(title = paste(input$selectGeneSymbol), x = NULL, y = "777777")                      })                    

output$plot1 <- renderPlot({
p1()})
output$plot2 <- renderPlot({
p2()})

}
shinyApp(ui, server)

Answer 1

也许这是您的期望

library(shiny)
library(ggplot2)
##  load("04.21_3.RData")
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))

############
ui <- fluidPage(
sidebarPanel(
selectizeInput(
"selectGeneSymbol", 
"Select:", 
choices = NULL,
multiple =F,
width = 400,
selected = NULL,
options = list(placeholder = 'e.g. gene here',create = F)
),
actionButton("plot1", "click1"),
actionButton("plot2", "click2"),
actionButton("dataTable", "click3")
),

mainPanel(
uiOutput("all"),
plotOutput("myPlot"),
tableOutput("myTable")
)
)
server <- function(input, output, session) {

updateSelectizeInput(session, "selectGeneSymbol", choices = colnames(mean_data[,-1]), server = TRUE)

global <- reactiveValues(out = NULL,
p1 = NULL,
p2 = NULL)
plotdata <- eventReactive(input$plot1,{ 
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})

output$all <- renderUI({                      ##
global$out
})

observeEvent(input$plot1, {
global$out <- plotOutput("plot1")
#myData(NULL)
})
##
observeEvent(input$plot2, {
global$out <- plotOutput("plot2")
#myData(NULL)
})

# observeEvent(input$dataTable, {
#   global$out <- plotOutput("myPlot")
#   
# })
####
myPlot = reactiveVal()
myData = reactiveVal()

observeEvent(input$dataTable, {
# data_cor<-mean_data[,-1]
# tm <- corr.test(data_cor[,input$selectGeneSymbol,drop=FALSE],
#                 y = data_cor, use = "pairwise", "spearman", adjust="none", 
#                 alpha=0.05, ci=F, minlength=5)
# res <-setNames(as.data.frame(t(do.call(rbind, tm[c("r", "p")]))), c("Correlation", "P_value"))
# res<-res[-which(rownames(res)== input$selectGeneSymbol),]
# res<-data.frame(Gene=rownames(res),res)
# res
# ##############
# data_correlation=t(mean_data[, -1])
# data_subset=data_correlation[c(input$selectGeneSymbol, as.vector(head(res$Gene, 10))), ]
# myPlot(
#   pheatmap(log2(data_subset+1), show_colnames = F,fontsize_row =12,
#            cluster_rows = F, cluster_cols = F, gaps_row = 1)
# )
# myData(res)

myData(mtcars)
})

p3 <- eventReactive(input$dataTable, {
hist(runif(500))
})

output$myPlot = renderPlot({
p3()
#myPlot()
})

output$myTable = renderTable({
myData()
})

####
p1 <- eventReactive(input$plot1,
{
ggplot(data =plotdata(), aes(x = Name, y = .data[[as.name(input$selectGeneSymbol)]])) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
theme(legend.position = "none") +
labs(title = paste(input$selectGeneSymbol), x = NULL, y = "666666")                      })

p2 <- eventReactive(input$plot2,
{
ggplot(data = plotdata(), aes(x = Name, y = .data[[as.name(input$selectGeneSymbol)]], fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
theme(legend.position = "none") +
labs(title = paste(input$selectGeneSymbol), x = NULL, y = "777777")                      })                    

output$plot1 <- renderPlot({
p1()})
output$plot2 <- renderPlot({
p2()})

}
shinyApp(ui, server)