如何使用通过 DT::renderDataTable 在输出中呈现的数据进行绘图

Question

我创建了一个数据table，其中包含 renderDT 和反应函数，以便将 table 更改为 selectInputs。现在我想用创建的数据 table 绘制一个 geom_line 图形，并有一个反应式仪表板必须用相同的 selectInputs 进行更改，但我不知道如何更改。如果您有一些想法，请分享。此外，我希望 selectInputs 中没有默认选择。这是代码：

library(shiny)
library(DT)
library(dplyr)
library(shinyWidgets)
library(tidyverse)
library(lubridate)
library(timetk)
library(ggplot2)
library(rJava)
library(xlsx)
library(graphics)


data_1 <-mtcars

# User Interface
ui <- fluidPage(
  titlePanel("My dashboard"),
  sidebarLayout(
    sidebarPanel(
      selectInput('filter_gear', 'gear', choices = NULL, selected = NULL, multiple = FALSE, selectize = FALSE, width = NULL, size = NULL),
      
      selectInput('filter_carb', 'carb', choices = NULL, selected = NULL, multiple = FALSE, selectize = FALSE, width = NULL, size = NULL),
      
      selectInput('filter_cyl', 'cyl', choices = NULL, selected = NULL, multiple = FALSE, selectize = FALSE, width = NULL, size = NULL)
    ),
    
    mainPanel(
      tabsetPanel(id="mydash", type= "tabs",
                  tabPanel("Plot", plotOutput("fig"), plotOutput("fig2"), plotOutput("fig3")),
                  tabPanel("Tables", p(DTOutput('databasedf')))
                  
      )
    )
  )
)


server <- function(input, output, session) {

  filterdf <- reactive({
    filterdf <- data_1
    filterdf <- droplevels.data.frame(filterdf)
    return(filterdf)
  })
  
  filtergear <- reactive({
    unique(as.character(filterdf()$gear))
  })
  
  observeEvent(filtergear(), {
    updateSelectInput(session,
                      "filter_gear",
                      choices = filtergear(),
                      selected = sort(filtergear()))
  })
  
  # # Subset dynamically the previous reactive filter #
  datasub1 <- reactive({
    data_1[data_1$gear %in% input$filter_gear,]
  })
  
  filtercarb <- reactive({
    unique(as.character(datasub1()$carb))
  })
  
  observeEvent(filtercarb(), {
    updateSelectInput(session,
                      "filter_carb",
                      choices = sort(filtercarb()),
                      selected = sort(filtercarb()))
  })
  
  # Subset dynamically the previous reactive filter #
  datasub2 <- reactive({
    # browser()
    data_1[data_1$carb %in% input$filter_carb,]
  })
  
  filtercyl <- reactive({
    unique(as.character(datasub2()$cyl))
  })
  
  observeEvent(filtercyl(), {
    updateSelectInput(session,
                      "filter_cyl",
                      choices = sort(filtercyl()),
                      selected = sort(filtercyl()))
  })
  
  output$databasedf <- DT::renderDT({
    
    #  Subset for plotly reactivity
    Filter1 <- droplevels.data.frame(data_1)
    Filter2 <- filter(Filter1,
                      Filter1$gear %in% input$filter_gear,
                      Filter1$carb %in% input$filter_carb,
                      Filter1$cyl %in% input$filter_cyl)
    
    # Plot
    datatable(Filter2,
              filter="none",
              selection="none",
              escape=FALSE,
              rownames = FALSE,
              # colnames = c("", ""),
              autoHideNavigation = TRUE,
              style = 'bootstrap4',
              options = list(searching = FALSE, # remove search option
                             ordering = FALSE, # remove sort option
                             paging = FALSE,  # remove paging
                             info = FALSE # remove bottom information
              )) %>%
      formatStyle(columns = 1, fontWeight = 'bold', `text-align` = 'left') # text to bold and lign left in first column
    
  })
  
  output$fig <-renderPlot({ 
    plt <- addDataFrame(Filter2, sheet, col.names=TRUE, row.names=TRUE, startRow=1, startColumn=1)
    fig <- plt %>% ggplot() + geom_line(aes(x=hp, y=mean(mpg), color=am)) })
  
}

shinyApp(ui, server)

Answer 1

我在 renderDT 之外定义了 Filter2 以允许 renderPlot 找到它。我留下了 plt 评论。我试图在不进行重大更改的情况下离开该应用程序。 ggplot 之前的 req 是为了避免在开始时出现错误（因为输入尚未使用 select 选项更新）。

library(shiny)
library(DT)
library(dplyr)
library(shinyWidgets)
library(tidyverse)
library(lubridate)
library(timetk)
library(ggplot2)
library(rJava)
library(xlsx)
library(graphics)


data_1 <- mtcars

# User Interface
ui <- fluidPage(
  titlePanel("My dashboard"),
  sidebarLayout(
    sidebarPanel(
      selectInput('filter_gear', 'gear', choices = NULL, selected = NULL, multiple = FALSE, selectize = FALSE, width = NULL, size = NULL),
      
      selectInput('filter_carb', 'carb', choices = NULL, selected = NULL, multiple = FALSE, selectize = FALSE, width = NULL, size = NULL),
      
      selectInput('filter_cyl', 'cyl', choices = NULL, selected = NULL, multiple = FALSE, selectize = FALSE, width = NULL, size = NULL)
    ),
    
    mainPanel(
      tabsetPanel(id="mydash", type= "tabs",
                  tabPanel("Plot", plotOutput("fig"), plotOutput("fig2"), plotOutput("fig3")),
                  tabPanel("Tables", p(DTOutput('databasedf')))
                  
      )
    )
  )
)


server <- function(input, output, session) {
  
  filterdf <- reactive({
    filterdf <- data_1
    filterdf <- droplevels.data.frame(filterdf)
    return(filterdf)
  })
  
  filtergear <- reactive({
    unique(as.character(filterdf()$gear))
  })
  
  observeEvent(filtergear(), {
    updateSelectInput(session,
                      "filter_gear",
                      choices = filtergear(),
                      selected = sort(filtergear()))
  })
  
  # # Subset dynamically the previous reactive filter #
  datasub1 <- reactive({
    data_1[data_1$gear %in% input$filter_gear,]
  })
  
  filtercarb <- reactive({
    unique(as.character(datasub1()$carb))
  })
  
  observeEvent(filtercarb(), {
    updateSelectInput(session,
                      "filter_carb",
                      choices = sort(filtercarb()),
                      selected = sort(filtercarb()))
  })
  
  # Subset dynamically the previous reactive filter #
  datasub2 <- reactive({
    # browser()
    data_1[data_1$carb %in% input$filter_carb,]
  })
  
  filtercyl <- reactive({
    unique(as.character(datasub2()$cyl))
  })
  
  observeEvent(filtercyl(), {
    updateSelectInput(session,
                      "filter_cyl",
                      choices = sort(filtercyl()),
                      selected = sort(filtercyl()))
  })
  

  Filter2  <- reactive({
    #  Subset for plotly reactivity
    Filter1 <- droplevels.data.frame(data_1)
    filter(Filter1,
           Filter1$gear %in% input$filter_gear,
           Filter1$carb %in% input$filter_carb,
           Filter1$cyl %in% input$filter_cyl)
  })
  
  output$databasedf <- DT::renderDT({
    
    datatable(Filter2(),
              filter="none",
              selection="none",
              escape=FALSE,
              rownames = FALSE,
              # colnames = c("", ""),
              #autoHideNavigation = TRUE,
              style = 'bootstrap4',
              options = list(searching = FALSE, # remove search option
                             ordering = FALSE, # remove sort option
                             paging = FALSE,  # remove paging
                             info = FALSE # remove bottom information
              )) %>%
      formatStyle(columns = 1, fontWeight = 'bold', `text-align` = 'left') # text to bold and lign left in first column
    
  })
  
  output$fig <-renderPlot({ 
    req(input$filter_gear)
    req(input$filter_carb)
    req(input$filter_cyl)
    
    #plt <- addDataFrame(reac_filter$Filter2, sheet, col.names=TRUE, row.names=TRUE, startRow=1, startColumn=1)
    ggplot() + geom_line(aes(x=hp, y=mean(mpg), color=am),data = Filter2()) })
  
}

shinyApp(ui, server)

如何使用通过 DT::renderDataTable 在输出中呈现的数据进行绘图

How to use the data rendered in output through DT::renderDataTable for plotting

r

ggplot2

shiny

reactive