diff --git a/README.md b/README.md index 8358d74..6540014 100644 --- a/README.md +++ b/README.md @@ -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 @@ -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'. diff --git a/app/R/app_server.R b/app/R/app_server.R index b8164ca..9c06387 100644 --- a/app/R/app_server.R +++ b/app/R/app_server.R @@ -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) }) @@ -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) @@ -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") } diff --git a/app/R/app_ui.R b/app/R/app_ui.R index 4991bbe..420cccb 100644 --- a/app/R/app_ui.R +++ b/app/R/app_ui.R @@ -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", @@ -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), ) ) ), @@ -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) ), ) ), diff --git a/app/R/plot_functions.R b/app/R/plot_functions.R index acf251e..bed04c9 100644 --- a/app/R/plot_functions.R +++ b/app/R/plot_functions.R @@ -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. @@ -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, @@ -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, @@ -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), @@ -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 @@ -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) } @@ -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, @@ -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, diff --git a/app/R/save_as_button.R b/app/R/save_as_button.R index cfc51ca..adb2094 100644 --- a/app/R/save_as_button.R +++ b/app/R/save_as_button.R @@ -1,4 +1,11 @@ -save_as_UI <- function(id, default_width = 600, default_height = 450) { +library(shiny) +library(shinyjs) +library(ggplot2) + +save_as_ui <- function(id, + default_width = 600, + default_height = 450, + default_dpi = 300) { tagList( tags$head( tags$style(HTML( @@ -17,15 +24,15 @@ save_as_UI <- function(id, default_width = 600, default_height = 450) { padding: 10px; margin-left: 0px; margin-bottom: 20px; - max-width: 500px; + max-width: 300px; } " )), ), #### Download Button #### actionButton( - NS(id,"save_as_button"), - label = HTML( ' Save as...'), + NS(id, "save_as_button"), + label = HTML(' Save as...'), tooltip = "Save image as...", class = "save-as", style = " @@ -41,34 +48,45 @@ save_as_UI <- function(id, default_width = 600, default_height = 450) { style = "display: none;", div( downloadButton( - NS(id,'download_button'), + NS(id, "download_button"), "Save image", class = "btn-info", style = "padding: 20px 10px;" ) ), div( + style = "display: none;", radioButtons( - NS(id,"download_format"), + NS(id, "download_format"), label = "Format:", choices = list("png", - "pdf", - "svg"), + "pdf", + "svg"), selected = "png", inline = TRUE ) ), div( numericInput( - NS(id,"download_image_width"), + NS(id, "download_image_resolution"), + label = "Resolution [dpi]", + value = default_dpi, + width = "120px" + ) + ), + div( + style = "display: none;", + numericInput( + NS(id, "download_image_width"), label = "Width [px]", value = default_width, width = "80px" ) ), div( + style = "display: none;", numericInput( - NS(id,"download_image_height"), + NS(id, "download_image_height"), label = "Height [px]", value = default_height, width = "80px" @@ -78,33 +96,50 @@ save_as_UI <- function(id, default_width = 600, default_height = 450) { ) } -save_as_Server <- function(id, dataset_name = NULL, plot = NULL, plot_tag = NULL) { +save_as_server <- function(id, + dataset_name = NULL, + plot = NULL, + plot_tag = NULL) { moduleServer(id, function(input, output, session) { observeEvent(input$save_as_button, { # Toggle this "save_as_options" shinyjs::toggle("save_as_options") # Hide all other "save_as_options" - sel <- paste("[id*=save_as_options]:not(#",id,"-save_as_options)",sep = "") + sel <- paste( + "[id*=save_as_options]:not(#", id, "-save_as_options)", + sep = "" + ) shinyjs::hide(selector = sel) # Scroll to the bottom of the page shinyjs::runjs("window.scrollTo(0,document.body.scrollHeight);") }) output$download_button <- downloadHandler( filename = function() { - paste(dataset_name,"_",plot_tag,"_plot.",input$download_format,sep = "") + paste( + dataset_name, + "_", + plot_tag, + "_plot.", + input$download_format, + sep = "" + ) }, content = function(file) { - w = input$download_image_width - h = input$download_image_height - format = input$download_format + screen_dpi <- 72 + dpi <- input$download_image_resolution + w <- input$download_image_width + h <- input$download_image_height + w <- as.integer(dpi * w / screen_dpi) + h <- as.integer(dpi * h / screen_dpi) + format <- input$download_format if (format == "png") { - png(file, width = w, height = h, units = "px") + png(file, width = w, height = h, units = "px", res = dpi) } else if (format == "pdf") { pdf(file, width = w, height = h) } else if (format == "svg") { svg(file, width = w, height = h) } - if (class(plot) %in% c("Heatmap", "HeatmapList", "ComplexHeatmap")) { + if (class(plot)[1] %in% c("Heatmap", "HeatmapList", "ComplexHeatmap")) { print(plot) dev.off() return() @@ -112,11 +147,12 @@ save_as_Server <- function(id, dataset_name = NULL, plot = NULL, plot_tag = NULL ggsave( filename = file, plot = plot, - dpi = "screen", - units = "px", - width = w, - height = h, - device = format) + dpi = dpi, + # units = "px", + # width = w, + # height = h, + device = format + ) dev.off() } ) diff --git a/db/R/data_preprocessing.R b/db/R/data_preprocessing.R index dbc09ad..e138208 100644 --- a/db/R/data_preprocessing.R +++ b/db/R/data_preprocessing.R @@ -26,7 +26,7 @@ preprocess_data <- function(raw_data_path = "", dataset_name = "", dataset_path dataset_name <- gsub(".xlsx", "", basename(dataset_path)) } if (dirname(dataset_path) != paste(data_path, "datasets", sep = "")) { - old_path=dataset_path + old_path <- dataset_path dataset_path <- paste(data_path, "datasets/", dataset_name, ".xlsx", sep = "") @@ -63,11 +63,11 @@ preprocess_data <- function(raw_data_path = "", dataset_name = "", dataset_path print("Preprocessing data for pca plots...") pca_data(protein_data, pca_data_path) print("Preprocessing data for heatmaps...") + heatmap_data(protein_data, heatmaps_path) protein_data <- protein_data |> pivot_longer(cols = !(Identifiers:Gene), names_to = "experiment", values_to = "expression") - heatmap_data(protein_data, heatmaps_path) return(files) } @@ -98,13 +98,6 @@ prepare_dataset <- function(raw_data_path, dataset_path) { rowData(s4[[1]])$nNonZero <- rowSums(assay(s4[[1]]) > 0) # Replace zeroes with NA in S4 object s4 <- QFeatures::zeroIsNA(object = s4, i = "raw") - # Log2-transform peptide data - s4 <- QFeatures::logTransform( - object = s4, # S4 peptide data - i = "raw", # raw expression matrix - name = "log", # log assay name - base = 2 - ) # Remove contaminant peptides s4 <- QFeatures::filterFeatures( object = s4, @@ -118,17 +111,24 @@ prepare_dataset <- function(raw_data_path, dataset_path) { filter <- rowData(s4[[1]])$Proteins %in% msqrob2::smallestUniqueGroups(rowData(s4[[1]])$Proteins) s4 <- s4[filter, , ] - # Normalize by median centering + # Normalize by quantiles s4 <- normalize( object = s4, # S4 peptide data - i = "log", # log expression data + i = "raw", # log expression data name = "norm", # norm assay name - method = "center.median" # normalization method + method = "quantiles" # normalization method + ) + # Log2-transform peptide data #### ****** modified here + s4 <- QFeatures::logTransform( + object = s4, # S4 peptide data + i = "norm", # raw expression matrix + name = "log", # log assay name + base = 2 ) # Summarize peptide to protein s4 <- QFeatures::aggregateFeatures( object = s4, # S4 peptide data - i = "norm", # normalized expression data + i = "log", # normalized expression data name = "prot", # protein assay name fcol = "Proteins", # rowData variable for aggregation fun = MsCoreUtils::robustSummary, # quantitative aggregation function diff --git a/db/config/bootstrap.sh b/db/config/bootstrap.sh index 57f0f5b..23aad50 100755 --- a/db/config/bootstrap.sh +++ b/db/config/bootstrap.sh @@ -21,7 +21,7 @@ set -e # Change the current directory to the directory of the script cd "$(dirname "$0")" # Fix secret credentials url. Should be "http://localhost:9000" -sed -i 's#9001/api/v1/service-account-credentials#9000#g' minio/.secret_credentials.json +sed -i 's#http.*api/v1/service-account-credentials#http://localhost:9000#g' minio/.secret_credentials.json # Generate random password cat /dev/urandom | tr -dc 'a-zA-Z0-9' | fold -w 10 | head -n 1 > .secret_passwd diff --git a/docker-compose.yml b/docker-compose.yml index 3510107..89564f4 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -3,25 +3,24 @@ services: image: cloudflare/cloudflared:latest container_name: pB-cloudflared restart: unless-stopped - environment: - - TUNNEL_TOKEN=eyJhIjoiZTk3ZjM1OGM3NTc5ZjdkYjJlNDVmNTI2OTE1MzgxMzYiLCJ0IjoiZDNiZWUxM2MtZWI3Ny00ZDY4LTllMTMtYzRlZGM5Yjg4NjFmIiwicyI6IlpHTmpPVEF6TXpNdFpEUTJZeTAwTURsakxXSXhZak10WldZNE16UTROemxsT0ROayJ9 + env_file: + - ${PWD}/db/config/cloudflared/.secret_tunnel_token command: tunnel --no-autoupdate run proxy: image: jc21/nginx-proxy-manager:latest container_name: pB-proxy - depends_on: - - cloudflared restart: unless-stopped ports: - # - '80:80' # Public HTTP Port - # - '443:443' # Public HTTPS Port + - '80:80' # Public HTTP Port + - '443:443' # Public HTTPS Port - '81:81' # Admin Web Port2 volumes: - nginx-proxy:/data + # - ${PWD}/proxy_data:/data - nginx-certs:/etc/letsencrypt healthcheck: - test: ["CMD", "/bin/check-health"] + test: [ "CMD", "/bin/check-health" ] interval: 10s timeout: 3s @@ -34,7 +33,8 @@ services: - "9001:9001" environment: - MINIO_ROOT_USER=ROOTUSER - - MINIO_ROOT_PASSWORD=CHANGEME123 + env_file: + - ${PWD}/db/config/minio/.secret_minio_passwd volumes: - minio_s3data:/s3data - ${PWD}/app/data:/data @@ -92,4 +92,4 @@ volumes: driver: local minio_s3data: nginx-proxy: - nginx-certs: \ No newline at end of file + nginx-certs: