Created
December 16, 2011 18:48
-
-
Save anonymous/1487363 to your computer and use it in GitHub Desktop.
Upgrade of textplot in PerformanceAnalytics and gplot
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#' Display text information in a graphics plot. | |
#' | |
#' This function displays text output in a graphics window. There is an option to display the text using the largest font that will fit in the plotting region. | |
#' For matrixes, data.frames and vectors a specialized textplot function is available that plots each of the cells individually in a way that is visually | |
#' appealing (maintains the table-like/grid-like structure of the data). If present, row and column labels will be displayed in a bold font. | |
#' | |
#' This function was modified from the PerformanceAnalytics version by Peter Carl and Brian G. Peterson (brian@@braverock.com). | |
#' Assistance was provided by John Colby in this post: | |
#' \url{http://stackoverflow.com/questions/8523944/left-justify-a-column-using-textplot-gplots-or-performanceanalytics} | |
#' | |
#' Modifications: | |
#' \itemize{ | |
#' \item More descriptive variables names, more in-line comments, more detailed/clear parameter documentation, more concise code | |
# \item This roxygen2 documentation | |
#' \item Bug fix and easier to use/understand cex parameter. If cex is specified then what you specify is what you get. Previously a specified cex was adjusted by par(cex) by the text() function, which is confusing. | |
#' \item This function sets par(cex = 1) and then passes the cex parameter (or computed cex in the auto-size case) to text(), so caller simply decides what cex is desired or omits cex to auto-size. | |
#' \item Bug fix to overlapping text when left aligning matrix/data.frame (see StackOverflow post linked above) | |
#' \item Eliminate vadj and hadj in favor of vCellAlign and hCellAlign and renamed valign/halign to vPlotAlign and hPlotAlign. Caller decides "center", "left", "right", "top", "bottom" for plot and cells and it all works out. | |
#' \item Using a small hack, textplot.character will horizontally align text within the plot region and within the plot itself. Previously the text was only aligned within the plot region so it appeared as if the alignment instruction was ignored. | |
#' } | |
#' | |
#' Color has NOT been tested. | |
#' Don't deal with the TAB character. | |
#' | |
#' | |
#' @param object Object to be displayed. If character of length > 1, then elements are concatenated with a newline delimiter. | |
#' @param hPlotAlign Character with alignment of the entire object within the plotting region in the x direction, one of "center", "left", or "right". For character \samp{object} with multiple lines of text | |
#' this parameter is also used to align the text within the plot (i.e. "center" will center the object within the plotting region and also center 2 or more lines of text within the plot itself) | |
#' @param vPlotAlign Character with alignment of the entire object within the plotting region in the y direction, one of "center", "left", or "right". | |
#' @param cex Numeric of length 1 with the text character size, see \link{par} for details. If missing, the code will attempt to use the largest value which allows the entire plot region to be filled. | |
#' @param cmar Numeric with the space between columns, in fractions of the size of the letter 'M'. Typically > 1 | |
#' @param rmar Numeric with the space between columns, in fractions of the size of the letter 'M'. Typically > 1 | |
#' @param showRowNames Logical indicating whether row names will be displayed (for matrix, data.frame, or vector objects) | |
#' @param showColumnNames Logical indicating whether column names will be displayed (for matrix, data.frame, or vector objects) | |
#' @param hCellAlign Character with the horizontal location of elements within cell (for matrix, data.frame, or vector objects). One of "center", "left", or "right". | |
#' @param vCellAlign Character with the vertical location of elements within cell (for matrix, data.frame, or vector objects). One of "center", "top", or "bottom". | |
#' @param mar Figure margins, see the documentation for \link{par} | |
#' @param dataColor Colors for data elements. If a single value is provided, all data elements will be the same color. If a matrix matching the dimensions of the data is provided, each data element will receive the specified color. | |
#' @param rowNameColor Colors for row names. May be specified as a scalar or a vector of the same row length as object. | |
#' @param columnNameColor Colors for column names. May be specified as a scalar or a vector of the same column length as object. | |
#' @param ... Optional arguments passed to the text plotting command. | |
#' | |
#' @return Numeric with the auto-sized cex value if cex is missing, otherwise the original cex value. | |
#' | |
#' @author Suraj Gupta (suraj at wingedfootcapital.com) | |
#' @export | |
Textplot = function( object , ... ) | |
{ | |
UseMethod( "Textplot" ) | |
} | |
#' @rdname Textplot | |
#' @method Textplot default | |
#' @S3method Textplot default | |
Textplot.default = function( object , ... ) | |
{ | |
if ( is.matrix( object ) || ( is.vector( object ) && ( length( object ) > 1 ) ) ) | |
{ | |
return( Textplot.matrix( object , ... ) ) | |
} | |
return( Textplot.character( as.character( object ) , ... ) ) | |
} | |
#' @rdname Textplot | |
#' @method Textplot matrix | |
#' @S3method Textplot matrix | |
Textplot.matrix = function( object , hPlotAlign = c( "center" , "left" , "right" ) , vPlotAlign = c( "center" , "top" , "bottom" ) , cex , mar = c( 1 , 1 , 4 , 1 ) + 0.1 , cmar = 1 , rmar = 1 , showRowNames = TRUE , showColumnNames = TRUE , hCellAlign= c( "center" , "left" , "right" ) , vCellAlign = c( "center" , "top" , "bottom" ) , dataColor = par( "col" ) , rowNameColor = par( "col" ) , columnNameColor = par( "col" ) , ... ) | |
{ | |
# convert vector to matrix | |
if ( is.vector( object ) ) { object = t( as.matrix( object ) ) } | |
else { object = as.matrix( object ) } | |
# pull alignment parameters | |
hPlotAlign = match.arg( hPlotAlign ) | |
vPlotAlign = match.arg( vPlotAlign ) | |
hCellAlign = match.arg( hCellAlign ) | |
vCellAlign = match.arg( vCellAlign ) | |
vadj = hadj = NULL | |
if ( hCellAlign == "center" ) { hadj = .5 } | |
else if ( hCellAlign == "left" ) { hadj = 0 } | |
else { hadj = 1 } | |
if ( vCellAlign == "center" ) { vadj = .5 } | |
else if ( vCellAlign == "top" ) { vadj = 1 } | |
else { vadj = 0 } | |
# check dimensions of dataColor, rowNameColor, columnNameColor | |
if( length( dataColor ) == 1 ) { dataColor = matrix( dataColor , nrow = nrow( object ) , ncol = ncol( object ) ) } | |
else { if ( nrow( dataColor ) != nrow( object ) || ncol( dataColor ) != ncol( object ) ) { stop( "Dimensions of 'dataColor' do not match dimensions of 'object'." ) } } | |
if( length( rowNameColor ) == 1 ) { rowNameColor = rep( rowNameColor , nrow( object ) ) } | |
else { if ( length( rowNameColor ) != nrow( object ) ) { stop( "Length of 'rowNameColor' do not match number of rows in 'object'." ) } } | |
if( length( columnNameColor ) == 1 ) { columnNameColor = rep( columnNameColor , ncol( object ) ) } | |
else { if ( length( columnNameColor ) != ncol( object ) ) { stop( "Length of 'columnNameColor' do not match number of rows in 'object'." ) } } | |
# save old par settings | |
opar = par()[ c( "mar" , "xpd" , "cex" ) ] | |
on.exit( par( opar ) ) | |
# set margins and force plotting to be clipped to plotting region | |
# here we HAVE to set cex = 1 because text() multiplies the cex parmeter by par( cex ) to get the final cex which is terribly confusing. | |
par( mar = mar , xpd = FALSE , cex = 1 ) | |
# start the plot and set up the coordinate system which we'll use for alignment | |
plot.new() | |
plot.window( xlim = c( 0 , 1 ) , ylim = c( 0 , 1 ) , log = "" , asp = NA ) | |
# add row/column names into the matrix itself as first row/column | |
# copy the row/column colors into dataColor matrix | |
if ( showRowNames ) | |
{ | |
if ( !is.null( rownames( object ) ) ) | |
{ | |
object = cbind( rownames( object ) , object ) | |
dataColor = cbind( rowNameColor , dataColor ) | |
} | |
} | |
if ( showColumnNames ) | |
{ | |
if ( !is.null( colnames( object ) ) ) | |
{ | |
object = rbind( colnames(object), object ) | |
dataColor = rbind( columnNameColor , dataColor ) | |
} | |
} | |
# if cex is not provided, then auto-size the text to fill the plot area | |
if ( missing( cex ) ) | |
{ | |
cex = 1 | |
for ( i in 1 : 20 ) | |
{ | |
# get the sum of the widths of each column (take the widest text in each column and sum the widths) | |
# then pad each column with cmar | |
width = sum( apply( object, 2 , function( x ) max( strwidth( x , cex = cex ) ) ) ) + strwidth( "M" , cex = cex ) * cmar * ncol( object ) | |
# the height is simply the height of any character times the number of rows * the row margin | |
height = strheight( 'M' , cex = cex ) * nrow( object ) * rmar | |
oldcex = cex | |
cex = cex / max( width , height ) | |
if (abs( oldcex - cex ) < 0.001 ) { break } | |
} | |
} | |
# alignment | |
width = sum( apply( object, 2 , function( x ) max( strwidth( x , cex = cex ) ) ) ) + strwidth( "M" , cex = cex ) * cmar * ncol( object ) | |
height = strheight( 'M' , cex = cex ) * nrow( object ) * rmar | |
if ( hPlotAlign == "left" ) { xpos = 0 } | |
else if ( hPlotAlign == "center" ) { xpos = 0 + ( 1 - width ) / 2 } | |
else { xpos = 0 + ( 1 - width ) } | |
if ( vPlotAlign == "top" ) { ypos = 1 } | |
else if ( vPlotAlign == "center" ) { ypos = 1 - ( 1 - height ) / 2 } | |
else { ypos = 1 - ( 1 - height ) } | |
# iterate across elements, plotting them | |
y = ypos | |
colWidths = apply( object, 2 , function( x ) max( strwidth( x , cex = cex ) ) ) + strwidth( "M" ) * cmar | |
rowHeight = strheight( "W" , cex = cex ) * rmar | |
for ( i in 1 : ncol( object ) ) | |
{ | |
xpos = xpos + hadj * colWidths[ i ] | |
for( j in 1 : nrow( object ) ) | |
{ | |
ypos = y - ( j - 1 ) * rowHeight | |
if ( ( showRowNames && i == 1 ) || ( showColumnNames && j == 1 ) ) | |
{ | |
text( xpos , ypos , object[ j , i ] , adj = c( hadj , vadj ) , cex = cex , font = 2 , col = dataColor[ j , i ] , ... ) | |
} | |
else | |
{ | |
text( xpos , ypos , object[ j , i ] , adj = c( hadj , vadj ) , cex = cex , font = 1 , col = dataColor[ j , i ] , ... ) | |
} | |
} | |
xpos = xpos + ( 1 - hadj ) * colWidths[ i ] | |
} | |
# return resulting cex | |
invisible( cex ) | |
} | |
#' @rdname Textplot | |
#' @method Textplot data.frame | |
#' @S3method Textplot data.frame | |
Textplot.data.frame = function( object , ... ) | |
{ | |
return( Textplot.matrix( object , ... ) ) | |
} | |
#' @rdname Textplot | |
#' @method Textplot character | |
#' @S3method Textplot character | |
Textplot.character = function( object , hPlotAlign = c( "center" , "left" , "right" ) , vPlotAlign = c( "center" , "top" , "bottom" ) , cex , mar = c( 0 , 0 , 3 , 0 ) + 0.1 , ... ) | |
{ | |
# if length > 1, then combine with new line | |
object = paste( object , collapse = "\n" , sep = "" ) | |
# TODO: took out the code to handle TAB characters | |
# pull hPlotAlign, vPlotAlign | |
hPlotAlign = match.arg( hPlotAlign ) | |
vPlotAlign = match.arg( vPlotAlign ) | |
# start the plot | |
plot.new() | |
# save old par settings | |
opar = par()[ c( "mar" , "xpd" , "cex" ) ] | |
on.exit( par( opar ) ) | |
# set margins and force plotting to be clipped to plotting region | |
# here we HAVE to set cex = 1 because text() multiplies the cex parmeter by par( cex ) to get the final cex which is terribly confusing. | |
par( mar = mar , xpd = FALSE , cex = 1 ) | |
# set up the coordinate system which we'll use for alignment | |
plot.window( xlim = c( 0 , 1 ) , ylim = c( 0 , 1 ) , log = "" , asp = NA ) | |
# if cex is missing then auto-size | |
lastloop = FALSE | |
if ( missing( cex ) ) | |
{ | |
cex = 1 | |
for ( i in 1 : 20 ) | |
{ | |
width = strwidth( object , cex = cex ) | |
height = strheight( object , cex = cex ) | |
oldcex = cex | |
cex = cex / max( width , height ) | |
if ( abs( oldcex - cex ) < 0.001 ) { break } | |
} | |
} | |
# alignment | |
width = strwidth( object , cex = cex ) | |
height = strheight( object , cex = cex ) | |
if ( hPlotAlign == "left" ) { xpos = 0 } | |
else if ( hPlotAlign == "center" ) { xpos = 0 + ( 1 - width ) / 2 } | |
else { xpos = 0 + ( 1 - width ) } | |
if ( vPlotAlign == "top" ) { ypos = 1 } | |
else if ( vPlotAlign == "center" ) { ypos = 1 - ( 1 - height ) / 2 } | |
else { ypos = 1 - ( 1 - height ) } | |
# horizonal alignment doesn't work as-is for multi-line text. that's because the entire text region is being aligned | |
# and not the text itself. A bit of a hack, but we simply pad the shorter lines of text with spaces to achieve the | |
# effect of left and right justification | |
if ( ( hPlotAlign == "right" ) || ( hPlotAlign == "center" ) ) | |
{ | |
textByLine = unlist( lapply( object , function( x ) strsplit( x , "\n" ) ) ) | |
for ( i in 1 : length( textByLine ) ) | |
{ | |
oneLineText = textByLine[ i ] | |
while ( strwidth( oneLineText , cex = cex ) <= width ) | |
{ | |
if ( hPlotAlign == "right" ) { oneLineText = paste( " " , oneLineText , sep = "" ) } | |
else { oneLineText = paste( " " , oneLineText , " " , sep = "" ) } | |
} | |
textByLine[ i ] = oneLineText | |
} | |
object = paste( textByLine , collapse = "\n" ) | |
} | |
# plot the text | |
text( x = xpos , y = ypos , labels = object , adj = c( 0 , 1 ) , cex = cex , ... ) | |
# return resulting cex | |
invisible( cex ) | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment