Commit 7bfdf655 authored by biohentze's avatar biohentze

Add annotate section with editable data table.

parent f8253b32
......@@ -47,7 +47,8 @@ ui <- dashboardPage(
sidebarMenu(
id = "menu",
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(
## Hide disabled elements
tags$head(tags$style(HTML("input[type='search']:disabled {visibility:hidden}"))),
## Custom CSS tO:
## Custom CSS to:
## - Reduce white space around boxes
## - Chenge font size
## - Change postion of notification box
......@@ -114,6 +115,11 @@ ui <- dashboardPage(
title = "Columns to hide", solidHeader = TRUE, status = "primary",
## Select columns to hide
uiOutput("columnsToHide")
),
box( width = NULL,
title = "Columns to edit", solidHeader = TRUE, status = "primary",
## Select columns to edit
uiOutput("columnsToEdit")
)
),
box( width = 3,
......@@ -142,7 +148,7 @@ ui <- dashboardPage(
)
)
),
tabItem(tabName = "output",
tabItem(tabName = "explore",
fluidRow(
column(12,
fluidRow(
......@@ -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
) # dashboardBody
......@@ -223,7 +244,7 @@ server <- function(input, output, session) {
## Select variables for plotting
output$variables <- renderUI({
selectizeInput(inputId = "selectedVar",
label = "Variables to plot",
label = "Select variables to plot",
multiple = TRUE,
choices = names(rv$data),
options = list(maxItems = 2))
......@@ -232,7 +253,15 @@ server <- function(input, output, session) {
## Select columns to hide
output$columnsToHide <- renderUI({
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,
choices = names(rv$data))
})
......@@ -326,7 +355,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, colsToHide = NULL)
selectedFrame = NULL, metadataImg1 = NULL, metadataImg2 = NULL, colsToHide = NULL, colsToEdit = NULL)
## Read uploaded data file
observeEvent(input$datafile, {
......@@ -366,16 +395,26 @@ server <- function(input, output, session) {
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({
req(rv$data)
datatable(rv$data[rv$currentRows,],
class = 'row-border hover',
selection = list(mode = 'multiple', selected = rv$selectedRows),
extensions = c('FixedHeader', 'ColReorder', 'Buttons'),
extensions = c('FixedHeader', 'Buttons'),
filter = "top",
escape = FALSE, # Don't escape HTML code in the table to allow e.g. checkboxes
options = list(displayModeBar = TRUE,
fixedHeader = TRUE,
colReorder = TRUE,
scrollX = TRUE,
stateSave = TRUE,
columnDefs = list(list(visible = FALSE, targets = rv$colsToHide)),
......@@ -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
## Make a proxy to manipulate the table after it's been rendered
......@@ -439,7 +479,7 @@ server <- function(input, output, session) {
df <- rv$data
## 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")
if(!is.null(brush)) {
......@@ -476,6 +516,7 @@ server <- function(input, output, session) {
## Show values for data point close to cursor
## We don't want to use Plotly's tooltip because it obscures data points
output$hover <- renderPrint({
req(rv$data)
hover <- event_data("plotly_hover")
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) {
observe({
req(rv$data)
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")
if(!is.null(click)) {
rv$imgPath1 <- as.character(rv$data[unlist(click$key), input$fileCol1])
......@@ -530,7 +571,7 @@ server <- function(input, output, session) {
})
## Detect switching tabs
observeEvent( input$tabs,{
observeEvent(input$tabs,{
updateFilters()
})
......@@ -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
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