如何通过 Shinyapp 中不同条件下的操作按钮刷新绘图

时间：2021-04-22 07:18:51

标签： r shiny uioutput

我创建了一个闪亮的应用程序，里面有三个重要的按钮。

三个按钮效果很好

click3 可以同时输出一个图和一个表。

现在在我的应用中他们只是互相刷新，但每次只有表格仍然保留。

我的问题是现在我想修改一些部分，我希望：

plot1 和 plot2 不会刷新 click3（plot3 和 table），click3 不会刷新 plot1 或 plot2。

######### 编辑：2021-04-22 21:09:43

抱歉，我没有澄清我的问题。

现在p1(),p2(), myPlot可以互相刷新。

但我希望 myPlot 和 myTable 可以一直待到新的 click3 刷新自己。 p1() and p2() 可以互相刷新但不会影响 myPlot 和 myTable 这样 p1() or p2() 就可以在 mainparnel 中与 myPlot 和 myTable 在一起。

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

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 个答案:

答案 0 :(得分：0)

也许这就是你的期望

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)
相关问题
最新问题