Skip to content

Commit

Permalink
add column filtering to datatable
Browse files Browse the repository at this point in the history
  • Loading branch information
mikejiang committed Oct 9, 2015
1 parent 8e4c199 commit 8540ced
Show file tree
Hide file tree
Showing 2 changed files with 91 additions and 69 deletions.
75 changes: 43 additions & 32 deletions R/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -205,12 +205,16 @@ function(input, output,session){
pd[["nFound"]] <- NULL
pd[["file"]] <- NULL
class(pd) <- "data.frame"
output$sub_pd <- DT::renderDataTable(pd
# , options = list(
# column.searchable = TRUE
# )
, server = FALSE
)
rv$pd_filtered <<- pd
output$sub_pd <- DT::renderDataTable(datatable(pd, filter = "bottom"
, options = list(
search = list(regex = TRUE)
, autoWidth = TRUE
)
, rownames = FALSE
, selection = "none"
)
)


}
Expand All @@ -232,28 +236,22 @@ function(input, output,session){

observeEvent(input$parse_ws,{
shinyjs::show("message2")
browser()

sub_Ind <- input$sub_pd_rows_all
sn <- rv$pd_filtered[sub_Ind, "name"]
thisCall <- substitute(parseWorkspace(rv$ws
,name = input$grp_selected
, keywords = input$kw_selected
, keywords.source = input$kw_src
, leaf.bool = input$isLeafBool
, subset = sn
)
)

gs <- try(eval(thisCall))
thisCall <- substitute(parseWorkspace(rv$ws
,name = input$grp_selected
, keywords = input$kw_selected
, keywords.source = input$kw_src
, leaf.bool = input$isLeafBool
)
)


if(input$subset_type == "numeric index"){
thisSubset <- input$sub_ind
thisSubset <- eval(as.list(parse(text = thisSubset))[[1]])
thisSubset <- as.numeric(thisSubset)
}else if(input$subset_type == "sample names"){
thisSubset <- input$sub_sn
browser()
thisSubset <- strsplit("")
}

thisCall[["subset"]] <- thisSubset

if(inherits(gs,"try-error")){
output$message2 = renderText(paste(geterrmessage()))#,"\nMaybe you need to upload FCS files as well?"))
}else if(class(gs)=="GatingSet"){
Expand All @@ -274,19 +272,32 @@ function(input, output,session){
, badgeLabel = "1"
, badgeColor = "green")
)

#update the pData tbl
output$pd_tbl <- DT::renderDataTable(pData(rv$gs))
output$pd_tbl <- DT::renderDataTable(datatable(pData(rv$gs)
, rownames = FALSE
,selection = list(mode = "single", selected = 1)
, filter = "bottom"
, options = list(search = list(regex = TRUE)
, autoWidth = TRUE
# , dom = 'T<"clear">lfrtip'
# , tableTools = list(sSwfPath = copySWF())
)
# , extensions = list("ColVis", "TableTools")#they are retired by Buttons extension, which is yet to be supported by DT package
)
, server = FALSE
)

#---- Populate sn selector ----
updateSelectInput(session, "sn_select"
, choices = sampleNames(rv$gs)
, label = NULL)
# updateSelectInput(session, "sn_select"
# , choices = sampleNames(rv$gs)
# , label = NULL)

})

#---update gh related panels---
observeEvent(input$sn_select,{
sn <- input$sn_select
observeEvent(input$pd_tbl_rows_selected,{
sn <- rownames(pData(rv$gs)[input$pd_tbl_rows_selected, ,drop = FALSE])

if(nchar(sn) > 0){
gh <- rv$gs[[sn]]
Expand Down Expand Up @@ -316,7 +327,7 @@ function(input, output,session){

observeEvent(input$load,{
output$message = renderPrint(cat("Choose a dataset"))

s = input$path_gs
if(is.null(s)){
output$message = renderPrint(cat("Choose a some files above"))
Expand Down
85 changes: 48 additions & 37 deletions R/ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,8 +33,8 @@ sidebar <- dashboardSidebar(
, menuItemOutput("gs_menu_obj")


, menuItem("Compensate & Transform", tabName = "Compensate", icon = icon("exchange"))
, menuItem("Build a Gating Template",tabName = "GatingTemplate", icon = icon("table"))
# , menuItem("Compensate & Transform", tabName = "Compensate", icon = icon("exchange"))
# , menuItem("Build a Gating Template",tabName = "GatingTemplate", icon = icon("table"))

)
)
Expand Down Expand Up @@ -86,31 +86,39 @@ body <- dashboardBody(
, radioButtons("kw_src", choices = c("XML", "FCS"), inline = TRUE, label = "keyword source")
)
)
, div(style="display:inline-block;"
, checkboxInput("isLeafBool", label = "Leaf boolean gates", value = FALSE)
)
, helpPopup(title = "Skipping the leaf/terminal boolean nodes can speed up the parsing significantly (especially for ICS gating scheme that typically contains lots of polyfunctional boolean gates,
which can be computed through COMPASS package.
Also if user does want them back later, simply call 'recompute()' method to calculate them without re-parsing the entire workspace."
, content = ""
, trigger = "hover"
)



, div(a(id = "toggleAdvanced"
, "show/hide advanced settings"
, style = "cursor:pointer")
),
# hidden(
div(id = "advanced", style = "display:inline-block;background-color:lightGray"
, dataTableOutput("sub_pd")
div(id = "advanced"
, style = "display:inline-block"
#leaf node option
, div(
helpPopup(title = "select samples to parse by using filtering boxes for each field"
, content = ""
, trigger = "hover"
)
,style="display:inline-block"
div(style="display:inline-block;"
, checkboxInput("isLeafBool", label = "Leaf boolean gates", value = FALSE)
)
, helpPopup(title = "Skipping the leaf/terminal boolean nodes can speed up the parsing significantly (especially for ICS gating scheme that typically contains lots of polyfunctional boolean gates,
which can be computed through COMPASS package.
Also if user does want them back later, simply call 'recompute()' method to calculate them without re-parsing the entire workspace."
, content = ""
, trigger = "hover"
)
)
#subset option
, div(
span("Filter samples by pData:")

, helpPopup(title = "select samples to parse by typing the keyword in each filtering boxes under each field"
, content = ""
, trigger = "hover"
)
, dataTableOutput("sub_pd")
)

# )
)
,hidden(verbatimTextOutput("message2"))
Expand Down Expand Up @@ -140,26 +148,29 @@ body <- dashboardBody(

, tabItem("gs_menu"

, tabBox(id = "gs_tab", width = NULL
,tabPanel(title = "Pheno Data", value = "pd_tab", icon = icon("th")
# , tabBox(id = "gs_tab", width = NULL
# ,tabPanel(title = "Pheno Data", value = "pd_tab", icon = icon("th")
,DT::dataTableOutput("pd_tbl")
)
,tabPanel(title = "Gating Tree", value = "tree_tab", icon = icon("sitemap")
,selectInput("sn_select", choices = c("select one sample ---" = ""), label = NULL)
# ,checkboxInput("isBool", "Show boolean gates")
,div(div(diagonalNetworkOutput("tree",width="400px",height="300px"),
style="display:inline-block;float:left;")
,div(imageOutput("gateplot",width = "300px",height="300px")
,style="margin-left:400px;", id = "tabSet")
,style="width:100%;height:100%;"
)
)
,tabPanel(title = "Gating Layout", value = "gate_layout_tab", icon = icon("picture-o")
, plotOutput("gate_layout"))
,tabPanel(title = "Pop Stats", value = "stats_tab", icon = icon("bar-chart")
,DT::dataTableOutput("pop_stats_tbl")
)
)

, tabBox(id = "gh_tab", width = NULL
,tabPanel(title = "Gating Tree", value = "tree_tab", icon = icon("sitemap")
# ,selectInput("sn_select", choices = c("select one sample ---" = ""), label = NULL)
# ,checkboxInput("isBool", "Show boolean gates")
,div(div(diagonalNetworkOutput("tree",width="400px",height="300px"),
style="display:inline-block;float:left;")
,div(imageOutput("gateplot",width = "300px",height="300px")
,style="margin-left:400px;", id = "tabSet")
,style="width:100%;height:100%;"
)
)
,tabPanel(title = "Gating Layout", value = "gate_layout_tab", icon = icon("picture-o")
, plotOutput("gate_layout"))
,tabPanel(title = "Pop Stats", value = "stats_tab", icon = icon("bar-chart")
,DT::dataTableOutput("pop_stats_tbl")
)
)
# )
# )
)

, tabItem("Compensate",
Expand Down

0 comments on commit 8540ced

Please sign in to comment.