在 R 中的表中显示选定的变量

Question

我只想获取从 selectInput（我的开关）中选择的表中的数据，因为现在该表显示了 Value 和 Amount。我尝试使用DT::datatable(tab_input1())，但它不起作用。怎么改？

我的代码：

library(plotly)
library(dplyr)
library(shiny)
library(shinyWidgets)
library(readxl)
library(tidyr)
library(DT)

df1 <- data.frame(Month = rep(month.abb[1:12],10,replace = TRUE), Product = paste0('Szafa ', rep(LETTERS[1:10], each = 12)),
                  Value = sample(c(0:300),120, replace = T), Amount = sample(c(1000:10000),120, replace = T),stringsAsFactors = F)

df2 <- data.frame(Month = rep(month.abb[1:12],10,replace = TRUE), Product = paste0('Fotel ', rep(LETTERS[1:10], each = 12)),
                  Value = sample(c(0:300),120, replace = T),Amount = sample(c(1000:10000),120, replace = T), stringsAsFactors = F)

# UI
ui <- fluidPage(
    column(
        6,fluidRow(column(6, selectizeInput("All", "Year: 2018", multiple = T,choices = unique(df1$Product), 
                                            options = list(maxItems = 5, placeholder = 'Choose a product:'))),
                   column(6, selectizeInput("All2", "Year: 2019", multiple = T,choices = unique(df2$Product), 
                                            options = list(maxItems = 5, placeholder = 'Choose a product:'))),
                   column(6, selectInput("y_axis1", "What you want to analyze?", choices = c("Value", "Amount")))
    )),
    column(
        12,fluidRow(column(12, plotlyOutput('plot'),
                           12, DT::dataTableOutput('tbl2'))
        )
    ) 
)

# Server code
server <- function(input, output) {

    tab_input1 <- reactive({
        switch(input$y_axis1,
               Value = "Value", 
               Amount = "Amount")
    })

    outVar <- reactive({
        df1 %>%
            filter(Product %in% input$All) %>%
            mutate(Product = paste(Product, "2018", sep = " ")) %>% 
            arrange(Month) %>%
            droplevels()
    })

    outVar2 <- reactive({
        df2 %>%
            filter(Product %in% input$All2) %>%
            mutate(Product = paste(Product, "2019", sep = " ")) %>% 
            arrange(Month) %>%
            droplevels()
    })

    output$plot <- renderPlotly({
        plot_ly(data=outVar(), x=~Month,  y = outVar()[,tab_input1()],
                type = 'scatter', mode = 'lines', legendgroup = "1",
                color = ~Product  , colors = c('red','blue', 'yellow', 'green', "orange")) %>%
            add_trace(data=outVar2(), x=~Month,  y = outVar2()[,tab_input1()],
                      type = 'scatter', mode = 'lines', legendgroup = "2",
                      color = ~Product , colors = c('red','blue', 'yellow', 'green', "orange"))  %>%
            layout(legend = list(orientation = 'h'))         
    }) 

    output$tbl2 <- DT::renderDataTable({
        DT::datatable(rbind(outVar(),outVar2()))
        #DT::datatable(tab_input1())
    })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

Answer 1

您可以在全局中定义c("Value", "Amount") 以使用它知道您要保留哪一列。

library(plotly)
library(dplyr)
library(shiny)
library(shinyWidgets)
library(readxl)
library(tidyr)
library(DT)

df1 <- data.frame(Month = rep(month.abb[1:12],10,replace = TRUE), Product = paste0('Szafa ', rep(LETTERS[1:10], each = 12)),
                  Value = sample(c(0:300),120, replace = T), Amount = sample(c(1000:10000),120, replace = T),stringsAsFactors = F)

df2 <- data.frame(Month = rep(month.abb[1:12],10,replace = TRUE), Product = paste0('Fotel ', rep(LETTERS[1:10], each = 12)),
                  Value = sample(c(0:300),120, replace = T),Amount = sample(c(1000:10000),120, replace = T), stringsAsFactors = F)

analyze <- c("Value", "Amount")

# UI
ui <- fluidPage(
  column(
    6,fluidRow(column(6, selectizeInput("All", "Year: 2018", multiple = T,choices = unique(df1$Product), 
                                        options = list(maxItems = 5, placeholder = 'Choose a product:'))),
               column(6, selectizeInput("All2", "Year: 2019", multiple = T,choices = unique(df2$Product), 
                                        options = list(maxItems = 5, placeholder = 'Choose a product:'))),
               column(6, selectInput("y_axis1", "What you want to analyze?", choices = analyze))
    )),
  column(
    12,fluidRow(column(12, plotlyOutput('plot'),
                       12, DT::dataTableOutput('tbl2'))
    )
  ) 
)

# Server code
server <- function(input, output) {

  tab_input1 <- reactive({
    switch(input$y_axis1,
           Value = "Value", 
           Amount = "Amount")
  })

  outVar <- reactive({
    df1 %>%
      filter(Product %in% input$All) %>%
      mutate(Product = paste(Product, "2018", sep = " ")) %>% 
      arrange(Month) %>%
      droplevels()
  })

  outVar2 <- reactive({
    df2 %>%
      filter(Product %in% input$All2) %>%
      mutate(Product = paste(Product, "2019", sep = " ")) %>% 
      arrange(Month) %>%
      droplevels()
  })

  output$plot <- renderPlotly({
    plot_ly(data=outVar(), x=~Month,  y = outVar()[,tab_input1()],
            type = 'scatter', mode = 'lines', legendgroup = "1",
            color = ~Product  , colors = c('red','blue', 'yellow', 'green', "orange")) %>%
      add_trace(data=outVar2(), x=~Month,  y = outVar2()[,tab_input1()],
                type = 'scatter', mode = 'lines', legendgroup = "2",
                color = ~Product , colors = c('red','blue', 'yellow', 'green', "orange"))  %>%
      layout(legend = list(orientation = 'h'))         
  }) 

  output$tbl2 <- DT::renderDataTable({
    rbind_tab <- rbind(outVar(),outVar2())
    del_column <- analyze[analyze != tab_input1()] # get which column to delete
    rbind_tab[[del_column]] <- NULL 
    DT::datatable(rbind_tab)
    #DT::datatable(tab_input1())
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)