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)))

我使用

并显示为rhansontable来创建第二张表。首先，您应该按输入从过滤器中选择一个或多个选项，然后从所选过滤器中选择一个级别。然后按搜索。我基本上想做的是根据第一个表的每个选定列的第一行对第二个表进行子集化。问题出在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过滤较大表格的应用。我不确定这是否符合您的设计想法。我仍然不清楚过滤器级别来自何处，或者表的作用是什么。但是您应该能够使这种方法适应您的设计。另请注意，我没有在桌子上动手。用renderTable直接替换对renderRHandsontable的呼叫也应该起作用。

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)

这是它所做的一切的礼物。

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

1 个答案: