[R-gregmisc-commits] r2053 - in pkg/gdata: R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Jun 30 00:30:01 CEST 2015


Author: warnes
Date: 2015-06-30 00:30:00 +0200 (Tue, 30 Jun 2015)
New Revision: 2053

Modified:
   pkg/gdata/R/upperTriangle.R
   pkg/gdata/man/upperTriangle.Rd
Log:
Add 'byrow' argument to lowerTriangle()/upperTriangle() functions.

Modified: pkg/gdata/R/upperTriangle.R
===================================================================
--- pkg/gdata/R/upperTriangle.R	2015-06-02 19:03:20 UTC (rev 2052)
+++ pkg/gdata/R/upperTriangle.R	2015-06-29 22:30:00 UTC (rev 2053)
@@ -1,22 +1,42 @@
-upperTriangle <- function(x, diag=FALSE)
+upperTriangle <- function(x, diag=FALSE, byrow=FALSE)
   {
-    x[upper.tri(x, diag=diag)]
+    if(byrow)
+      t(x)[rev(upper.tri(x, diag=diag))]
+    else
+      x[upper.tri(x, diag=diag)]
   }
 
-"upperTriangle<-" <- function(x, diag=FALSE, value)
+"upperTriangle<-" <- function(x, diag=FALSE, byrow=FALSE, value)
   {
-    x[upper.tri(x, diag=diag)] <- value
-    x
+    if(byrow) {
+      ret <- t(x)
+      ret[rev(upper.tri(x, diag=diag))] <- value
+      t(ret)
+    }
+    else {        
+      x[upper.tri(x, diag=diag)] <- value
+      x
+    }
   }
 
-lowerTriangle <- function(x, diag=FALSE)
+lowerTriangle <- function(x, diag=FALSE, byrow=FALSE)
   {
+  if(byrow)
+    t(x)[rev(lower.tri(x, diag=diag))]
+  else
     x[lower.tri(x, diag=diag)]
   }
 
-"lowerTriangle<-" <- function(x, diag=FALSE, value)
+"lowerTriangle<-" <- function(x, diag=FALSE, byrow=FALSE, value)
   {
+  if(byrow) {
+    ret <- t(x)
+    ret[rev(lower.tri(x, diag=diag))] <- value
+    t(ret)
+  }
+  else {        
     x[lower.tri(x, diag=diag)] <- value
     x
   }
+}
 

Modified: pkg/gdata/man/upperTriangle.Rd
===================================================================
--- pkg/gdata/man/upperTriangle.Rd	2015-06-02 19:03:20 UTC (rev 2052)
+++ pkg/gdata/man/upperTriangle.Rd	2015-06-29 22:30:00 UTC (rev 2053)
@@ -8,15 +8,18 @@
   Extract or replace the upper/lower triangular portion of a matrix
 }
 \usage{
-upperTriangle(x, diag=FALSE)
-upperTriangle(x, diag=FALSE) <- value
-lowerTriangle(x, diag=FALSE)
-lowerTriangle(x, diag=FALSE) <- value
+upperTriangle(x, diag=FALSE, byrow=FALSE)
+upperTriangle(x, diag=FALSE, byrow=FALSE) <- value
+lowerTriangle(x, diag=FALSE, byrow=FALSE)
+lowerTriangle(x, diag=FALSE, byrow=FALSE) <- value
 }
 %- maybe also 'usage' for other objects documented here.
 \arguments{
   \item{x}{Matrix}
   \item{diag}{Logical.  If \code{TRUE}, include the matrix diagonal.}
+  \item{byrow}{Logical.  If \code{FALSE}, return/replace elements in 
+    column-wise order. If \code{TRUE}, return/replace elements in 
+    row-wise order.}
   \item{value}{Either a single value or a vector of length equal to that
     of the current upper/lower triangular.  Should be of a mode which 
     can be coerced to that of \code{x}.}
@@ -25,19 +28,35 @@
 \value{
   \code{upperTriangle(x)} and \code{lowerTriangle(x)} return the upper
   or lower triangle of matrix x, respectively. The assignment forms
-  replace the upper or lower traingular area of the
-  matrix with the provided value(s).
+  replace the upper or lower triangular area of the
+  matrix with the provided value(s).  
   }
+\note{
+  By default, the elements are returned/replaced in R's default column-wise order.  Thus 
+  \preformatted{  lowerTriangle(x) <- upperTriangle(x)}
+  will not yield a symmetric matrix.  Instead use:
+  \preformatted{  lowerTriangle(x) <- upperTriangle(x, byrow=TRUE)} 
+  or equivalently:
+  \preformatted{  lowerTriangle(x, byrow=TRUE) <- upperTriangle(x)} 
+}
+  
 \author{Gregory R. Warnes \email{greg at warnes.net}}
-\seealso{ \code{\link[base]{diag}} }
+\seealso{ 
+  \code{\link[base]{diag}},  
+  \code{\link[base]{lower.tri}}, 
+  \code{\link[base]{upper.tri}}
+}
 \examples{
   x <- matrix( 1:25, nrow=5, ncol=5)
   x
   upperTriangle(x)
   upperTriangle(x, diag=TRUE)
+  upperTriangle(x, diag=TRUE, byrow=TRUE)
 
+
   lowerTriangle(x)
   lowerTriangle(x, diag=TRUE)
+  lowerTriangle(x, diag=TRUE, byrow=TRUE)
 
   upperTriangle(x) <- NA
   x
@@ -51,5 +70,11 @@
   lowerTriangle(x, diag=TRUE) <- 1:15
   x
 
+  ## Copy lower triangle into upper triangle to make 
+  ## the matrix (diagonally) symmetric
+  x <- matrix(LETTERS[1:25], nrow=5, ncol=5, byrow=TRUE)
+  x
+  lowerTriangle(x) = upperTriangle(x, byrow=TRUE)
+  x
 }
 \keyword{array}



More information about the R-gregmisc-commits mailing list