基于闪亮应用程序中另一个数据框的列对数据框进行子集

Question

我有下面的数据框：

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 行，我应该在其中给出input$sel

#ui.r
library(shiny)
library(rhandsontable)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(width=2,
                 selectInput("sel","Filter by:",
                             choices = c("agency_postcode","date_start","days","car_group","transmission","driver_age"),
                             multiple=T,selected = "agency_postcode"),
                 actionButton("sr","Search")
    ),
    mainPanel(
      fluidRow(
        column(4,offset = 0, style='padding:0px;',rHandsontableOutput("hot")),
        column(8,offset = 0, style='padding:0px;',rHandsontableOutput("hot2"))

      )

    )
  )
)
#server.r
#server.r
library(shiny)
library(rhandsontable)
library(jsonlite)
server <- function(input, output) {

  #Create rhandsontable as a reactive expression
  DFR2<-reactive({

    rhandsontable(DF2[1,1:2], rowHeaders = NULL,height = 200)%>%
      hot_col(colnames(DF2)[1:2])   
  })

  #Display the rhandsontable
  output$hot <- renderRHandsontable({

    DFR2()

  })

  #Convert the rhandsontable to a daraframe
  DFR3<-reactive({
    req(input$hot)
    hot_to_r(input$hot)
  })
  #Subset the initial dataframe by value of the 1st row-1st column cell of DF3
  DFR4 <- reactive({

    req(DFR3())
    D<-DF2[ which(DF2[,1] %in% DFR3()[1, 1]), ] #input$sel is supposed to be used here instead of 1
    for(i in 1:ncol(D)){
      D[,i] <- factor(D[,i])
    }
    D
  })
  #Display the new rhandsontable
  output$hot2 <- renderRHandsontable({
    input$sr
    isolate(rhandsontable(DFR4()[1,], rowHeaders = NULL,height = 200)%>%
              hot_col(colnames(DFR4())) )  


  })


}

Answer 1

好的。这是一个使用小表格过滤较大表格的应用程序，使用inner_join。我不确定这是否符合您的想法。我仍然不清楚过滤器级别来自哪里，或者桌子上的手是做什么用的。但是您应该能够使这种方法适应您的设计。另请注意，我没有在桌子上使用手。用renderRHandsontable 直接替换对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。