Bug Fixes (#70)

* R script format updates + bug fix

* add verbose to rsync command

* cleanup

* fix R script pageNum bug

Author: mikesioda

resources/R/BioLockJ_Lib.R

@@ -8,35 +8,25 @@ addNamedVectorElement <- function( v, name, value ) {
 }
 
 # Add a page number in the lower right corner of the page
-addPageNumber <- function (pageNum, line=0){
-	mtext(pageNum, side=1, outer=TRUE, line=line, adj = 1)
-	# optional return value
-	if (is.numeric(pageNum) ) pageNum + 1
+addPageNumber <- function( pageNum ){
+	mtext (pageNum, side=1, outer=TRUE, adj=1 )
 }
 
 # Add text to the bottom of the page, centered
 addPageFooter <- function(text, line=0){
-	mtext(text, side=1, outer=TRUE, line=line, adj = .5)
+	mtext(text, side=1, outer=TRUE, line=line, adj=0.5)
 }
 
 # Add a page title
-addPageTitle <- function (main, level=NULL, line=2){
-	mtext(main, side=3, outer = TRUE, font=par("font.main"), cex=par("cex.main"), line=line)
-	if (!is.null(level)){
-		titlePart2 = displayLevel( level )
-		title(main=titlePart2, outer = TRUE, line=(line-1))
-	}
+addPageTitle <- function( main ) {
+	mtext(main, side=3, outer=TRUE, font=par("font.main"), cex=par("cex.main"), line=1)
 }
 
 # Return P value formated with sprintf as defined in MASTER Config r.pValFormat, otherwise use %1.2g default
 displayCalc <- function( pval ) {
 	return( paste( sprintf(getProperty("r.pValFormat", "%1.2g"), pval) ) )
 }
 
-displayLevel <- function(level){
-	return( str_to_title( paste(level,"Level") ) )
-}
-
 # Return TRUE if BioLock property r.debug=Y, otherwise return FALSE
 doDebug <- function() {
 	return( getProperty( "r.debug", FALSE ) )
@@ -250,6 +240,11 @@ getReportFields <- function() {
 	return( c( getBinaryFields(), getNominalFields(), getNumericFields() ) )
 }
 
+# Display R^2 label and value
+displayR2 <- function( val ) {
+	return( bquote( paste( R^2, ": ", .( displayCalc( val ) ) ) ) )
+}
+
 # Return the most recent stats file at the given level based on the suffix returned by statsFileSuffix()
 getStatsTable <- function( level, parametric=NULL, adjusted=TRUE ) {
 	statsFile = pipelineFile( paste0( level, "_", statsFileSuffix( parametric, adjusted ), "$" ) )

resources/R/BioLockJ_MAIN.R

@@ -56,7 +56,6 @@ getModuleScript <- function() {
 		initial.options = commandArgs(trailingOnly=FALSE)
 		script.name <- sub("--file=", "", initial.options[grep("--file=", initial.options)])
 		if( length( script.name ) == 0 ) {
-		
 			if( init( getInteractiveMain() ) ) {
 				script.name = getInteractiveMain() 
 			}

resources/R/R_PlotMds.R

@@ -1,10 +1,9 @@
 # Module script for: biolockj.module.report.r.R_PlotMds
 
 # Import vegan library for distance plot support
-# Main function generates 3 MDS plots for each attribute at each level in taxaLevels()
+# Main function generates numAxis MDS plots for each field at each level in taxaLevels()
 main <- function() { 
    importLibs( c( "vegan" ) )
-   numAxis = getProperty("r_PlotMds.numAxis")
    mdsFields = getProperty( "r_PlotMds.reportFields", c( getBinaryFields(), getNominalFields() )  )
 
    for( level in taxaLevels() ) {
@@ -13,8 +12,10 @@ main <- function() {
       metaTable = getMetaData( level )
       if( is.null(countTable) || is.null(metaTable) ) { next }
       if( doDebug() ) sink( getLogFile( level ) )
+      logInfo( "mdsFields", mdsFields )
 
       myMDS = capscale( countTable~1, distance=getProperty("r_PlotMds.distance") )
+      numAxis = min( c( getProperty("r_PlotMds.numAxis"), ncol(myMDS$CA$u) ) )
       metaColColors = getColorsByCategory( metaTable )
 
       pcoaFileName = paste0( getPath( file.path(getModuleDir(), "temp"), paste0(level, "_pcoa") ), ".tsv" )
@@ -25,57 +26,42 @@ main <- function() {
       write.table( data.frame(mds=names(myMDS$CA$eig), eig=myMDS$CA$eig), file=eigenFileName, col.names=FALSE, row.names=FALSE, sep="\t")
       logInfo( "Save Eigen value table", pcoaFileName )
 
-      # Make plots
       outputFile = paste0( getPath( getOutputDir(), paste0(level, "_MDS.pdf" ) ) )
       pdf( outputFile, paper="letter", width=7.5, height=10.5 )
-      par(mfrow=c(3, 2), las=1, oma=c(1,0,2,1), mar=c(5, 4, 2, 2), cex=.95)
-      percentVariance = as.numeric(eigenvals(myMDS)/sum( eigenvals(myMDS) ) ) * 100
+      par( mfrow=c(3, 2), las=1, oma=c(1,0,2,1), mar=c(5, 4, 2, 2), cex=0.95 )
+      perVariance = as.numeric(eigenvals(myMDS)/sum( eigenvals(myMDS) ) ) * 100
       pageNum = 0
 
       for( field in mdsFields ){
-        logInfo( "mdsFields", mdsFields )
-        pageNum = pageNum + 1
-         metaColVals = as.character(metaTable[,field])
-         logInfo( "metaColVals", metaColVals )
-         par(mfrow = par("mfrow"), cex = par("cex"))
-         att = as.factor(metaColVals)
-         colorKey = metaColColors[[field]]
-         logInfo( c( "Using colors: ", paste(colorKey, "for", names(colorKey), collapse= ", ")) )
-         position = 1
-         pageNum = 1
-         numAxis = min(c(numAxis, ncol(myMDS$CA$u)))
-         for (x in 1:(numAxis-1)) {
-            for (y in (x+1):numAxis) {
-               if (position > prod(par("mfrow") ) ) {
-                  position = 1
-                  pageNum = pageNum + 1
-               }
-               pch=getProperty("r.pch", 20)
+		par(mfrow = par("mfrow"), cex = par("cex"))
+      position = 1
+
+		metaColVals = as.character(metaTable[,field])
+		colorKey = metaColColors[[field]]
+		
+		logInfo( "metaColVals", metaColVals )
+		logInfo( c( "Using colors: ", paste(colorKey, "for", names(colorKey), collapse= ", ")) )
+         
+		for( x in 1: (numAxis-1) ) {
+			for( y in (x+1): numAxis ) {
+
                plot( myMDS$CA$u[,x], myMDS$CA$u[,y], main=paste("Axes", x, "vs", y),
-                        xlab=getMdsLabel( x, percentVariance[x] ),
-                        ylab=getMdsLabel( y, percentVariance[y] ),
-                        cex=1.2, pch=pch, col=colorKey[metaColVals] )
+                        xlab=getMdsLabel( x, perVariance[x] ),
+                        ylab=getMdsLabel( y, perVariance[y] ),
+                        cex=1.2, pch=getProperty("r.pch", 20), col=colorKey[metaColVals] )
+               
+               
+               if( position == 1 || position > prod( par("mfrow") ) ) {
+					position = 1
+                  	pageNum = pageNum + 1
+                  	addHeaderFooter( field, level, pageNum )
+               	}
+               
                position = position + 1
-               if ( position == 2 ){ 
-                  addPageTitle( field, line=1 )
-                  addPageNumber( pageNum )
-                  addPageFooter( "Multidimensional Scaling" )
-                  # put this plot at the upper right position
-                  # that puts the legend in a nice white space, and it makes axis 1 in line with itself in two plots (same for axis3)
-                  plotRelativeVariance(percentVariance, numAxis)
-                  position = position + 1
-                  title( displayLevel( level ) )
-                  # Add legend
-                  legendKey = colorKey
-                  legendLabels = paste0(names(legendKey), " (n=", table(metaColVals)[names(legendKey)], ")")
-                  legendKey = legendKey[ order(table(metaColVals)[names(colorKey)]) ]
-                  maxInLegend = 6
-                  if (length(colorKey) > (maxInLegend + 1)){
-                    legendKey = c( colorKey[ 1:maxInLegend], NA)
-                    numDropped = length(colorKey) - length(legendKey) + 1
-                    legendLabels = c(legendLabels[1:maxInLegend], paste("(", numDropped, "other labels )"))
-                  }
-                  legend(x="topright", title=field, legend = legendLabels, col=legendKey, pch=pch, bty="n")
+               
+               if( position == 2 ) { 
+					plotRelativeVariance( field, metaColVals, perVariance, level, numAxis, colorKey )
+					position = position + 1
                }
             }
          }
@@ -85,19 +71,42 @@ main <- function() {
    }
 }
 
+# Add page title + footer with page number
+addHeaderFooter <- function( field, level, pageNum ) {
+	addPageTitle( field )
+	addPageNumber( pageNum )
+	addPageFooter( paste( str_to_title( level ), "Multidimensional Scaling" ) )
+}
+
+# Get variance plot label as percentage
 getMdsLabel <- function( axisNum, variance ) { 
-   return( paste0("Axis ", axisNum, " (", paste0( round( variance ), "%)" ) ) )
+   return( paste0("Axis ", axisNum, " ( ", paste0( round( variance ), "% )" ) ) )
 }
 
-plotRelativeVariance <- function(percentVariance, numAxis){
-   numBars = min(c(length(percentVariance), 6)) # arbitrary choice, don't show more than 6
+# This plot is always put in the upper right corner of the page
+plotRelativeVariance <- function( field, metaColVals, perVariance, level, numAxis, colorKey ){
+   numBars = min( c(length(perVariance), maxInLegend) )
    numBars = max(numBars, numAxis)
-   heights = percentVariance[1:numBars]
+   heights = perVariance[1:numBars]
    bp = barplot(heights, col="dodgerblue1", ylim=c(0,100), names=1:numBars,
                       xlab="Axis", ylab="Variance" )
    labels = round(heights)
    near0 = which(labels < 1)
    labels[near0] = "<1"
-   if (numBars <= 6){ labels = paste(labels, "%") }
+   if( numBars <= maxInLegend ) labels = paste( labels, "%" )
    text(x=bp, y=heights, labels = labels, pos=3, xpd=TRUE)
+   title( str_to_title( level ) )
+
+	legendKey = colorKey
+	legendLabels = paste0(names(legendKey), " (n=", table(metaColVals)[names(legendKey)], ")")
+	legendKey = legendKey[ order(table(metaColVals)[names(colorKey)]) ]
+	
+	if (length(colorKey) > (maxInLegend + 1) ){
+		legendKey = c( colorKey[ 1:maxInLegend], NA)
+	    numDropped = length(colorKey) - length(legendKey) + 1
+	    legendLabels = c(legendLabels[1:maxInLegend], paste("(", numDropped, "other labels )"))
+	}
+	legend( "topright", title=field, legend=legendLabels, cex=0.8, col=legendKey, pch=getProperty("r.pch", 20), bty="n" )
 }
+
+maxInLegend = 6

resources/R/R_PlotOtus.R

@@ -16,15 +16,13 @@ addBoxPlot <- function( item, taxaVals, metaVals, barColors )
                      vertical=TRUE, pch=getProperty("r.pch"), add=TRUE )
 }
 
+# Display plot heading with 2 pvalues + R^2 effect size
 plotHeading <- function( parPval, nonParPval, r2, field ) {
    HEAD_1 = 0.2; HEAD_2 = 1.4; LEFT = 0; RIGHT = 1; TOP = 3;
-
-   title1_A = paste( "Adj.", getTestName( field ), "P-value:", displayCalc( parPval ) )
-   title1_B = bquote( paste( R^2, ": ", .( displayCalc( r2 ) ) ) )
+   title1 = paste( "Adj.", getTestName( field ), "P-value:", displayCalc( parPval ) )
    title2 = paste( "Adj.", getTestName( field, FALSE ), "P-value:", displayCalc( nonParPval ) )
-
-   mtext( title1_A, TOP, HEAD_1, col=getColor( parPval ), cex=0.75, adj=LEFT )
-   mtext( title1_B, TOP, HEAD_1, cex=0.75, adj=RIGHT )
+   mtext( title1, TOP, HEAD_1, col=getColor( parPval ), cex=0.75, adj=LEFT )
+   mtext( displayR2( r2 ), TOP, HEAD_1, cex=0.75, adj=RIGHT )
    mtext( title2, TOP, HEAD_2, col=getColor( nonParPval ), cex=0.75, adj=LEFT )
 }
 
@@ -48,12 +46,9 @@ getBoxPlotLabels <- function( labels ) {
 getCexAxis <- function( labels=NULL, returnMax=FALSE, returnMin=FALSE) {
    cexAxisMax = 1
    cexAxisMin = 0.65
-   if (returnMax){
-      return(cexAxisMax)
-   }
-   if (returnMin){
-      return(cexAxisMin)
-   }
+   if ( returnMax ) return( cexAxisMax )
+   if ( returnMin ) return( cexAxisMin )
+   
    nchars = sum(nchar(labels)) + length(labels) - 1
    if( nchars < r.plotWidth ) return( cexAxisMax )
    if( nchars < ( r.plotWidth +7 ) ) return( 0.9 )
@@ -86,58 +81,56 @@ main <- function() {
       binaryCols = getBinaryFields()
       nominalCols = getNominalFields()
       numericCols = getNumericFields()
-
       logInfo( "binaryCols", binaryCols )
       logInfo( "nominalCols", nominalCols )
       logInfo( "numericCols", numericCols )
-
-      reportCols = getReportFields()
-
+      
       parStats = getStatsTable( level, TRUE )
       nonParStats = getStatsTable( level, FALSE )
       r2Stats = getStatsTable( level )
-
       metaColColors = getColorsByCategory( metaTable )
 
       outputFile = getPath( getOutputDir(), paste0(level, "_OTU_plots.pdf") )
       pdf( outputFile, paper="letter", width=7, height=10.5 )
-      
       par(mfrow=c(3, 2), las=1, oma=c(1.2,1,4.5,0), mar=c(5, 4, 3, 2), cex=1)
       pageNum = 0
 
       # if r.rareOtuThreshold > 1, cutoffValue is an absolute threshold, otherwise it's a % of countTable rows
       cutoffValue = getProperty("r.rareOtuThreshold", 1)
-      if( cutoffValue < 1 ) cutoffValue = cutoffValue * nrow(countTable)
+      if( cutoffValue < 1 ) cutoffValue = cutoffValue * nrow( countTable )
 
-      for( item in names(countTable) ) {
+      for( item in names( countTable ) ) {
          if( sum( countTable[,item] > 0 ) >=  cutoffValue ) {
-            par( mfrow = par("mfrow") ) # step to next pageNum, even if the last page is not full
-            position = 1
-            pageNum = pageNum + 1
+         	
+         	# Every item starts a new page
+            par( mfrow = par("mfrow") ) 
+            position = 0
+
             taxaVals = countTable[,item]
 
-            for( meta in reportCols ) {
+            for( meta in getReportFields() ) {
+            
                metaVals = metaTable[,meta]
                if( meta %in% binaryCols || meta %in% nominalCols ) {
-                  logInfo( c( "Plot Box-Plot [", item, "~", meta, "]" ) )
+                  logInfo( c( "Add Box-Plot [", item, "~", meta, "]" ) )
                   addBoxPlot( item, taxaVals, metaVals, metaColColors[[meta]] )
                }
-               else if( meta %in% numericCols ) {
-                  logInfo( c( "Plot Scatter-Plot [", item, "~", meta, "]" ) )
+               else {
+                  logInfo( c( "Add Scatter-Plot [", item, "~", meta, "]" ) )
                   addScatterPlot( item, taxaVals, metaVals )
                }
 
-               plotHeading( parStats[ item, meta ], nonParStats[ item, meta ], r2Stats[ item, meta], meta )
+               plotHeading( parStats[item, meta], nonParStats[item, meta], r2Stats[item, meta], meta )
                mtext( meta, side=1, font=1, cex=1, line=2.5 )
                position = position + 1
 
-               if(position == 2) {
-                  addPageTitle( item )
-                  addPageNumber( pageNum )
-               }
-               if( position > prod( par("mfrow") ) ) {
-                  position = 1
-                  pageNum = pageNum + 1
+			   if( position == 1 ) {
+			   		pageNum = pageNum + 1
+            			addHeaderFooter( item, level, pageNum )
+               } else if( position > prod( par("mfrow") ) ) {
+            			position = 1
+            			pageNum = pageNum + 1
+            			addHeaderFooter( item, level, pageNum )
                }
             }
          }
@@ -147,4 +140,11 @@ main <- function() {
    }
 }
 
+# Add page title + footer with page number
+addHeaderFooter <- function( item, level, pageNum ) {
+	addPageTitle( item )
+	addPageNumber( pageNum )
+	addPageFooter( paste( str_to_title( level ), "Taxa Plots" ) )
+}
+
 r.plotWidth=23