【问题标题】:When click actionbutton to refresh plot there is a table that is not be refreshed单击操作按钮刷新绘图时,有一个未刷新的表
【发布时间】:2021-07-16 13:33:35
【问题描述】:

我创建了一个闪亮的应用程序,其中包含三个重要按钮。

三个按钮效果很好

而且click3可以同时输出一个plot和一个table。

现在遇到了一个问题,plot1、plot2、plot3(plot3和热图输出一起)可以理想地互相刷新。但是看起来好像不是这样。

无论点击 click1 还是 click2,输出表始终保持不变。

我尝试修改我的代码,但没有成功。

我希望有人能给我一些建议,无论点击哪个按钮,表格都会随着 heatmpa 消失。

我的可重现代码和数据在这里:

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")
    
  })
  
  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)
  })
  
  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)

【问题讨论】:

    标签: r ggplot2 shiny shinyapps


    【解决方案1】:

    试试这个

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

    【讨论】:

    • 嗯,谢谢,先生。我不知道我的问题,但你的信息给了我方向。
    猜你喜欢
    • 1970-01-01
    • 2013-10-10
    • 2014-12-25
    • 1970-01-01
    • 2022-06-11
    • 2017-01-16
    • 2016-10-02
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多