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

- Optimisations et corrections de bug

- Ajouts de fonctions
parent 9ee2b784
This diff is collapsed.
......@@ -6,7 +6,7 @@
## Visualization page : file information text ----
file.information <- function(filename, obj) {
FileInformation <- 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)
......@@ -16,7 +16,7 @@ file.information <- function(filename, obj) {
## Editable Help Texts ----
# Visualization Page :
helptext.visu <- function () {
HelptextVisu <- 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 :
......@@ -32,14 +32,14 @@ It shows all significant markers, calculated with the test MAST. You could affin
All of the outputs are exportable : in .svg for the plots and in .csv for the table.")}
# Heatmap Page :
helptext.heatmap <- function () {
HelptextHeatmap <- 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 () {
HelptextGenes <- 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.
......@@ -49,7 +49,7 @@ The Gene Ontology also use the pre-calculated markers for each factors (like the
All of the outputs are exportable : in .png for the graph and in .csv for the tables.")}
# Compare Page :
helptext.compare <- function () {
HelptextCompare <- 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.
......@@ -64,14 +64,14 @@ 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 () {
HelptextGrid <- 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() {
PresetsGrid <- function() {
selectInput(inputId = "presets_grid",
label="Choose a preset...",
choices = c("- User selection -"="user", "Plasma Cells"="plasmacells", "Apoptosis"="apoptosis", "Immunology"="immuno"),
......@@ -79,7 +79,7 @@ selectInput(inputId = "presets_grid",
}
# Then : add and/or edit the genes lists here :
presets.listgenes.grid <- function(shiny_session, input.presets) {
PresetsListgenesGrid <- 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") {
......@@ -90,11 +90,11 @@ presets.listgenes.grid <- function(shiny_session, input.presets) {
}
## Color palettes ----
color.palettes <- function(inputname) {
ColorPalettes <- function(inputname) {
selectInput(inputId = as.character(inputname),
label="Choose a color palette :",
choices = list(`Ggplot` = c("Dark2", "Set1", "Set2", "Set3", "Pastel1", "Pastel2", "Paired", "Accent", "Spectral"),
`Ggpubr` = c("npg", "aaas", "lancet", "jco", "ucscgb"),
`Misc` = c("simpsons", "rickandmorty")),
choices = list(`ggplot` = c("Dark2", "Set1", "Set2", "Set3", "Pastel1", "Pastel2", "Paired", "Accent", "Spectral"),
`ggpubr` = c("npg", "aaas", "lancet", "jco", "ucscgb"),
`Misc` = c("simpsons","startrek", "rickandmorty")),
selected = "npg")
}
......@@ -5,8 +5,8 @@
## List of the functions required and designed to use Shiny SChnurR
## Assign.colors function ----
assign.colors <- function(obj, ident, palette){
## AssignColors function ----
AssignColors <- function(obj, ident, palette){
ident <- as.factor(ident)
nr.groups <- length(levels(ident))
colors <- colorRampPalette(get_palette(palette, 8))(nr.groups)
......@@ -15,51 +15,51 @@ assign.colors <- function(obj, ident, palette){
}
## Function which use assign.colors to give a color for each group of each class ----
all.class.colors <- function(obj, palette) {
AllClassColors <- function(obj, palette) {
coldf <- lapply(obj@meta.data[,sapply(obj@meta.data, class) %in% c("factor","character")],
assign.colors,
AssignColors,
obj = obj,
palette = palette)
return(coldf)
}
## Uptade Gene lists function ----
update.geneslist <- function(obj, shiny_session, genes_list, inputname, selected_choice = "IGKC") {
## Update Gene lists function ----
UpdateGeneslist <- 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) {
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 ) {
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) {
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") {
## Class choices function ----
ClassChoices <- 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) {
## Link class choices function ----
LinkClassChoices <- 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) {
GroupChoices <- 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)]) }
......@@ -67,28 +67,53 @@ group.choices <- function(obj, input_class_selector, inputname) {
## Genes or Quantitative variable choice function ----
genes.or.qv <- function(inputname, g, d) {
GenesOrQv <- 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) {
## Qv choices function ----
QvChoices <- 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) {
ClustersInformation <- 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) {
SelectionInformation <- 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
}
## Compare : Data for the plots function ----
CellsToPlot <- function(obj, class, group, add, addclass, addgroup) {
data <- SubsetData(object = obj,
cells=rownames(obj@meta.data)[which(eval(parse(text=paste0("obj@meta.data$",class))) %in% group)] )
if (add %% 2 != 0) {
data <- SubsetData(object = data,
cells=rownames(data@meta.data)[which(eval(parse(text=paste0("data@meta.data$",addclass))) %in% addgroup)])
}
return(data)
}
## Compare : Meta.data for csv export function ----
MetaData <- function(cells, obj) {
data <- data.frame(FetchData(cells,
names(rapply(obj@meta.data, class=c("factor","character","numeric","integer"), f=class))))
}
## Compare : Scale color for feature plots ----
ScaleColors <- function(obj, var, cells) {
palette.full <- c("lightgrey", plasma(200))
data.max.global <- max(FetchData(obj, var))
data.max.local <- max(FetchData(cells, var))
palette.local <- palette.full[1:ceiling(length(palette.full) * data.max.local / data.max.global)]
return(palette.local)
}
\ No newline at end of file
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