Skip to content

Commit

Permalink
Bug Fixes (#70)
Browse files Browse the repository at this point in the history 
* R script format updates + bug fix

* add verbose to rsync command

* cleanup

* fix R script pageNum bug
  • Loading branch information
@mikesioda @msioda
mikesioda authored and msioda committed Feb 22, 2019
1 parent 1d4b4f1 commit 2e40b92
Show file tree
Hide file tree
Showing 10 changed files with 199 additions and 239 deletions.
25 changes: 10 additions & 15 deletions resources/R/BioLockJ_Lib.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 ) )
Expand Down Expand Up @@ -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 ), "$" ) )
Expand Down
1 change: 0 additions & 1 deletion resources/R/BioLockJ_MAIN.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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()
}
Expand Down
111 changes: 60 additions & 51 deletions resources/R/R_PlotMds.R
View file
Original file line number Diff line number Diff line change
@@ -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() ) {
Expand All @@ -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" )
Expand All @@ -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
}
}
}
Expand All @@ -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
70 changes: 35 additions & 35 deletions resources/R/R_PlotOtus.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 )
}

Expand All @@ -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 )
Expand Down Expand Up @@ -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 )
}
}
}
Expand All @@ -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
Loading

0 comments on commit 2e40b92

Please sign in to comment.