Question

我的代码一直在处理data.frames，但是现在我转换为data.table我无法通过用户的输入过滤data.table。 filter_expr设置为TRUE，最后只有TRUE的行应该在最终的表格版本中。我认为%in% operator可能是问题，但我还没找到答案。

我约会的时间：

structure(list(fruit = c("Apple", "Apple", "Apple", "Apple", 
"Apple", "Apple", "Banana", "Banana", "Banana", "Banana", "Banana", 
"Banana", "Citrus", "Citrus", "Citrus", "Citrus", "Citrus", "Citrus"
), Month = c(1L, 9L, 12L, 1L, 9L, 12L, 1L, 9L, 12L, 1L, 9L, 12L, 
1L, 9L, 12L, 1L, 9L, 12L), Fertilizer = c("A", "A", "A", "B", 
"B", "B", "A", "A", "A", "B", "B", "B", "A", "A", "A", "B", "B", 
"B"), red = c("+", "+", "+", "+", "+", "+", "+", "+", "+", "+", 
"+", "+", "+", "+", "+", "+", "+", "+"), green = c("+", "-", 
"+", "-", "+", "-", "+", "-", "+", "-", "+", "-", "+", "-", "+", 
"-", "+", "-"), yellow = c("+", "+", "-", "+", "+", "-", "+", 
"+", "-", "+", "+", "-", "+", "+", "-", "+", "+", "-")), .Names = c("fruit", 
"Month", "Fertilizer", "red", "green", "yellow"), row.names = c(NA, 
-18L), class = c("data.table", "data.frame"), .internal.selfref = <pointer: 0x10280e978>)

我使用this file进行测试。

library(shiny)
library(data.table)
library(DT)

ui <- (fluidPage(tagList(
  navbarPage(
    "My Application",
    tabPanel("Pregated Data",
             sidebarLayout(
               sidebarPanel(
                 conditionalPanel(condition = "input.tabselected == 1",
                                  fileInput(inputId = 'file_input', 'Choose CSV File',
                                            accept=c('text/csv',
                                                     'text/comma-separated-values,text/plain', 
                                                     '.csv')),
                                  #progressbar
                                  tags$hr(),
                                  checkboxInput('header', 'Header', TRUE),
                                  radioButtons('sep', 'Separator',
                                               c(Comma=',',
                                                 Semicolon=';',
                                                 Tab='\t'),
                                               ',')

                 ),
                 conditionalPanel(condition = "input.tabselected == 2",
                                  uiOutput("file_input"))
               ),
               mainPanel(
                 tabsetPanel(
                   tabPanel("Data", value = 1, dataTableOutput('table1')),
                   tabPanel("checkboxes",value = 2,conditionalPanel(condition = "input.choice ==1"), 
                            dataTableOutput('fruit_table')), 
                            id = "tabselected"
                 )
               )
             )
    )
  )
)))



server <- function(input, output) {

  fileData <- reactive(
    if (is.null(input$file_input)){
      return()
    }else{
      tdata <- fread(input$file_input$datapath, header=input$header, sep=input$sep)
      return(tdata)
    }
  )

  output$table1 <- renderDataTable({
    if(is.null(fileData())){
      return(NULL)
    }else{
      datatable( fileData(), options = list(pageLength = 25))
    }
  })


  output$file_input <- renderUI ({
    if(is.null(fileData())){
      return()
    }else{
      tagList(
        checkboxGroupInput(inputId = "fruit",
                           label = "fruit",
                           choices = c(unique(fileData()[,get("fruit")])),
                           selected = fileData()[1, 1, with = FALSE]),
        radioButtons(inputId = "month",
                     label = "Month",
                     choices =unique(fileData()[,get("Month")]),
                     selected = fileData()[1,Month],
                     inline = TRUE),
        checkboxGroupInput(inputId = "tube",
                           label = "Fertilizer",
                           choices = unique(fileData()[,get("Fertilizer")]),
                           selected = fileData()[1, 3, with = F]),
        ###checkboxes from Loop:
        lapply(1:(length(fileData())-3), function(i) {
          checkboxGroupInput(inputId = paste0("color",i),
                             label = colnames(fileData()[,i+3, with = FALSE]),
                             choices = c(unique(fileData()[,get(colnames(fileData()[,i+3, with = FALSE]))])),
                             inline = TRUE,
                             selected = fileData()[1, i+3, with = FALSE])
        }
      )
      )
    }})   

  ###returns table form boolean-Gates csv file rigth after upload
  output$fruit_table <- renderDataTable({
    if(is.null(fileData())){
      return(NULL)
    }else{

      validate(
        need(input$fruit, 'Check at least one fruit!'),
        need(input$tube, 'Check at least one Fertilizer!'),
        need(!is.null(input$color1) | !is.null(input$color2) | !is.null(input$color3), 
             "Check at least one Color!")
      )

      filter_expr <- TRUE

      if (!(is.null(input$fruit))) {
        filter_expr <- filter_expr & fileData()[,fruit] %in% input$fruit
      }
      # 

      if (!(is.null(input$month))) {
        filter_expr <- filter_expr & fileData()[,Month]  == as.integer(input$month)
      }

      if (!(is.null(input$tube))) {
        filter_expr <- filter_expr & fileData()[,Fertilizer] %in% input$tube
      }


      #colname <- c(colnames(fileData()[,4:length(fileData())]))
      #print(colname)
      lapply(1:(length(fileData())-3), function(i) {
        if (!(is.null(paste0("input$color",i)))) {
          filter_expr <- filter_expr & fileData()[,colnames(fileData()[,3+i,with = FALSE])] %in% paste0("input$color",i)
          print(fileData()[,colnames(fileData()[,3+1,with = FALSE])]%in% paste0("input$color",i))
          #print(fileData()[,colname[i],with = FALSE])
        }

      })

      datatable(fileData()[filter_expr,],options = list(pageLength = 25))

    }
  })
}
shinyApp(ui = ui, server = server)

感谢您的帮助！

Answer 1

假设这适用于您的示例，这里是一个玩具示例。不同之处在于命名变量与插入col id。

iris[,5] %in% "setosa" # outputs a vector
iris2 = iris
setDT(iris2)

iris2[,5] %in% "setosa" # outputs single T/F
iris2[,Species] %in% "setosa" # outputs a vector

不确定这是否是你需要的......

在data.table与data.frame上的闪亮R过滤％％

1 个答案: