Commit 71991af0 authored by biohentze's avatar biohentze

Hide selected columns.

parent 552a5c5e
......@@ -103,12 +103,19 @@ ui <- dashboardPage(
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '')
),
box( width = 3,
title = "Plot variables", solidHeader = TRUE, status = "primary",
## Select variables to display
uiOutput("variables")
),
),
column(width = 3,
box( width = NULL,
title = "Plot variables", solidHeader = TRUE, status = "primary",
## Select variables to display
uiOutput("variables")
),
box( width = NULL,
title = "Columns to hide", solidHeader = TRUE, status = "primary",
## Select columns to hide
uiOutput("columnsToHide")
)
),
box( width = 3,
title = "Images", solidHeader = TRUE, status = "primary",
## Select image root directory
......@@ -132,7 +139,7 @@ ui <- dashboardPage(
uiOutput("roiX"),
uiOutput("roiY"),
uiOutput("roiFrame")
)
)
)
),
tabItem(tabName = "output",
......@@ -206,7 +213,6 @@ server <- function(input, output, session) {
# Update global search and column search strings
defaultSearch <- input$dataTable_search
defaultSearchColumns <- c("", input$dataTable_search_columns)
# Update the search terms on the proxy table
updateSearch(proxy, keywords = list(global = defaultSearch, columns = defaultSearchColumns))
})
......@@ -223,6 +229,14 @@ server <- function(input, output, session) {
options = list(maxItems = 2))
})
## Select columns to hide
output$columnsToHide <- renderUI({
selectizeInput(inputId = "colsToHide",
label = "Columns to hide",
multiple = TRUE,
choices = names(rv$data))
})
## Select columns containing ROI coordinates
output$roiX <- renderUI({
colNames <- names(rv$data)
......@@ -312,7 +326,7 @@ server <- function(input, output, session) {
rv <- reactiveValues(data = NULL, currentRows = NULL, selectedRows = NULL, imgPath1 = NULL, imgPath2 = NULL, pixelPosition = NULL,
selectedFrame = NULL, metadataImg1 = NULL, metadataImg2 = NULL)
selectedFrame = NULL, metadataImg1 = NULL, metadataImg2 = NULL, colsToHide = NULL)
## Read uploaded data file
observeEvent(input$datafile, {
......@@ -343,46 +357,58 @@ server <- function(input, output, session) {
rv
})
# Columns to hide
observeEvent(input$colsToHide, {
req(rv$data) ## Proceed only if file read
# Get index of each column
# Note: indexing starts at 0 but if row names are present they are in column 0
# so we don't use -1 to get the actual column indices.
rv$colsToHide <- match(input$colsToHide, colnames(rv$data))
})
## Show the data table
output$dataTable <- renderDT(datatable(rv$data[rv$currentRows,],
selection = list(mode = 'multiple', selected = rv$selectedRows),
extensions = c('FixedHeader', 'ColReorder', 'Buttons'),
filter = "top",
escape = FALSE, # required to render checkboxes
options = list(displayModeBar = TRUE,
fixedHeader = TRUE,
colReorder = TRUE,
scrollX = TRUE,
stateSave = FALSE,
searchCols = defaultSearchColumns,
search = list(regex = FALSE, caseInsensitive = FALSE, search = defaultSearch),
autoWidth = TRUE,
lengthMenu = c(10, 25, 50, 100, 500, 1000),
dom = 'Bfrtip',
buttons = list('pageLength',
list(
extend = 'collection',
text = 'Show filtered rows in plot',
action = DT::JS("function ( e, dt, node, config ) {
output$dataTable <- renderDT(
datatable(rv$data[rv$currentRows,],
selection = list(mode = 'multiple', selected = rv$selectedRows),
extensions = c('FixedHeader', 'ColReorder', 'Buttons'),
filter = "top",
escape = FALSE, # Don't escape HTML code in the table to allow checkboxes
editable = FALSE,
options = list(displayModeBar = TRUE,
fixedHeader = TRUE,
colReorder = TRUE,
scrollX = TRUE,
stateSave = TRUE,
columnDefs = list(list(visible = FALSE, targets = rv$colsToHide)),
searchCols = defaultSearchColumns,
search = list(regex = FALSE, caseInsensitive = FALSE, search = defaultSearch),
autoWidth = TRUE,
lengthMenu = c(10, 25, 50, 100, 500, 1000),
dom = 'Bfrtip',
buttons = list('pageLength',
list(
extend = 'collection',
text = 'Show filtered rows in plot',
action = DT::JS("function ( e, dt, node, config ) {
Shiny.setInputValue('selectFiltered', true, {priority: 'event'});
}")
),
list(
extend = 'collection',
text = 'Clear selection',
action = DT::JS("function ( e, dt, node, config ) {
),
list(
extend = 'collection',
text = 'Clear selection',
action = DT::JS("function ( e, dt, node, config ) {
Shiny.setInputValue('clearSelected', true, {priority: 'event'});
}")
)
)
)),
server = TRUE)
## Make a proxy to manipulate the table after it's been rendered
## All data point selection irrespective of origin
## should select rows in the proxy table which then
## updates the plot and/or the image(s)
proxy <- dataTableProxy('dataTable')
)
)
)), server = TRUE) # Server side processing required for large data tables
## Make a proxy to manipulate the table after it's been rendered
## All data point selection irrespective of origin
## should select rows in the proxy table which then
## updates the plot and/or the image(s)
proxy <- dataTableProxy('dataTable')
## Show the plot
output$plot <- renderPlotly({
req(rv$data)
......@@ -444,6 +470,7 @@ server <- function(input, output, session) {
}
}
}
updateFilters() # Don't lose search terms
rv$currentRows
})
## Show values for data point close to cursor
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment