Commit 4f06e4f3 authored by Jean-Karim Heriche's avatar Jean-Karim Heriche

New code architecture using shiny modules. Added image viewer to remove...

New code architecture using shiny modules. Added image viewer to remove dependency on patched EBImage package.
parent bca8a88b
# Install R 4.0.1
FROM r-base:4.0.1
# Install R 4.0.2
FROM r-base:4.0.2
RUN apt-get update && apt-get install -y libssl-dev liblzma-dev libbz2-dev libicu-dev libtiff-dev libfftw3-dev libcurl4-openssl-dev libxml2-dev libssh2-1-dev libgit2-dev
# Install Java for use with the rJava package
RUN apt-get install -y openjdk-8-jdk
# Install required R packages
# We need a patched version of EBImage
# jkh1/EBImage must be installed before RBioformats
# otherwise RBioformats will install the official EBImage package
# and re-installing the patched version over the official one
# seems to cause problems to rJava
RUN R CMD javareconf
RUN R -e "install.packages('rJava', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('remotes', repos='https://ftp.gwdg.de/pub/misc/cran/')"
......@@ -18,23 +13,33 @@ RUN R -e "install.packages('rversions', repos='https://ftp.gwdg.de/pub/misc/cran
RUN R -e "install.packages('roxygen2', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('xml2', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('devtools', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "library(devtools); install_github('jkh1/EBImage')"
RUN R -e "install.packages('BiocManager', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "BiocManager::install('aoles/RBioFormats')"
RUN R -e "BiocManager::install('EBImage')"
RUN R -e "install.packages('DT', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('shiny', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('shinyFiles', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('shinycssloaders', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('shinybusy', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('shinydashboard', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('shinyjs', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('shinyWidgets', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('shinybusy', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('assertthat', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('ggplot2', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('plotly', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('RANN', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('BiocManager', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "BiocManager::install('aoles/RBioFormats')"
RUN R -e "install.packages('MASS', repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages('uwot', repos='https://ftp.gwdg.de/pub/misc/cran/')"
# Copy the app to the image
RUN mkdir -p /usr/local/app/image-data-explorer
COPY image_data_explorer.R /usr/local/app/image-data-explorer/
COPY R /usr/local/app/image-data-explorer/R
COPY www /usr/local/app/image-data-explorer/www
COPY imageViewer /usr/local/app/image-data-explorer/imageViewer
# Install the custom imageViwer package
RUN R -e "library(devtools);setwd('/usr/local/app/image-data-explorer/imageViewer'); install();"
# IDE is available on port 5476
EXPOSE 5476
......@@ -50,4 +55,6 @@ WORKDIR /home/ide
USER ide
# Run the app
CMD ["Rscript","/usr/local/app/image-data-explorer/image_data_explorer.R"]
WORKDIR "/usr/local/app/image-data-explorer"
CMD ["Rscript","image_data_explorer.R"]
# Authors: Coralie Muller & Jean-Karim Heriche
#####################
## Module Annotate ##
#####################
# Allow row annotation with user-defined labels
############### UI ##################
ui_annotate <- function(id) {
ns <- NS(id)
fluidRow(
column(12,
box( width = 4,
title = "Annotation column", solidHeader = TRUE, status = "primary",
## Select column to hold annotations
uiOutput(ns("annotationColumn")),
),
box( width = 4,
title = "Annotation labels", solidHeader = TRUE, status = "primary",
## Enter annotation labels
uiOutput(ns("annotationLabels"))
),
actionButton(ns("annotateButton"), "Apply", icon("check"),
style="color: #fff; background-color: #3C8DBC; border-color: #3C8DBC")
) # End column
) # End fluidRow
} # End Function
###################### Server ######################
annotate_server <- function(input, output,session, rv, session_parent) {
req(rv$data)
ns <- session$ns # Allow to use ns()
## Select annotations column
Annotate_col <- function(id, label, binary, choice, opt, idtext, label_text, place){
output$annotationColumn <- renderUI({
tagList(
selectizeInput(inputId = ns(id),
label = label,
multiple = binary,
choices = choice,
options = opt),
textAreaInput(inputId = ns(idtext),
label = label_text,
placeholder = place,
rows = 1)
) # End tagList
}) # End RenderUI
} # End Annotate_col
Annotate_col("annotationCol", "Choose existing column to hold annotations", FALSE, c("", names(rv$data)), list(maxItems = 1) ,"newCol" , "or add a new column", "Type in name of new column")
## Define annotations labels
Annotate_labs <- function(id, label, place, row){
output$annotationLabels <- renderUI({
textAreaInput(inputId = ns(id),
label = label,
placeholder = place,
rows = row)
}) # End RenderUI
} # End Annotate_labs
Annotate_labs("labelsList", "Enter list of labels", "Type in new labels separated by commas", 5)
observeEvent(input$newCol,{
if(!is.null(input$newCol) && !is.null(input$annotationCol) && input$newCol != "" && input$annotationCol != "") {
showNotification("Only one column can be used.", type ="error")
}})
observeEvent(input$annotationCol,{
if(!is.null(input$annotationCol) && input$annotationCol != "" && !(class(rv$data[,input$annotationCol]) %in% c("character", "logical"))) {
ids <- showNotification("Annotation column must be of character type.
If you go ahead with this choice, the column type will be changed
which can cause problems (e.g. with plotting)", type ="error", duration = NULL)
}})
actionAnnotateFunction <- function(){
shinyjs::disable("annotateButton")
req(rv$data)
if(!is.null(input$newCol) && input$newCol != "") {
new.column <- rep(NA,nrow(rv$data))
rv$data <- cbind(rv$data, new.column)
colnames(rv$data)[ncol(rv$data)] <- input$newCol
rv$annotationCol <- input$newCol
} else if(!is.null(input$annotationCol) && input$annotationCol != "") {
rv$annotationLabels <- unique(rv$data[,input$annotationCol])
rv$annotationCol <- input$annotationCol
}
if(length(input$labelsList)>0) {
new.labels <- unlist(strsplit(input$labelsList, "\\s*,\\s*"))
if(length(new.labels)>0) {
rv$annotationLabels <- c(rv$annotationLabels, new.labels)
}
}
if(is.null(rv$annotationLabels) || length(rv$annotationLabels) == 0) {
showNotification("Some labels must be provided.", type ="error", duration = NULL)
} else {
# Move to the Explore tab
updateTabsetPanel(session_parent , "tabs_menu", selected = "explore")
}
shinyjs::enable("annotateButton")
}
# Run action function on button click
onclick("annotateButton", actionAnnotateFunction())
return(rv)
}
# Authors: Coralie Muller & Jean-Karim Heriche
#TODO
####################
## Cluster Module ##
####################
ui_cluster <- function(id) {
ns <- NS(id)
fluidRow(
column(12,
box(id="box_alert", width= 6,
title = "Clustering", solidHeader = TRUE, status = "primary",
tags$div(style = "line-height: 2",
tags$b("Clustering is not implemented yet. Please come back later or consider contributing code to the app."),
)
) # End box
) # End column
) # End fluidRow
} # End ui_cluster()
cluster_server <- function(input, output, session) {
#TODO
}
# Authors: Coralie Muller & Jean-Karim Heriche
################
## Data Input ##
################
# Upload a data file and allow to select configuration parameters
################### UI ##########################
ui_data_input <- function(id) {
ns <- NS(id)
fluidPage(
fluidRow(
column(12,
column( width=3,
box( width = NULL,
title = "Input data file", solidHeader = TRUE, status = "primary",
## Input: Select a file
fileInput(ns("datafile"), "Select data file",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
## Input: Checkbox if file has header
checkboxInput(ns("header"), "File has header", TRUE),
## Input: Select separator and select quotes
radioButtons(ns("sep"), "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = "\t"),
## Input: Select quotes
radioButtons(ns("quote"), "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '')),
),
# Selection of columns for various purposes
column(width = 3,
SelectVariable("Plot variables", ns("variables")),
SelectVariable("Additional variables to display on hover", ns("columnsOnHover")),
SelectVariable("Columns to hide", ns("columnsToHide")),
SelectVariable("Group", ns("groupsColumn"))),
box( width = 3,
title = "Images", solidHeader = TRUE, status = "primary",
## Select image root directory
tags$div(style = "line-height: 2",
tags$b("Select image root dir"),
shinyDirButton(ns('imgRoot'),
label = 'Browse...',
title = 'Select image root directory'),
tags$br(),
"Selected image directory:",
tags$br(),
verbatimTextOutput(ns('imageDir'))
),
## Select column containing image file names
uiOutput(ns("fileColumn1")),
checkboxInput(ns("normalize.img1"), "Rescale intensity for image 1", TRUE),
uiOutput(ns("fileColumn2")),
checkboxInput(ns("normalize.img2"), "Rescale intensity for image 2", TRUE)
),
box( width = 3,
title = "ROIs", solidHeader = TRUE, status = "primary",
## Select columns containing ROI coordinates
uiOutput(ns("roiX")),
uiOutput(ns("roiY")),
uiOutput(ns("roiFrame")),
)
)
),
fluidRow(
box(width = 3,
title = "Save parameters", solidHeader = TRUE, status = "warning",
downloadButton(ns("saveConfigFile"), "Save the current choices"),
uiOutput(ns("readConfigFileButton"))
)
)
# End second row
)# End column
}# End ui_data_input
############### Global Functions for the UI ################
SelectVariable <-function( name, output_name ){
box(width = NULL,
title = name , solidHeader = TRUE, status = "primary",
## Select variables
uiOutput(output_name)
)
}
################### Server ##########################
input_data_server <- function(input, output, session) {
ns <- session$ns # Allow to use ns() input in the server
## Increase max upload size to 100 MB
options(shiny.maxRequestSize=100*1024^2)
## Server-side directories we're allowed to navigate to find the image root dir
roots = c(home = "~", wd = '.')
# Vector of user input names (i.e. inputId) that we may want to restore from file
# Values are stored in rv$inputChoices
inputChoices.params <- c("selectedVar", "colsOnHover", "colsToHide", "groupLabels", "roiX", "roiY",
"roiFrame", "imgRoot", "fileCol1", "fileCol2", "normalize.img1", "normalize.img2")
# Store all reactive values we need to share between modules in one object
rv <- reactiveValues(inputChoices = setNames(vector("list", length(inputChoices.params)), inputChoices.params),
data = NULL, currentRows = NULL, selectedRows = NULL, clusters = NULL,
imgPath1 = NULL, imgPath2 = NULL, pixelPosition = NULL,
selectedFrame = NULL, metadataImg1 = NULL, metadataImg2 = NULL, colsToHide = NULL,
colsToEdit = NULL, selectedVar = NULL, roiX = NULL, roiY = NULL, roiFrame = NULL,
fileCol1 = NULL, fileCol2 = NULL, normalize.img1 = NULL, normalize.img2 = NULL,
proxy = NULL, key = NULL, colsOnHover = NULL, dataTable_rows_all = NULL, annotationCol = NULL,
annotationLabels = NULL, imgRoot = NULL, datapath = NULL, select_variable_DR = NULL,
saveparams = NULL)
## Input data file must have a header
observeEvent(input$header,{
if(!input$header) {
showNotification("Data file must have a header.", type ="error")
}
})
## Dynamically generate UI input to select variables once data is uploaded and read
Output_variable <- function(type, idx, label, binary, opt) {
output[[type]] <- renderUI({
if(type == "groupsColumn") {
colNames <- c("", names(rv$data))
}else{
colNames <- names(rv$data)}
selectizeInput(inputId = ns(idx),
label = label,
multiple = binary,
choices = colNames,
options = opt)
}) # End renderUI
} # End Output_variable()
## Select variables for plotting
Output_variable("variables", "selectedVar", "Select 1 or 2 variables to plot", TRUE, list(maxItems = 2))
## Select columns to display on hover
Output_variable("columnsOnHover", "colsOnHover", "Values from these columns will be displayed when hovering over a point", TRUE, list(maxItems = 10))
## Select columns to hide
Output_variable("columnsToHide", "colsToHide", "These columns will not be displayed", TRUE, NULL)
## Select column containing group labels to associate with colours
Output_variable("groupsColumn", "groupLabels", "Select column containing group labels", FALSE, list(maxItems = 1))
## Select columns containing ROI coordinates
Select_colums_coordinates <- function( coor, name, id, label){
output[[coor]] <- renderUI({
colNames <- names(rv$data)
## Try to infer from name and set as default
found <- grepl(name, colNames, ignore.case = TRUE)
selection <- NULL
if(any(found)) {
selection <- colNames[found]
}
selectizeInput(inputId = ns(id),
label = label,
multiple = FALSE,
selected = selection,
choices = c("",colNames),
options = list(maxItems = 1))
}) # End renderUI
} # End Select_colums_coordinates()
Select_colums_coordinates("roiX", "coordinate_x", "roiX", "Column for X coordinates")
Select_colums_coordinates("roiY", "coordinate_y", "roiY", "Column for Y coordinates")
Select_colums_coordinates("roiFrame", "coordinate_time", "roiFrame", "Column for frame (Z or time) coordinates")
## Select image root directory
shinyDirChoose(input, 'imgRoot', roots = roots)
observeEvent(input$imgRoot, {
rv$inputChoices[["imgRoot"]] <- parseDirPath(roots,input$imgRoot)
})
output$imageDir <- renderText({
if(!is.null(rv$inputChoices[["imgRoot"]])) {
rv$imgRoot <- rv$inputChoices[["imgRoot"]]
} else {
rv$imgRoot <- parseDirPath(roots,input$imgRoot)
}
rv$imgRoot
})
## Select column containing image file names as paths relative to image dir
Select_colums_image_file_names <- function( type, grepl_name, id, label_image){
output[[type]] <- renderUI({
colNames <- names(rv$data)
selection <- NULL
if(!is.null(rv$inputChoices[[id]])) {
selection <- rv$inputChoices[[id]]
} else {
## Try to infer from name and set as default
found <- grepl("path|file", colNames, ignore.case = TRUE) & grepl(grepl_name, colNames, ignore.case = TRUE)
if(any(found)) {
selection <- colNames[found]
}
}
selectizeInput(inputId = ns(id),
label = label_image,
multiple = TRUE,
selected = selection,
choices = c("", colNames),
options = list(maxItems = 1))
}) # End renderUI
} # End Select_colums_image_file_names()
Select_colums_image_file_names("fileColumn1", "image|intensit", "fileCol1", "Column with file names for image 1")
Select_colums_image_file_names("fileColumn2", "label|mask", "fileCol2", "Column with file names for image 2")
output$readConfigFileButton <- renderUI({
if(!is.null(rv$data)) {
fileInput(ns("readConfigFile"), "Restore settings from file",
multiple = FALSE,
accept = c(".rds"))
}
})
# Remember inputs
observe({
rv$inputChoices[["selectedVar"]] <- input$selectedVar
rv$inputChoices[["colsOnHover"]] <- input$colsOnHover
rv$inputChoices[["colsToHide"]]<- input$colsToHide
rv$inputChoices[["groupLabels"]] <- input$groupLabels
rv$inputChoices[["roiX"]] <- input$roiX
rv$inputChoices[["roiY"]] <- input$roiY
rv$inputChoices[["roiFrame"]] <- input$roiFrame
# rv$inputChoices[["imgRoot"]] <- parseDirPath(roots, input$imgRoot)
rv$inputChoices[["fileCol1"]] <- input$fileCol1
rv$inputChoices[["fileCol2"]] <- input$fileCol2
rv$inputChoices[["normalize.img1"]] <- input$normalize.img1
rv$inputChoices[["normalize.img2"]] <- input$normalize.img2
})
## Save current choices to a file
output$saveConfigFile <- downloadHandler(
filename = function() {
data.file <- tools::file_path_sans_ext(basename(input$datafile$name))
paste0("IDE-saved_input_choices-", data.file, "-", Sys.Date(), ".rds") },
content = function(file) {
## Collect current choices
rv$inputChoices[["imgRoot"]] <- parseDirPath(roots, input$imgRoot)
settings <- list("selectedVar" = input$selectedVar, "colsOnHover" = input$colsOnHover,
"colsToHide" = input$colsToHide, "groupLabels" = input$groupLabels, "roiX" = input$roiX,
"roiY" = input$roiY, "roiFrame" = input$roiFrame, "imgRoot" = rv$inputChoices[["imgRoot"]],
"fileCol1" = input$fileCol1, "fileCol2" = input$fileCol2, "normalize.img1" = input$normalize.img1, "normalize.img2" = input$normalize.img2)
saveRDS(settings, file)
}
)
## Restore input choices from file
observeEvent(input$readConfigFile, {
req(rv$data)
if (see_if(has_extension( input$readConfigFile$datapath, 'rds')) == TRUE) { # using the asserthat package
## Read saved choices from file
settings <- readRDS(file = input$readConfigFile$datapath)
for(field in inputChoices.params) {
rv$inputChoices[[field]] <- settings[[field]]
SelectizeInput("selectedVar")
SelectizeInput("colsOnHover")
SelectizeInput("colsToHide")
SelectizeInput("groupLabels")
SelectizeInput("roiX")
SelectizeInput("roiY")
SelectizeInput("roiFrame")
SelectizeInput("fileCol1")
SelectizeInput("fileCol2")
SelectizeInput("normalize.img1")
SelectizeInput("normalize.img2")
}
} # End if
else{
showNotification("Saved configuration must be in .rds file.", type ="error")} # End else
})
## Populate fields in UI
SelectizeInput<-function(id){
updateSelectizeInput(session = session, inputId = id, selected = rv$inputChoices[[id]])
}
# Check the input file format
# This only looks at the file extension
observeEvent(input$datafile, {
Check_extension_file()
})
Check_extension_file <-function(){
# This uses the assertthat package
if (see_if(has_extension(input$datafile$datapath, 'csv')) == TRUE
| see_if(has_extension(input$datafile$datapath, 'txt')) == TRUE
| see_if(has_extension(input$datafile$datapath, 'TXT')) == TRUE
| see_if(has_extension(input$datafile$datapath, 'CSV')) == TRUE) {
Upload_data_file()
} # End if
else{
showNotification("Data file is not in a supported format. Please use .csv or .txt format.", type ="error")} # End else
}
## Read uploaded data file
Upload_data_file <- function (){
observeEvent(input$datafile, {
if (is.null(input$datafile)) return(NULL)
## After the user selects and uploads a data file,
## the content of the data file will be shown.
req(input$datafile) ## Proceed only if file selected
## When reading semicolon separated files,
## having a comma separator causes read.csv to error
tryCatch(
{
rv$data <- read.csv(input$datafile$datapath,
header = input$header,
sep = input$sep,
quote = input$quote,
stringsAsFactors = FALSE)
rv$data[,"id"] <- c(1:nrow(rv$data)) # Used to uniquely identify data points
rv$data[,"idx"] <- sample(c(1:nrow(rv$data))) # Used to reorder data points
# These don't need to be visible to the user
rv$colsToHide <- c(rv$colsToHide, match("id", colnames(rv$data)), match("idx", colnames(rv$data)))
rv$currentRows <- c(1:nrow(rv$data))
rv$datapath<- input$datafile$name
},
error = function(e) {
## Return a safeError if a parsing error occurs
stop(safeError(e))
}
)
})
}
# Store variables in rv in order to pass them from module to module
Save_Variable_rv <-function(type){
observeEvent(input[[type]], {
req(rv$data)
rv[[type]] <- input[[type]]
})
}
Save_Variable_rv("selectedVar")
Save_Variable_rv("roiX")
Save_Variable_rv("roiY")
Save_Variable_rv("roiFrame")
Save_Variable_rv("dir")
Save_Variable_rv("fileCol1")
Save_Variable_rv("fileCol2")
Save_Variable_rv("colsOnHover")
# Columns to hide / edit
Columns_event <- function(type){
observeEvent(input[[type]], {
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[[type]] <- match(input[[type]], colnames(rv$data))
if(type == "colsToHide"){
# These columns don't need to be visible to the user
rv[[type]] <- c(rv[[type]], match("id", colnames(rv$data)), match("idx", colnames(rv$data)))
}
})
}
Columns_event("colsToHide")
Columns_event("colsToEdit")
# Group labels
Columns_event_Group_label <- function(type) {
observeEvent(input[[type]], {
req(rv$data) ## Proceed only if file read
# Get index of column
# Note: indexing starts at 0 but if row names are present they are in column 0
</