Skip to content

Commit

Permalink
Merge pull request #56 from UoMResearchIT/dev
Browse files Browse the repository at this point in the history 
Fixes heatmap, security, and save_as bugs
  • Loading branch information
@fherreazcue
fherreazcue authored Mar 28, 2024
2 parents 2a7b8b2 + f73bab0 commit c001ec7
Show file tree
Hide file tree
Showing 8 changed files with 210 additions and 139 deletions.
17 changes: 10 additions & 7 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,9 +47,16 @@ docker pull jc21/nginx-proxy-manager:latest
```

### One time setup
Navigate to the cloned repo directory, and setup minio for the first time:
Navigate to the cloned repo directory.
```
cd proteinBASE
```
Create a password for the root user of minio. You can generate a random one with:
```
echo "MINIO_ROOT_PASSWORD=$(cat /dev/urandom | tr -dc 'a-zA-Z0-9' | fold -w 10 | head -n 1)" > ./db/config/minio/.secret_minio_passwd
```
Now we can spin up minio for the first time:
```
docker compose up minio proxy -d
```
#### Minio keys
Expand All @@ -58,12 +65,8 @@ For example, if the ip is 10.20.30.40, in a browser go to
```
http://10.20.30.40:9001/access-keys
```
Log in using the temporary credentials
```
u: ROOTUSER
p: CHANGEME123
```
Update your credentials.
Log in using the root user credentials ( user: ROOTUSER and the password you just generated).

Once logged in, use the 'create' button.
Hit 'Create' again, and then 'Download for import'.

Expand Down
35 changes: 27 additions & 8 deletions app/R/app_server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -106,13 +106,32 @@ app_server <- function(input, output, session) {
type = "error", duration = 10
)
})
ht_colors(generate_heatmap_colors(excel_ok))
# Set row names
row_names <- paste(excel_ok$Gene,
" (",
excel_ok$Protein,
")",
sep = "")
# Update autocomplete choices for search bar
updateSelectizeInput(
session,
"subh_gene",
choices = sort(unique(unlist(strsplit(rownames(excel_ok), ",")))),
choices = sort(unique(unlist(row_names))),
server = TRUE
)
# Check for duplicated row_names and add a number to make unique
duplicates <- duplicated(row_names)
if (any(duplicates)) {
sequence <- ave(
seq_along(row_names), row_names, FUN = function(x) seq_along(x) - 1
)
row_names[duplicates] <- paste(row_names[duplicates],
sequence[duplicates],
sep = " ")
}
rownames(excel_ok) <- row_names
# Calculate colors used for heatmap and subheatmap
ht_colors(generate_heatmap_colors(excel_ok))
return(excel_ok)
})

Expand Down Expand Up @@ -196,7 +215,7 @@ app_server <- function(input, output, session) {
verbose = FALSE,
calibrate = FALSE)
sub_rows <- unlist(selection$row_index)
sub_cols <- unlist(selection$column_index)
sub_cols <- unlist(selection$column_label)
sub_data(heatmap_data()[sub_rows, sub_cols, drop = FALSE])
if (nrow(sub_data()) == 0 || ncol(sub_data()) == 0) {
.subheat_plot(NULL)
Expand Down Expand Up @@ -265,12 +284,12 @@ app_server <- function(input, output, session) {

#### Download buttons ####
shinyjs::hide("subheat_save_as-save_as_button")
save_as_Server("pca_save_as", input$dataset, .pca_plot(), "PCA")
save_as_Server("heatmap_save_as", input$dataset, .heatmap_plot(),
save_as_server("pca_save_as", input$dataset, .pca_plot(), "PCA")
save_as_server("heatmap_save_as", input$dataset, .heatmap_plot(),
"HeatMap")
save_as_Server("subheat_save_as", input$dataset, .subheat_plot(),
save_as_server("subheat_save_as", input$dataset, .subheat_plot(),
"SubHeatMap")
save_as_Server("bar_save_as", input$dataset, .bar_plot(), "Bar")
save_as_Server("box_save_as", input$dataset, .box_plot(), "Box")
save_as_server("bar_save_as", input$dataset, .bar_plot(), "Bar")
save_as_server("box_save_as", input$dataset, .box_plot(), "Box")

}
12 changes: 7 additions & 5 deletions app/R/app_ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -115,7 +115,9 @@ app_ui <- function(request) {
#### PCA ####
tabPanel("PCA",
plotlyOutput("PCA_plot", width = 600, height = 500),
save_as_UI("pca_save_as", 600, 500)
div(
save_as_ui("pca_save_as", 600, 500)
),
),
#### HeatMap ####
tabPanel("HeatMap",
Expand Down Expand Up @@ -145,11 +147,11 @@ app_ui <- function(request) {
height = 500,
brush = "heatmap_brush"
),
save_as_UI("heatmap_save_as", 250, 500),
save_as_ui("heatmap_save_as", 250, 500),
),
div(
uiOutput("sub_heat"),
save_as_UI("subheat_save_as", 600, 500),
save_as_ui("subheat_save_as", 600, 500),
)
)
),
Expand All @@ -160,11 +162,11 @@ app_ui <- function(request) {
div(class = "container",
div(
plotlyOutput("plot_bar", width = 500, height = 500),
save_as_UI("bar_save_as", 500, 500)
save_as_ui("bar_save_as", 500, 500)
),
div(
plotlyOutput("plot_box", width = 300, height = 500),
save_as_UI("box_save_as", 300, 500)
save_as_ui("box_save_as", 300, 500)
),
)
),
Expand Down
157 changes: 84 additions & 73 deletions app/R/plot_functions.R
View file
Original file line number Diff line number Diff line change
@@ -1,10 +1,14 @@
#### Load libraries ####
library(ggplot2)
library(mixOmics)
library(ComplexHeatmap)
library(circlize)
library(stringr)
library(grid)
library(dplyr)

#### Settings ####
font_family <- 'sans'
font_family <- "sans"
title_fontsize <- 13
label_fontsize <- 11
# Fonts in complex heatmaps are smaller, so added an extra pt.
Expand All @@ -23,7 +27,7 @@ label_font_gp <- function() {
##### Plotting scripts ####

#### TAB 1 ####
pca_plot <- function(matrix){
pca_plot <- function(matrix) {
# Run PCA
pca_protein <- mixOmics::pca(
X = matrix,
Expand All @@ -37,11 +41,11 @@ pca_plot <- function(matrix){
# Extract labels for x and y axes
labels.pca <- as.vector(pca_protein$cum.var)
xlabel <- paste0("PC1, ",
(round((labels.pca[1]*100),
digits = 2)),"%")
(round((labels.pca[1] * 100),
digits = 2)), "%")
ylabel <- paste0("PC2, ",
(round(((labels.pca[2]-labels.pca[1])*100),
digits = 2)),"%")
(round(((labels.pca[2] - labels.pca[1]) * 100),
digits = 2)), "%")

# Generate 2D PCA plot
pca_plot <- ggplot(coord,
Expand All @@ -50,8 +54,8 @@ pca_plot <- function(matrix){
text = paste("", sampleName))) +
geom_point(size = 4) +
labs(x = xlabel, y = ylabel, color = "") +
xlim((min(coord$PC1)-10), max(coord$PC1)+10) +
ylim((min(coord$PC2)-10), max(coord$PC2)+10) +
xlim((min(coord$PC1) - 10), max(coord$PC1) + 10) +
ylim((min(coord$PC2) - 10), max(coord$PC2) + 10) +
theme_light() +
theme(text = element_text(family = font_family, size = title_fontsize),
axis.text.x = element_text(size = label_fontsize),
Expand All @@ -61,16 +65,16 @@ pca_plot <- function(matrix){
}

#### TAB 2 ####
generate_heatmap_colors <- function(matrix){
x <- as.matrix(matrix)
x.trunc <- as.vector(unique(x))
x.trim <- x.trunc[x.trunc >= quantile(x.trunc, probs = 0.01, na.rm = T) &
x.trunc <= quantile(x.trunc, probs = 0.99, na.rm = T)]
x.max <- which.max(x.trim)
x.min <- which.min(x.trim)
generate_heatmap_colors <- function(data) {
x <- as.matrix(select_if(data, is.numeric))
x_trunc <- as.vector(unique(x))
x_trim <- x_trunc[x_trunc >= quantile(x_trunc, probs = 0.01, na.rm = TRUE) &
x_trunc <= quantile(x_trunc, probs = 0.99, na.rm = TRUE)]
x_max <- which.max(x_trim)
x_min <- which.min(x_trim)
# Create a color function for the heatmap values
col_fun <- circlize::colorRamp2(c(x.trim[x.min], 0, x.trim[x.max]),
c("blue", "white", "red"),
col_fun <- circlize::colorRamp2(breaks = c(x_trim[x_min], 0, x_trim[x_max]),
colors = c("blue", "white", "red"),
space = "sRGB")
# Create color lists for samples and groups labels
samples_names <- gsub("_", " ", colnames(x)) # for sample annotation
Expand All @@ -80,48 +84,53 @@ generate_heatmap_colors <- function(matrix){
group_colors <- hcl.colors(length(group_names))
col_group <- setNames(group_colors, group_names)

return(list(col_fun = col_fun, col_samples = col_samples, col_group = col_group))
return(list(col_fun = col_fun,
col_samples = col_samples,
col_group = col_group))
}

top_annotation <- function(data, heatmap_colors, legend = TRUE) {
samples_lab <- gsub("_", " ", colnames(data))
groups_lab <- gsub("_\\d+", "", colnames(data))
top_annotation = HeatmapAnnotation(Samples = samples_lab,
Groups = groups_lab,
col = list(Samples = heatmap_colors$col_samples,
Groups = heatmap_colors$col_group),
show_annotation_name = T,
annotation_name_side = "left",
annotation_name_gp = label_font_gp(),
annotation_legend_param = list(
title_gp = title_font_gp(),
labels_gp = label_font_gp()
),
show_legend = legend)
top_annotation <- HeatmapAnnotation(
Samples = samples_lab,
Groups = groups_lab,
col = list(Samples = heatmap_colors$col_samples,
Groups = heatmap_colors$col_group),
show_annotation_name = TRUE,
annotation_name_side = "left",
annotation_name_gp = label_font_gp(),
annotation_legend_param = list(
title_gp = title_font_gp(),
labels_gp = label_font_gp()
),
show_legend = legend
)
return(top_annotation)
}

make_heatmap <- function(data, heatmap_colors){
data_m <- as.matrix(data)
make_heatmap <- function(data, heatmap_colors) {
data_m <- as.matrix(select_if(data, is.numeric))
set.seed(3)
ht <- ComplexHeatmap::Heatmap(data_m,
name = "P. Level",
cluster_rows = TRUE,
cluster_columns = TRUE,
col = heatmap_colors$col_fun,
show_row_names = F,
show_column_names = F,
row_title = "Proteins",
row_title_gp = title_font_gp(),
column_title = "",
row_dend_width = unit(1.5, "cm"),
top_annotation = top_annotation(data_m, heatmap_colors),
heatmap_legend_param = list(
title_gp = title_font_gp(),
labels_gp = label_font_gp()
)
)
dht = draw(ht,merge_legend = TRUE,newpage = FALSE)
ht <- ComplexHeatmap::Heatmap(
data_m,
name = "P. Level",
cluster_rows = TRUE,
cluster_columns = TRUE,
col = heatmap_colors$col_fun,
show_row_names = FALSE,
show_column_names = FALSE,
row_title = "Proteins",
row_title_gp = title_font_gp(),
column_title = "",
row_dend_width = unit(1.5, "cm"),
top_annotation = top_annotation(data_m, heatmap_colors),
heatmap_legend_param = list(
title_gp = title_font_gp(),
labels_gp = label_font_gp()
)
)
dht <- draw(ht, merge_legend = TRUE, newpage = FALSE)
return(dht)
}

Expand All @@ -131,39 +140,41 @@ calculate_row_fontsize <- function(n_rows) {
return(max(12 - floor((n_rows - 20) / 10), 3))
}

make_sub_heatmap <- function(data, heatmap_colors){
data_m <- as.matrix(data)
row_lab <- gsub(".*,\\s*", "", rownames(data_m))
make_sub_heatmap <- function(data, heatmap_colors) {
data_m <- as.matrix(select_if(data, is.numeric))
row_lab <- rownames(data_m)
row_font_size <- calculate_row_fontsize(length(row_lab))
set.seed(3)
ht <- ComplexHeatmap::Heatmap(data_m,
name = "P. Level",
cluster_rows = FALSE,
cluster_columns = FALSE,
col = heatmap_colors$col_fun,
show_row_names = T,
row_labels = row_lab,
row_names_gp = gpar(fontsize = row_font_size, fontfamily = font_family),
show_column_names = F,
row_title = "Proteins",
row_title_gp = title_font_gp(),
column_title = "",
top_annotation = top_annotation(data_m, heatmap_colors, legend = FALSE),
show_heatmap_legend = FALSE)
ht <- ComplexHeatmap::Heatmap(
data_m,
name = "P. Level",
cluster_rows = FALSE,
cluster_columns = FALSE,
col = heatmap_colors$col_fun,
show_row_names = TRUE,
row_labels = row_lab,
row_names_gp = gpar(fontsize = row_font_size, fontfamily = font_family),
show_column_names = FALSE,
row_title = "Proteins",
row_title_gp = title_font_gp(),
column_title = "",
top_annotation = top_annotation(data_m, heatmap_colors, legend = FALSE),
show_heatmap_legend = FALSE
)
return(draw(ht))
}

#### TAB 3 ####
bar_plot <- function(gene_dropdown, df){
bar_plot <- function(gene_dropdown, df) {
## TODO: Sort out Warning: Removed x rows containing missing values
if (!(gene_dropdown %in% df$Gene)) {
return()
}
df.plot <- df |>
df_plot <- df |>
filter(Gene == gene_dropdown) |>
mutate(experiment_type = str_extract(experiment, "[A-Z]+")) |>
filter(!is.na(expression))
p <- ggplot(data = df.plot, aes(x = experiment, y = expression))
p <- ggplot(data = df_plot, aes(x = experiment, y = expression))
p <- p +
geom_bar(mapping = aes(x = experiment,
y = expression,
Expand All @@ -180,15 +191,15 @@ bar_plot <- function(gene_dropdown, df){
labs(NULL)
return(p)
}
box_plot <- function(gene_dropdown, df){
box_plot <- function(gene_dropdown, df) {
if (!(gene_dropdown %in% df$Gene)) {
return()
}
df.plot <- df |>
df_plot <- df |>
filter(Gene == gene_dropdown) |>
mutate(experiment_type = str_extract(experiment, "[A-Z]+")) |>
filter(!is.na(expression))
p <- ggplot(data = df.plot, aes(x = experiment_type, y = expression))
p <- ggplot(data = df_plot, aes(x = experiment_type, y = expression))
p <- p +
geom_boxplot(mapping = aes(x = experiment_type,
y = expression,
Expand Down
Loading

0 comments on commit c001ec7

Please sign in to comment.