[R-gregmisc-users] SF.net SVN: r-gregmisc: [1049] trunk/gplots/R/textplot.R

[<wa...@us...>]

Revision: 1049
          http://svn.sourceforge.net/r-gregmisc/?rev=1049&view=rev
Author:   warnes
Date:     2007-02-08 13:32:32 -0800 (Thu, 08 Feb 2007)

Log Message:
-----------
Add paramaeters 'col.data', 'col.rows', and 'col.columns' to
textplot.matrix to allow specification of the color of the matrix
data, rows, and columns.

Modified Paths:
--------------
    trunk/gplots/R/textplot.R

Modified: trunk/gplots/R/textplot.R
===================================================================
--- trunk/gplots/R/textplot.R	2007-02-08 16:56:57 UTC (rev 1048)
+++ trunk/gplots/R/textplot.R	2007-02-08 21:32:32 UTC (rev 1049)
@@ -35,6 +35,9 @@
                             hadj=1,
                             vadj=1,
                             mar= c(1,1,4,1)+0.1,
+                            col.data=par("col"),
+                            col.rownames=par("col"),
+                            col.colnames=par("col"),
                             ... )
 {
 
@@ -43,6 +46,22 @@
   else
     object <- as.matrix(object)
 
+  # check dimensions of col.data, col.rownames, col.colnames
+  if(length(col.data)==1)
+    col.data <- matrix(col.data, nrow=nrow(object), ncol=ncol(object))
+  else
+    if( nrow(col.data)!=nrow(object) || ncol(col.data)!=ncol(object) )
+      stop("Dimensions of 'col.data' do not match dimensions of 'object'.")
+
+  if(length(col.rownames)==1)
+      col.rownames <- rep(col.rownames, nrow(object))      
+
+  if(length(col.colnames)==1)
+    if(show.rownames)
+      col.colnames <- rep(col.colnames, ncol(object)+1)
+    else
+      col.colnames <- rep(col.colnames, ncol(object))
+  
   halign=match.arg(halign)
   valign=match.arg(valign)
 
@@ -63,15 +82,17 @@
     rownames(object) <- paste( "[", 1:nrow(object), ",]", sep="")
 
 
-  # extend the matrix to include them
+  # extend the matrix to include row and column labels
   if( show.rownames )
     {
       object <- cbind( rownames(object), object )
+      col.data <- cbind( col.rownames, col.data )
+      
     }
   if( show.colnames )
     {
-
       object <- rbind( colnames(object), object )
+      col.data <- rbind( col.colnames, col.data )
     }
 
   # set the character size
@@ -143,9 +164,11 @@
     for(j in 1:nrow(object)) {
       ypos<-y-(j-1)*rowheight
       if( (show.rownames && i==1) || (show.colnames && j==1) )
-        text(xpos, ypos, object[j,i], adj=c(hadj,vadj), cex=cex, font=2, ... )
+        text(xpos, ypos, object[j,i], adj=c(hadj,vadj), cex=cex, font=2,
+             col=col.data[j,i], ... )
       else
-        text(xpos, ypos, object[j,i], adj=c(hadj,vadj), cex=cex, font=1, ... )
+        text(xpos, ypos, object[j,i], adj=c(hadj,vadj), cex=cex, font=1,
+             col=col.data[j,i], ... )
     }
   }
 


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.