diff --git a/DESCRIPTION b/DESCRIPTION index 3e635c6..2a41c36 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: soda Title: Simple Omics Data Analysis -Version: 0.8.55 +Version: 0.8.55.9000 Authors@R: c(person(given = "Yassene", family = "Mohammed", diff --git a/R/class_lips_exp.R b/R/class_lips_exp.R index f168cea..b9a1781 100644 --- a/R/class_lips_exp.R +++ b/R/class_lips_exp.R @@ -272,6 +272,7 @@ Lips_exp = R6::R6Class( pca_scores_table = NULL, pca_loadings_table = NULL, dbplot_table = NULL, + fa_analysis_table = NULL, # GSEA & over representation gsea_prot_list = NULL, @@ -292,6 +293,7 @@ Lips_exp = R6::R6Class( heatmap = NULL, pca_plot = NULL, double_bond_plot = NULL, + fa_analysis_plot = NULL, # Functional analysis plots dotplot = NULL, @@ -486,6 +488,14 @@ Lips_exp = R6::R6Class( self$params$or_emap_plot$enable_physics = enable_physics }, + param_fa_analysis_plot = function(data_table, feature_meta, sample_meta, group_column, pathway, img_format) { + self$params$fa_analysis_plot$data_table = data_table + self$params$fa_analysis_plot$feature_meta = feature_meta + self$params$fa_analysis_plot$sample_meta = sample_meta + self$params$fa_analysis_plot$group_col = group_column + self$params$fa_analysis_plot$pathway = pathway + self$params$fa_analysis_plot$img_format = img_format + }, #-------------------------------------------------------- Table methods ---- @@ -859,9 +869,12 @@ Lips_exp = R6::R6Class( self$param_ridge_plot(showCategory = 30, img_format = "png") - - - + self$param_fa_analysis_plot(data_table = self$tables$raw_data, + feature_meta = self$tables$feature_table, + sample_meta = self$tables$raw_meta, + group_column = self$indices$group_col, + pathway = NULL, + img_format = "png") @@ -2246,7 +2259,110 @@ Lips_exp = R6::R6Class( layout(xaxis = list(title = 'Count') ) self$plots$or_barplot = fig + }, + + + plot_fa_analysis = function(data_table = self$tables$raw_data, + feature_table = self$tables$feature_table, + sample_meta = self$tables$raw_meta, + group_col = self$indices$group_col, + pathway = self$params$fa_analysis_plot$pathway, + colour_list, + width = NULL, + height = NULL) { + + ## At the moment this function is using the raw data table + # do the calculations + res <- fa_analysis_calc(data_table = data_table, + feature_table = feature_table, + sample_meta = sample_meta) + + + # Produce the class x group table + # add ID's, group's and make long + res$ID <- rownames(res) + res$group <- sample_meta[res$ID, group_col] + res_long <- res |> + tidyr::pivot_longer(cols = -c(ID, group), + names_to = "fa_chain", + values_to = "value") + + # calculate mean and stdev per group + plot_table <- tapply(as.data.frame(res_long), list(res_long$group, res_long$fa_chain), function(x) { + avg <- mean(x[, "value"], na.rm = TRUE) + stdev <- sd(x[, "value"], na.rm = TRUE) + + return(list(avg = avg, + stdev = stdev, + fa_chain = x[1, "fa_chain"], + group = x[1, "group"])) + # print(x) + }) + + plot_table <- do.call(rbind.data.frame, plot_table) + + # filter plot_table based on pathway selection + pathway_fa <- c( + paste(seq(16, 26, 2), 0, sep = ":"), + paste(seq(16, 24, 2), 1, sep = ":"), + c("18:2", "18:3", "20:2", "20:3", "20:4", + "22:4", "22:5","24:4", "24:5"), + c("18:3", "18:4", "20:3", "20:4", "20:5", + "22:5", "22:6", "24:5", "24:6") + ) + names(pathway_fa) <- c(rep("SFA", 6), + rep("MUFA", 5), + rep("PUFA6", 9), + rep("PUFA3", 9)) + + if(!is.null(pathway)) { + selected_pathway_fa <- unique(pathway_fa[names(pathway_fa) %in% pathway]) + plot_table <- plot_table[plot_table$fa_chain %in% selected_pathway_fa, ] + } + + # Store the plot_table + self$tables$fa_analysis_table <- plot_table + + # plotting + i <- 1 + fig <- plotly::plot_ly(colors = colour_list, width = width, height = height) + for (grp in unique(plot_table$group)) { + fig <- fig |> + plotly::add_trace(data = plot_table[plot_table$group == grp, ], + x = ~fa_chain, + y = ~avg, + color = colour_list[i], + type = "bar", + name = grp, + error_y = ~ list(array = stdev, + color = "#000000")) + fig <- fig |> + plotly::layout(legend = list(orientation = 'h', + xanchor = "center", + x = 0.5), + xaxis = list(title = "Fatty acid chain"), + yaxis = list(title = "Concentration")) + i <- i + 1 + } + fig <- fig |> + plotly::layout(annotations = + list(x = 1, + y = -0.175, + text = "NOTE: error bars are standard deviation", + showarrow = FALSE, + xref = "paper", + yref = "paper", + xanchor = "right", + yanchor = "auto", + xshift = 0, + yshift = 0, + font = list(size = 10)) + ) + fig + + self$plots$fa_analysis_plot <- fig } + #------------------------------------------------------------------ END ---- ) ) diff --git a/R/plotboxes_lipidomics.R b/R/plotboxes_lipidomics.R index 89a0ebb..2297f8e 100644 --- a/R/plotboxes_lipidomics.R +++ b/R/plotboxes_lipidomics.R @@ -1476,4 +1476,139 @@ db_plot_events = function(r6, dimensions_obj, color_palette, input, output, sess )) } }) -} \ No newline at end of file +} + + +#-----------------------------------------------------------FA analysis index ---- +fa_analysis_generate = function(r6, colour_list, dimensions_obj, input) { + print_tm(r6$name, "Fatty acid analysis index plot: generating plot.") + + if (input$fa_analysis_plotbox$maximized){ + width = dimensions_obj$xpx_total * dimensions_obj$x_plot_full + height = dimensions_obj$ypx_total * dimensions_obj$y_plot_full + } else { + width = dimensions_obj$xpx * dimensions_obj$x_plot + height = dimensions_obj$ypx * dimensions_obj$y_plot + } + + r6$plot_fa_analysis(data_table = r6$tables$raw_data, #table_switch(input$class_comparison_dataset, r6), + group_col = input$fa_analysis_metacol, + colour_list = colour_list, + width = width, + height = height) +} + +fa_analysis_spawn = function(r6, format, output) { + print_tm(r6$name, "Fatty acid analysis index: spawning plot.") + + output$fa_analysis_plot = plotly::renderPlotly({ + r6$plots$fa_analysis_plot + plotly::config(r6$plots$fa_analysis_plot, toImageButtonOptions = list(format = format, + filename = timestamped_name('fa_analysis'), + height = NULL, + width = NULL, + scale = 1)) + }) +} + +fa_analysis_ui = function(dimensions_obj, session) { + # add function to show bs4dash with plotting function + get_plotly_box(id = "fa_analysis", + label = "Fatty acid analysis", + dimensions_obj = dimensions_obj, + session = session) +} + +fa_analysis_server = function(r6, output, session) { + ns = session$ns + print_tm(r6$name, "Fatty acid analysis index: START.") + + # set some UI + output$fa_analysis_sidebar_ui = shiny::renderUI({ + shiny::tagList( + shiny::selectInput( + inputId = ns("fa_analysis_metacol"), + label = "Select group column", + choices = colnames(r6$tables$raw_meta), + selected = r6$params$fa_analysis_plot$group_col + ), + shiny::selectInput( + inputId = ns("fa_analysis_pathway"), + label = "Select pathway", + choices = c("SFA" = "SFA", + "MUFA" = "MUFA", + "PUFA(n-6)" = "PUFA6", + "PUFA(n-3)" = "PUFA3"), + selected = "", + multiple = TRUE, + width = "100%"), + shiny::hr(style = "border-top: 1px solid #7d7d7d;"), + shiny::selectInput( + inputId = ns("fa_analysis_img_format"), + label = "Image format", + choices = c("png", "svg", "jpeg", "webp"), + selected = r6$params$fa_analysis_plot$img_format, + width = "100%"), + shiny::downloadButton( + outputId = ns("download_fa_analysis_table"), + label = "Download associated table", + style = "width:100%;" + ) + ) + }) +} + +fa_analysis_events = function(r6, dimensions_obj, color_palette, input, output, session) { + # Generate the plot + shiny::observeEvent(c(input$fa_analysis_metacol, + input$fa_analysis_pathway, + input$fa_analysis_img_format), { + print_tm(r6$name, "Fatty acid analysis: Updating params...") + + r6$param_fa_analysis_plot(data_table = r6$tables$raw_data, + feature_meta = r6$tables$feature_table, + sample_meta = r6$tables$raw_meta, + group_col = input$fa_analysis_metacol, + pathway = input$fa_analysis_pathway, + img_format = input$fa_analysis_img_format) + + base::tryCatch({ + fa_analysis_generate(r6, color_palette, dimensions_obj, input) + fa_analysis_spawn(r6, input$fa_analysis_img_format, output) + }, + error = function(e) { + print_tm(r6$name, 'Fatty acid analysis error, missing data.') + print(e) + }, + finally = {} + ) + }) + + # Download associated table + output$download_fa_analysis_table = shiny::downloadHandler( + filename = function(){timestamped_name("fa_analysis_table.csv")}, + content = function(file_name){ + write.csv(r6$tables$fa_analysis_table, file_name) + } + ) + + # Expanded boxes + fa_analysis_proxy = plotly::plotlyProxy(outputId = "fa_analysis_plot", + session = session) + + shiny::observeEvent(input$fa_analysis_plotbox,{ + if (input$fa_analysis_plotbox$maximized) { + plotly::plotlyProxyInvoke(p = fa_analysis_proxy, + method = "relayout", + list(width = dimensions_obj$xpx_total * dimensions_obj$x_plot_full, + height = dimensions_obj$ypx_total * dimensions_obj$y_plot_full + )) + } else { + plotly::plotlyProxyInvoke(p = fa_analysis_proxy, + method = "relayout", + list(width = dimensions_obj$xpx * dimensions_obj$x_plot, + height = dimensions_obj$ypx * dimensions_obj$y_plot + )) + } + }) +} diff --git a/R/serv_lipidomics.R b/R/serv_lipidomics.R index 5252bb2..2c2e02e 100644 --- a/R/serv_lipidomics.R +++ b/R/serv_lipidomics.R @@ -9,7 +9,8 @@ plotbox_switch_ui_lips = function(selection_list){ "select_volcano_plot" = volcano_plot_ui, "select_heatmap" = heatmap_ui, "select_pca" = pca_ui, - "select_double_bond_plot" = double_bonds_ui + "select_double_bond_plot" = double_bonds_ui, + "select_fa_analysis_plot" = fa_analysis_ui ) ) } @@ -25,7 +26,8 @@ plotbox_switch_server_lips = function(selection_list){ "select_volcano_plot" = volcano_plot_server, "select_heatmap" = heatmap_server, "select_pca" = pca_server, - "select_double_bond_plot" = double_bonds_server + "select_double_bond_plot" = double_bonds_server, + "select_fa_analysis_plot" = fa_analysis_server ) ) } @@ -2124,6 +2126,8 @@ lipidomics_server = function(id, ns, input, output, session, module_controler) { heatmap_events(r6, dimensions_obj, color_palette, input, output, session) pca_events(r6, dimensions_obj, color_palette, input, output, session) db_plot_events(r6, dimensions_obj, color_palette, input, output, session) + fa_analysis_events(r6, dimensions_obj, color_palette, input, output, session) + session$userData[[id]]$showPlots = shiny::observeEvent(input$showPlots,{ # Update x dimensions in px and bs, and y in px diff --git a/R/utils.R b/R/utils.R index 0c9e852..9f8f3e3 100644 --- a/R/utils.R +++ b/R/utils.R @@ -119,7 +119,8 @@ lipidomics_plot_list = function() { "Volcano plot" = "select_volcano_plot", "Heatmap" = "select_heatmap", "PCA" = "select_pca", - "Double bond plot" = "select_double_bond_plot" + "Double bond plot" = "select_double_bond_plot", + "Fatty acid analysis" = "select_fa_analysis_plot" ) return(plot_list) } @@ -1494,3 +1495,61 @@ get_cp_results = function(object, showCategory) { } return(df) } + +#------------------------------------------------------ Fatty acid analysis ---- +fa_analysis_calc <- function(data_table = NULL, + feature_table = NULL, + sample_meta = NULL) { + ## Features + # remove PA and TG + feature_table$lipid <- rownames(feature_table) + sel_feat_idx <- feature_table$lipid[!(feature_table$lipid_class %in% c("PA", "TG"))] + sel_feature_table <- feature_table[feature_table$lipid %in% sel_feat_idx, ] + + ## Data + # remove PA and TG + sel_data_table <- data_table[, sel_feat_idx] + + # get the unique chain lengths and unsaturation + uniq_carbon <- sort(union(unique(sel_feature_table$carbons_1), + unique(sel_feature_table$carbons_2))) + uniq_carbon <- uniq_carbon[uniq_carbon != 0] + uniq_unsat <- sort(union(unique(sel_feature_table$unsat_1), + unique(sel_feature_table$unsat_2))) + + # Initialize results data.frame + fa_chains <- expand.grid(uniq_unsat, uniq_carbon) + fa_chains <- paste(fa_chains[, 2], fa_chains[, 1], sep = ":") + res <- as.data.frame(matrix(ncol = length(fa_chains), + nrow = nrow(sel_data_table))) + colnames(res) <- fa_chains + rownames(res) <- rownames(sel_data_table) + + # do the calculations + for(a in uniq_carbon) { + for(b in uniq_unsat) { + sel_fa_chain <- paste(a, b, sep = ":") + sel_lipids <- sel_feature_table$lipid[(sel_feature_table$carbons_1 == a & + sel_feature_table$unsat_1 == b) | + (sel_feature_table$carbons_2 == a & + sel_feature_table$unsat_2 == b)] + sel_lipids_double <- sel_feature_table$lipid[(sel_feature_table$carbons_1 == a & + sel_feature_table$unsat_1 == b) & + (sel_feature_table$carbons_2 == a & + sel_feature_table$unsat_2 == b)] + + res[, sel_fa_chain] <- `+`( + rowSums(sel_data_table[, sel_lipids, drop = FALSE], na.rm = TRUE), + rowSums(sel_data_table[, sel_lipids_double, drop = FALSE], na.rm = TRUE) + ) + } + } + + # remove empty columns + empty_idx <- apply(res, 2, function(x) { + all(x == 0) + }) + res <- res[, !empty_idx] + + return(res) +}