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

62 views Asked by At

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)
1

There are 1 answers

0
YBS On

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)