datatable filters on the fly

Question

以下の基本的な例では、ユーザーがフィルタを追加するたびにすべてのフィルタを更新したいと考えています。

UI：

library(shiny) 
library(DT) 

fluidPage(
    fluidRow(
    column(4, 
     DT::dataTableOutput("dt") 
    ) 
) 
) 

サーバー：フィルタが適用されない

library(shiny) 

shinyServer(function(input, output) { 
    df <- data.frame(var1 = c(rep("A",3),rep("B",3)), var2 = c("x","y","x","z","x","s"), var3 = c(1:6)) 

output$dt <- renderDataTable({ 
    DT::datatable(df, filter = 'top') 
    }) 

}) 

：

は、私が "A" にVAR1、sとzにフィルタを適用vの推奨ラベルに残りますAR2フィルタは値がsまたはz

Answer 1

に存在しない場合でも、これは私がフィルタのselectInputを使用する場合、私はどうなるかです。最高の解決策ではないかもしれませんが、いつも私のために働いています。

ui.r

library(shiny) 
library(DT) 

fluidPage(
    fluidRow(
    column(4,selectizeInput("var1", label = "Var 1", choices = NULL, multiple = TRUE)), 
    column(4,selectizeInput("var2", label = "Var 2", choices = NULL, multiple = TRUE)), 
    column(4,selectizeInput("var3", label = "Var 3", choices = NULL, multiple = TRUE)), 
    column(4,DT::dataTableOutput("dt") 
    ) 
) 
) 

コードのコードserver.R

library(shiny) 

shinyServer(function(input, output, session) { 
    df <- data.frame(var1 = c(rep("A",3),rep("B",3)), var2 = c("x","y","x","z","x","s"), var3 = c(1:6)) 

    updateSelectizeInput(session, 'var1', choices = sort(unique(df$var1)), server = TRUE) 
    updateSelectizeInput(session, 'var2', choices = sort(unique(df$var2)), server = TRUE) 
    updateSelectizeInput(session, 'var3', choices = sort(unique(df$var3)), server = TRUE) 

    filterData <- function(dataset){ 
    df <- dataset 
    if (!is.null(input$var1)){ 
     df <- df[which(df$var1 == input$var1),] 
    } 
    if (!is.null(input$var2)){ 
     df <- df[which(df$var2 == input$var2),] 
    } 
    if (!is.null(input$var3)){ 
     df <- df[which(df$var3 == input$var3),] 
    } 
    df 
    } 

    output$dt <- renderDataTable({ 
    DT::datatable(filterData(df)) 
    }) 

    getwhich<-function(){ 
    whichs<-which(df$var3 == df$var3) 

    if(!is.null(input$var1)){ 
     whichs<-intersect(whichs,which(df$var1 %in% input$var1)) 
    } 
    if(!is.null(input$var2)){ 
     whichs<-intersect(whichs,which(df$var2 %in% input$var2)) 
    } 
    if(!is.null(input$var3)){ 
     whichs<-intersect(whichs,which(df$var3 %in% input$var3)) 
    } 
    return(whichs) 
    } 

    observe({ 
    w<-getwhich() 
    if(is.null(input$var1)){ 
     updateSelectizeInput(session,"var1",choices=sort(unique(df$var1[w]))) 
    } 

    }) 

    observe({ 
    w<-getwhich() 
    if(is.null(input$var2)){ 
     updateSelectizeInput(session,"var2",choices=sort(unique(df$var2[w]))) 
    } 

    }) 

    observe({ 
    w<-getwhich() 
    if(is.null(input$var3)){ 
     updateSelectizeInput(session,"var3",choices=sort(unique(df$var3[w]))) 
    } 

    }) 


}) 

の希望、このことができます。