R 基于应用程序中另一个数据帧的列对数据帧进行子集

我的数据框架如下：

DF2 = data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
                 car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
                 transmission=factor(rep(c("automatic","manual"),5)))

我使用它并将其显示为rhandsontable，以便创建第二个表。首先，您应该从“按输入筛选”中选择一个或多个选项，然后从所选筛选中选择一个级别。然后按搜索。我基本上想做的是根据第一个表中每个选定列的第一行来子集第二个表。问题出现在server.r的第30行中，我应该在其中输入$sel

---

嗯。这是一个应用程序，它使用一个小表来过滤一个更大的表。我不确定这是否符合你心目中的设计。我仍然不清楚过滤层来自何处，或者手放在桌子上是干什么用的。但是您应该能够将这种方法应用到您的设计中。还要注意的是，我没有在桌子上动手。使用RenderHandsOnTable直接替换对renderTable的调用也可以

library(shiny)
library(dplyr)
library(purrr)

sub_cars <- mtcars[, c("cyl", "gear", "am")]

ui <- fluidPage(
  column(width=3,
         selectInput(
    inputId = "sel_col",
    label = "Select variables",
    multiple = TRUE,
    choices = c("cyl", "gear", "am"),
    selectize = TRUE),
    uiOutput("cyl"),
    uiOutput("gear"),
    uiOutput("am")
    ),
  column(width = 3, 
         tableOutput("filter_table")),
  column(width = 6,
         tableOutput("large_table"))

)

server <- function(input, output) {
  output$cyl <- renderUI({
    if ("cyl" %in% input$sel_col) {
      selectInput(
        inputId = "sel_cyl",
        label = "Select cylinders",
        choices = unique(sub_cars$cyl),
        multiple = TRUE,
        selectize = TRUE
      )
    }
  })    
    output$gear <- renderUI({
      if ("gear" %in% input$sel_col) {
        selectInput(
          inputId = "sel_gear",
          label = "Select gears",
          choices = unique(sub_cars$gear),
          multiple = TRUE,
          selectize = TRUE
        )
      }
    })
    output$am <- renderUI({
      if ("am" %in% input$sel_col) {
        selectInput(
          inputId = "sel_am",
          label = "Select am",
          choices = unique(sub_cars$am),
          multiple = TRUE,
          selectize = TRUE
        )
      }
    })

    # make a small filter table
    filter_df <- reactive({
      validate(
        need(!is_null(input$sel_col),
             message = "Please select a column"))
      cols <- input$sel_col
      cols_vals <- map(cols, function(x) input[[paste0("sel_", x, collapse="")]])

      df <- map2_dfr(cols, cols_vals, function(x, y)
        filter(sub_cars,!!as.name(x) %in% y)) %>% 
        select(one_of(cols)) %>% 
        distinct()

      return(df)
    })

    output$filter_table <- renderTable({
      validate(
        need(nrow(filter_df()) > 0,
             message = "Please select filter values"))
      filter_df()
      })

    # inner join the larger table
    large_df <- reactive({
      validate(
        need(nrow(filter_df()) > 0,
             message = "Please select filter values"))
      cols <- input$sel_col
      inner_join(x=filter_df(), y=mtcars, by = cols)
    })

    output$large_table <- renderTable({large_df()})
}

shinyApp(ui, server)

这是一张它的gif图片

---

我们缺少一些为过滤器选择级别的代码。更重要的是，基于输入$sel，第二个表将是什么样子的示例。根据目前的描述，我了解以下内容。要获取第二个表，需要筛选第一个表以保留每个选定列的第一个元素。对于这两种表操作，最好使用连接函数而不是筛选。您可以基于用户输入创建一个小表，然后使用类似于dplyr:：internal_join的方法从一个大表中提取与较小表中的条目相匹配的行。您可以在此基础上添加一个解决方案吗？

library(shiny)
library(dplyr)
library(purrr)

sub_cars <- mtcars[, c("cyl", "gear", "am")]

ui <- fluidPage(
  column(width=3,
         selectInput(
    inputId = "sel_col",
    label = "Select variables",
    multiple = TRUE,
    choices = c("cyl", "gear", "am"),
    selectize = TRUE),
    uiOutput("cyl"),
    uiOutput("gear"),
    uiOutput("am")
    ),
  column(width = 3, 
         tableOutput("filter_table")),
  column(width = 6,
         tableOutput("large_table"))

)

server <- function(input, output) {
  output$cyl <- renderUI({
    if ("cyl" %in% input$sel_col) {
      selectInput(
        inputId = "sel_cyl",
        label = "Select cylinders",
        choices = unique(sub_cars$cyl),
        multiple = TRUE,
        selectize = TRUE
      )
    }
  })    
    output$gear <- renderUI({
      if ("gear" %in% input$sel_col) {
        selectInput(
          inputId = "sel_gear",
          label = "Select gears",
          choices = unique(sub_cars$gear),
          multiple = TRUE,
          selectize = TRUE
        )
      }
    })
    output$am <- renderUI({
      if ("am" %in% input$sel_col) {
        selectInput(
          inputId = "sel_am",
          label = "Select am",
          choices = unique(sub_cars$am),
          multiple = TRUE,
          selectize = TRUE
        )
      }
    })

    # make a small filter table
    filter_df <- reactive({
      validate(
        need(!is_null(input$sel_col),
             message = "Please select a column"))
      cols <- input$sel_col
      cols_vals <- map(cols, function(x) input[[paste0("sel_", x, collapse="")]])

      df <- map2_dfr(cols, cols_vals, function(x, y)
        filter(sub_cars,!!as.name(x) %in% y)) %>% 
        select(one_of(cols)) %>% 
        distinct()

      return(df)
    })

    output$filter_table <- renderTable({
      validate(
        need(nrow(filter_df()) > 0,
             message = "Please select filter values"))
      filter_df()
      })

    # inner join the larger table
    large_df <- reactive({
      validate(
        need(nrow(filter_df()) > 0,
             message = "Please select filter values"))
      cols <- input$sel_col
      inner_join(x=filter_df(), y=mtcars, by = cols)
    })

    output$large_table <- renderTable({large_df()})
}

shinyApp(ui, server)