Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
198 views
in Technique[技术] by (71.8m points)

r - how to refresh or override plots using actionButton in shiny

I have deal with the plot show problem about one,two or all of them togather.

But now I just wanna have a modification on my code.

I mean I want to show one plot each time when I click the first button. And then I click the second button, the new plot will appear in the same place but refresh/override the first one or in turn. Then, I click the third button, there will show the two plots togather.

I referred to this method but there was no effect or I did sth wrong.

Here is my sample code. I need your help. Vary thankful.

library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)

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

# Prepare dataset.
#   1. Bind mean and sd data
#   2. Reshape
data <- bind_rows(list(
  mean = mean_data,
  sd = sd_data
), .id = "stat")
data_mean_sd1 <- data %>%
  pivot_longer(-c(Name, stat), names_to = "Gene", values_to = "value") %>%
  pivot_wider(names_from = "stat", values_from = "value")
###
ui <- fluidPage(
  
  pageWithSidebar(
    headerPanel("Gene_FPKM Value Barplot"),
    sidebarPanel(
      selectInput(
        "selectGeneSymbol", 
        "Select Gene Symbol:", 
        choices = unique(data_mean_sd1$Gene),
        multiple =F,
        width = 400,
        selected = "Igfbp7"
      ),
      actionButton(inputId = "plot1", label = "FPKM"),
      actionButton(inputId = "plot2", label = "logFC"),
      actionButton(inputId = "all",label = "logFC&FPKM")
    ),
    mainPanel(
      uiOutput("all")    
      )
  )
  
)

server <- function(input, output) {
  
  
  plot_data1 <- reactive({
    subset(data_mean_sd1, Gene %in% input$selectGeneSymbol)
  })
  
  
  plot_data2 <- reactive({
    subset(data_mean_sd1, Gene %in% input$selectGeneSymbol)
  })
  
  global <- reactiveValues(out = NULL)
  
  observeEvent(input$plot1, {
    global$out <- plotOutput("plot1")
  })
  
  observeEvent(input$plot2, {
    global$out <- plotOutput("plot2")
  })
  
  output$all <- renderUI({
    global$out
  })
  
  
  output$plot1 <- renderPlot({
    
    ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
      geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
      geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
      theme_classic2() +
      rotate_x_text(angle = 45) +
      theme(legend.position = "none") +
      labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
      theme(plot.title = element_text(hjust = 0.5)) +
      theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
      theme(axis.text.x=element_text(vjust=1,size=12))
  })
  
  output$plot2 <- renderPlot({
    ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
      geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
      geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
      theme_classic2() +
      rotate_x_text(angle = 45) +
      theme(legend.position = "none") +
      labs(title = input$selectGeneSymbol, x = NULL, y = "logFC_value") +
      theme(plot.title = element_text(hjust = 0.5)) +
      theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
      theme(axis.text.x=element_text(vjust=1,size=12))
  })
  
  output$all<-renderPlot({
    list(
      output$plot1,
      output$plot2
    )
  })
}

# Create Shiny app ----
shinyApp(ui = ui, server = server)
question from:https://stackoverflow.com/questions/65902285/how-to-refresh-or-override-plots-using-actionbutton-in-shiny

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

Your current selection choice means plot1 and plot2 will be exactly same. So I put a second selectInput. You can use grid.arrange() from gridExtra package to display multiple plots. Perhaps this meets your needs:

EDIT: Using eventReactive to generate the plots will ensure that the plots are not updated whenever a gene symbol is changed.

library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)

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

# Prepare dataset.
#   1. Bind mean and sd data
#   2. Reshape
data <- bind_rows(list(
  mean = mean_data,
  sd = sd_data
), .id = "stat")
data_mean_sd1 <- data %>%
  pivot_longer(-c(Name, stat), names_to = "Gene", values_to = "value") %>%
  pivot_wider(names_from = "stat", values_from = "value")
###
ui <- fluidPage(
  
  pageWithSidebar(
    headerPanel("Gene_FPKM Value Barplot"),
    sidebarPanel(
      selectInput(
        "selectGeneSymbol", 
        "Select Gene Symbol:", 
        choices = unique(data_mean_sd1$Gene),
        multiple =F,
        width = 400,
        selected = 1 #"Igfbp7"
      ),
      selectInput(
        "selectGeneSymbol2", 
        "Select Gene Symbol2:", 
        choices = unique(data_mean_sd1$Gene),
        multiple =F,
        width = 400,
        selected = 1 #"Igfbp7"
      ),
      actionButton(inputId = "plot1", label = "FPKM"),
      actionButton(inputId = "plot2", label = "logFC"),
      actionButton(inputId = "all",label = "logFC&FPKM")
    ),
    mainPanel(
      uiOutput("all")    
    )
  )
  
)

server <- function(input, output, session) {
  
  plot_data1 <- reactive({
    subset(data_mean_sd1, Gene %in% input$selectGeneSymbol)
  })
  
  plot_data2 <- reactive({
    subset(data_mean_sd1, Gene %in% input$selectGeneSymbol2)
  })
  
  global <- reactiveValues(out = NULL)
  
  observeEvent(input$plot1, {
    global$out <- plotOutput("plot1", height=500)
  })
  
  observeEvent(input$plot2, {
    global$out <- plotOutput("plot2", height=500)
  })
  
  observeEvent(input$all, {
    global$out <- plotOutput("plot3", height=850)
  })
  
  output$all <- renderUI({
    global$out
  })
  
  p1 <- eventReactive(list(input$plot1,
                       input$all), {
    ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
      geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
      geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
      theme_classic2() +
      rotate_x_text(angle = 45) +
      theme(legend.position = "none") +
      labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
      theme(plot.title = element_text(hjust = 0.5)) +
      theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
      theme(axis.text.x=element_text(vjust=1,size=12))
      })
    
  p2 <- eventReactive(list(input$plot2,
                       input$all), {
    ggplot(data = plot_data2(), aes(x = Name, y = mean,fill=Name)) +
      geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
      geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
      theme_classic2() +
      rotate_x_text(angle = 45) +
      theme(legend.position = "none") +
      labs(title = input$selectGeneSymbol2, x = NULL, y = "FPKM_value") +
      theme(plot.title = element_text(hjust = 0.5)) +
      theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
      theme(axis.text.x=element_text(vjust=1,size=12))
    })
    
  output$plot1 <- renderPlot({ p1() })
  output$plot2 <- renderPlot({ p2() })
  output$plot3 <- renderPlot({ grid.arrange(p1(),p2(), ncol=1) })

  
}

# Create Shiny app ----
shinyApp(ui = ui, server = server)

output


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...