Mercurial > repos > melpetera > corr_table
changeset 0:b22c453e4cf4 draft
Uploaded
| author | melpetera |
|---|---|
| date | Thu, 11 Oct 2018 05:35:55 -0400 |
| parents | |
| children | 29ec7e3afdd4 |
| files | CorrTable/Corr.xml CorrTable/Corr_Script_samples_row.R CorrTable/Corr_wrap.r |
| diffstat | 3 files changed, 790 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/CorrTable/Corr.xml Thu Oct 11 05:35:55 2018 -0400 @@ -0,0 +1,300 @@ +<tool id="corrtable" name="Between-table Correlation" version="0.0.0"> + <description>Correlation table between two tables and graphic representation </description> + <requirements> + <requirement type="package" version="1.1_4">r-batch</requirement> + <requirement type="package" version="3.0.0">r-ggplot2</requirement> + <requirement type="package" version="1.4.3">r-reshape2</requirement> + </requirements> + <command interpreter="Rscript"> + + Corr_wrap.r + + tab1_in "$tab1_in" + tab2_in "$tab2_in" + + tab1_samples "$tab1_samples" + tab2_samples "$tab2_samples" + + corr_method "$corr_method" + + test_corr "${filter_section.testcorr_cond.test_corr}" + #if str($filter_section.testcorr_cond.test_corr) == 'yes' : + correct_multi "${filter_section.testcorr_cond.correct_multi}" + risk_alpha "${filter_section.testcorr_cond.risk_alpha}" + #end if + + filter "${filter_section.filter_cond.filter}" + #if str($filter_section.filter_cond.filter) == 'yes' : + filters_choice "${filter_section.filter_cond.filtchoice_cond.filters_choice}" + #if str($filter_section.filter_cond.filtchoice_cond.filters_choice) == 'filters_0_thr' : + threshold "${filter_section.filter_cond.filtchoice_cond.threshold}" + #end if + #end if + + reorder_var "$out_section.reorder_var" + + color_heatmap "${out_section.heatmap_cond.color_heatmap}" + #if str($out_section.heatmap_cond.color_heatmap) == 'yes' : + type_classes "${out_section.heatmap_cond.typeclass_cond.type_classes}" + #if str($out_section.heatmap_cond.typeclass_cond.type_classes) == 'regular' : + reg_class_value "${out_section.heatmap_cond.typeclass_cond.reg_class_value}" + #elif str($out_section.heatmap_cond.typeclass_cond.type_classes) == 'irregular' : + irreg_class_vect "${out_section.heatmap_cond.typeclass_cond.irreg_class_vect}" + #end if + #end if + + tabcorr_out "$tabcorr_out" + heatmap_out "$heatmap_out" + + </command> + + <inputs> + + <param name="tab1_in" type="data" label="Table 1 file" help="The two input tables must have the same sample IDs" format="tabular" /> + <param name="tab1_samples" label="Where are the samples in table 1?" type="select" display="radio" help=""> + <option value="row">Row</option> + <option value="column">Column</option> + </param> + + <param name="tab2_in" type="data" label="Table 2 file" help="The two input tables must have the same sample IDs" format="tabular" /> + <param name="tab2_samples" label="Where are the samples in table 2?" type="select" display="radio" help=""> + <option value="row">Row</option> + <option value="column">Column</option> + </param> + + <param name="corr_method" label="Method to calculate the correlation coefficients" type="select" help=""> + <option value="pearson">Pearson</option> + <option value="spearman">Spearman</option> + <option value="kendall">Kendall</option> + </param> + + <section name="filter_section" title="Filtering options" expanded="False"> + <conditional name="testcorr_cond"> + <param name="test_corr" label="Significance test for the correlation coefficients" type="select" display="radio" help=""> + <option value="no">No</option> + <option value="yes">Yes</option> + </param> + <when value="yes"> + <param name="correct_multi" label="Method for multiple testing correction" type="select" help=""> + <option value="none">none</option> + <option value="fdr">fdr</option> + <option value="BH">BH</option> + <option value="bonferroni">bonferroni</option> + <option value="BY">BY</option> + <option value="hochberg">hochberg</option> + <option value="holm">holm</option> + <option value="hommel">hommel</option> + </param> + <param name="risk_alpha" label="(Corrected) p-value significance threshold" type="float" value="0.05" help="Must be between 0 and 1" /> + </when> + <when value="no"> + </when> + </conditional> + + <conditional name="filter_cond"> + <param name="filter" label="Filter the correlation table" type="select" display="radio" help=""> + <option value="no">No</option> + <option value="yes">Yes</option> + </param> + + <when value ="yes"> + <conditional name="filtchoice_cond"> + <param name="filters_choice" label="Do you want to use only zero filter or combine it with the threshold filter?" type="select" display="radio" help="The zero filter removes variables which have all their correlation coefficients equal to 0. The threshold filter removes variables which have all their correlation coefficients, in absolute value, strictly below a threshold."> + <option value="filter_0">Only zero filter</option> + <option value="filters_0_thr">Threshold filter</option> + </param> + + <when value="filters_0_thr"> + <param name="threshold" label="Threshold" type="float" value="" help="Must be between 0 and 1" /> + </when> + + <when value="filter_0"> + </when> + </conditional> + </when> + + <when value="no"> + </when> + </conditional> + </section> + + <section name="out_section" title="Graphical outputs" expanded="False"> + <param name="reorder_var" label="Reorder variables (using Hierarchical Cluster Analysis)" type="select" display="radio" help=""> + <option value="no">No</option> + <option value="yes">Yes</option> + </param> + + <conditional name="heatmap_cond"> + <param name="color_heatmap" label="Colored correlation table strategy" type="select" display="radio" help="Standard corresponds to a scale with a smooth gradient between three colors: red, white and green (continuous case). Customized creates classes for the correlation coefficients - the scale has discrete values."> + <option value="no">Standard</option> + <option value="yes">Customized</option> + </param> + + <when value="yes"> + <conditional name="typeclass_cond"> + <param name="type_classes" label="Choose the type of classes" type="select" display="radio" help="Regular means the classes have the same size. Irregular means it is possible to choose any intervals." > + <option value="regular">Regular classes</option> + <option value="irregular">Irregular classes</option> + </param> + + <when value="regular"> + <param name="reg_class_value" label="Class size" type="float" value="" help="Must be between 0 and 1" /> + </when> + + <when value="irregular"> + <param name="irreg_class_vect" label="Vector with values for classes" type="text" value="" help="The vector must be of the following form: (value1,value2,value3,..). The values must be between -1 and 1 not included. For example: (-0.8,-0.5,-0.4,0,0.4,0.5,0.8)." /> + </when> + </conditional> + </when> + + <when value ="no"> + </when> + + </conditional> + </section> + + </inputs> + + <outputs> + <data name="tabcorr_out" label="CorrTable" format="tabular" /> + <data name="heatmap_out" label="CT_plot" format="pdf" /> + </outputs> + + <help> + +.. class:: infomark + +**Author:** +Ophelie Barbet for original code (PFEM - INRA) +Maintainer: Melanie Petera (PFEM - INRA - MetaboHUB) + +--------------------------------------------------- + +========================= +Between-table Correlation +========================= + +----------- +Description +----------- + + | Allows to visualise links existing between two data tables, with the creation of a correlation table between the variables of these tables, and a heatmap representing the correlation table colored according to the coefficients. + | + +----------- +Input files +----------- + ++----------------------------+------------+ +| Parameter | Format | ++============================+============+ +| 1 : Table 1 file | tabular | ++----------------------------+------------+ +| 2 : Table 2 file | tabular | ++----------------------------+------------+ + +| +| The two input tables must have the same sample IDs. +| + +---------- +Parameters +---------- + +Positions of samples in table 1 and table 2 +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + | Essential to correctly calculate the correlations. + | + +Method for calculating the correlation coefficients +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + | - 'Pearson': Measures the intensity of the linear association between two continuous variables. + | - The 'Spearman' and 'Kendall' methods are explained in the R documentation of the 'cor' function as follows: " Kendall's tau or Spearman's rho statistic is used to estimate a rank-based measure of association. These are more robust and have been recommended if the data do not necessarily come from a bivariate normal distribution.". + | + +Significance test for the correlation coefficients +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + | This test is performed on each correlation coefficient, with the following hypotheses: + | H0: The correlation coefficient is not significantly different from zero. + | H1: The correlation coefficient is significantly different from zero. + | + | Coefficients whose null hypothesis (H0) are not rejected are replaced by zeros in the correlation table. + | + +| **Method for multiple testing correction (only if significance test is 'Yes'):** +| The 7 methods implemented in the 'p.adjust' R function are available and documented as follows: +| "The adjustment methods include the Bonferroni correction ("bonferroni") in which the p-values are multiplied by the number of comparisons. Less conservative corrections are also included by Holm (1979) ("holm"), Hochberg (1988) ("hochberg"), Hommel (1988) ("hommel"), Benjamini and Hochberg (1995) ("BH" or its alias "fdr"), and Benjamini and Yekutieli (2001) ("BY"), respectively. A pass-through option ("none") is also included. The set of methods are contained in the p.adjust.methods vector for the benefit of methods that need to have the method as an option and pass it on to p.adjust. The first four methods are designed to give strong control of the family-wise error rate. There seems no reason to use the unmodified Bonferroni correction because it is dominated by Holm's method, which is also valid under arbitrary assumptions. Hochberg's and Hommel's methods are valid when the hypothesis tests are independent or when they are non-negatively associated (Sarkar, 1998; Sarkar and Chang, 1997). Hommel's method is more powerful than Hochberg's, but the difference is usually small and the Hochberg p-values are faster to compute. The "BH" (aka "fdr") and "BY" method of Benjamini, Hochberg, and Yekutieli control the false discovery rate, the expected proportion of false discoveries amongst the rejected hypotheses. The false discovery rate is a less stringent condition than the family-wise error rate, so these methods are more powerfil than the others." +| + +| **(Corrected) p-value significance threshold (only if significance test is 'Yes'):** +| A value between 0 and 1, usually 0.05. +| + +Filter the correlation table +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + | Allows to reduce the correlation table size by keeping only variables considered relevant. + | + +| **Choose the filters to apply (only if filter is 'Yes'):** +| - 'Only zero filter': Remove variables with all their correlation coefficients equal to zero. +| - 'Threshold filter': Remove variables with all their correlation coefficients (in absolute value) strictly below a threshold. + +| *Choose a threshold (only threshold filter is used):* A value between 0 and 1. +| + +Reorder variables using Hierarchical Cluster Analysis (HCA) +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + | Allows the most linked variables to be close in the correlation table. + | A HCA is performed on each input tables, with: + | - 1 - correlation coefficient, as distance + | - Ward as aggregation method. + | + + +Colored correlation table strategy +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + | Allows to create a colored correlation table. Variables of table 1 and variables of table 2 are related using colored rectangles. + | About the colors, the negative correlations are in red, more or less intense according to their position between -1 and 0, and the positive correlations in green, more or less intense according to their position between 0 and 1. The coefficients equal to 0 are in white. + | - 'Standard': the graphical representation has a scale with a smooth gradient between three colors: red, white and green. + | - 'Customized': the colored correlation table has coefficient classes. It is possible to create regular or irregular classes. The scale is discreet. + | + +| **Choose the type of classes (only if colored correlation table strategy is 'Customized'):** + +| - 'Regular': classes are all (or almost) the same size. +| To realize these intervals, we start from 1 to go to 0 by taking a step of the size chosen by the user, and we make the symmetry for -1 towards 0. If the last step does not fall on the 0 value, we create a class between this last value and 0, smaller in size than the others. It is important to specify that 0 represents a class on its own, which is assigned the color white for the heatmap. + +| *Size of classes (if regular classes):* A value between 0 and 1. + +| Example: if the size is 0.4, classes are [-1;-0.6], ]-0.6;-0.2], ]-0.2;0[, 0, ]0;0.2], ]0.2;0.6] and ]0.6;1]. +| + +| - 'Irregular': classes have variable lengths. +| It is possible to do as many classes as you want, and of any size. There is not necessarily symmetry between -1 and 0, and 0 and 1. You can choose to have a white class with only 0, or an interval which contains the value 0. + +| *Vector with values for classes (if irregular classes):* The values in the vector must be between -1 and 1 excluded, and in ascending order. It must have this form (value1,value2,...). If the vector contains 0, then this value becomes a class on its own, otherwise the white class is the one which contains 0. + +| Example: if the vector is (-0.8,-0.5,-0.4,0,0.4,0.5,0.8), the classes are [-1;-0.8], ]-0.8;-0.5], ]-0.5;-0.4], ]-0.4;0[, 0, ]0;0.4], ]0.4;0.5], ]0.5;0.8] and ]0.8;1]. +| + + +------------ +Output files +------------ + +Correlation Table +^^^^^^^^^^^^^^^^^ + | Tabular output + | Correlation table between the variables of the two input tables + | + +Heatmap (colored correlation table) +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + | Pdf output + | Colored representation of the correlation table. The coefficients are replaced by colors. A coefficient close to -1 is red, close to 0 white, and close to 1 in green. + | + + + </help> + +</tool> \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/CorrTable/Corr_Script_samples_row.R Thu Oct 11 05:35:55 2018 -0400 @@ -0,0 +1,410 @@ + ################################################################################################# + # CORRELATION TABLE # + # # + # # + # Input : 2 tables with common samples # + # Output : Correlation table ; Heatmap (pdf) # + # # + # Dependencies : Libraries "ggplot2" and "reshape2" # + # # + ################################################################################################# + + + # Parameters (for dev) + if(FALSE){ + + rm(list = ls()) + setwd(dir = "Y:/Developpement") + + tab1.name <- "Test/Ressources/Inputs/CT2_DM.tabular" + tab2.name <- "Test/Ressources/Inputs/CT2_base_Diapason_14ClinCES_PRIN.txt" + param1.samples <- "column" + param2.samples <- "row" + corr.method <- "pearson" + test.corr <- "yes" + alpha <- 0.05 + multi.name <- "none" + filter <- "yes" + filters.choice <- "filters_0_thr" + threshold <- 0.2 + reorder.var <- "yes" + color.heatmap <- "yes" + type.classes <-"irregular" + reg.value <- 1/3 + irreg.vect <- c(-0.3, -0.2, -0.1, 0, 0.3, 0.4) + output1 <- "Correlation_table.txt" + output2 <- "Heatmap.pdf" + + } + + + + correlation.tab <- function(tab1.name, tab2.name, param1.samples, param2.samples, corr.method, test.corr, alpha, + multi.name, filter, filters.choice, threshold, reorder.var, color.heatmap, type.classes, + reg.value, irreg.vect, output1, output2){ + + # This function allows to visualize the correlation between two tables + # + # Parameters: + # - tab1.name: table 1 file's access + # - tab2.name: table 2 file's access + # - param1.samples ("row" or "column"): where the samples are in tab1 + # - param2.samples ("row" or "column"): where the samples are in tab2 + # - corr.method ("pearson", "spearman", "kendall"): + # - test.corr ("yes" or "no"): test the significance of a correlation coefficient + # - alpha (value between 0 and 1): risk for the correlation significance test + # - multi.name ("holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none"): correction of multiple tests + # - filter ("yes", "no"): use filter.0 or/and filter.threshold + # - filters.choice ("filter_0" or "filters_0_thr"): zero filter removes variables with all their correlation coefficients = 0 + # and threshold filter remove variables with all their correlation coefficients in abs < threshold + # - threshold (value between 0 and 1): threshold for filter threshold + # - reorder.var ("yes" or "no"): reorder variables in the correlation table thanks to the HCA + # - color.heatmap ("yes" or "no"): color the heatmap with classes defined by the user + # - type.classes ("regular" or "irregular"): choose to color the heatmap with regular or irregular classes + # - reg.value (value between 0 and 1): value for regular classes + # - irreg.vect (vector with values between -1 and 1): vector which indicates values for intervals (irregular classes) + # - output1: correlation table file's access + # - output2: heatmap (colored correlation table) file's access + + + # Input ---------------------------------------------------------------------------------------------- + + tab1 <- read.table(tab1.name, sep = "\t", header = TRUE, check.names = FALSE, row.names = 1) + tab2 <- read.table(tab2.name, sep = "\t", header = TRUE, check.names = FALSE, row.names = 1) + + # Transpose tables according to the samples + if(param1.samples == "column"){ + tab1 <- t(tab1) + } + + if(param2.samples == "column"){ + tab2 <- t(tab2) + } + + # Sorting tables in alphabetical order of the samples + tab1 <- tab1[order(rownames(tab1)),] + tab2 <- tab2[order(rownames(tab2)),] + + + # Check if the 2 datasets match regarding samples identifiers + # Adapt from functions "check.err" and "match2", RcheckLibrary.R + + err.stock <- NULL + + id1 <- rownames(tab1) + id2 <- rownames(tab2) + + if(sum(id1 != id2) > 0){ + err.stock <- c("\nThe two tables do not match regarding sample identifiers.\n") + + if(length(which(id1%in%id2)) != length(id1)){ + identif <- id1[which(!(id1%in%id2))] + if (length(identif) < 4){ + err.stock <- c(err.stock, "\nThe following identifier(s) found in the first table do not appear in the second table:\n") + } + else { + err.stock <- c(err.stock, "\nFor example, the following identifiers found in the first table do not appear in the second table:\n") + } + identif <- identif[1:min(3,length(which(!(id1%in%id2))))] + err.stock <- c(err.stock," ",paste(identif,collapse="\n "),"\n") + } + + if(length(which(id2%in%id1)) != length(id2)){ + identif <- id2[which(!(id2%in%id1))] + if (length(identif) < 4){ + err.stock <- c(err.stock, "\nThe following identifier(s) found in the second table do not appear in the first table:\n") + } + else{ + err.stock <- c(err.stock, "\nFor example, the following identifiers found in the second table do not appear in the first table:\n") + } + identif <- identif[1:min(3,length(which(!(id2%in%id1))))] + err.stock <- c(err.stock," ",paste(identif,collapse="\n "),"\n") + } + err.stock <- c(err.stock,"\nPlease check your data.\n") + } + + if(length(err.stock)!=0){ + stop("\n- - - - - - - - -\n",err.stock,"\n- - - - - - - - -\n\n") + } + + + # Check qualitative variables in each input tables + err.msg <- NULL + + var1.quali <- vector() + var2.quali <- vector() + + for (i in 1:dim(tab1)[2]){ + if(class(tab1[,i]) != "numeric" & class(tab1[,i]) != "integer"){ + var1.quali <- c(var1.quali,i) + } + } + + for (j in 1:dim(tab2)[2]){ + if(class(tab2[,j]) != "numeric" & class(tab2[,j]) != "integer"){ + var2.quali <- c(var2.quali, j) + } + } + + if (length(var1.quali) != 0 | length(var2.quali) != 0){ + err.msg <- c(err.msg, "\nThere are qualitative variables in your input tables which have been removed to compute the correlation table.\n\n") + + if(length(var1.quali) != 0 && length(var1.quali) < 4){ + err.msg <- c(err.msg, "In table 1, the following qualitative variables have been removed:\n", + " ",paste(colnames(tab1)[var1.quali],collapse="\n "),"\n") + } else if(length(var1.quali) != 0 && length(var1.quali) > 3){ + err.msg <- c(err.msg, "For example, in table 1, the following qualitative variables have been removed:\n", + " ",paste(colnames(tab1)[var1.quali[1:3]],collapse="\n "),"\n") + } + + if(length(var2.quali) != 0 && length(var2.quali) < 4){ + err.msg <- c(err.msg, "In table 2, the following qualitative variables have been removed:\n", + " ",paste(colnames(tab2)[var2.quali],collapse="\n "),"\n") + } else if(length(var2.quali) != 0 && length(var2.quali) > 3){ + err.msg <- c(err.msg, "For example, in table 2, the following qualitative variables have been removed:\n", + " ",paste(colnames(tab2)[var2.quali[1:3]],collapse="\n "),"\n") + } + } + + if(length(var1.quali) != 0){ + tab1 <- tab1[,-var1.quali] + } + if(length(var2.quali) != 0){ + tab2 <- tab2[,-var2.quali] + } + + if(length(err.msg) != 0){ + cat("\n- - - - - - - - -\n",err.msg,"\n- - - - - - - - -\n\n") + } + + # Correlation table --------------------------------------------------------------------------------- + + tab.corr <- matrix(nrow = dim(tab2)[2], ncol = dim(tab1)[2]) + for (i in 1:dim(tab2)[2]){ + for (j in 1:dim(tab1)[2]){ + tab.corr[i,j] <- cor(tab2[,i], tab1[,j], method = corr.method, use = "pairwise.complete.obs") + } + } + + colnames(tab.corr) <- colnames(tab1) + rownames(tab.corr) <- colnames(tab2) + + + + # Significance of correlation test ------------------------------------------------------------------ + + if (test.corr == "yes"){ + + pvalue <- vector() + for (i in 1:dim(tab.corr)[1]){ + for (j in 1:dim(tab.corr)[2]){ + suppressWarnings(corrtest <- cor.test(tab2[,i], tab1[,j], method = corr.method)) + pvalue <- c(pvalue, corrtest$p.value) + if (multi.name == "none"){ + if (corrtest$p.value > alpha){ + tab.corr[i,j] <- 0 + } + } + } + } + + if(multi.name != "none"){ + adjust <- matrix(p.adjust(pvalue, method = multi.name), nrow = dim(tab.corr)[1], ncol = dim(tab.corr)[2], byrow = T) + tab.corr[adjust > alpha] <- 0 + } + } + + + # Filter settings ------------------------------------------------------------------------------------ + + if (filter == "yes"){ + + # Remove variables with all their correlation coefficients = 0 : + if (filters.choice == "filter_0"){ + threshold <- 0 + } + + var2.thres <- vector() + for (i in 1:dim(tab.corr)[1]){ + if (length(which(abs(tab.corr[i,]) <= threshold)) == dim(tab.corr)[2]){ + var2.thres <- c(var2.thres, i) + } + } + + if (length(var2.thres) != 0){ + tab.corr <- tab.corr[-var2.thres,] + tab2 <- tab2[, -var2.thres] + } + + var1.thres <- vector() + for (i in 1:dim(tab.corr)[2]){ + if (length(which(abs(tab.corr[,i]) <= threshold)) == dim(tab.corr)[1]){ + var1.thres <- c(var1.thres, i) + } + } + + if (length(var1.thres) != 0){ + tab.corr <- tab.corr[,-var1.thres] + tab1 <- tab1[,-var1.thres] + } + + } + + + # Reorder variables in the correlation table (with the HCA) ------------------------------------------ + if (reorder.var == "yes"){ + + cormat.tab2 <- cor(tab2, method = corr.method, use = "pairwise.complete.obs") + dist.tab2 <- as.dist(1 - cormat.tab2) + hc.tab2 <- hclust(dist.tab2, method = "ward.D2") + tab.corr <- tab.corr[hc.tab2$order,] + + cormat.tab1 <- cor(tab1, method = corr.method, use = "pairwise.complete.obs") + dist.tab1 <- as.dist(1 - cormat.tab1) + hc.tab1 <- hclust(dist.tab1, method = "ward.D2") + tab.corr <- tab.corr[,hc.tab1$order] + + } + + + + # Output 1 : Correlation table ----------------------------------------------------------------------- + + # Export correlation table + write.table(x = data.frame(name = rownames(tab.corr), tab.corr), file = output1, sep = "\t", quote = FALSE, row.names = FALSE) + + + + # Create the heatmap --------------------------------------------------------------------------------- + + # A message if no variable kept + if(length(tab.corr)==0){ + pdf(output2) + plot.new() + legend("center","Filtering leads to no remaining correlation coefficient.") + dev.off() + } else { + + + library(ggplot2) + library(reshape2) + + # Melt the correlation table : + melted.tab.corr <- melt(tab.corr) + + if (color.heatmap == "yes") { + + # Add a column for the classes of each correlation coefficient + classe <- rep(0, dim(melted.tab.corr)[1]) + melted <- cbind(melted.tab.corr, classe) + + if (type.classes == "regular"){ + + vect <- vector() + if (seq(-1,0,reg.value)[length(seq(-1,0,reg.value))] == 0){ + vect <- c(seq(-1,0,reg.value)[-length(seq(-1,0,reg.value))], + rev(seq(1,0,-reg.value))) + } else { + vect <- c(seq(-1,0,reg.value), 0, rev(seq(1,0,-reg.value))) + } + + } else if (type.classes == "irregular") { + + irreg.vect <- c(-1, irreg.vect, 1) + vect <- irreg.vect + + } + + # Color palette : + myPal <- colorRampPalette(c("#00CC00", "white", "red"), space = "Lab", interpolate = "spline") + + # Create vector intervals + cl <- vector() + cl <- paste("[", vect[1], ";", round(vect[2],3), "]", sep = "") + + for (x in 2:(length(vect)-1)) { + if (vect[x+1] == 0) { + cl <- c(cl, paste("]", round(vect[x],3), ";", round(vect[x+1],3), "[", sep = "")) + } else { + cl <- c(cl, paste("]", round(vect[x],3), ";", + round(vect[x+1],3), "]", sep = "")) + } + } + + # Assign an interval to each correlation coefficient + for (i in 1:dim(melted.tab.corr)[1]){ + for (j in 1:(length(cl))){ + if (vect[j] == -1){ + melted$classe[i][melted$value[i] >= vect[j] + && melted$value[i] <= vect[j+1]] <- cl[j] + } else { + melted$classe[i][melted$value[i] > vect[j] + && melted$value[i] <= vect[j+1]] <- cl[j] + } + } + } + + # Find the 0 and assign it the white as name + if (length(which(vect == 0)) == 1) { + melted$classe[melted$value == 0] <- "0" + indic <- which(vect == 0) + cl <- c(cl[1:(indic-1)], 0, cl[indic:length(cl)]) + names(cl)[indic] <- "#FFFFFF" + } else if (length(which(vect == 0)) == 0) { + indic <- 0 + for (x in 1:(length(vect)-1)) { + if (0 > vect[x] && 0 <= vect[x+1]) { + names(cl)[x] <- "#FFFFFF" + indic <- x + } + } + } + + indic <- length(cl) - indic + 1 + cl <- rev(cl) + + # Assign the colors of each intervals as their name + names(cl)[1:(indic-1)] <- myPal(length(cl[1:indic])*2-1)[1:indic-1] + names(cl)[(indic+1):length(cl)] <- myPal(length(cl[indic:length(cl)])*2-1)[(ceiling(length(myPal(length(cl[indic:length(cl)])*2-1))/2)+1):length(myPal(length(cl[indic:length(cl)])*2-1))] + + + melted$classe <- factor(melted$classe) + melted$classe <- factor(melted$classe, levels = cl[cl%in%levels(melted$classe)]) + + # Heatmap if color.heatmap = yes : + ggplot(melted, aes(Var2, Var1, fill = classe)) + + ggtitle("Colored correlation table" ) + xlab("Table 1") + ylab("Table 2") + + geom_tile(color ="ghostwhite") + + scale_fill_manual( breaks = levels(melted$classe), + values = names(cl)[cl%in%levels(melted$classe)], + name = paste(corr.method, "correlation", sep = "\n")) + + theme_classic() + + theme(axis.text.x = element_text(angle = 90, vjust = 0.5), + plot.title = element_text(hjust = 0.5)) + + } else { + + # Heatmap if color.heatmap = no : + ggplot(melted.tab.corr, aes(Var2, Var1, fill = value)) + + ggtitle("Colored correlation table" ) + xlab("Table 1") + ylab("Table 2") + + geom_tile(color ="ghostwhite") + + scale_fill_gradient2(low = "red", high = "#00CC00", mid = "white", midpoint = 0, limit = c(-1,1), + name = paste(corr.method, "correlation", sep = "\n")) + + theme_classic() + + theme(axis.text.x = element_text(angle = 90, vjust = 0.5), + plot.title = element_text(hjust = 0.5)) + } + + + ggsave(output2, device = "pdf", width = 10+0.075*dim(tab.corr)[2], height = 5+0.075*dim(tab.corr)[1], limitsize = FALSE) + + + } # End if(length(tab.corr)==0)else + + } # End of correlation.tab + + + # Function call + # correlation.tab(tab1.name, tab2.name, param1.samples, param2.samples, corr.method, test.corr, alpha, multi.name, filter, + # filters.choice, threshold, reorder.var, color.heatmap, type.classes, + # reg.value, irreg.vect, output1, output2)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/CorrTable/Corr_wrap.r Thu Oct 11 05:35:55 2018 -0400 @@ -0,0 +1,80 @@ +#!/usr/bin/Rscript --vanilla --slave --no-site-file + +################################################################################################ +# WRAPPER FOR Corr_Script_samples_row.R (CORRELATION TABLE) # +# # +# Author: Ophelie BARBET # +# User: Galaxy # +# Original data: used with Corr_Script_samples_row.R # +# Starting date: # +# V-1: First version of wrapper # +# # +# # +# Input files: 2 tables with common samples file # +# Output files: Correlation table ; Heatmap file # +# # +################################################################################################ + + +library(batch) #necessary for parseCommandArgs function +args = parseCommandArgs(evaluate=FALSE) #interpretation of arguments given in command line as an R list of objects + +source_local <- function(...){ + argv <- commandArgs(trailingOnly = FALSE) + base_dir <- dirname(substring(argv[grep("--file=", argv)], 8)) + for(i in 1:length(list(...))){source(paste(base_dir, list(...)[[i]], sep="/"))} +} +#Import the different functions +source_local("Corr_Script_samples_row.R") + + +if(length(args) < 10){ stop("NOT enough argument !!!") } + + +cat('\n--------------------------------------------------------------------', +'\nParameters used in "Between-table Correlation":\n\n') +print(args) +cat('--------------------------------------------------------------------\n\n') + + +risk_alpha <- NULL +correct_multi <- NULL +if(args$test_corr == "yes"){ + risk_alpha <- args$risk_alpha + correct_multi <- args$correct_multi +} + +filters_choice <- NULL +threshold <- NULL +if(args$filter == "yes"){ + filters_choice <- args$filters_choice + if(filters_choice == "filters_0_thr"){ + threshold <- args$threshold + } +} + +type_classes <- NULL +reg_class_value <- NULL +irreg_class_vect <- NULL +if(args$color_heatmap == "yes"){ + type_classes <- args$type_classes + if(type_classes == "regular"){ + reg_class_value <- args$reg_class_value + } else if(type_classes == "irregular"){ + irreg_class_vect <- eval(parse(text=paste0("c",args$irreg_class_vect))) + } +} + + +correlation.tab(args$tab1_in, args$tab2_in, args$tab1_samples, args$tab2_samples, args$corr_method, args$test_corr, risk_alpha, correct_multi, args$filter, filters_choice, threshold, +args$reorder_var, args$color_heatmap, type_classes, reg_class_value, irreg_class_vect, args$tabcorr_out, args$heatmap_out) + + +cat('\n--------------------------------------------------------------------', +'\nInformation about R (version, Operating System, attached or loaded packages):\n\n') +sessionInfo() +cat('--------------------------------------------------------------------\n\n') + + +#delete the parameters to avoid the passage to the next tool in .RData image +rm(args) \ No newline at end of file