Mercurial > repos > melpetera > utilitaires
changeset 4:104715b1913c draft
Uploaded
| author | melpetera |
|---|---|
| date | Thu, 04 Oct 2018 12:13:00 -0400 |
| parents | 2cc6a8076e0a |
| children | 8cbf91971d91 |
| files | CorrTable/Corr.xml CorrTable/Corr_Script_samples_row.R CorrTable/Corr_wrap.r Intchecks/RcheckLibrary.R Intchecks/Script_intensity_check.R Intchecks/wrapper_intensity_check.R Intchecks/xml_intensity_check.xml |
| diffstat | 7 files changed, 562 insertions(+), 774 deletions(-) [+] |
line wrap: on
line diff
--- a/CorrTable/Corr.xml Mon Oct 01 10:00:11 2018 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,299 +0,0 @@ -<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="Both input tables must have the same samples" 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="Both input tables must have the same samples" 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 for calculating 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" expanded="True"> - <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 filter threshold?" type="select" display="radio" help="The zero filter delete variables which have all their correlation coefficients equal to 0. The threshold filter remove 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">Both: zero filter and 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="Graphic outputs" expanded="True"> - <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 means the graphic representation has a scale with a smooth gradient between three colors: red, white and green (continuous case). Customized means classes for the correlation coefficients are created. 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="Size of classes" 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 - PFEM ; INRA - ---------------------------------------------------- - -========================= -Between-table Correlation -========================= - ------------ -Description ------------ - - | Allows to see the link which exists between two data tables, with the creation of a correlation table between the variables of these tables, and a heatmap representing the colored correlation table according to the coefficients. - | - ------------ -Input files ------------ - -+----------------------------+------------+ -| Parameter | Format | -+============================+============+ -| 1 : Table 1 file | tabular | -+----------------------------+------------+ -| 2 : Table 2 file | tabular | -+----------------------------+------------+ - -| -| Both tables must have the same samples. -| - ----------- -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 coefficients. We have 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) is 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 by keeping only variables considered relevant. - | - -| **Choose the filters to apply (only if filter is 'Yes'):** -| - 'Only zero filter': Remove variables which have all their correlation coefficients equal to zero -| - 'Both: zero filter and threshold filter': Remove variables which have all their correlation coefficients, in absolute value, strictly below a threshold - -| *Choose a threshold (only if zero filter and threshold filter are 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 for the 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 graphic 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 value 0, 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 in its own right, 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 are not all the same size. -| It is possible to do as many classes as you want, and of all sizes. 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 have to 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 in its own right, 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 - | Dimension: number of variables in table 2 * number of variables in table 1 - | - -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
--- a/CorrTable/Corr_Script_samples_row.R Mon Oct 01 10:00:11 2018 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,397 +0,0 @@ - ################################################################################################# - # 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()) - getwd() - 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("\nBoth tables do not match regarding samples identifiers.") - - 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") - } - - - # 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 realize 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 variable(s) 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 variable(s) 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") - } - - # 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]){ - 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 --------------------------------------------------------------------------------- - - 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 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)
--- a/CorrTable/Corr_wrap.r Mon Oct 01 10:00:11 2018 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,78 +0,0 @@ -#!/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-----------------------------------------------------------\n', 'Parameters of the tool "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-----------------------------------------------------------\n','Information 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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Intchecks/RcheckLibrary.R Thu Oct 04 12:13:00 2018 -0400 @@ -0,0 +1,124 @@ +###################################################### +# R check library +# Coded by: M.Petera, +# - - +# R functions to use in R scripts +# (management of various generic subroutines) +# - - +# V0: script structure + first functions +# V1: More detailed error messages in match functions +###################################################### + + +# Generic function to return an error if problems have been encountered - - - - + +check.err <- function(err.stock){ + + # err.stock = vector of results returned by check functions + + if(length(err.stock)!=0){ stop("\n- - - - - - - - -\n",err.stock,"\n- - - - - - - - -\n") } + +} + + + + +# Table match check functions - - - - - - - - - - - - - - - - - - - - - - - - - + +# To check if dataMatrix and (variable or sample)Metadata match regarding identifiers +match2 <- function(dataMatrix, Metadata, Mtype){ + + # dataMatrix = data.frame containing dataMatrix + # Metadata = data.frame containing sampleMetadata or variableMetadata + # Mtype = "sample" or "variable" depending on Metadata content + + err.stock <- NULL # error vector + + id2 <- Metadata[,1] + if(Mtype=="sample"){ id1 <- colnames(dataMatrix)[-1] } + if(Mtype=="variable"){ id1 <- dataMatrix[,1] } + + if( length(which(id1%in%id2))!=length(id1) || length(which(id2%in%id1))!=length(id2) ){ + err.stock <- c("\nData matrix and ",Mtype," metadata do not match regarding ",Mtype," identifiers.") + if(length(which(id1%in%id2))!=length(id1)){ + if(length(which(!(id1%in%id2)))<4){ err.stock <- c(err.stock,"\n The ") + }else{ err.stock <- c(err.stock,"\n For example, the ") } + err.stock <- c(err.stock,"following identifiers found in the data matrix\n", + " do not appear in the ",Mtype," metadata file:\n") + identif <- id1[which(!(id1%in%id2))][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)){ + if(length(which(!(id2%in%id1)))<4){ err.stock <- c(err.stock,"\n The ") + }else{ err.stock <- c(err.stock,"\n For example, the ") } + err.stock <- c(err.stock,"following identifiers found in the ",Mtype," metadata file\n", + " do not appear in the data matrix:\n") + identif <- id2[which(!(id2%in%id1))][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") + } + + return(err.stock) + +} + +# To check if the 3 standard tables match regarding identifiers +match3 <- function(dataMatrix, sampleMetadata, variableMetadata){ + + # dataMatrix = data.frame containing dataMatrix + # sampleMetadata = data.frame containing sampleMetadata + # variableMetadata = data.frame containing variableMetadata + + err.stock <- NULL # error vector + + id1 <- colnames(dataMatrix)[-1] + id2 <- sampleMetadata[,1] + id3 <- dataMatrix[,1] + id4 <- variableMetadata[,1] + + if( length(which(id1%in%id2))!=length(id1) || length(which(id2%in%id1))!=length(id2) ){ + err.stock <- c(err.stock,"\nData matrix and sample metadata do not match regarding sample identifiers.") + if(length(which(id1%in%id2))!=length(id1)){ + if(length(which(!(id1%in%id2)))<4){ err.stock <- c(err.stock,"\n The ") + }else{ err.stock <- c(err.stock,"\n For example, the ") } + err.stock <- c(err.stock,"following identifiers found in the data matrix\n", + " do not appear in the sample metadata file:\n") + identif <- id1[which(!(id1%in%id2))][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)){ + if(length(which(!(id2%in%id1)))<4){ err.stock <- c(err.stock,"\n The ") + }else{ err.stock <- c(err.stock,"\n For example, the ") } + err.stock <- c(err.stock,"following identifiers found in the sample metadata file\n", + " do not appear in the data matrix:\n") + identif <- id2[which(!(id2%in%id1))][1:min(3,length(which(!(id2%in%id1))))] + err.stock <- c(err.stock," ",paste(identif,collapse="\n "),"\n") + } + } + + if( length(which(id3%in%id4))!=length(id3) || length(which(id4%in%id3))!=length(id4) ){ + err.stock <- c(err.stock,"\nData matrix and variable metadata do not match regarding variable identifiers.") + if(length(which(id3%in%id4))!=length(id3)){ + if(length(which(!(id3%in%id4)))<4){ err.stock <- c(err.stock,"\n The ") + }else{ err.stock <- c(err.stock,"\n For example, the ") } + err.stock <- c(err.stock,"following identifiers found in the data matrix\n", + " do not appear in the variable metadata file:\n") + identif <- id3[which(!(id3%in%id4))][1:min(3,length(which(!(id3%in%id4))))] + err.stock <- c(err.stock," ",paste(identif,collapse="\n "),"\n") + } + if(length(which(id4%in%id3))!=length(id4)){ + if(length(which(!(id4%in%id3)))<4){ err.stock <- c(err.stock,"\n The ") + }else{ err.stock <- c(err.stock,"\n For example, the ") } + err.stock <- c(err.stock,"following identifiers found in the variable metadata file\n", + " do not appear in the data matrix:\n") + identif <- id4[which(!(id4%in%id3))][1:min(3,length(which(!(id4%in%id3))))] + err.stock <- c(err.stock," ",paste(identif,collapse="\n "),"\n") + } + } + + if(length(err.stock)!=0){ err.stock <- c(err.stock,"\nPlease check your data.\n") } + + return(err.stock) + +} \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Intchecks/Script_intensity_check.R Thu Oct 04 12:13:00 2018 -0400 @@ -0,0 +1,264 @@ +#################################################################### +# SCRIPT INTENSITY CHECK +# V1: Fold and NA +# +# Input: Data Matrix, VariableMetadata, SampleMetadata +# Output: VariableMetadata, Graphics (barplots and boxplots) +# +# Dependencies: RcheckLibrary.R +# +#################################################################### + + +# Parameters (for dev) +if(FALSE){ + + rm(list = ls()) + setwd("Y:\\Developpement\\Intensity check\\Pour tests") + + DM.name <- "DM_NA.tabular" + SM.name <- "SM_NA.tabular" + VM.name <- "vM_NA.tabular" + type <- "One_class" + class.col <- "2" + class1 <- "Blanks" + VM.output <- "new_VM.txt" + graphs.output <- "Barplots_and_Boxplots.pdf" +} + +intens_check <- function(DM.name, SM.name, VM.name, type, class.col, class1, VM.output, graphs.output){ + # This function allows to check the intensities considering classes with a fold calculation, the number and + # the proportion of NA + # + # Two options: + # - one class (selected by the user) against all the remaining samples ("One_class") + # - tests on each class ("Each_class") + # + # Parameters: + # DM.name, SM.name, VM.name: dataMatrix, sampleMetadata, variableMetadata files access + # type: "One_class" or "Each_class" + # class.col: number of the sampleMetadata's column with classes + # class1: name of the class if type="One_class" + # VM.output: output file's access (VM with the new columns) + # graphs.output: pdf with barplots for the proportion of NA and boxplots with the folds values + + + + + # Input --------------------------------------------------------- + + DM <- read.table(DM.name, header=TRUE, sep="\t", check.names=FALSE) + SM <- read.table(SM.name, header=TRUE, sep="\t", check.names=FALSE) + VM <- read.table(VM.name, header=TRUE, sep="\t", check.names=FALSE) + + + + # Table match check with Rchecklibrary + table.check <- match3(DM, SM, VM) + check.err(table.check) + + + rownames(DM) <- DM[,1] + var_names <- DM[,1] + DM <- DM[,-1] + DM <- data.frame(t(DM)) + + class.col <- colnames(SM)[as.numeric(class.col)] + + # check class.col, class1 and the number of classes--------------- + + if(!(class.col %in% colnames(SM))){ + stop("\n- - - - - - - - -\n", "The column ",class.col, " is not a part of the specify sample Metadata","\n- - - - - - - - -\n") + } + + c_class <- SM[,class.col] + c_class <- as.factor(c_class) + nb_class <- nlevels(c_class) + classnames <- levels(c_class) + + + if((nb_class > (nrow(SM))/3)){ + class.err <- c("\n There are too many classes, think about reducing the number of classes and excluding those + with few samples \n") + cat(class.err) + } + + if(type == "One_class"){ + if(!(class1 %in% classnames)){ + list.class1 <- c("\n Classes:",classnames,"\n") + cat(list.class1) + err.class1 <- c("The class ",class1, " does not appear in the column ", class.col) + stop("\n- - - - - - - - -\n", err.class1,"\n- - - - - - - - -\n") + } + } + + #If type is "one_class", change others classes in "other" + if(type == "One_class"){ + for(i in 1:length(c_class)){ + if(c_class[i]!=class1){ + c_class <- as.character(c_class) + c_class[i] <- "Other" + c_class <- as.factor(c_class) + nb_class <- nlevels(c_class) + classnames <- levels(c_class) + + } + } + } + + DM <- cbind(DM,c_class) + + # fold ------------------------------------------------------- + n <- 1 + fold <- data.frame() + for(j in 1:(nb_class-1)){ + for(k in (j+1):nb_class) { + for (i in 1:(length(DM)-1)){ + fold[i,n] <- mean(DM[which(DM$c_class==classnames[k]),i], na.rm=TRUE)/ + mean(DM[which(DM$c_class==classnames[j]),i], na.rm=TRUE)} + names(fold)[n] <- paste("fold",classnames[k],"VS", classnames[j], sep="_") + n <- n + 1} + } + + # NA --------------------------------------------------------- + calcul_NA <- data.frame() + pct_NA <- data.frame() + for (i in 1:(length(DM)-1)){ + for (j in 1:nb_class){ + n <- 0 + new_DM <- DM[which(DM$c_class==classnames[j]),i] + for(k in 1:length(new_DM)){ + if (is.na(new_DM[k])){ + n <- n + 1} + calcul_NA[i,j] <- n + pct_NA[i,j] <- (calcul_NA[i,j]/length(new_DM))*100} + } + } + names(calcul_NA) <- paste("Nb_NA",classnames, sep="_") + names(pct_NA) <- paste("Pct_NA", classnames, sep="_") + + # Alert message if there is no NA + + sumNA <- colSums(calcul_NA) + sum_total <- sum(sumNA) + + alerte <- NULL + if(sum_total==0){ + alerte <- c(alerte, "Data Matrix contains no NA.\n") + } + + if(length(alerte) != 0){ + cat(alerte,"\n") + } + + table_NA <- cbind(calcul_NA, pct_NA) + + # check columns names ---------------------------------------- + + # Fold + VM.names <- colnames(VM) + fold.names <- colnames(fold) + + for (i in 1:length(VM.names)){ + for (j in 1:length(fold.names)){ + if (VM.names[i]==fold.names[j]){ + fold.names[j] <- paste(fold.names[j],"2", sep="_") + } + } + } + colnames(fold) <- fold.names + + # NA + NA.names <- colnames(table_NA) + + for (i in 1:length(VM.names)){ + for (j in 1:length(NA.names)){ + if (VM.names[i]==NA.names[j]){ + NA.names[j] <- paste(NA.names[j],"2", sep="_") + } + } + } + colnames(table_NA) <- NA.names + + #for NA barplots --------------------------------------------- + + data_bp <- data.frame() + + for (j in 1:ncol(pct_NA)){ + Nb_NA_0_20 <- 0 + Nb_NA_20_40 <- 0 + Nb_NA_40_60 <- 0 + Nb_NA_60_80 <- 0 + Nb_NA_80_100 <- 0 + for (i in 1:nrow(pct_NA)){ + + if ((0<=pct_NA[i,j])&(pct_NA[i,j]<20)){ + Nb_NA_0_20=Nb_NA_0_20+1 + } + + if ((20<=pct_NA[i,j])&(pct_NA[i,j]<40)){ + Nb_NA_20_40=Nb_NA_20_40+1} + + if ((40<=pct_NA[i,j])&(pct_NA[i,j]<60)){ + Nb_NA_40_60=Nb_NA_40_60+1} + + if ((60<=pct_NA[i,j])&(pct_NA[i,j]<80)){ + Nb_NA_60_80=Nb_NA_60_80+1} + + if ((80<=pct_NA[i,j])&(pct_NA[i,j]<=100)){ + Nb_NA_80_100=Nb_NA_80_100+1} + } + data_bp[1,j] <- Nb_NA_0_20 + data_bp[2,j] <- Nb_NA_20_40 + data_bp[3,j] <- Nb_NA_40_60 + data_bp[4,j] <- Nb_NA_60_80 + data_bp[5,j] <- Nb_NA_80_100 + } + rownames(data_bp) <- c("0-20%", "20-40%", "40-60%", "60-80%", "80-100%") + colnames(data_bp) <- classnames + data_bp <- as.matrix(data_bp) + + + # Output-------------------------------------------------------- + + VM <- cbind(VM,fold,table_NA) + + write.table(VM, VM.output,sep="\t", quote=FALSE, row.names=FALSE) + + #graphics pdf + + pdf(graphs.output) + + #Boxplots for NA + + par(mar=c(5.1, 4.1, 4.1, 8.1), xpd=TRUE) + + bp=barplot(data_bp, col=rainbow(nrow(data_bp)), main="Proportion of NA", xlab="Classes", ylab="Variables") + legend("topright", fill=rainbow(nrow(data_bp)),rownames(data_bp), inset=c(-0.3,0)) + + + stock=0 + for (i in 1:nrow(data_bp)){ + text(bp, stock+data_bp[i,]/2, data_bp[i,], col="white") + stock <- stock+data_bp[i,] + } + + + #Boxplots for fold test + for (j in 1:ncol(fold)){ + title=paste(fold.names[j]) + boxplot(fold[j], main=title) + } + + dev.off() + +} + + +# Function call--------------- + +#setwd("Y:\\Developpement\\Intensity check\\Pour tests") +#intens_check("DM_NA.tabular", "SM_NA.tabular", "VM_NA.tabular", "One_class", "class", "Blanks", "VM_oneclass_NA.txt", +#"Barplots_and_Boxplots") + + \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Intchecks/wrapper_intensity_check.R Thu Oct 04 12:13:00 2018 -0400 @@ -0,0 +1,49 @@ +#!/usr/bin/Rscript --vanilla --slave --no-site-file + +#################################################################### +# WRAPPER for INTENSITY CHECK +#Script: Script_intensity_check_v1.R +#Xml: xml_intensity_check_v1.xml +# +# V1: Fold and NA +# +# Input: Data Matrix, VariableMetadata, SampleMetadata +# Output: VariableMetadata, Graphics (barplots and boxplots) +# +# +#################################################################### + + +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("Script_intensity_check.R", "RcheckLibrary.R") + + +if(length(args) < 7){ stop("NOT enough argument !!!") } + +class1 <- NULL +if(args$type == "One_class"){ + class1 <- args$class1 +} + +#print args +cat("\n-------------------------------\nIntensity Check parameters:\n\n") +print(args) +cat("--------------------------------\n") + + +intens_check(args$dataMatrix_in, args$sampleMetadata_in, args$variableMetadata_in, args$type, + args$class_col, class1, args$variableMetadata_out, args$graphs_out) + +sessionInfo() +cat("--------------------------------\n") + +#delete the parameters to avoid the passage to the next tool in .RData image +rm(args)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Intchecks/xml_intensity_check.xml Thu Oct 04 12:13:00 2018 -0400 @@ -0,0 +1,125 @@ +<tool id="intens_check" name="Intensity Check" version="1.0.1"> + <description>Adding informations about intensities in the Variable metadata</description> + <requirements> + <requirement type="package" version="1.1_4">r-batch</requirement> + </requirements> + <command interpreter="Rscript"> + + wrapper_intensity_check.R + + dataMatrix_in "$dataMatrix_in" + sampleMetadata_in "$sampleMetadata_in" + variableMetadata_in "$variableMetadata_in" + + class_col "$class_col" + + type "${type_cond.type}" + #if $type_cond.type == "One_class" : + class1 "${type_cond.class1}" + #end if + + variableMetadata_out "$variableMetadata_out" + graphs_out "$graphs_out" + </command> + + <inputs> + <param name="dataMatrix_in" type="data" label="Data Matrix file" help="" format="tabular" /> + <param name="sampleMetadata_in" type="data" label="Sample metadata file" help="" format="tabular" /> + <param name="variableMetadata_in" type="data" label="Variable metadata file" help="" format="tabular" /> + + <param name="class_col" type="data_column" data_ref="sampleMetadata_in" use_header_names="true" label="Class column" help="Class column in Sample metadata" /> + + <conditional name="type_cond"> + <param name="type" type="select" label="Type" display="radio" help="Which class do you want to test ?"> + <option value="One_class">Tests between one class and the remaining samples </option> + <option value="Each_class">Tests for each class </option> + </param> + <when value="One_class"> + <param name="class1" type="text" label="Selected class" help="This class is the numerator for the fold test" /> + </when> + <when value="Each_class"> + </when> + </conditional> + + </inputs> + + <outputs> + <data name="variableMetadata_out" label="IC_${variableMetadata_in.name}" format="tabular" /> + <data name="graphs_out" label="IC_Graphs" format="pdf" /> + </outputs> + + <help> + +.. class:: infomark + +**Authors** + | Anthony Fernandes - PFEM ; INRA + +--------------------------------------------------- + +======================== +Intensity Check +======================== + +----------- +Description +----------- + +This tool performs two tests: the fold calculation, the number and the proportion of missing values. + +**Fold:** +The test calculates the ratio between two classes. +In the column name, the first class specified is the one used like numerator for the ratio. + +**Missing values:** +This tool calculates the number and the proportion of missing values considering the class. +Missing values in numerical columns of data must be coded NA. + +**Two types of tests:** + | - Between **one class** and the remaining samples: if you have only two classes or if you want to test only one class. + | - **Each class**: if the column class contains at least three classes and you want to test each of them. + +----------- +Input files +----------- + ++----------------------------+------------+ +| Parameter | Format | ++============================+============+ +| 1 : Data Matrix file | tabular | ++----------------------------+------------+ +| 2 : Sample metadata file | tabular | ++----------------------------+------------+ +| 3 : Variable metadata file | tabular | ++----------------------------+------------+ + +---------- +Parameters +---------- + +**Class column** + | Select the class column in Sample metadata. + +**Type** + | Two options: + | - "One class" allows to perform tests on one class against the remaining samples. + | - "Each class" allows to add several columns with the ratio and the number of missing values for each class. + +**Selected class** + | If the type is "one class", specify it to calculate the ratio and the number of missing values. + +------------ +Output file +------------ + +**Variable metadata file** + | Contains the previous columns in variable metadata and the new ones with fold tests, numbers and proportion of missing values. + +**Graphs file** + | Contains barplots with the proportion of NA considering classes and boxplots with the folds values + + </help> + + +</tool> + \ No newline at end of file