Skip to content

GitLab

Commit 7326e390 authored by Jean-Karim Heriche's avatar Jean-Karim Heriche
Browse files
Options

Merge branch 'feature_selection' into 'master' 

Feature selection

See merge request !9
parents fe04eea5 938fa757
Hide whitespace changes
Inline Side-by-side
Showing with 314 additions and 112 deletions
Dockerfile
View file @ 7326e390
......@@ -7,12 +7,12 @@ RUN apt-get install -y openjdk-8-jdk
# Install required R packages
RUN R CMD javareconf
RUN R -e "install.packages(c('rJava', 'remotes', 'rversions', 'roxygen2', 'xml2', 'devtools'), 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 "install.packages(c('rJava', 'remotes', 'rversions', 'roxygen2', 'xml2', 'devtools'), repos=c('https://cloud.r-project.org/', 'https://ftp.gwdg.de/pub/misc/cran/'))"
RUN R -e "install.packages('BiocManager', repos=c('https://cloud.r-project.org/', '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(c('DT', 'shiny', 'shinyFiles', 'shinycssloaders', 'shinydashboard', 'shinyjs', 'shinyWidgets', 'shinybusy', 'assertthat'), repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages(c('ggplot2', 'plotly', 'RANN', 'MASS', 'uwot'), repos='https://ftp.gwdg.de/pub/misc/cran/')"
RUN R -e "install.packages(c('DT', 'shiny', 'shinyFiles', 'shinycssloaders', 'shinydashboard', 'shinyjs', 'shinyWidgets', 'shinybusy', 'assertthat'), repos=c('https://cloud.r-project.org/', 'https://ftp.gwdg.de/pub/misc/cran/'))"
RUN R -e "install.packages(c('ggplot2', 'plotly', 'RANN', 'MASS', 'uwot', 'xgboost', 'Ckmeans.1d.dp', 'caret'), repos=c('https://cloud.r-project.org/', 'https://ftp.gwdg.de/pub/misc/cran/'))"
# Copy the app to the image
RUN mkdir -p /usr/local/app/image-data-explorer
......
R/annotate.R
View file @ 7326e390
......@@ -9,22 +9,21 @@
############### 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
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 Function
......
R/datafile.R
View file @ 7326e390
......@@ -412,6 +412,7 @@ input_data_server <- function(input, output, session) {
Save_Variable_rv("plateCol")
Save_Variable_rv("wellCol")
Save_Variable_rv("fieldCol")
Save_Variable_rv("treatCol")
# Columns to hide / edit
Columns_event <- function(type){
......
R/dim_reduction.R
View file @ 7326e390
......@@ -10,24 +10,22 @@
ui_dimensionality_reduction <- function(id) {
ns <- NS(id)
fluidRow(
column(12,
box( width = 3,
title = "Columns to consider", solidHeader = TRUE, status = "primary",
uiOutput(ns("featuresToReduce"))
),
box( width = 3,
title = "Algorithm", solidHeader = TRUE, status = "primary",
uiOutput(ns("dimReductionMethod"))),
box(width = 3,
title = "Parameters", solidHeader = TRUE, status = "primary",
uiOutput(ns("dimReductionParams"))),
actionButton(ns("dimReductionButton"), "Apply", icon("check"),
style="color: #fff; background-color: #3C8DBC; border-color: #3C8DBC")
) #End column
) # End fluidRow
column(12,
box( width = 3,
title = "Features to consider", solidHeader = TRUE, status = "primary",
uiOutput(ns("featuresToReduce"))
),
box( width = 3,
title = "Algorithm", solidHeader = TRUE, status = "primary",
uiOutput(ns("dimReductionMethod"))),
box(width = 3,
title = "Parameters", solidHeader = TRUE, status = "primary",
uiOutput(ns("dimReductionParams"))),
actionButton(ns("dimReductionButton"), "Apply", icon("check"),
style="color: #fff; background-color: #3C8DBC; border-color: #3C8DBC")
) # End column
} # End ui_dimensionality_reduction()
......@@ -51,16 +49,16 @@ dimensionality_reduction_server <- function(input, output, session, rv, session_
checkboxInput(ns(idtext), text, check)
) # End tagList
}) # End RenderUI
} # End dimensionality_reduction_server
}
DR_col("featuresToReduce", "Dimensionality reduction will be applied to these features", TRUE, names(rv$data) , "check" , "Select all numeric variables", FALSE)
# Select all numeric variables but exclude variables used only by the app (i.e. not in the input data)
observeEvent(input$check,{
if(input$check){
# Get names of numric columns
# Get names of numeric columns
numeric.cols <- colnames(Filter(is.numeric, rv$data))
# Remove non-data variables
numeric.cols <- numeric.cols[numeric.cols != 'id' & numeric.cols != 'idx']
numeric.cols <- numeric.cols[numeric.cols != 'ide.id' & numeric.cols != 'ide.idx']
updateSelectizeInput(session, inputId = "featuresToReduce", selected = numeric.cols)
}
if(!input$check){
......@@ -83,7 +81,6 @@ dimensionality_reduction_server <- function(input, output, session, rv, session_
output$dimReductionParams <- renderUI({
if(input$dimReductionMethod== "UMAP") {
tagList(
tags$div(tags$b("Distance measure to use")),
numericInput(ns("UMAP.n_neighbours"), "n_neighbors:", 15, min = 1, max = NA),
numericInput(ns("UMAP.min_dist"), "min_dist:", 0.01, min = NA, max = NA)
)
......
R/explore_image.R
View file @ 7326e390
......@@ -74,45 +74,42 @@ explore_image_server <-function(input, output, session, rv){
## Get table row(s) associated with clicked pixel(s)
## Use nearest neighbour
observe({
observeEvent(input$pixelPosition, {
clickPosition <- NULL
roiData <- NULL
nn.rows.idx <- NULL
if(!is.null(input$pixelPosition) && !is.null(rv$roiX ) && !is.null(rv$roiY) && rv$roiX != "" && rv$roiY != "") {
## Depends only on input$pixelPosition (input$roiX and input$roiY are not expected to change here).
## This prevents being run upon clearing row selection.
isolate({
rv$pixelPosition <- matrix(input$pixelPosition, ncol = 2, byrow = TRUE)
if(!is.null(rv$selectedFrame)) {
for(i in 1:nrow(rv$pixelPosition)) {
if(!is.null(rv$roiFrame) && rv$roiFrame != "") {
## rv$imgPath1 and rv$selectedFrame should always have a unique value even when length>1
## because the image has already been selected if we click on it
## so it's safe to use the first value
clickPosition <- data.frame(t(c(rv$pixelPosition[i,], rv$selectedFrame[1])))
## Make sure we're looking only for ROIs present in the frame currently displayed
## This assumes that we interact with imageViewer1
roiData <- rv$data[rv$data[,rv$fileCol1] == rv$imgPath1[1] & rv$data[,rv$roiFrame] == rv$selectedFrame[1],
c(rv$roiX, rv$roiY, rv$roiFrame)]
} else {
clickPosition <- data.frame(t(c(rv$pixelPosition[i,])))
roiData <- rv$data[,c(rv$roiX, rv$roiY)]
}
nn <- nn2(roiData,
clickPosition,
k = 1,
searchtype = "radius",
radius = 50) # Search within 50 pixels of the click
## nn$nn.idx indexes into roiData.
## When subsetting, the index into the full data is stored as rowname
## so rownames(roiData) contains the index into the original data.
nn.rows.idx <- c(nn.rows.idx, as.numeric(rownames(roiData[nn$nn.idx,]))[1])
rv$pixelPosition <- matrix(input$pixelPosition, ncol = 2, byrow = TRUE)
if(!is.null(rv$selectedFrame)) {
for(i in 1:nrow(rv$pixelPosition)) {
if(!is.null(rv$roiFrame) && rv$roiFrame != "") {
## rv$imgPath1 and rv$selectedFrame should always have a unique value even when length>1
## because the image has already been selected if we click on it
## so it's safe to use the first value
clickPosition <- data.frame(t(c(rv$pixelPosition[i,], rv$selectedFrame[1])))
## Make sure we're looking only for ROIs present in the frame currently displayed
## This assumes that we interact with imageViewer1
roiData <- rv$data[rv$data[,rv$fileCol1] == rv$imgPath1[1] & rv$data[,rv$roiFrame] == rv$selectedFrame[1],
c(rv$roiX, rv$roiY, rv$roiFrame)]
} else {
clickPosition <- data.frame(t(c(rv$pixelPosition[i,])))
roiData <- rv$data[,c(rv$roiX, rv$roiY)]
}
selectRows(rv$proxy, nn.rows.idx) # Set selected points in table
rv$selectedRows <- nn.rows.idx
runjs("Shiny.setInputValue('explore_module-image-pixelPosition', null);")
nn <- nn2(roiData,
clickPosition,
k = 1,
searchtype = "radius",
radius = 50) # Search within 50 pixels of the click
## nn$nn.idx indexes into roiData.
## When subsetting, the index into the full data is stored as rowname
## so rownames(roiData) contains the index into the original data.
nn.rows.idx <- c(nn.rows.idx, as.numeric(rownames(roiData[nn$nn.idx,]))[1])
}
}) # End isolate
selectRows(rv$proxy, nn.rows.idx) # Set selected points in table
runjs("Shiny.setInputValue('explore_module-image-pixelPosition', null);")
}
} # End if
}) # End observe
}
R/explore_plate_view.R
View file @ 7326e390
......@@ -25,6 +25,7 @@ plate_view_server <- function(input, output, session, rv) {
output$plate_view <- renderPlotly({
req(rv$data)
selectedPlates <- unique(rv$data[rv$selectedRows, rv$plateCol])
isolate({
req(length(selectedPlates)>0)
# Extract selected plate data
plateData <- rv$data[rv$data[,rv$plateCol] %in% selectedPlates,]
......@@ -47,7 +48,7 @@ plate_view_server <- function(input, output, session, rv) {
"1536" = c(nb.rows = 32, nb.cols = 48)
)
# Use the first selected plate since this is the one we'll eventuually draw
nb.wells <- length(unique(plateData[plateData[, rv$plateCol] == selectedPlates[1],rv$wellCol]))
nb.wells <- length(unique(plateData[plateData[, rv$plateCol] == selectedPlates[1], rv$wellCol]))
plateSize <- min(plate.sizes[nb.wells/plate.sizes<=1])
validate(need(plateSize>=4 && plateSize<=1536, "Unrecognized plate size/format."))
nb.rows <- plate.formats[[as.character(plateSize)]]["nb.rows"]
......@@ -55,11 +56,18 @@ plate_view_server <- function(input, output, session, rv) {
nb.cols <- plate.formats[[as.character(plateSize)]]["nb.cols"]
col.labels <- 1:nb.cols
plateData <- cbind(plateData[, c("ide.id", rv$plateCol, rv$wellCol,rv$fieldCol, rv$treatCol, rv$selectedVar[1]), drop = FALSE], rows = NA, cols = NA)
# Match well index to row/col coordinates
for(i in 1:nrow(plateData)) {
idx <- plateData[i, rv$wellCol]
plateData[i, "rows"] <- row.labels[((idx-1) %/% nb.cols)+1]
plateData[i, "cols"] <- ((idx-1) %% nb.cols)+1
if(all(grepl("^[A-Za-z]", plateData[, rv$wellCol]))) { # assume we have row/col coordinates
plateData[, "rows"] <- gsub('\\d','', plateData[, rv$wellCol])
plateData[, "cols"] <- gsub('\\D','', plateData[, rv$wellCol])
} else if(all(!grepl("\\D", plateData[, rv$wellCol]))) { # all numeric, assume we have well indices
# Match well index to row/col coordinates
for(i in 1:nrow(plateData)) {
idx <- plateData[i, rv$wellCol]
plateData[i, "rows"] <- row.labels[((idx-1) %/% nb.cols)+1]
plateData[i, "cols"] <- ((idx-1) %% nb.cols)+1
}
} else {
showNotification("Unrecognized well identifier", type = "error")
}
plateData$rows <- factor(plateData$rows)
plateData$rows <- factor(plateData$rows, rev(levels(plateData$rows)))
......@@ -90,6 +98,7 @@ plate_view_server <- function(input, output, session, rv) {
modeBarButtonsToRemove = c("sendDataToCloud", "hoverCompareCartesian", "select2d", "lasso2d")) %>% # Control Plotly's tool bar
toWebGL()
}
})
}) # End renderPlotly
### Interactions with the plate viewer
......
R/explore_plot.R
View file @ 7326e390
......@@ -71,9 +71,6 @@ plot_server <- function(input, output, session, rv) {
click <- event_data("plotly_click", priority = "event", source = "scatterPlot")
if(!is.null(click)) {
selectRows(rv$proxy, as.numeric(unlist(click$key))) # Set selected point in table
if(!is.null(rv$roiX) && rv$roiX != "" && !is.null(rv$roiY) && rv$roiY != ""){
rv$pixelPosition <- rv$data[unlist(click$key), c(rv$roiX, rv$roiY)]
}
# Reset event to avoid triggering updates when switching workspaces
runjs("Shiny.setInputValue('plotly_click-scatterPlot', null);")
}
......@@ -86,7 +83,6 @@ plot_server <- function(input, output, session, rv) {
brush <- event_data("plotly_selected", priority = "event", source = "scatterPlot")
if(!is.null(brush)) {
selectRows(rv$proxy, as.numeric(unique(unlist(brush$key))))
rv$selectedRows <- as.numeric(unique(unlist(brush$key)))
# Reset event to avoid triggering updates when switching workspaces
runjs("Shiny.setInputValue('plotly_selected-scatterPlot', null);")
}
......
R/explore_table.R
View file @ 7326e390
......@@ -72,7 +72,7 @@ explore_table_server <- function(input, output, session, rv) {
rv$proxy <- dataTableProxy('dataTable')
# Interactions with the table
observe({
observeEvent( input$dataTable_rows_selected, {
rv$selectedRows <- input$dataTable_rows_selected
if(is.null(rv$roiX) || rv$roiX == "") { # No ROIs,we only deal with images
if(length(rv$selectedRows)!=1) {
......@@ -97,9 +97,8 @@ explore_table_server <- function(input, output, session, rv) {
rv$selectedFrame <- rv$data[rv$selectedRows, rv$roiFrame]
}
}
print("Table clicked")
updateFilters()
})
}, ignoreNULL = FALSE)
observeEvent(input$selectFiltered, {
selectRows(rv$proxy, input$dataTable_rows_all)
......
R/feature_selection.R
View file @ 7326e390
......@@ -8,23 +8,222 @@
ui_feature_selection <- function(id) {
ns <- NS(id)
fluidRow(
column(12,
box(id="box_alert", width= 6,
title = "Feature selection", solidHeader = TRUE, status = "primary",
tags$div(style = "line-height: 2",
tags$b("Feature selection is not implemented yet. Please come back later or consider contributing code to the app."),
fluidPage(
fluidRow(
column(12,
fluidRow(
box( width = 3,
title = "Features to consider", solidHeader = TRUE, status = "primary",
uiOutput(ns("featuresToProcess"))
),
box( width = 3,
title = "Target annotation column", solidHeader = TRUE, status = "primary",
uiOutput(ns("targetCol"))
),
# box(width = 3,
# title = "Parameters", solidHeader = TRUE, status = "primary",
# uiOutput(ns("featSelectionParams"))),
actionButton(ns("featSelectionButton"), "Start", icon("check"),
style="color: #fff; background-color: #3C8DBC; border-color: #3C8DBC")
),
fluidRow(
box( width = 6, align = "left",
title = "Plot of feature importance", solidHeader = TRUE, status = "primary",
plotlyOutput(ns("plot"), height = '500px')
), # End box
box( width = 6,
title = "Model information", solidHeader = TRUE, status = "primary",
verbatimTextOutput(ns("accuracy"))
)
) # End box
) # End column
) # End fluidRow
} # End ui_cluster()
)
) # End column
), # End first row
fluidRow(
column(12,
column( width = 3,
uiOutput(ns("predictButton"))
)
)
) # End second row
) # End fluidPage
} # End ui_feature_selection()
feature_selection_server <- function(input, output, session) {
feature_selection_server <- function(input, output, session, rv, session_parent) {
#TODO
req(rv$data)
ns <- session$ns
}
## Select input variables
## Allow to select all variables of numerical type as it may be more user-friendly to deselect a few variables
## instead of selecting many one by one.
output$featuresToProcess <- renderUI({
tagList(
selectizeInput(inputId = ns("featuresToProcess"),
label = "Classification will use these features",
multiple = TRUE,
choices = names(rv$data)),
checkboxInput(ns("check"), "Select all numeric variables", FALSE)
) # End tagList
}) # End RenderUI
output$targetCol <- renderUI({
tagList(
selectizeInput(inputId = ns("targetCol"),
label = "Select column containing target annotations",
multiple = FALSE,
choices = c("", names(rv$data))),
checkboxInput(ns("nocv"), "Don't use cross-validation (faster but may be less accurate)", FALSE)
)
})
# Select all numeric variables but exclude variables used only by the app (i.e. not in the input data)
observeEvent(input$check,{
if(input$check){
# Get names of numeric columns
numeric.cols <- colnames(Filter(is.numeric, rv$data))
# Remove non-data variables
numeric.cols <- numeric.cols[numeric.cols != 'ide.id' & numeric.cols != 'ide.idx']
updateSelectizeInput(session, inputId = "featuresToProcess", selected = numeric.cols)
}
if(!input$check){
updateSelectizeInput(session, inputId = "featuresToProcess", selected = "")
}
})
#######################################################
## Classification and feature selection with XGBoost ##
#######################################################
classifier.data <- reactiveValues(model = NULL, classes = NULL)
action_button_feature_selection <- function(){
shinyjs::disable("featSelectionButton")
req(rv$data)
tmp <- rv$data[,c(input$targetCol, input$featuresToProcess)]
# Remove rows with NAs and infinite values
tmp <- tmp[is.finite(rowSums(tmp[,input$featuresToProcess])),]
# Target vector
target <- tmp[, input$targetCol]
tmp <- tmp[, input$featuresToProcess]
classes <- levels(as.factor(target))
classifier.data$classes <- classes
# Extract data with annotations
idx.to.keep <- which(!is.na(target) & tolower(target) != 'none' & target != "")
# Split into training and test set indices
# Note: if unlucky we may get class imbalance
# If this becomes a problem, we can use functions from the caret package
train.idx <- sample(idx.to.keep, floor(0.67*length(idx.to.keep)))
test.idx <- idx.to.keep[-train.idx]
# Form training and test sets
train.data <- as.matrix(tmp[train.idx, input$featuresToProcess])
train.labels <- as.factor(target[train.idx])
test.data <- as.matrix(tmp[test.idx, input$featuresToProcess])
test.labels <- as.factor(target[test.idx])
# Tune xgboost hyperparameters using caret
nrounds <- seq(from = 100, to = 500, by = 50)
eta <- c(0.025, 0.05, 0.1, 0.3, 0.4)
depth <- c(3, 4, 5, 6)
if(input$nocv) { # No cross validation: use default parameters
paramGrid <- expand.grid(
nrounds = 500,
eta = 0.3,
max_depth = 6,
gamma = 0,
colsample_bytree = 1,
min_child_weight = 1,
subsample = 1
)
nfolds <- 1
} else {
paramGrid <- expand.grid(
nrounds = nrounds,
eta = eta,
max_depth = depth,
gamma = 0,
colsample_bytree = 1,
min_child_weight = 1,
subsample = 1
)
nfolds <- 5
}
trainCtrl <- caret::trainControl(
method = "cv", # cross-validation
number = nfolds, # with n folds
verboseIter = FALSE, # no training log
allowParallel = TRUE # FALSE for reproducible results
)
xgbModel <- caret::train(
x = train.data,
y = train.labels,
trControl = trainCtrl,
tuneGrid = paramGrid,
method = "xgbTree",
verbose = FALSE
)
classifier.data$model <- xgbModel
# Evaluate on held out data
xgbpred <- predict(xgbModel, newdata = test.data)
confusion.matrix <- confusionMatrix(xgbpred, test.labels, mode = "everything")
# Get feature importance using the xgboost library
# This also clusters the features. The number of clusters is automatically determined (using BIC)
feature.importance <- xgb.importance(model = xgbModel$finalModel, feature_names = xgbModel$finalModel$feature_names)
p <- xgb.ggplot.importance(feature.importance)
p <- p + ggtitle("") + theme(legend.title = element_blank())
output$plot <- renderPlotly({
ggplotly(p, tooltip = "none", source = "featureImportance") %>%
layout(legend = list(orientation = "v", x = 1, y = 0.8, title=list(text='Clusters'))) %>%
config(p = ., staticPlot = FALSE, doubleClick = "reset+autosize", autosizable = TRUE, displayModeBar = TRUE,
sendData = FALSE, displaylogo = FALSE,
modeBarButtonsToRemove = c("sendDataToCloud", "hoverCompareCartesian", "select2d", "lasso2d")) # Control Plotly's tool bar
})
output$accuracy <- renderPrint( confusion.matrix )
output$predictButton <- renderUI(actionButton(ns("predict"),
"Make predictions and add them to the table"))
remove_modal_spinner()
shinyjs::enable("featSelectionButton")
}
# Run action function on button click
onclick("featSelectionButton", Check_variable(action_button_feature_selection()))
# Check that we have at least two columns selected and they they are numeric
# then start processing
Check_variable <- function(buttonaction){
if(is.null(input$targetCol) || input$targetCol == "") {
showNotification("You need to select an annotation column with class assignments.", type = "error")
} else if(length(input$featuresToProcess)<2) {
showNotification("You need to select at least 2 features/columns.", type = "error")
} else if(!any(unlist(lapply(rv$data[,input$featuresToProcess], is.numeric)))) {
showNotification("Non-numeric features/columns selected.", type = "error")
}
else{
show_modal_spinner(text = "It looks like this is going to take a while. Please wait...",
spin = "orbit")
buttonaction
}
}
observeEvent(input$predict, {
req(rv$data)
if(!is.null(classifier.data$model)) {
if(!("xgboost.predictions" %in% colnames(rv$data))) {
rv$data$xgboost.predictions <- NA
}
tmp <- rv$data[,input$featuresToProcess]
# Remove rows with NAs and infinite values
tmp <- as.matrix(tmp[is.finite(rowSums(tmp)),])
preds <- predict(classifier.data$model, newdata = tmp)
rv$data[rownames(tmp),]$xgboost.predictions <- classifier.data$classes[preds]
showNotification("Model predictions have been added to the data.", type = "warning")
}
})
}
\ No newline at end of file
image_data_explorer.R
View file @ 7326e390
......@@ -10,11 +10,13 @@ options(shiny.maxRequestSize=500*1024^2)
## Increase amount of RAM allocated to the JVM to allow BioFormats to read large files. This needs to be done before loading rJava (or packages using it).
# options(java.parameters = "-Xmx8g")
cran.mirrors <- c('https://ftp.gwdg.de/pub/misc/cran/', 'https://cloud.r-project.org/')
cran.mirrors <- c('https://cloud.r-project.org/', 'https://ftp.gwdg.de/pub/misc/cran/')
## Install required packages if missing
## CRAN packages
pkg <- c("devtools", "BiocManager", "DT", "shiny", "shinyFiles", "shinycssloaders", "shinydashboard", "shinyjs", "shinyWidgets", "shinybusy", "assertthat", "ggplot2", "plotly", "RANN", "MASS", "uwot")
pkg <- c("devtools", "BiocManager", "DT", "shiny", "shinyFiles", "shinycssloaders", "shinydashboard", "shinyjs",
"shinyWidgets", "shinybusy", "assertthat", "ggplot2", "plotly", "RANN", "MASS", "uwot", "xgboost", "Ckmeans.1d.dp",
"e1071", "caret")
new.pkg <- pkg[!(pkg %in% installed.packages())]
if (length(new.pkg)) {
message(paste0("Installing ", new.pkg, "\n"))
......@@ -48,6 +50,7 @@ library(assertthat)
library(RANN)
library(MASS)
library(uwot)
library(xgboost)
## Making data table filtering persistent
## from https://dev.to/awwsmm/reactive-datatables-in-r-with-persistent-filters-l26
......@@ -62,6 +65,7 @@ source("R/cluster.R")
source("R/annotate.R")
source("R/explore.R")
source("R/dim_reduction.R")
source("R/feature_selection.R")
ui <- function(request) {
......@@ -85,8 +89,9 @@ ui <- function(request) {
ui_explore("explore_module")
)),
tabItem( tabName = "annotate",
ui_annotate("annotate_module")
),
fluidRow(
ui_annotate("annotate_module")
)),
tabItem( tabName = "dimensionality_reduction",
fluidRow(
ui_dimensionality_reduction("dimensionality_reduction_module")
......@@ -122,7 +127,7 @@ server <- function(input,output,session){
menuItem(HTML("&nbsp;&nbsp;Annotate"), tabName = "annotate", icon = icon("edit")),
menuItem(HTML("&nbsp;&nbsp;Dimensionality<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;reduction"),
tabName = "dimensionality_reduction", icon = icon("cube")),
menuItem(HTML("&nbsp;&nbsp;Feature<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;selection"),
menuItem(HTML("&nbsp;&nbsp;Classification and <br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;feature selection"),