Skip to content

GitLab

Commit 086902cb authored by Jean-Karim Heriche's avatar Jean-Karim Heriche
Browse files
Options

Started work on features for high-throughput microscopy. Minor code clean-up.

parent 17cc9acd
Hide whitespace changes
Inline Side-by-side
Showing with 256 additions and 119 deletions
R/datafile.R
View file @ 086902cb
......@@ -4,8 +4,7 @@
## Data Input ##
################
# Upload a data file and allow to select configuration parameters
# Upload a data file and set configuration parameters
################### UI ##########################
ui_data_input <- function(id) {
......@@ -41,52 +40,61 @@ ui_data_input <- function(id) {
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)
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 = "ROIs", solidHeader = TRUE, status = "primary",
## Select columns containing ROI coordinates
uiOutput(ns("roiX")),
uiOutput(ns("roiY")),
uiOutput(ns("roiFrame")),
column( width = 3,
box( width = NULL,
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")),
uiOutput(ns("fileColumn2"))
),
box( width = NULL,
title = "ROIs", solidHeader = TRUE, status = "primary",
## Select columns containing ROI coordinates
uiOutput(ns("roiX")),
uiOutput(ns("roiY")),
uiOutput(ns("roiFrame"))
)
),
column( width = 3,
box( width = NULL,
title = "High-throughput microscopy info", solidHeader = TRUE, status = "primary",
uiOutput(ns("Plate")),
uiOutput(ns("Well")),
uiOutput(ns("Field")),
uiOutput(ns("Treatment"))
)
)
)
),
), # end first row
fluidRow(
box(width = 3,
title = "Save parameters", solidHeader = TRUE, status = "warning",
downloadButton(ns("saveConfigFile"), "Save the current choices"),
uiOutput(ns("readConfigFileButton"))
column(12,
column( width = 3,
box(width = NULL,
title = "Save parameters", solidHeader = TRUE, status = "warning",
downloadButton(ns("saveConfigFile"), "Save the current choices"),
uiOutput(ns("readConfigFileButton"))
)
)
)
)
# End second row
)# End column
) # End second row
)
}# End ui_data_input
......@@ -122,18 +130,17 @@ input_data_server <- function(input, output, session) {
# 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")
"roiFrame", "imgRoot", "fileCol1", "fileCol2", "plateCol", "wellCol", "fieldCol", "treatCol")
# 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)
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, plateCol = NULL, wellCol = NULL,
fieldCol = NULL, treatCol = NULL, platePos = 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,{
......@@ -231,6 +238,32 @@ input_data_server <- function(input, output, session) {
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")
# High-throughput microscopy info
## Select columns containing plate info
Select_plate_info <- 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_plate_info("Plate", "plate", "plateCol", "Column for plates")
Select_plate_info("Well", "well", "wellCol", "Column for wells")
Select_plate_info("Field", "field|position", "fieldCol", "Column for fields/positions")
Select_plate_info("Treatment", "treatment", "treatCol", "Column for treatments")
output$readConfigFileButton <- renderUI({
if(!is.null(rv$data)) {
fileInput(ns("readConfigFile"), "Restore settings from file",
......@@ -248,11 +281,12 @@ input_data_server <- function(input, output, session) {
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
rv$inputChoices[["fileCol2"]] <- input$fileCol2
rv$inputChoices[["plateCol"]] <- input$plateCol
rv$inputChoices[["wellCol"]] <- input$wellCol
rv$inputChoices[["fieldCol"]] <- input$fieldCol
rv$inputChoices[["treatCol"]] <- input$treatCol
})
## Save current choices to a file
......@@ -266,7 +300,8 @@ input_data_server <- function(input, output, session) {
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)
"fileCol1" = input$fileCol1, "fileCol2" = input$fileCol2, "plateCol" = input$plateCol,
"wellCol" = input$wellCol, "fieldCol" = inputfieldCol, "treatCol" = input$treatCol)
saveRDS(settings, file)
}
)
......@@ -274,30 +309,32 @@ input_data_server <- function(input, output, session) {
## 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
if (has_extension( input$readConfigFile$datapath, 'rds') == TRUE) {
## 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")
}
updateInput("selectedVar")
updateInput("colsOnHover")
updateInput("colsToHide")
updateInput("groupLabels")
updateInput("roiX")
updateInput("roiY")
updateInput("roiFrame")
updateInput("fileCol1")
updateInput("fileCol2")
updateInput("plateCol")
updateInput("wellCol")
updateInput("fieldCol")
updateInput("treatCol")
} # End if
else{
showNotification("Saved configuration must be in .rds file.", type ="error")} # End else
})
## Populate fields in UI
SelectizeInput <- function(id){
updateInput <- function(id){
updateSelectizeInput(session = session, inputId = id, selected = rv$inputChoices[[id]])
}
......@@ -308,11 +345,10 @@ input_data_server <- function(input, output, session) {
})
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) {
if (has_extension(input$datafile$datapath, 'csv')
|| has_extension(input$datafile$datapath, 'txt')
|| has_extension(input$datafile$datapath, 'TXT')
|| has_extension(input$datafile$datapath, 'CSV')) {
Upload_data_file()
} # End if
else{
......
R/explore.R
View file @ 086902cb
......@@ -4,11 +4,12 @@
## Module Explore ##
####################
# This module is composed of five other modules and is where most of the action happens for the user.
# It allows three-way interactions between a plot a data table and an image viewer.
# This module is composed of several other modules and is where most of the action happens for the user.
# It allows three-way interactions between a plot, a data table and an image viewer.
# Load required modules
source("R/explore_plot.R")
source("R/explore_plot.R") # scatterplot
source("R/explore_plate_view.R") # HTM plate viewer
source("R/explore_image.R")
source("R/explore_image2.R") # Second image viewer that can be used simultaneously with the first one
source("R/explore_table.R")
......@@ -23,19 +24,25 @@ ui_explore <- function(id) {
column(12,
fluidRow(
column(6,
ui_explore_plot(ns("plot"))
tabsetPanel(
id = ns("plot_tabs"),
ui_explore_plot(ns("plot")),
ui_explore_plate_view(ns("plate_view"))
)
), # End column
column(6,
ui_explore_image(ns("image"))
tabsetPanel(
ui_explore_image(ns("image"))
)
) # End column
) # End fluidRow
), # End column
fluidRow(
column(12,
ui_explore_info(ns("explore_data"))
)
) # End fluidRow
), # End fluidRow
fluidRow(
column(12,
ui_explore_info(ns("explore_data"))
)
), # End fluidRow
fluidRow(
......@@ -58,6 +65,7 @@ explore_server <- function(input, output, session, rv, react) {
# Plot creation
callModule(plot_server, "plot", rv)
callModule(plate_view_server, "plate_view", rv)
# Data_table creation
callModule(explore_table_server, "table", rv, react)
......
R/explore_image.R
View file @ 086902cb
......@@ -9,16 +9,16 @@
############### UI ###############
ui_explore_image <- function(id) {
ns <- NS(id)
fluidPage(
fluidRow(
box( width = 12,
title = "Image 1", solidHeader = TRUE, status = "primary",
withSpinner(
imageViewerOutput(ns("imageViewer1"))
)
)
tabPanel(
h4('Image viewer'),
box( width = 12,
title = "Image 1", solidHeader = TRUE, status = "primary",
withSpinner(
imageViewerOutput(ns("imageViewer1"))
)
) # End box
) # End fluidRow
)
} # End ui_explore_image()
############### Server ###############
......@@ -68,7 +68,6 @@ explore_image_server <-function(input, output, session, rv){
image1 <- drawCircle(image1, rv$pixelPosition[i, 1], rv$pixelPosition[i, 2], r, "red", fill=TRUE, z=1)
}
}
# if(rv$normalize.img1 == TRUE) { image1 <- normalize(image1)}
imageViewerWidget(image1)
}
})
......
R/explore_image2.R
View file @ 086902cb
......@@ -15,7 +15,7 @@ ui_explore_image2 <- function(id) {
imageViewerOutput(ns("imageViewer2"))
)
) # End box
) # End fluidRow
)
} # End ui_explore_image2()
############## Server ###############
......@@ -64,7 +64,6 @@ explore_image_server2 <-function(input, output, session, rv){
image2 <- drawCircle(image2, rv$pixelPosition[i,1], rv$pixelPosition[i,2], r, "red", fill=TRUE, z=1)
}
}
# if(rv$normalize.img2 == TRUE) { image2 <- normalize(image2)}
imageViewerWidget(image2)
}
})
......
R/explore_plate_view.R 0 → 100644
View file @ 086902cb
# Author: Jean-Karim Heriche
##################################
## Module Explore: Plate viewer ##
##################################
############### UI ###############
ui_explore_plate_view<- function(id) {
ns <- NS(id)
tabPanel(
h4('Plate viewer'),
box( width = 12, align = "left",
title = "Plate viewer", solidHeader = TRUE, status = "primary",
withSpinner(
plotlyOutput(ns("plate_view"), height = '500px'))
) # End box
)
} # End ui_explore_plate_view()
############### Server ###############
plate_view_server <- function(input, output, session, rv) {
ns <- session$ns # Allow to use ns()
updateFilters <- function() {
isolate({
# 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(rv$proxy, keywords = list(global = defaultSearch, columns = defaultSearchColumns))
})
}
output$plot <- renderPlotly({
req(rv$data)
# Extract plate data
plateData <- rv$data[rv$plateCol == rv$platePos[,1], ]
# Draw plate
ggplot(plateData, aes(y = factor(rown, rev(levels(rown))), x = factor(col))) +
geom_point(aes(colour = colorvar), size =18) + theme_bw() +
labs(x=NULL, y = NULL)
}) # End renderPlotly
### Interactions with the plate viewer
## Get clicked well/position
## This selects the corresponding row in the data table
observe({
req(rv$data)
isolate({
if(!is.null(rv$platePos) && !is.na(platePos[1])) {
df <- rv$data
updateFilters() # Don't lose search terms in the data table
rv$currentRows
}
})
}) # End Observe
# Info on hover
output$hover <- renderTable({
if(!is.null(rv$platePos) && !is.na(platePos[1])) {
hover <- event_data("plotly_hover")
df <- head(rv$data[,c(rv$selectedVar, rv$colsOnHover), drop = FALSE], n = 1)
df[,] <- NA
if(!is.null(hover)) {
df <- rv$data[unlist(hover$key), rv$colsOnHover, drop = FALSE]
}
return(df)
}
}) # End renderTable
# Info on selection
output$info <- renderTable({
if(!is.null(rv$platePos) && !is.na(platePos[1])) {
data.frame("Plate" = platePos[,1], "Well" = platePos[,2], "Field" = platePos[,3], "Treatment" = platePos[,4])
} else {
data.frame("Plate" = NA, "Well" = NA, "Field" = NA, "Treatment" = NA)
}
})
}
R/explore_plot.R
View file @ 086902cb
......@@ -6,28 +6,22 @@
# Creation of the plot and the on-hover info table
## Preserve data table settings
## Default global search value
if (!exists("defaultSearch")) defaultSearch <- ""
## Default column search values
if (!exists("defaultSearchColumns")) defaultSearchColumns <- NULL
############### UI ###############
ui_explore_plot <- function(id) {
ns <- NS(id)
column(12,
box( width = 12, align = "left",
title = "Plot", solidHeader = TRUE, status = "primary",
withSpinner(
plotlyOutput(ns("plot"), height = '500px'))
) # End box
) # End fluidRow
tabPanel(
h4('Scatter plot'),
box( width = 12, align = "left",
title = "Plot", solidHeader = TRUE, status = "primary",
withSpinner(
plotlyOutput(ns("plot"), height = '500px'))
) # End box
)
} # End ui_explore_plot()
############### Server ###############
plot_server <- function(input, output, session, rv) {
rv_explore <- reactiveValues( menu = 1)
ns <- session$ns # Allow to use ns()
updateFilters <- function() {
......@@ -40,6 +34,7 @@ plot_server <- function(input, output, session, rv) {
})
}
output$plot <- renderPlotly({
req(rv$data)
D <- rv$data[rv$currentRows,]
......@@ -83,8 +78,7 @@ plot_server <- function(input, output, session, rv) {
## This selects it in the data table
observe({
req(rv$data)
req(rv$selectedVar)
if(rv_explore$menu == 1) { # Ensure we already have a plot
if(length(rv$selectedVar) > 0 && length(rv$selectedVar) <= 2) { # Ensure we have a plot
click <- event_data("plotly_click", priority = "event", source = "A")
if(!is.null(click)) {
selectRows(rv$proxy, as.numeric(unlist(click$key))) # Set selected point in table
......@@ -99,7 +93,7 @@ plot_server <- function(input, output, session, rv) {
observe({
req(rv$data)
if(rv_explore$menu == 1) { # Ensure we already have a plot
if(length(rv$selectedVar) > 0 && length(rv$selectedVar) <= 2) { # Ensure we have a plot
brush <- event_data("plotly_selected", priority = "event", source = "A")
if(!is.null(brush)) {
selectRows(rv$proxy, as.numeric(unique(unlist(brush$key))))
......@@ -110,8 +104,9 @@ plot_server <- function(input, output, session, rv) {
}
})
# Info on hover
output$hover <- renderTable({
if(rv_explore$menu == 1 && length(rv$selectedVar) > 0 && length(rv$selectedVar) <= 2) { # Ensure we have a plot
if(length(rv$selectedVar) > 0 && length(rv$selectedVar) <= 2) { # Ensure we have a plot
hover <- event_data("plotly_hover")
df <- head(rv$data[,c(rv$selectedVar, rv$colsOnHover), drop = FALSE], n = 1)
df[,] <- NA
......@@ -122,6 +117,7 @@ plot_server <- function(input, output, session, rv) {
}
})
# Info on selection
output$info <- renderTable({
if(!is.null(rv$imgPath1) && !is.null(rv$pixelPosition) && !is.null(rv$roiX) && rv$roiX != "") {
data.frame("X" = rv$pixelPosition[,1], "Y" = rv$pixelPosition[,2], "Z/T" = rv$selectedFrame, "File" = rv$imgPath1)
......
image_data_explorer.R
View file @ 086902cb
......@@ -42,9 +42,9 @@ library(shinydashboard)
library(shinyjs)
library(shinyWidgets)
library(shinybusy)
library(assertthat)
library(ggplot2)
library(plotly)
library(assertthat)
library(RANN)
library(MASS)
library(uwot)
......@@ -105,7 +105,7 @@ ui <- function(request) {
server <- function(input,output,session){
ns <- session$ns # Allow to use ns() in the server
## To update menu areas
react <- reactiveValues(update_key = NULL)
## Detect switching menu areas
......
www/style.css
View file @ 086902cb
......@@ -12,6 +12,11 @@ Custom CSS for the image data explorer
.input[type='search']:disabled {visibility:hidden}
.row {
margin-right: -13px;
margin-left: -13px;
}
/* Reduce white space around boxes */
[class*="col-lg-"],[class*="col-md-"],
[class*="col-sm-"],[class*="col-xs-"]{
......@@ -31,8 +36,12 @@ Custom CSS for the image data explorer
}
.tab-content {
padding-left: 10px;
padding-right: 10px;
padding-left: 5px;
padding-right: 5px;
}
.tabbable > .nav > li > a[data-toggle='tab'] {
padding: 3px 5px;
}
/*Custom CSS to change the IDE dashboard colours*/
......
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