diff w4mcorcov_calc.R @ 2:e03582f26617 draft

planemo upload for repository https://github.com/HegemanLab/w4mcorcov_galaxy_wrapper/tree/master commit 7682e8e7ae2bfb926d94b414b9a1649389f33582
author eschen42
date Sun, 12 Nov 2017 19:45:36 -0500
parents 0c2ad44b6c9c
children 5aaab36bc523
line wrap: on
line diff
--- a/w4mcorcov_calc.R	Sun Oct 22 18:47:57 2017 -0400
+++ b/w4mcorcov_calc.R	Sun Nov 12 19:45:36 2017 -0500
@@ -7,8 +7,8 @@
 #### OPLS-DA
 algoC <- "nipals"
 
-do_detail_plot <- function(x_dataMatrix, x_predictor, x_is_match, x_algorithm, x_prefix, x_show_labels, x_progress = print, x_env) {
-  off <- function(x) if (x_show_labels == "0") x else 0
+do_detail_plot <- function(x_dataMatrix, x_predictor, x_is_match, x_algorithm, x_prefix, x_show_labels, x_show_loado_labels, x_progress = print, x_env) {
+  off <- function(x) if (x_show_labels == "0") 0 else x
   if (x_is_match && ncol(x_dataMatrix) > 0 && length(unique(x_predictor))> 1) {
     my_oplsda <- opls(
         x      = x_dataMatrix
@@ -34,7 +34,7 @@
         lim_x <- max(sapply(X=c(min_x, max_x), FUN=abs))
         covariance <- covariance / lim_x
         lim_x <- 1.2
-        main_label <- sprintf("%s for levels %s versus %s", x_prefix, fctr_lvl_1, fctr_lvl_2)
+        main_label <- sprintf("%s for level %s versus %s", x_prefix, fctr_lvl_1, fctr_lvl_2)
         main_cex <- min(1.0, 46.0/nchar(main_label))
         # "It is generally accepted that a variable should be selected if vj>1, [27–29],
         #   but a proper threshold between 0.83 and 1.21 can yield more relevant variables according to [28]."
@@ -50,8 +50,8 @@
           y = plus_cor
         , x = plus_cov
         , type="p"
-        , xlim=c(-lim_x, lim_x + off(0.1))
-        , ylim=c(-1.0 - off(0.1), 1.0)
+        , xlim=c( -lim_x - off(0.2), lim_x + off(0.2) )
+        , ylim=c( -1.0   - off(0.2), 1.0   + off(0.2) )
         , xlab = sprintf("relative covariance(feature,t1)")
         , ylab = sprintf("correlation(feature,t1)")
         , main = main_label
@@ -62,8 +62,8 @@
         )
         low_x <- -0.7 * lim_x
         high_x <- 0.7 * lim_x
-        text(x = low_x, y = -0.05, labels =  fctr_lvl_1)
-        text(x = high_x, y = 0.05, labels =  fctr_lvl_2)
+        text(x = low_x, y = -0.05, labels =  fctr_lvl_1, col = "blue")
+        text(x = high_x, y = 0.05, labels =  fctr_lvl_2, col = "red")
         if ( x_show_labels != "0" ) {
           my_loadp <- loadp
           my_loado <- loado
@@ -77,17 +77,22 @@
           n_labels <- min( n_labels, (1 + length(loadp)) / 2 )
           labels_to_show <- c(
             names(head(sort(my_loadp),n = n_labels))
-          , names(head(sort(my_loado),n = n_labels))
           , names(tail(sort(my_loadp),n = n_labels))
-          , names(tail(sort(my_loado),n = n_labels))
           )
+          if ( x_show_loado_labels ) {
+            labels_to_show <- c(
+              labels_to_show
+            , names(head(sort(my_loado),n = n_labels))
+            , names(tail(sort(my_loado),n = n_labels))
+            )
+          }
           labels <- unname(sapply( X = tsv1$featureID, FUN = function(x) if( x %in% labels_to_show ) x else "" ))
           text(
             y = plus_cor - 0.013
           , x = plus_cov + 0.020
-          , cex = 0.3
+          , cex = 0.4
           , labels = labels
-          , col = rgb(blue = blue, red = red, green = 0, alpha = 0.2 + 0.8 * alpha)
+          , col = rgb(blue = 0, red = 0, green = 0, alpha = 0.5) # rgb(blue = blue, red = red, green = 0, alpha = 0.2 + 0.8 * alpha)
           , srt = -30 # slant 30 degrees downward
           , adj = 0   # left-justified
           )
@@ -164,6 +169,7 @@
   # matchingC is one of { "none", "wildcard", "regex" }
   matchingC <- calc_env$matchingC
   labelFeatures <- calc_env$labelFeatures
+  labelOrthoFeatures <- calc_env$labelOrthoFeatures
 
   # arg/env checking
   if (!(facC %in% names(smpl_metadata))) {
@@ -297,6 +303,7 @@
         , x_algorithm   = algoC
         , x_prefix      = if (pairSigFeatOnly) "Significantly contrasting features" else "Significant features"
         , x_show_labels = labelFeatures
+        , x_show_loado_labels = labelOrthoFeatures
         , x_progress    = progress_action
         , x_env         = calc_env
         )
@@ -352,6 +359,7 @@
           , x_algorithm   = algoC
           , x_prefix      = if (pairSigFeatOnly) "Significantly contrasting features" else "Significant features"
           , x_show_labels = labelFeatures
+          , x_show_loado_labels = labelOrthoFeatures
           , x_progress    = progress_action
           , x_env         = calc_env
           )
@@ -404,6 +412,7 @@
               , x_algorithm   = algoC
               , x_prefix      = "Features"
               , x_show_labels = labelFeatures
+              , x_show_loado_labels = labelOrthoFeatures
               , x_progress    = progress_action
               , x_env         = calc_env
               )
@@ -448,6 +457,7 @@
             , x_algorithm   = algoC
             , x_prefix      = "Features"
             , x_show_labels = labelFeatures
+            , x_show_loado_labels = labelOrthoFeatures
             , x_progress    = progress_action
             , x_env         = calc_env
             )