Skip to content

Commit

Permalink
add GUI for template building
Browse files Browse the repository at this point in the history
  • Loading branch information
mikejiang committed Jun 9, 2016
1 parent 8540ced commit e6ed5b7
Show file tree
Hide file tree
Showing 3 changed files with 182 additions and 10 deletions.
5 changes: 5 additions & 0 deletions R/global.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
library(shiny)
plugIns <- openCyto:::.getPluginMethods()
gating_methods <- c(plugIns[["gating"]], "refGate", "boolGate")
pp_methods <- plugIns[["preprocessing"]]

123 changes: 119 additions & 4 deletions R/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -89,7 +89,7 @@ function(input, output,session){
output$file_table = DT::renderDataTable(ws_list(),rownames = FALSE
, selection = list(mode = "single"#"multiple"
, selected = 2)
,

)

#-------- update the message and button based on the file info--------
Expand Down Expand Up @@ -302,7 +302,7 @@ function(input, output,session){
if(nchar(sn) > 0){
gh <- rv$gs[[sn]]
# gate
output$gate_layout <- renderPlot(plotGate(gh))
output$gate_layout <- renderPlot(autoplot(gh))

#pop stats
stats <- getPopStats(gh)
Expand All @@ -324,8 +324,8 @@ function(input, output,session){
updateTextInput(session,'path_gs', value = path_selected)
})


observeEvent(input$load,{
rv$preload <- 1 ##preload for testing
observeEvent(input$load+rv$preload,{
output$message = renderPrint(cat("Choose a dataset"))

s = input$path_gs
Expand Down Expand Up @@ -353,6 +353,121 @@ function(input, output,session){
output$message = renderPrint(cat("Not a stored GatingSet or GatingSetList"))
}
})

###init template tbl
rv$gt.tbl <- data.frame(alias = NA
, pop = NA
, parent = NA
, dims = NA
, gating_method = NA
, gating_args = NA
, collapseDataForGating = NA
, groupBy = NA
, preprocessing_method = NA
, preprocessing_args = NA
)
#update template table view
observeEvent(rv$gt.tbl,{
output$gt_tbl <- DT::renderDataTable(datatable(rv$gt.tbl
, rownames = FALSE
,selection = list(mode = "single", selected = 1)
)

, server = FALSE
)
})

##init dims and nodes
observeEvent(rv$gs,
{
rv$nodes <- getNodes(rv$gs)
fr_pd <- pData(parameters(getData(rv$gs[[1]], use.exprs = FALSE)))
marker <- fr_pd[["desc"]]
marker[is.na(marker)] <- ""
chnl <- fr_pd[["name"]]

updateSelectInput(session, "dims", choices = paste0(chnl, marker, sep = " "))
}
)
#update dims
observeEvent(rv$gs,
{
rv$nodes <- getNodes(rv$gs)
fr_pd <- pData(parameters(getData(rv$gs[[1]], use.exprs = FALSE)))
marker <- fr_pd[["desc"]]
marker[is.na(marker)] <- ""
chnl <- fr_pd[["name"]]

updateSelectInput(session, "dims", choices = paste0(chnl, marker, sep = " "))
}
)
##update parent input
observeEvent(rv$nodes,
{
updateSelectInput(session, "parent", choices = rv$nodes)
}
)
##update data based on selected parent
observeEvent(input$parent,
{
if(input$parent!="")
rv$fs <- getData(rv$gs, input$parent)
})

#plot to inspect the data before adding gating method
observeEvent(input$bt_plot_data, {
chnl <- input$dims
if(length(chnl) == 1)
p <- autoplot(rv$fs, x = chnl)
else
p <- autoplot(rv$fs, x = chnl[1], y = chnl[2])
output$gt_data_plot <- renderPlot(p)
})

#plot and inspect the gate
observeEvent(input$bt_apply_gate, {
nodes <- getNodes(rv$gs)
#convert some field to be compaitle with template-parser
groupBy <- input$groupBy
groupBy <- paste(groupBy, collapse = ":")
dims <- input$dims
if(dims!="")
dims <- paste(dims, collapse = ",")
#parse pop patterns
pop <- input$pop
pop.parsed <- ""
ind <- grepl("A", pop)
if(sum(ind) == 1)
pop.parsed <- pop[ind]
else if(sum(ind) == 2)
pop.parsed <- "A+/-"

ind <- grepl("B", pop)
if(sum(ind) == 1)
pop.parsed <- paste0(pop.parsed, pop[ind])
else if(sum(ind) == 2)
pop.parsed <- paste0(pop.parsed, "B+/-")
#add gates to gs
new_row <- add_pop(rv$gs
, alias = input$alias
, pop = pop.parsed
, parent = input$parent
, dims = dims
, gating_method = input$gating_method
, gating_args = input$gating_args
, groupBy = groupBy
, collapseDataForGating = input$collapseData
, preprocessing_method = input$pp_method
, preprocessing_args = input$pp_args)
# add the row to template
rv$gt.tbl <- rbind(rv$gt.tbl, new_row)
#plot the new gates
rv$nodes <- getNodes(rv$gs)
new.nodes <- setdiff(rv$nodes, nodes)

p <- autoplot(rv$gs, new.nodes)
output$gt_data_plot <- renderPlot(p)
})
plt = reactive({
h = digest::digest(input$selnode)
if(has.key(h,H)){
Expand Down
64 changes: 58 additions & 6 deletions R/ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,13 +28,13 @@ sidebar <- dashboardSidebar(
, extendShinyjs(script = "www/actions.js")
, sidebarMenu(

menuItem("Import workspaces", tabName = "Import", icon = icon("arrow-right"), selected = TRUE)
menuItem("Import workspaces", tabName = "Import", icon = icon("arrow-right"))
, menuItem("Load GatingSets", tabName = "load_menu", icon = icon("folder-open"))
, menuItemOutput("gs_menu_obj")


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

)
)
Expand Down Expand Up @@ -139,7 +139,8 @@ body <- dashboardBody(
)
, tabItem("load_menu"
, box(shinyDirButton("gs_dir_btn",label = "choose GatingSet ...", title = "Please select a folder", buttonType = "primary")
, textInput("path_gs", label = "", value = file.path(datadirectory, "gs_manual"))
, textInput("path_gs", label = "", value = "/loc/no-backup/mike/test_gs"#file.path(datadirectory, "gs_manual")
)
, myActionButton(inputId = "load",label = "Load Data")
, div(verbatimTextOutput("message"),style='width:90%')
, title = "Load GatingSets", solidHeader = TRUE, status = "primary", width = NULL
Expand Down Expand Up @@ -176,9 +177,60 @@ body <- dashboardBody(
, tabItem("Compensate",
box(title = "Compensate & Transform", solidHeader = TRUE, status = "primary")
),
tabItem("GatingTemplate",
box(title = "Build a Gating Template", solidHeader = TRUE, status = "primary")
)
tabItem("GatingTemplate"
,DT::dataTableOutput("gt_tbl")


,div(
div(textInput("alias", label="Population name", value='')
,style="display:inline-block;float:left;")
, div(selectInput("parent", choices="", label='Select Parent Population')
,style="display:inline-block;float:left;")
, div(selectizeInput("dims", choices="", label='Channels', multiple =TRUE
, options = list(maxItems = 2)
)
,style="display:inline-block;float:left;")
, div(selectInput("pop", choices=c("A+","A-","B+","B-"), label='Population pattern', multiple =TRUE)
,style="display:inline-block;float:left;")
, div(selectInput("gating_method",
choices = as.list(gating_methods),
label="Gating Method",
selected = "mindensity"
)
,style="display:inline-block;float:left;")
, div(textInput("gating_args", label="Gating Parameters", value='')
,style="display:inline-block;float:left;")
, div(checkboxInput("collapseData", label = "collapse data for gating")
,style="display:inline-block;float:left;")
, div(selectInput("groupBy", label = "Group By", choices = "", multiple = TRUE)
,style="display:inline-block;float:left;")
, div(selectInput("pp_method",
choices = c("---" = "", as.list(pp_methods)),
label = "Preprocessing Method"
, selected = ""
)
,style="display:inline-block;float:left;")
, div(textInput("pp_args", label="Preprocessing parameters", value='')
,style="display:inline-block;float:left;")
,style="display:inline-block")
,div(

myActionButton("bt_plot_data",label="plot data")


, myActionButton("bt_apply_gate",label="add gate")


)
, div(
plotOutput("gt_data_plot")
)

)





)
)
Expand Down

0 comments on commit e6ed5b7

Please sign in to comment.