简体   繁体   中英

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

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

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)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM