Shinyapp 中的多个直方图

multiple histograms in Shinyapp

我想select多个变量来查看它们的直方图。下面的代码只打印一个变量的直方图。非常感谢。

library(shiny)
library(ggplot2)
library(gridExtra)

ui <- fluidPage(
  titlePanel("title panel"),
  sidebarLayout(position = "left",
                sidebarPanel("sidebar panel",
                             checkboxGroupInput(inputId = "selected_var",
                                                label = "Select variables:",
                                                choices = names(mtcars)) 
                ),
                mainPanel("main panel",
                          column(6, plotOutput(outputId = "plotgraph", 
                                               width = "500px", height = "400px"))
                )
  )
)

server <- function(input, output){
  output$plotgraph <- renderPlot({
    ggplot(data = mtcars, aes_string(x = input$selected_var)) +
      geom_histogram(aes(y = ..density..), bins = 100, col = "darkgreen", 
                     fill = "darkgreen")+
      geom_density(col = "red", alpha = .2, fill = "#FF6666")
    
  })  
}

shinyApp(ui = ui, server = server)

这是我相信可以让您接近您想要的东西。

library(shiny)
library(ggplot2)
library(tidyverse)

ui <- fluidPage(
  titlePanel("title panel"),
  sidebarLayout(position = "left",
                sidebarPanel("sidebar panel",
                             checkboxGroupInput(inputId = "selected_var",
                                                label = "Select variables:",
                                                choices = names(mtcars)) 
                ),
                mainPanel("main panel",
                          column(6,plotOutput(outputId="plotgraph", width="500px",height="400px"))
                )))



server <- function(input, output){
  # Tidy the data
  tidyCars <- as_tibble(mtcars %>% 
                rownames_to_column("Model")) %>% 
                pivot_longer(
                  -Model,
                  names_to="Variable",
                  values_to="Value"
                )

  output$plotgraph <- renderPlot({
    # Suppress warning message when no variables are selected
    req(input$selected_var)
    
    # Modify print request to handle tidy format
    tidyCars %>% 
      # Filter to selected variables
      filter(Variable %in% input$selected_var) %>% 
      # Define the plot
      ggplot(aes(x=Value)) +
      geom_histogram(aes(y = ..density..),bins = 100,col="darkgreen",fill="darkgreen")+
      geom_density(col = "red",alpha=.2, fill="#FF6666") +
      # One plot for each variable
      facet_wrap(vars(Variable))
  })  
}

shinyApp(ui = ui, server = server)

可以使用包 ggpubr 中的 ggarrange,然后使用 lapply:

创建地块列表
library(shiny)
library(ggplot2)
library(ggpubr)

ui <- fluidPage(
  titlePanel("title panel"),
  sidebarLayout(position = "left",
                sidebarPanel("sidebar panel",
                             checkboxGroupInput(inputId = "selected_var",
                                                label = "Select variables:",
                                                choices = names(mtcars))
                ),
                mainPanel("main panel",
                          column(6, plotOutput(outputId = "plotgraph",
                                              width = "500px", height = "400px"))
                )
  )
)

server <- function(input, output){
  output$plotgraph <- renderPlot({
    if (is.null(input$selected_var))
      plist <- list(ggplot() + theme_void())
    else
      plist <- lapply(
        input$selected_var,
        function(x) ggplot(data = mtcars, aes_string(x = x)) +
          geom_histogram(aes(y = ..density..), bins = 100,
                         col = "darkgreen", fill="darkgreen") +
          geom_density(col = "red", alpha = .2, fill = "#FF6666")
      )
    ggarrange(plotlist = plist)
  })
}

shinyApp(ui = ui, server = server)