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