How to refresh the plot by actionbutton in different conitions in shinyapp - r

Question

I created a shinyapp and there are three vital buttons.
The three buttons works well
And the click3 can output a plot and a table togather.
Now in my app they just refresh each other but only the table still stay each time.
My question is now I want to modify some parts, I hope:
plot1 and plot2 will not refresh click3(plot3 and table) and click3 will not refresh plot1 or plot2.
######### EDIT:2021-04-22 21:09:43
Sorry about that I didn't clarify my question.
Now p1(),p2(), myPlot can refresh each other.
But I hope myPlot and myTable can keep stay until new click3 refresh themself. p1() and p2() can refresh each other but will not affect myPlot and myTable
So that p1() or p2() could stay togather with myPlot and myTable in mainparnel.
My reproducible code and data here:
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

Perhaps this is your expectation
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)