Commit 7bfdf655 authored by biohentze's avatar biohentze

Add annotate section with editable data table.

parent f8253b32
...@@ -47,7 +47,8 @@ ui <- dashboardPage( ...@@ -47,7 +47,8 @@ ui <- dashboardPage(
sidebarMenu( sidebarMenu(
id = "menu", id = "menu",
menuItem("Input data", tabName = "datafile", icon = icon("file-import")), menuItem("Input data", tabName = "datafile", icon = icon("file-import")),
menuItem("Explore", tabName = "output", icon = icon("microscope")) menuItem("Explore", tabName = "explore", icon = icon("microscope")),
menuItem("Annotate", tabName = "edit", icon = icon("edit"))
) )
), ),
...@@ -57,7 +58,7 @@ ui <- dashboardPage( ...@@ -57,7 +58,7 @@ ui <- dashboardPage(
## Hide disabled elements ## Hide disabled elements
tags$head(tags$style(HTML("input[type='search']:disabled {visibility:hidden}"))), tags$head(tags$style(HTML("input[type='search']:disabled {visibility:hidden}"))),
## Custom CSS tO: ## Custom CSS to:
## - Reduce white space around boxes ## - Reduce white space around boxes
## - Chenge font size ## - Chenge font size
## - Change postion of notification box ## - Change postion of notification box
...@@ -114,6 +115,11 @@ ui <- dashboardPage( ...@@ -114,6 +115,11 @@ ui <- dashboardPage(
title = "Columns to hide", solidHeader = TRUE, status = "primary", title = "Columns to hide", solidHeader = TRUE, status = "primary",
## Select columns to hide ## Select columns to hide
uiOutput("columnsToHide") uiOutput("columnsToHide")
),
box( width = NULL,
title = "Columns to edit", solidHeader = TRUE, status = "primary",
## Select columns to edit
uiOutput("columnsToEdit")
) )
), ),
box( width = 3, box( width = 3,
...@@ -142,7 +148,7 @@ ui <- dashboardPage( ...@@ -142,7 +148,7 @@ ui <- dashboardPage(
) )
) )
), ),
tabItem(tabName = "output", tabItem(tabName = "explore",
fluidRow( fluidRow(
column(12, column(12,
fluidRow( fluidRow(
...@@ -188,6 +194,21 @@ ui <- dashboardPage( ...@@ -188,6 +194,21 @@ ui <- dashboardPage(
) )
) )
) )
),
tabItem(tabName = "edit",
fluidRow(
column(12)
),
fluidRow(
column(12,
box( width = 12,
title = "Editable data", solidHeader = TRUE, status = "primary",
withSpinner(
DTOutput("dataTableEdit")
)
)
)
)
) )
) # tabItems ) # tabItems
) # dashboardBody ) # dashboardBody
...@@ -223,7 +244,7 @@ server <- function(input, output, session) { ...@@ -223,7 +244,7 @@ server <- function(input, output, session) {
## Select variables for plotting ## Select variables for plotting
output$variables <- renderUI({ output$variables <- renderUI({
selectizeInput(inputId = "selectedVar", selectizeInput(inputId = "selectedVar",
label = "Variables to plot", label = "Select variables to plot",
multiple = TRUE, multiple = TRUE,
choices = names(rv$data), choices = names(rv$data),
options = list(maxItems = 2)) options = list(maxItems = 2))
...@@ -232,7 +253,15 @@ server <- function(input, output, session) { ...@@ -232,7 +253,15 @@ server <- function(input, output, session) {
## Select columns to hide ## Select columns to hide
output$columnsToHide <- renderUI({ output$columnsToHide <- renderUI({
selectizeInput(inputId = "colsToHide", selectizeInput(inputId = "colsToHide",
label = "Columns to hide", label = "Select columns to hide",
multiple = TRUE,
choices = names(rv$data))
})
## Select columns to edit
output$columnsToEdit <- renderUI({
selectizeInput(inputId = "colsToEdit",
label = "Select columns to edit",
multiple = TRUE, multiple = TRUE,
choices = names(rv$data)) choices = names(rv$data))
}) })
...@@ -326,7 +355,7 @@ server <- function(input, output, session) { ...@@ -326,7 +355,7 @@ server <- function(input, output, session) {
rv <- reactiveValues(data = NULL, currentRows = NULL, selectedRows = NULL, imgPath1 = NULL, imgPath2 = NULL, pixelPosition = NULL, rv <- reactiveValues(data = NULL, currentRows = NULL, selectedRows = NULL, imgPath1 = NULL, imgPath2 = NULL, pixelPosition = NULL,
selectedFrame = NULL, metadataImg1 = NULL, metadataImg2 = NULL, colsToHide = NULL) selectedFrame = NULL, metadataImg1 = NULL, metadataImg2 = NULL, colsToHide = NULL, colsToEdit = NULL)
## Read uploaded data file ## Read uploaded data file
observeEvent(input$datafile, { observeEvent(input$datafile, {
...@@ -366,16 +395,26 @@ server <- function(input, output, session) { ...@@ -366,16 +395,26 @@ server <- function(input, output, session) {
rv$colsToHide <- match(input$colsToHide, colnames(rv$data)) rv$colsToHide <- match(input$colsToHide, colnames(rv$data))
}) })
## Show the data table # Columns to edit
observeEvent(input$colsToEdit, {
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$colsToEdit <- match(input$colsToEdit, colnames(rv$data))
})
## Show the data table in the explorer (this one is not editable)
output$dataTable <- renderDT({ output$dataTable <- renderDT({
req(rv$data)
datatable(rv$data[rv$currentRows,], datatable(rv$data[rv$currentRows,],
class = 'row-border hover',
selection = list(mode = 'multiple', selected = rv$selectedRows), selection = list(mode = 'multiple', selected = rv$selectedRows),
extensions = c('FixedHeader', 'ColReorder', 'Buttons'), extensions = c('FixedHeader', 'Buttons'),
filter = "top", filter = "top",
escape = FALSE, # Don't escape HTML code in the table to allow e.g. checkboxes escape = FALSE, # Don't escape HTML code in the table to allow e.g. checkboxes
options = list(displayModeBar = TRUE, options = list(displayModeBar = TRUE,
fixedHeader = TRUE, fixedHeader = TRUE,
colReorder = TRUE,
scrollX = TRUE, scrollX = TRUE,
stateSave = TRUE, stateSave = TRUE,
columnDefs = list(list(visible = FALSE, targets = rv$colsToHide)), columnDefs = list(list(visible = FALSE, targets = rv$colsToHide)),
...@@ -400,7 +439,8 @@ server <- function(input, output, session) { ...@@ -400,7 +439,8 @@ server <- function(input, output, session) {
}") }")
) )
) )
)) )) %>%
formatStyle( 0, target= 'row', lineHeight='60%')
}, server = TRUE) # Server side processing required for large data tables }, server = TRUE) # Server side processing required for large data tables
## Make a proxy to manipulate the table after it's been rendered ## Make a proxy to manipulate the table after it's been rendered
...@@ -439,7 +479,7 @@ server <- function(input, output, session) { ...@@ -439,7 +479,7 @@ server <- function(input, output, session) {
df <- rv$data df <- rv$data
## Get indices of data points in selected area (Box and Lasso Select tool) ## Get indices of data points in selected area (Box and Lasso Select tool)
if(input$menu == "output") { # Ensure we already have a plot if(input$menu == "explore") { # Ensure we already have a plot
brush <- event_data("plotly_selected") brush <- event_data("plotly_selected")
if(!is.null(brush)) { if(!is.null(brush)) {
...@@ -476,6 +516,7 @@ server <- function(input, output, session) { ...@@ -476,6 +516,7 @@ server <- function(input, output, session) {
## Show values for data point close to cursor ## Show values for data point close to cursor
## We don't want to use Plotly's tooltip because it obscures data points ## We don't want to use Plotly's tooltip because it obscures data points
output$hover <- renderPrint({ output$hover <- renderPrint({
req(rv$data)
hover <- event_data("plotly_hover") hover <- event_data("plotly_hover")
if(is.null(hover)) NULL else cat(unlist(hover$key), " : ", paste(rv$data[unlist(hover$key),input$selectedVar])) if(is.null(hover)) NULL else cat(unlist(hover$key), " : ", paste(rv$data[unlist(hover$key),input$selectedVar]))
}) })
...@@ -483,7 +524,7 @@ server <- function(input, output, session) { ...@@ -483,7 +524,7 @@ server <- function(input, output, session) {
observe({ observe({
req(rv$data) req(rv$data)
req(input$selectedVar) req(input$selectedVar)
if(input$menu == "output") { # Ensure we already have a plot if(input$menu == "explore") { # Ensure we already have a plot
click <- event_data("plotly_click") click <- event_data("plotly_click")
if(!is.null(click)) { if(!is.null(click)) {
rv$imgPath1 <- as.character(rv$data[unlist(click$key), input$fileCol1]) rv$imgPath1 <- as.character(rv$data[unlist(click$key), input$fileCol1])
...@@ -530,7 +571,7 @@ server <- function(input, output, session) { ...@@ -530,7 +571,7 @@ server <- function(input, output, session) {
}) })
## Detect switching tabs ## Detect switching tabs
observeEvent( input$tabs,{ observeEvent(input$tabs,{
updateFilters() updateFilters()
}) })
...@@ -677,6 +718,38 @@ server <- function(input, output, session) { ...@@ -677,6 +718,38 @@ server <- function(input, output, session) {
} }
}) })
## Show table in annotator (this is the editable one)
output$dataTableEdit <- renderDT({
req(rv$data)
nonEditableColumns <- c(1:ncol(rv$data))
nonEditableColumns <- c(0, nonEditableColumns[-rv$colsToEdit])
datatable(rv$data[rv$currentRows,],
class = 'row-border hover',
selection = list(mode = 'multiple', selected = rv$selectedRows),
extensions = c('FixedHeader', 'Buttons'),
editable = list(target = "cell", disable = list(columns = nonEditableColumns)),
filter = "top",
escape = FALSE, # Don't escape HTML code in the table to allow e.g. checkboxes
options = list(displayModeBar = TRUE,
fixedHeader = 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 = c('copy', 'csv')
)) %>%
formatStyle( 0, target= 'row', lineHeight='60%')
}, server = TRUE) # Server side processing required for large data tables
observeEvent(input$dataTableEdit_cell_edit, {
rv$data <<- editData(rv$data, input$dataTableEdit_cell_edit, 'dataTableEdit')
})
## Stop the app when browser tab is closed ## Stop the app when browser tab is closed
session$onSessionEnded(stopApp) session$onSessionEnded(stopApp)
......
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