Commit ccd50e8a authored by Bagueneau Mathias's avatar Bagueneau Mathias
Browse files

- Ajout des fichiers utils.R (fonctions) et config.R (fonction pour customiser l'application)

parent 13d21c52
#------------#
# Config.R #
#------------#
# List of some parameters you could change in Shiny SChnurR
## Visualization page : file information text ----
file.information <- function(filename, obj) {
az <- paste(strong("Filename :"), filename)
er <- paste(strong("Genes number :"), length(rownames(obj)), " | ",strong("Cells number :"), length(Cells(obj)), " | ",strong("Median genes/cell :"), median(obj@meta.data$nFeature_SCT))
ty <- paste(strong("Assay used :"), obj@active.assay)
HTML(paste(az,er,ty, sep='</br>'))
}
## Editable Help Texts ----
# Visualization Page :
helptext.visu <- function () {
print("Welcome to Shiny SChnurR !
You first need to upload a rds file, or choose one already provided as example.
Then, many information are provided :
Some files information, with genes and cells number, and the assay used.
Two plots for the visualization.
A data table with some pre-calculated markers.
The first plot allows you to visualise by all the class (resolution, idents, ...) of your file.
The second one is for the features or quantitative variables (all the genes repartitions, scores, ...).
The two graphs could be controlled with the panel made for. You have two graph modes : t-SNE or UMAP, and clusters information for every factors.
On the plots, you could also select some cells, and have the percentage of your selection by the total cell number.
The data table under the graphs is pre-calculated depending the selected class.
It shows all significant markers, calculated with the test MAST. You could affine your marker research with the filters.
All of the outputs are exportable : in .svg for the plots and in .csv for the table.")}
# Heatmap Page :
helptext.heatmap <- function () {
print("The Heatmap page allows you to do a Heatmap with many parameters.
You could choose a class and the number of top genes you want to be shown.
The Heatmap also use the pre-calculated markers for each class (like the data table from the visualization page). If the markers are not pre-calculated, it will be done here but could take a while...
The Heatmap is exportable in .png.")}
# Genes Page :
helptext.genes <- function () {
print("The Genes page allows you to do a Gene Ontology and have information about genes.
You have to choose a class, group(s) of it, and ontology. Three type of ontology are available : Biological Process, Molecular Function and Cellular Component.
Then you will have a graph (you can also change the graph mode), and two tables.
The first table gives you the list of the genes present in your selection.
The second one gives you the ontology.
The Gene Ontology also use the pre-calculated markers for each factors (like the data table from the visualization page and the Heatmap). If the markers are not pre-calculated, it will be done here but could take a while...
All of the outputs are exportable : in .png for the graph and in .csv for the tables.")}
# Compare Page :
helptext.compare <- function () {
print("In this page, you could compare groups from class with each other.
You could choose multiple groups, and also add a second class to filter with.
Then you could Find the significant markers of your selection.
Be carefull to not select redondant cells.
After this, another option and two text areas appears. The text areas are filled with the top 30 genes upregulated from one condition against the other. These areas are writable (you can add or remove some genes).
Then you could do a gene ontology with these two lists.
The results are into two tables.
Like the Visualization page, you have a Control panel to change some parameters to the graphs (like graph mode, point size, ...) and choose what you want to see (class, features, ...).
You could also choose an ontology.
All of the outputs are exportable : in .svg for the plots and in .csv for the tables.
You could export the barcodes and the metadata of the selected cells, in .csv.
You could also export the selected cells as Seurat object in .rds.")}
# Grid Page :
helptext.grid <- function () {
print("The Grid page allows a great visualization for genes plots.
In this page, you could choose many genes to visualize. Some presets are available to show genes plots depending a cell type, a pathway, ...
You could also change some parameters, like the graph mode or the number of columns you want.
The grid plot is exportable in .png.")}
## Functions to customize the Grid Presets ----
# First : if you want to add a preset, add it into "choices" here :
presets.grid <- function() {
selectInput(inputId = "presets_grid",
label="Choose a preset...",
choices = c("- User selection -"="user", "Plasma Cells"="plasmacells", "Apoptosis"="apoptosis", "Immunology"="immuno"),
selected = "user")
}
# Then : add and/or edit the genes lists here :
presets.listgenes.grid <- function(shiny_session, input.presets) {
if (input.presets == "plasmacells") {
updateSelectizeInput(shiny_session, "genes_list_grid", selected=c("IRF4","XBP1","PRDM1","IGKC","IGLC2","IGLC3","IGHM","IGHG1","IGHG2","IGHG3","IGHG4", "IGHA1","IGHE","IGHD","SDC1","CD38","CD19","MS4A1","SLAMF7","TNFRSF17"))
} else if (input.presets == "apoptosis") {
updateSelectizeInput(shiny_session, "genes_list_grid", selected=c("MCL1","BCL2","BCL2L1","BAK","BAX","BCL2L11","BBC3"))
} else if (input.presets == "immuno") {
updateSelectizeInput(shiny_session, "genes_list_grid", selected=c("CD3D","CD8A","CD4","NCAM1","FCGR3A","CD14","HLA-DRA","ITGAX","ITGAM","CD79A","CD19","MS4A1","SDC1","IRF8","IL3RA","FCER1A","HBA1"))
}
}
#-----------#
# Utils.R #
#-----------#
## List of the functions required and designed to use Shiny SChnurR
## Assign.colors function ----
assign.colors <- function(obj, ident, palette){
ident <- as.factor(ident)
nr.groups <- length(levels(ident))
colors <- colorRampPalette(brewer.pal(8, palette))(nr.groups)
colors.df <- data.frame(group=levels(ident), color=colors)
return(colors.df)
}
## Uptade Gene lists function ----
update.geneslist <- function(obj, shiny_session, genes_list, inputname, selected_choice = "IGKC") {
genesList <- rownames(obj)
updateSelectizeInput(shiny_session, as.character(inputname), choices = genes_list, selected = selected_choice)
}
## Scale X and Scale Y functions ----
scalex <- function(obj, reduction) {
x <- scale_x_continuous(limits = c(min(obj@reductions[[reduction]]@cell.embeddings[,1]), max(obj@reductions[[reduction]]@cell.embeddings[,1])))
}
scaley <- function(obj, reduction ) {
y <- scale_y_continuous(limits = c(min(obj@reductions[[reduction]]@cell.embeddings[,2]), max(obj@reductions[[reduction]]@cell.embeddings[,2])))
}
## NoFile texts function ----
nofile <- function(file1, file2) {
if ((is.null(file1)) && (file2 =="")) {print("Please upload or choose a file")}
}
## Class choices ----
class.choices <- function(inputname, obj, selected_choice = "integrated_snn_res.0.4") {
selectizeInput(as.character(inputname), "Choose a Class :", choices = names(rapply(obj@meta.data, class=c("factor","character"), f=class)), selected = as.character(selected_choice))
}
## Link class choices ----
link.class.choices <- function(shiny_session, cl_sel1, cl_sel2, cl_sel3, cl_selected) {
updateSelectizeInput(shiny_session, as.character(cl_sel1), selected = cl_selected)
updateSelectizeInput(shiny_session, as.character(cl_sel2), selected = cl_selected)
updateSelectizeInput(shiny_session, as.character(cl_sel3), selected = cl_selected)
}
## Filter by groups function----
group.choices <- function(obj, input_class_selector, inputname) {
choice <- unique(eval(parse(text=paste0("obj@meta.data$",input_class_selector))))
if(!is.na(choice)) {
selectInput(as.character(inputname), "Choose a group :", multiple = TRUE, choices = choice[order(choice)]) }
}
## Genes or Quantitative variable choice function ----
genes.or.qv <- function(inputname, g, d) {
selectInput(as.character(inputname),
"Choose a Feature :",
choices = c("Genes" = as.character(g),"Quantitave Variable" = as.character(d)),
selected = "Genes")
}
## Qv choices ----
qv.choices <- function(inputname, obj) {
selectInput(as.character(inputname),
"Choose a Quantitative variable :",
choices = names(rapply(obj@meta.data, class=c("numeric","integer"), f=class)),
selected = names(rapply(obj@meta.data, class=c("numeric","integer"), f=class)))
}
## Clusters information function ----
clusters.information <- function(obj, input_class_selector) {
clusters_infos_Data <- data.table("Cluster" = levels(as.factor(obj@meta.data[[input_class_selector]])), "Cells_nb" = as.vector(summary(as.factor(obj@meta.data[[input_class_selector]]))), "Percentage" =formatC(((as.vector(summary(as.factor(obj@meta.data[[input_class_selector]])))/length(as.factor(obj@meta.data[[input_class_selector]])))*100),digits=2, format ="f" ))
t(head(clusters_infos_Data, n=999 ))
}
## Cell selection information text function ----
selection.information <- function(obj, input_class_selector) {
select_infos_Data <- paste0("Your selection : Cells nb : ", nrow(event_data("plotly_selected")), " | % : ", formatC(((nrow(event_data("plotly_selected"))/length(obj@meta.data[[input_class_selector]]))*100),digits=2, format ="f" ) )
if (is.null(nrow(event_data("plotly_selected")))) "Please select some cells" else select_infos_Data
}
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