Mercurial > repos > eschen42 > w4mcorcov
changeset 11:ddcc33ff3205 draft
planemo upload for repository https://github.com/HegemanLab/w4mcorcov_galaxy_wrapper/tree/master commit 4428e3252d54c8a8e0e5d85e8eaaeb13e9b21de7
| author | eschen42 |
|---|---|
| date | Wed, 05 Sep 2018 22:31:21 -0400 |
| parents | 9a52306991b3 |
| children | ddaf84e15d06 |
| files | w4mcorcov.xml w4mcorcov_calc.R w4mcorcov_lib.R w4mcorcov_util.R w4mcorcov_wrapper.R |
| diffstat | 5 files changed, 216 insertions(+), 113 deletions(-) [+] |
line wrap: on
line diff
--- a/w4mcorcov.xml Sat Sep 01 11:33:03 2018 -0400 +++ b/w4mcorcov.xml Wed Sep 05 22:31:21 2018 -0400 @@ -1,4 +1,4 @@ -<tool id="w4mcorcov" name="OPLS-DA_Contrasts" version="0.98.14"> +<tool id="w4mcorcov" name="OPLS-DA_Contrasts" version="0.98.15"> <description>OPLS-DA Contrasts of Univariate Results</description> <macros> <xml name="paramPairSigFeatOnly"> @@ -419,20 +419,20 @@ <has_text text="vip4o" /> <!-- first matched line --> <has_text text="M349.2383T700" /> - <has_text text="-0.37867079" /> - <has_text text="-37.71066" /> - <has_text text="0.5246766" /> - <has_text text="0.0103341" /> + <has_text text="0.43361563" /> + <has_text text="37.76875778" /> + <has_text text="0.54672558" /> + <has_text text="0.3920409" /> <!-- second matched line --> <has_text text="M207.9308T206" /> - <has_text text="0.31570433" /> - <has_text text="5.86655640" /> - <has_text text="0.2111623" /> - <has_text text="0.0488654" /> + <has_text text="-0.3365475" /> + <has_text text="-6.337903" /> + <has_text text="0.270297" /> + <has_text text="0.037661" /> </assert_contents> </output> </test> - <!-- test #6 --> + <!-- test #6 - issue 6 --> <test> <param name="dataMatrix_in" value="input_dataMatrix.tsv"/> <param name="sampleMetadata_in" value="issue6_input_sampleMetadata.tsv"/> @@ -461,6 +461,32 @@ </assert_contents> </output> </test> + <!-- test #6 - issue 8 --> + <test> + <param name="dataMatrix_in" value="input_dataMatrix.tsv"/> + <param name="sampleMetadata_in" value="issue8_input_sampleMetadata.tsv"/> + <param name="variableMetadata_in" value="input_variableMetadata.tsv"/> + <param name="tesC" value="none"/> + <param name="facC" value="k._10"/> + <param name="labelFeatures" value="3"/> + <param name="levCSV" value="k_3,k-4"/> + <param name="matchingC" value="none"/> + <output name="contrast_corcov"> + <assert_contents> + <!-- column-labels line --> + <has_text text="featureID" /> + <has_text text="factorLevel1" /> + <has_text text="factorLevel2" /> + <has_text text="correlation" /> + <has_text text="covariance" /> + <has_text text="vip4p" /> + <has_text text="vip4o" /> + <!-- k1 rejected by levCSV, leaving only k_3 and k-4 --> + <not_has_text text="k1" /> + <not_has_text text="other" /> + </assert_contents> + </output> + </test> </tests> <help><![CDATA[
--- a/w4mcorcov_calc.R Sat Sep 01 11:33:03 2018 -0400 +++ b/w4mcorcov_calc.R Wed Sep 05 22:31:21 2018 -0400 @@ -71,7 +71,9 @@ # print("str(my_cor_vs_cov)") # str(my_cor_vs_cov) if (is.null(my_cor_vs_cov) || sum(!is.na(my_cor_vs_cov$tsv1$covariance)) < 2) { - x_progress("No cor_vs_cov data produced") + if (is.null(cor_vs_cov_x)) { + x_progress("No cor_vs_cov data produced") + } plot(x=1, y=1, xaxt="n", yaxt="n", xlab="", ylab="", type="n") text(x=1, y=1, labels="too few covariance data") return(my_cor_vs_cov) @@ -561,7 +563,8 @@ plot_action <- function(fctr_lvl_1, fctr_lvl_2) { progress_action( sprintf("calculating/plotting contrast of %s vs. %s" - , fctr_lvl_1, fctr_lvl_2)) + , fctr_lvl_1, fctr_lvl_2) + ) predictor <- sapply( X = chosen_facC , FUN = function(fac) if ( fac == fctr_lvl_1 ) fctr_lvl_1 else fctr_lvl_2 @@ -569,7 +572,7 @@ my_cor_cov <- do_detail_plot( x_dataMatrix = my_matrix , x_predictor = predictor - , x_is_match = is_match + , x_is_match = TRUE , x_algorithm = algoC , x_prefix = if (pairSigFeatOnly) { "Significantly contrasting features" @@ -582,7 +585,7 @@ , x_env = calc_env ) if ( is.null(my_cor_cov) ) { - progress_action("NOTHING TO PLOT.") + progress_action("NOTHING TO PLOT") } else { my_tsv <- my_cor_cov$tsv1 my_tsv$mz <- mz_lookup(my_tsv$featureID) @@ -619,57 +622,72 @@ fctr_lvl_2 <- col_match[3] # ^^ # Factor-level 2 # only process this column if both factors are members of lvlCSV is_match <- isLevelSelected(fctr_lvl_1) && isLevelSelected(fctr_lvl_2) - progress_action( - sprintf("calculating/plotting contrast of %s vs. %s" - , fctr_lvl_1, fctr_lvl_2)) - # choose only samples with one of the two factors for this column - chosen_samples <- smpl_metadata_facC %in% c(fctr_lvl_1, fctr_lvl_2) - predictor <- smpl_metadata_facC[chosen_samples] - # extract only the significantly-varying features and the chosen samples - fully_significant <- 1 == vrbl_metadata[,vrbl_metadata_col] * - ( if (intersample_sig_col %in% colnames(vrbl_metadata)) { - vrbl_metadata[,intersample_sig_col] - } else { - 1 - } + if (is_match) { + progress_action( + sprintf("calculating/plotting contrast of %s vs. %s." + , fctr_lvl_1, fctr_lvl_2 + ) ) - col_selector <- vrbl_metadata_names[ - if ( pairSigFeatOnly ) fully_significant else overall_significant - ] - my_matrix <- tdm[ chosen_samples, col_selector, drop = FALSE ] - my_cor_cov <- do_detail_plot( - x_dataMatrix = my_matrix - , x_predictor = predictor - , x_is_match = is_match - , x_algorithm = algoC - , x_prefix = if (pairSigFeatOnly) { - "Significantly contrasting features" - } else { - "Significant features" - } - , x_show_labels = labelFeatures - , x_progress = progress_action - , x_crossval_i = min(7, length(chosen_samples)) - , x_env = calc_env - ) - if ( is.null(my_cor_cov) ) { - progress_action("NOTHING TO PLOT.") + # choose only samples with one of the two factors for this column + chosen_samples <- smpl_metadata_facC %in% c(fctr_lvl_1, fctr_lvl_2) + predictor <- smpl_metadata_facC[chosen_samples] + # extract only the significantly-varying features and the chosen samples + fully_significant <- 1 == vrbl_metadata[,vrbl_metadata_col] * + ( if (intersample_sig_col %in% colnames(vrbl_metadata)) { + vrbl_metadata[,intersample_sig_col] + } else { + 1 + } + ) + col_selector <- vrbl_metadata_names[ + if ( pairSigFeatOnly ) fully_significant else overall_significant + ] + my_matrix <- tdm[ chosen_samples, col_selector, drop = FALSE ] + my_cor_cov <- do_detail_plot( + x_dataMatrix = my_matrix + , x_predictor = predictor + , x_is_match = is_match + , x_algorithm = algoC + , x_prefix = if (pairSigFeatOnly) { + "Significantly contrasting features" + } else { + "Significant features" + } + , x_show_labels = labelFeatures + , x_progress = progress_action + , x_crossval_i = min(7, length(chosen_samples)) + , x_env = calc_env + ) + if ( is.null(my_cor_cov) ) { + progress_action("NOTHING TO PLOT.") + } else { + tsv <- my_cor_cov$tsv1 + tsv$mz <- mz_lookup(tsv$featureID) + tsv$rt <- rt_lookup(tsv$featureID) + tsv["level1Level2Sig"] <- vrbl_metadata[ + match(tsv$featureID, vrbl_metadata_names) + , vrbl_metadata_col + ] + corcov_tsv_action(tsv) + did_plot <- TRUE + } } else { - tsv <- my_cor_cov$tsv1 - tsv$mz <- mz_lookup(tsv$featureID) - tsv$rt <- rt_lookup(tsv$featureID) - tsv["level1Level2Sig"] <- vrbl_metadata[ - match(tsv$featureID, vrbl_metadata_names) - , vrbl_metadata_col - ] - corcov_tsv_action(tsv) - did_plot <- TRUE + progress_action( + sprintf("skipping contrast of %s vs. %s." + , fctr_lvl_1, fctr_lvl_2 + ) + ) } } } } } else { # tesC == "none" + # find all the levels for factor facC in sampleMetadata level_union <- unique(sort(smpl_metadata_facC)) + # identify the selected levels for factor facC from sampleMetadata + level_include <- sapply(X = level_union, FUN = isLevelSelected) + # discard the non-selected levels for factor facC + level_union <- level_union[level_include] if ( length(level_union) > 1 ) { if ( length(level_union) > 2 ) { ## pass 1 - contrast each selected level with all other levels combined into one "super-level" ## @@ -687,12 +705,11 @@ } chosen_samples <- smpl_metadata_facC %in% c(fctr_lvl_1, fctr_lvl_2) fctr_lvl_2 <- "other" - progress_action( - sprintf("calculating/plotting contrast of %s vs. %s" - , fctr_lvl_1, fctr_lvl_2) - ) if (length(unique(chosen_samples)) < 1) { - progress_action("NOTHING TO PLOT...") + progress_action( + sprintf("Skipping contrast of %s vs. %s; there are no chosen samples." + , fctr_lvl_1, fctr_lvl_2) + ) } else { chosen_facC <- as.character(smpl_metadata_facC[chosen_samples]) predictor <- sapply( @@ -704,25 +721,32 @@ my_matrix <- tdm[ chosen_samples, , drop = FALSE ] # only process this column if both factors are members of lvlCSV is_match <- isLevelSelected(fctr_lvl_1) - my_cor_cov <- do_detail_plot( - x_dataMatrix = my_matrix - , x_predictor = predictor - , x_is_match = is_match - , x_algorithm = algoC - , x_prefix = "Features" - , x_show_labels = labelFeatures - , x_progress = progress_action - , x_crossval_i = min(7, length(chosen_samples)) - , x_env = calc_env - ) - if ( is.null(my_cor_cov) ) { - progress_action("NOTHING TO PLOT") + if (is_match) { + progress_action( + sprintf("Calculating/plotting contrast of %s vs. %s" + , fctr_lvl_1, fctr_lvl_2) + ) + my_cor_cov <- do_detail_plot( + x_dataMatrix = my_matrix + , x_predictor = predictor + , x_is_match = is_match + , x_algorithm = algoC + , x_prefix = "Features" + , x_show_labels = labelFeatures + , x_progress = progress_action + , x_crossval_i = min(7, length(chosen_samples)) + , x_env = calc_env + ) + if ( is.null(my_cor_cov) ) { + progress_action("NOTHING TO PLOT...") + } else { + tsv <- my_cor_cov$tsv1 + tsv$mz <- mz_lookup(tsv$featureID) + tsv$rt <- rt_lookup(tsv$featureID) + corcov_tsv_action(tsv) + did_plot <<- TRUE + } } else { - tsv <- my_cor_cov$tsv1 - tsv$mz <- mz_lookup(tsv$featureID) - tsv$rt <- rt_lookup(tsv$featureID) - corcov_tsv_action(tsv) - did_plot <<- TRUE } } "dummy" # need to return a value; otherwise combn fails with an error @@ -738,43 +762,56 @@ fctr_lvl_1 <- x[1] fctr_lvl_2 <- x[2] chosen_samples <- smpl_metadata_facC %in% c(fctr_lvl_1, fctr_lvl_2) - progress_action( - sprintf("calculating/plotting contrast of %s vs. %s" - , fctr_lvl_1, fctr_lvl_2)) if (length(unique(chosen_samples)) < 1) { - progress_action("NOTHING TO PLOT...") + progress_action( + sprintf("Skipping contrast of %s vs. %s. - There are no chosen samples." + , fctr_lvl_1, fctr_lvl_2 + ) + ) } else { chosen_facC <- as.character(smpl_metadata_facC[chosen_samples]) predictor <- chosen_facC my_matrix <- tdm[ chosen_samples, , drop = FALSE ] # only process this column if both factors are members of lvlCSV is_match <- isLevelSelected(fctr_lvl_1) && isLevelSelected(fctr_lvl_2) - my_cor_cov <- do_detail_plot( - x_dataMatrix = my_matrix - , x_predictor = predictor - , x_is_match = is_match - , x_algorithm = algoC - , x_prefix = "Features" - , x_show_labels = labelFeatures - , x_progress = progress_action - , x_crossval_i = min(7, length(chosen_samples)) - , x_env = calc_env - ) - if ( is.null(my_cor_cov) ) { - progress_action("NOTHING TO PLOT") + if (is_match) { + progress_action( + sprintf("Calculating/plotting contrast of %s vs. %s." + , fctr_lvl_1, fctr_lvl_2) + ) + my_cor_cov <- do_detail_plot( + x_dataMatrix = my_matrix + , x_predictor = predictor + , x_is_match = is_match + , x_algorithm = algoC + , x_prefix = "Features" + , x_show_labels = labelFeatures + , x_progress = progress_action + , x_crossval_i = min(7, length(chosen_samples)) + , x_env = calc_env + ) + if ( is.null(my_cor_cov) ) { + progress_action("NOTHING TO PLOT.....") + } else { + tsv <- my_cor_cov$tsv1 + tsv$mz <- mz_lookup(tsv$featureID) + tsv$rt <- rt_lookup(tsv$featureID) + corcov_tsv_action(tsv) + did_plot <<- TRUE + } } else { - tsv <- my_cor_cov$tsv1 - tsv$mz <- mz_lookup(tsv$featureID) - tsv$rt <- rt_lookup(tsv$featureID) - corcov_tsv_action(tsv) - did_plot <<- TRUE + progress_action( + sprintf("Skipping contrast of %s vs. %s." + , fctr_lvl_1, fctr_lvl_2 + ) + ) } } "dummy" # need to return a value; otherwise combn fails with an error } ) } else { - progress_action("NOTHING TO PLOT....") + progress_action("NOTHING TO PLOT......") } } if (!did_plot) {
--- a/w4mcorcov_lib.R Sat Sep 01 11:33:03 2018 -0400 +++ b/w4mcorcov_lib.R Wed Sep 05 22:31:21 2018 -0400 @@ -1,12 +1,3 @@ suppressMessages(library(batch)) -# suppressMessages(library(foreach)) suppressMessages(library(ropls)) suppressMessages(library(methods)) - -# cat("Installed packages:",stderr()) -# write.table((installed.packages(.Library, priority = "high"))[, c(1,3:5)], stderr()) -# cat("Loaded packages:",stderr()) -# write(.packages(), stderr()) - -print(sessionInfo()) -
--- a/w4mcorcov_util.R Sat Sep 01 11:33:03 2018 -0400 +++ b/w4mcorcov_util.R Wed Sep 05 22:31:21 2018 -0400 @@ -21,10 +21,54 @@ return (retval) } +errorSink <- function(which_function, ...) { + var_args <- "..." + tryCatch( + var_args <<- (deparse(..., width.cutoff = 60)) + , error = function(e) {print(e$message)} + ) + if (var_args == "...") + return + # format error for logging + format_error <- function(e) { + sprintf( + "Error\n{ message: %s\n, arguments: %s\n}\n" + , e$message + , Reduce(f = paste, x = var_args) + ) + } + format_warning <- function(e) { + sprintf( + "Warning\n{ message: %s\n, arguments: %s\n}\n" + , e$message + , Reduce(f = paste, x = var_args) + ) + } + sink_number <- sink.number() + sink(stderr()) + tryCatch( + var_args <- (deparse(..., width.cutoff = 60)) + , expr = { + retval <- which_function(...) + } + , error = function(e) cat(format_error(e), file = stderr()) + , warning = function(w) cat(format_warning(w), file = stderr()) + ) + while (sink.number() > sink_number) { + sink() + } +} +errorPrint <- function(...) { + errorSink(which_function = print, ...) +} +errorCat <- function(...) { + errorSink(which_function = cat, ..., "\n") +} + # # pseudo-inverse - computational inverse of non-square matrix a # p.i <- function(a) { # solve(t(a) %*% a) %*% t(a) # } - +# vim: sw=2 ts=2 et ai :
--- a/w4mcorcov_wrapper.R Sat Sep 01 11:33:03 2018 -0400 +++ b/w4mcorcov_wrapper.R Wed Sep 05 22:31:21 2018 -0400 @@ -72,7 +72,12 @@ # MAIN # ######## +errorPrint(sessionInfo()) + argVc <- unlist(parseCommandArgs(evaluate=FALSE)) +errorCat("\n\n---\n\nArguments that were passed to R are as follows:\n") +errorPrint(argVc) + my_env <- new.env() ##------------------------------