r-gregmisc-users — Discussion list for R gregmisc packages (gplot, gmodels, gdata, gtools)

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1536] trunk/gdata/R/ls.funs.R

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

Revision: 1536
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1536&view=rev
Author:   warnes
Date:     2012-06-05 19:07:53 +0000 (Tue, 05 Jun 2012)
Log Message:
-----------
Fix error in ls.funs() that occurs when there are no objects in the environment.

Modified Paths:
--------------
    trunk/gdata/R/ls.funs.R

Modified: trunk/gdata/R/ls.funs.R
===================================================================
--- trunk/gdata/R/ls.funs.R	2012-06-05 18:36:05 UTC (rev 1535)
+++ trunk/gdata/R/ls.funs.R	2012-06-05 19:07:53 UTC (rev 1536)
@@ -3,7 +3,12 @@
     mycall <- match.call()
     mycall[[1]] <- as.name("ls")
     nameList <- eval.parent(mycall)
-    funcFlags <- sapply( nameList, function(x) is.function(get(x)) )
-    nameList[funcFlags]
+    if(length(nameList)>0)
+      {
+        funcFlags <- sapply( nameList, function(x) is.function(get(x)) )
+        return(nameList[funcFlags])
+      }
+    else
+      return( list() )
   }
                         

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1535] trunk/gdata/R/object.size.R

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

Revision: 1535
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1535&view=rev
Author:   warnes
Date:     2012-06-05 18:36:05 +0000 (Tue, 05 Jun 2012)
Log Message:
-----------
Avoid warning by calling utils::object.size rather than Internal(object.size(x))

Modified Paths:
--------------
    trunk/gdata/R/object.size.R

Modified: trunk/gdata/R/object.size.R
===================================================================
--- trunk/gdata/R/object.size.R	2012-05-31 22:14:44 UTC (rev 1534)
+++ trunk/gdata/R/object.size.R	2012-06-05 18:36:05 UTC (rev 1535)
@@ -7,8 +7,9 @@
 
 object.size <- function(...) 
 {
-  structure(sapply(list(...), function(x) .Internal(object.size(x))), 
-            class=c("object_size", "numeric"))
+  structure(sapply(list(...),
+                   utils::object.size),
+                   class=c("object_size", "numeric"))
 }
 
 print.object_size <- function(x, quote=FALSE, humanReadable, ...)

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1534] trunk/gdata

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

Revision: 1534
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1534&view=rev
Author:   warnes
Date:     2012-05-31 22:14:44 +0000 (Thu, 31 May 2012)
Log Message:
-----------
- Remove dispatch function 'nobs' and method 'nobs.lm' since these are
  now provided by the R 'stats' package.

Modified Paths:
--------------
    trunk/gdata/R/nobs.R
    trunk/gdata/man/nobs.Rd

Modified: trunk/gdata/R/nobs.R
===================================================================
--- trunk/gdata/R/nobs.R	2012-05-31 22:03:07 UTC (rev 1533)
+++ trunk/gdata/R/nobs.R	2012-05-31 22:14:44 UTC (rev 1534)
@@ -1,12 +1,14 @@
 # $Id$
 
-nobs <- function(x,...)
-  UseMethod("nobs",x)
+## Now provided by 'stats' package
+## nobs <- function(x,...)
+##  UseMethod("nobs",x)
 
-nobs.default <- function(x, ...) sum( !is.na(x) )
+nobs.default <- function(object, ...) sum( !is.na(object) )
 
-nobs.data.frame <- function(x, ...)
-  sapply(x, nobs.default)
+nobs.data.frame <- function(object, ...)
+  sapply(object, nobs.default)
 
-nobs.lm <- function(x, ...)
-  nobs.default(x$residuals)
+## Now provided by the 'stats' package
+## nobs.lm <- function(x, ...)
+##   nobs.default(x$residuals)

Modified: trunk/gdata/man/nobs.Rd
===================================================================
--- trunk/gdata/man/nobs.Rd	2012-05-31 22:03:07 UTC (rev 1533)
+++ trunk/gdata/man/nobs.Rd	2012-05-31 22:14:44 UTC (rev 1534)
@@ -28,30 +28,30 @@
 %
 
 \name{nobs}
-\alias{nobs}
-\alias{nobs.default}
+%% \alias{nobs} % Now provided by stats
 \alias{nobs.data.frame}
-\alias{nobs.lm}
+\alias{nobs.default} 
+%% \alias{nobs.lm} % Now provided by stats
 %- Also NEED an `\alias' for EACH other topic documented here.
 \title{ Compute the Number of Non-missing Observations }
 \description{
- Compute the number of non-missing observations.  Special methods exist for
- data frames, and lm objects.
+ Compute the number of non-missing observations.  New 'default' method,
+ and method for data frames.
 }
 \usage{
-nobs(x, ...)
-\method{nobs}{default}(x, ...)
-\method{nobs}{data.frame}(x, ...)
-\method{nobs}{lm}(x, ...)
+%% nobs(object, ...)
+\method{nobs}{default}(object, ...)
+\method{nobs}{data.frame}(object, ...)
+%% \method{nobs}{lm}(object, ...)
 }
 \arguments{
-  \item{x}{ Target Object }
+  \item{object}{ Target Object }
   \item{\dots}{ Optional parameters (currently ignored)}
 }
 \details{
 
   In the simplest case, this is really just wrapper code for
-  \code{sum(!is.na(x))}.
+  \code{sum(!is.na(object))}.
   
 }
 \value{

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1533] trunk/gplots/man/qqnorm.aov.Rd

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

Revision: 1533
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1533&view=rev
Author:   warnes
Date:     2012-05-31 22:03:07 +0000 (Thu, 31 May 2012)
Log Message:
-----------
Properly mark up S3 method.

Modified Paths:
--------------
    trunk/gplots/man/qqnorm.aov.Rd

Modified: trunk/gplots/man/qqnorm.aov.Rd
===================================================================
--- trunk/gplots/man/qqnorm.aov.Rd	2012-05-04 21:20:33 UTC (rev 1532)
+++ trunk/gplots/man/qqnorm.aov.Rd	2012-05-31 22:03:07 UTC (rev 1533)
@@ -8,7 +8,7 @@
   class \code{aov}. One can interactively label the points in the plot.
 }
 \usage{
-qqnorm.aov(y, full=FALSE, label=FALSE, omit=NULL,
+\method{qqnorm}{aov}(y, full=FALSE, label=FALSE, omit=NULL,
            xlab=paste(if (full) "" else "Half", " Normal plot"), 
            ylab="Effects", ...)
 }

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1532] trunk/gdata/DESCRIPTION

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

Revision: 1532
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1532&view=rev
Author:   warnes
Date:     2012-05-04 21:20:33 +0000 (Fri, 04 May 2012)
Log Message:
-----------
Update for next release

Modified Paths:
--------------
    trunk/gdata/DESCRIPTION

Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION	2012-05-04 19:39:23 UTC (rev 1531)
+++ trunk/gdata/DESCRIPTION	2012-05-04 21:20:33 UTC (rev 1532)
@@ -3,8 +3,8 @@
 Description: Various R programming tools for data manipulation
 Depends: R (>= 2.6.0)
 Imports: gtools
-Version: 2.9.0
-Date: 2011-09-30
+Version: 2.10.0
+Date: 2012-05-04
 Author: Gregory R. Warnes, with contributions from Ben Bolker, Gregor Gorjanc, 
         Gabor Grothendieck, Ales Korosec, Thomas Lumley, Don MacQueen, 
         Arni Magnusson, Jim Rogers, and others

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1531] trunk/gdata

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

Revision: 1531
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1531&view=rev
Author:   warnes
Date:     2012-05-04 19:39:23 +0000 (Fri, 04 May 2012)
Log Message:
-----------
Add ls.funs() to show functions defined in the specified environment.

Modified Paths:
--------------
    trunk/gdata/NAMESPACE

Added Paths:
-----------
    trunk/gdata/R/ls.funs.R
    trunk/gdata/man/ls.funs.Rd

Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE	2012-05-04 19:38:20 UTC (rev 1530)
+++ trunk/gdata/NAMESPACE	2012-05-04 19:39:23 UTC (rev 1531)
@@ -18,6 +18,7 @@
        is.what,
        keep,
        ll,
+       ls.funs,
        lowerTriangle,
        "lowerTriangle<-",
        matchcols,

Added: trunk/gdata/R/ls.funs.R
===================================================================
--- trunk/gdata/R/ls.funs.R	                        (rev 0)
+++ trunk/gdata/R/ls.funs.R	2012-05-04 19:39:23 UTC (rev 1531)
@@ -0,0 +1,9 @@
+ls.funs <- function (...)
+  {
+    mycall <- match.call()
+    mycall[[1]] <- as.name("ls")
+    nameList <- eval.parent(mycall)
+    funcFlags <- sapply( nameList, function(x) is.function(get(x)) )
+    nameList[funcFlags]
+  }
+                        

Added: trunk/gdata/man/ls.funs.Rd
===================================================================
--- trunk/gdata/man/ls.funs.Rd	                        (rev 0)
+++ trunk/gdata/man/ls.funs.Rd	2012-05-04 19:39:23 UTC (rev 1531)
@@ -0,0 +1,38 @@
+\name{ls.funs}
+\alias{ls.funs}
+\title{List function objects}
+\description{
+  Return a character vector giving the names of function objects in the
+  specified environment.
+}
+\usage{
+ls.funs(...)
+}
+\arguments{
+  \item{\dots}{Arguments passed to \code{ls}. See the help for
+    \code{\link[base]{ls}} for details.}
+}
+\details{
+  This function calls \code{ls} and then returns a character vector
+  containing only the names of only function objects.
+}
+\value{
+  character vector
+}
+\author{
+  Gregory R. Warnes \email{gr...@wa...}
+}
+\seealso{
+  \code{\link[base]{ls}}, \code{\link[base]{is.function}}
+}
+\examples{
+## List functions defined in the global environment:
+ls.funs()
+
+## List functions available in the base package:
+ls.funs("package:base")
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{misc}
+\keyword{environment}

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1530] trunk/gdata/man/is.what.Rd

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

Revision: 1530
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1530&view=rev
Author:   warnes
Date:     2012-05-04 19:38:20 +0000 (Fri, 04 May 2012)
Log Message:
-----------
Fix enumerate syntax.

Modified Paths:
--------------
    trunk/gdata/man/is.what.Rd

Modified: trunk/gdata/man/is.what.Rd
===================================================================
--- trunk/gdata/man/is.what.Rd	2012-05-04 16:06:49 UTC (rev 1529)
+++ trunk/gdata/man/is.what.Rd	2012-05-04 19:38:20 UTC (rev 1530)
@@ -20,10 +20,10 @@
 \note{
   The following procedure is used to look for valid tests:
   \enumerate{
-    \item{Find all objects named \code{is.*} in all loaded
+    \item{}{Find all objects named \code{is.*} in all loaded
       environments.}
-    \item{Discard objects that are not functions.}
-    \item{Include test result only if it is of class \code{"logical"},
+    \item{}{Discard objects that are not functions.}
+    \item{}{Include test result only if it is of class \code{"logical"},
       not an \code{NA}, and of length 1.}
   }
 }

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1529] trunk/gtools/R/smartbind.R

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

Revision: 1529
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1529&view=rev
Author:   warnes
Date:     2012-05-04 16:06:49 +0000 (Fri, 04 May 2012)
Log Message:
-----------
smartbind(): Improve handling of factors and ordered factors.

Modified Paths:
--------------
    trunk/gtools/R/smartbind.R

Modified: trunk/gtools/R/smartbind.R
===================================================================
--- trunk/gtools/R/smartbind.R	2012-04-19 22:09:02 UTC (rev 1528)
+++ trunk/gtools/R/smartbind.R	2012-05-04 16:06:49 UTC (rev 1529)
@@ -2,11 +2,8 @@
 ## Function to do rbind of data frames quickly, even if the columns don't match
 ##
 
-smartbind <- function(..., fill=NA, sep=':')
+smartbind <- function(..., fill=NA, sep=':', verbose=FALSE)
   {
-    verbose <- FALSE
-    
-    
     data <- list(...)
     if(is.null(names(data)))
       names(data) <- as.character(1:length(data))
@@ -29,24 +26,50 @@
                                    else paste(x, seq(1,rowLens[x]),sep=sep))
                           )
 
+    colClassList     <- vector(mode="list", length=length(data))
+    factorColumnList <- vector(mode="list", length=length(data))
+    factorLevelList  <- vector(mode="list", length=length(data))
+    
        
-    start <- 1
+    start      <- 1
+    blockIndex <- 1
     for(block in data)
       {
-        if(verbose) print(block)
+        colClassList    [[blockIndex]] <- list()
+        factorColumnList[[blockIndex]] <- character(length=0)
+        factorLevelList [[blockIndex]] <- list()
+        
+        if(verbose) print(head(block))
         end <- start+nrow(block)-1
         for(col in colnames(block))
           {
+            classVec <- class(block[,col])
+
+            ## store class and factor level information for later use
+            colClassList[[blockIndex]][[col]] <- classVec
+            if("factor" %in% classVec)
+              {
+                
+                factorColumnList[[blockIndex]] <-
+                  c(factorColumnList[[blockIndex]], col)
+                
+                factorLevelList[[blockIndex]][[col]] <-
+                  levels(block[,col])
+            }
+            
             if( !(col %in% names(retval)))
               {
                 if(verbose) cat("Start:", start,
                                 "  End:", end,
                                 "  Column:", col,
                                 "\n", sep="")
-                if(class(block[,col])=="factor")
-                  newclass <- "character"
+                if ("factor" %in% classVec)
+                  {
+                    newclass <- "character"
+                  }
                 else
-                  newclass <- class(block[,col])
+                  newclass <- classVec
+                
                 retval[[col]] <- as.vector(rep(fill,nrows), mode=newclass)
               }
             
@@ -54,9 +77,87 @@
                                                   mode=class(retval[[col]]))
           }
         start <- end+1
+        blockIndex <- blockIndex+1
       }
 
-    #retval <- as.list(retval)
+    all.equal.or.null <- function(x,y,...)
+      {
+        if(is.null(x) || is.null(y) )
+          return(TRUE)
+        else
+          return(all.equal(x,y,...))
+      }
+    
+    ## Handle factors, merging levels
+    for( col in unique(unlist(factorColumnList)) )
+      {
+        ## Ensure column classes match across blocks
+        colClasses <- lapply(colClassList, function(x) x[[col]])
+        allSame <- all(sapply(colClasses[-1],
+                              function(x) isTRUE(all.equal.or.null(colClasses[[1]], x))
+                              )
+                       )
+
+        if(allSame)
+          colClass <- colClasses[[1]]
+        else
+          {
+            warning("Column class mismatch for '", col, "'. ",
+                    "Converting column to class 'character'.")
+            next()
+          }
+        
+
+        ## check if factor levels are all the same
+        colLevels <- lapply(factorLevelList, function(x) x[[col]])
+        allSame <- all(sapply(colLevels[-1],
+                              function(x) isTRUE(all.equal.or.null(colLevels[[1]], x))
+                              )
+                       )
+
+        
+        if(allSame)
+          {
+            if("ordered" %in% colClass)
+              retval[[col]] <- ordered(retval[[col]], levels=colLevels[[1]] )
+            else
+              retval[[col]] <- factor(retval[[col]], levels=colLevels[[1]] )
+          }
+        else
+          {
+            ## Check if longest set of levels is a superset of all others,
+            ## and use that one
+            longestIndex  <- which.max( sapply(colLevels, length) )
+            longestLevels <- colLevels[[longestIndex]] 
+            allSubset <- sapply(colLevels[-longestIndex],
+                                function(l) all(l %in% longestLevels)
+                                )
+            if(allSubset)
+              {
+                if("ordered" %in% colClass)
+                  retval[[col]] <- ordered(retval[[col]], levels=longestLevels )
+                else
+                  retval[[col]] <- factor(retval[[col]], levels=longestLevels )
+              }
+            else
+              {
+                # form superset by appending to longest level set
+                levelSuperSet <- unique(c(longestLevels, unlist(colLevels)))
+                retval[[col]] <- factor(retval[[col]], levels=levelSuperSet )
+                
+                if(length(colClass)>1) # not just plain factor
+                   {
+                     browser()
+                    warning( "column '", col, "' of class ",
+                            paste("'", colClass, "'", collapse=":",
+                                  sep="'"),
+                            " converted to class 'factor'. Check level ordering." )
+                  }
+
+              }
+          }
+      }
+    
     attr(retval,"row.names") <- rowNameList
     class(retval) <- "data.frame"
     return(retval)

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1528] trunk/gmodels/inst/NEWS

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

Revision: 1528
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1528&view=rev
Author:   warnes
Date:     2012-04-19 22:09:02 +0000 (Thu, 19 Apr 2012)
Log Message:
-----------
Update for release 2.15.2

Modified Paths:
--------------
    trunk/gmodels/inst/NEWS

Modified: trunk/gmodels/inst/NEWS
===================================================================
--- trunk/gmodels/inst/NEWS	2012-04-19 22:07:16 UTC (rev 1527)
+++ trunk/gmodels/inst/NEWS	2012-04-19 22:09:02 UTC (rev 1528)
@@ -1,8 +1,22 @@
-Version 2.15.1
---------------
+Version 2.15.2 - 2012-04-19
+---------------------------
 
 Bug fixes:
 
+- Update est.mer() to work with recent versions of lme4  which changed
+  'mer' objects from S3 to S4 class 
+
+- Changes to pass new R CMD check tests
+
+- The 'Design' package has been replaced my 'rms', so update man page
+  references.
+
+
+Version 2.15.1 - 2011-01-16
+---------------------------
+
+Bug fixes:
+
 - Fix warnings reported by new versions of R CMD check.
 
 

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1527] trunk/gmodels/DESCRIPTION

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

Revision: 1527
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1527&view=rev
Author:   warnes
Date:     2012-04-19 22:07:16 +0000 (Thu, 19 Apr 2012)
Log Message:
-----------
Update version and date.

Modified Paths:
--------------
    trunk/gmodels/DESCRIPTION

Modified: trunk/gmodels/DESCRIPTION
===================================================================
--- trunk/gmodels/DESCRIPTION	2012-04-19 22:06:49 UTC (rev 1526)
+++ trunk/gmodels/DESCRIPTION	2012-04-19 22:07:16 UTC (rev 1527)
@@ -1,5 +1,6 @@
 Package: gmodels
-Version: 2.15.1
+Version: 2.15.2
+Date: 2012-04-19
 Title: Various R programming tools for model fitting
 Author: Gregory R. Warnes. Includes R source code and/or documentation
         contributed by Ben Bolker, Thomas Lumley, and Randall C

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1526] trunk/gmodels/man/estimable.Rd

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

Revision: 1526
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1526&view=rev
Author:   warnes
Date:     2012-04-19 22:06:49 +0000 (Thu, 19 Apr 2012)
Log Message:
-----------
The 'Design' package has been replaced my 'rms', so update man page references.

Modified Paths:
--------------
    trunk/gmodels/man/estimable.Rd

Modified: trunk/gmodels/man/estimable.Rd
===================================================================
--- trunk/gmodels/man/estimable.Rd	2012-04-19 22:05:48 UTC (rev 1525)
+++ trunk/gmodels/man/estimable.Rd	2012-04-19 22:06:49 UTC (rev 1526)
@@ -71,10 +71,10 @@
   linear functions are meaningful.
 
   For computing contrasts among levels of a single factor,
-  \code{fit.contrast} may be more convenient.  For computing
-  contrasts between two specific combinations of model parameters, the
-  \code{contrast} function in Frank Harrell's Design library may be more
-  convenient.
+  \code{fit.contrast} may be more convenient.  For computing contrasts
+  between two specific combinations of model parameters, the
+  \code{contrast} function in Frank Harrell's 'rms' library
+  (formerly 'Design') may be more convenient.
 
   %The \code{.wald} function is called internally by \code{estimable} and
   %is not intended for direct use.
@@ -104,7 +104,7 @@
   \code{\link[stats]{lm}},
   \code{\link[nlme]{lme}},
   \code{\link[stats]{contrasts}},
-  \code{\link[Design]{contrast}},
+  \code{\link[rms]{contrast.rms}},
   }
 
 \examples{

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1525] trunk/gmodels/R

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

Revision: 1525
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1525&view=rev
Author:   warnes
Date:     2012-04-19 22:05:48 +0000 (Thu, 19 Apr 2012)
Log Message:
-----------
More fixes for support of S4 'mer' class from lme4 package.

Modified Paths:
--------------
    trunk/gmodels/R/ci.R
    trunk/gmodels/R/est.mer.R

Modified: trunk/gmodels/R/ci.R
===================================================================
--- trunk/gmodels/R/ci.R	2012-04-19 21:13:28 UTC (rev 1524)
+++ trunk/gmodels/R/ci.R	2012-04-19 22:05:48 UTC (rev 1525)
@@ -85,7 +85,10 @@
                                 show.beta0 = FALSE,
                                 n.sim = n.sim)
 
-    retval <- retval[, c("Estimate", "Lower.CI", "Upper.CI", "Std. Error", "p value")]
+    retval <- retval[,
+                     c("Estimate", "Lower.CI", "Upper.CI", "Std. Error", "p value"),
+                     drop=FALSE
+                     ]
     colnames(retval)[c(2:3, 5)] <- c("CI lower", "CI upper", "p-value")
     rownames(retval) <- names(x.effects)
     

Modified: trunk/gmodels/R/est.mer.R
===================================================================
--- trunk/gmodels/R/est.mer.R	2012-04-19 21:13:28 UTC (rev 1524)
+++ trunk/gmodels/R/est.mer.R	2012-04-19 22:05:48 UTC (rev 1525)
@@ -4,6 +4,7 @@
 # Laboratory of Genomic Diversity at NCI Frederick
 # SAIC Frederick, Inc
 # Created April 25, 2006
+# Updated 2012-04-19 for S4 version of lmer object
 
 est.mer <- function(obj, cm, beta0, conf.int, show.beta0, n.sim)
 {
@@ -17,32 +18,34 @@
     n <- dim(cm)[2]
 
   ## drop extra information on end
-  samp.cm <- as.matrix(samp@fixef)[, 1:n] %*% t(cm)
+  samp.cm <- t(samp@fixef)[1:n,, drop=FALSE] %*% cm
 
   # calculate requested statistics
   est <- apply(samp.cm, 2, mean)
-  stderr <- sd(samp.cm)
+  stderr <- apply(samp.cm, 2, sd)
   
   pval <- sapply(1:length(beta0),
                  function(i){percentile(beta0[i], samp.cm[,i])})
   pval <- ifelse(pval <= .5, 2*pval, 2*(1-pval))
 
   if(is.null(conf.int))
-  {
-    lower.ci <- NULL
-    upper.ci <- NULL
-  }else{
-    alpha <- 1-conf.int
-    samp.ci <- sapply(1:length(beta0),
-                      function(i)
+    {
+      lower.ci <- NULL
+      upper.ci <- NULL
+    }
+  else
+    {
+      alpha <- 1-conf.int
+      samp.ci <- sapply(1:length(beta0),
+                        function(i)
                         {
                           quantile(samp.cm[,i], probs=c(alpha/2, 1-alpha/2))
                         }
-                      )
+                        )
 
-    lower.ci <- samp.ci[1,]
-    upper.ci <- samp.ci[2,]
-  }
+      lower.ci <- samp.ci[1,]
+      upper.ci <- samp.ci[2,]
+    }
 
   # return results
   if(!show.beta0)
@@ -61,8 +64,11 @@
   return(samp.stats)
 }
 
-percentile <- function(x, distn)
+percentile <- function(x, distn, include.observed=FALSE)
 {
+  if(include.observed)
+    distn <- c(x, distn)
+  
   n <- length(distn)
     
   return(findInterval(x, distn[order(distn)]) / n)

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1524] trunk/gmodels/man/coefFrame.Rd

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

Revision: 1524
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1524&view=rev
Author:   warnes
Date:     2012-04-19 21:13:28 +0000 (Thu, 19 Apr 2012)
Log Message:
-----------
Split long line.

Modified Paths:
--------------
    trunk/gmodels/man/coefFrame.Rd

Modified: trunk/gmodels/man/coefFrame.Rd
===================================================================
--- trunk/gmodels/man/coefFrame.Rd	2012-04-19 17:50:20 UTC (rev 1523)
+++ trunk/gmodels/man/coefFrame.Rd	2012-04-19 21:13:28 UTC (rev 1524)
@@ -8,7 +8,9 @@
   parameter.
 }
 \usage{
-coefFrame(mod, data, by = NULL, fit.on = TRUE, fitfun, keep.unused.levels = TRUE, byvar.sep = "\001", ...) 
+coefFrame(mod, data, by = NULL, fit.on = TRUE, fitfun,
+          keep.unused.levels = TRUE, byvar.sep = "\001", ...)
+
 }
 \arguments{
   \item{mod}{a model formula, to be passed to by \code{fitfun}.}

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1523] trunk/gmodels/man

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

Revision: 1523
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1523&view=rev
Author:   warnes
Date:     2012-04-19 17:50:20 +0000 (Thu, 19 Apr 2012)
Log Message:
-----------
Changes to pass R CMD check

Modified Paths:
--------------
    trunk/gmodels/man/ci.Rd
    trunk/gmodels/man/glh.test.Rd

Modified: trunk/gmodels/man/ci.Rd
===================================================================
--- trunk/gmodels/man/ci.Rd	2012-04-03 19:49:53 UTC (rev 1522)
+++ trunk/gmodels/man/ci.Rd	2012-04-19 17:50:20 UTC (rev 1523)
@@ -20,7 +20,7 @@
   \method{ci}{lm}(x, confidence = 0.95, alpha = 1 - confidence,...)
   \method{ci}{lme}(x, confidence = 0.95, alpha = 1 - confidence,...)
   \method{ci}{mer}(x, confidence = 0.95, alpha = 1 - confidence,
-                    sim.mer=TRUE, n.sim=1000, ...) 
+                    sim.mer=TRUE, n.sim=10000, ...) 
 }
 \arguments{
   \item{x}{ object from which to compute confidence intervals. }

Modified: trunk/gmodels/man/glh.test.Rd
===================================================================
--- trunk/gmodels/man/glh.test.Rd	2012-04-03 19:49:53 UTC (rev 1522)
+++ trunk/gmodels/man/glh.test.Rd	2012-04-19 17:50:20 UTC (rev 1523)
@@ -10,8 +10,8 @@
 }
 \usage{
 glh.test(reg, cm, d=rep(0, nrow(cm)) )
-print.glh.test(x, digits=4,...)
-summary.glh.test(object, digits=4,...)
+\method{print}{glh.test}(x, digits=4,...)
+\method{summary}{glh.test}(object, digits=4,...)
 }
 
 \arguments{

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1522] trunk/gdata/R/startsWith.R

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

Revision: 1522
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1522&view=rev
Author:   warnes
Date:     2012-04-03 19:49:53 +0000 (Tue, 03 Apr 2012)
Log Message:
-----------
Add startsWith() function.

Added Paths:
-----------
    trunk/gdata/R/startsWith.R

Added: trunk/gdata/R/startsWith.R
===================================================================
--- trunk/gdata/R/startsWith.R	                        (rev 0)
+++ trunk/gdata/R/startsWith.R	2012-04-03 19:49:53 UTC (rev 1522)
@@ -0,0 +1,5 @@
+startsWith <- function(str, pattern, trim=FALSE)
+  {
+    if(trim) str <- trim(str)
+    substr(str,start=1,stop=nchar(pattern))==pattern
+  }

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1521] trunk/gmodels/R/ci.R

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

Revision: 1521
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1521&view=rev
Author:   warnes
Date:     2011-12-14 18:17:29 +0000 (Wed, 14 Dec 2011)
Log Message:
-----------
Improve formatting of ci.mer().

Modified Paths:
--------------
    trunk/gmodels/R/ci.R

Modified: trunk/gmodels/R/ci.R
===================================================================
--- trunk/gmodels/R/ci.R	2011-12-14 18:14:03 UTC (rev 1520)
+++ trunk/gmodels/R/ci.R	2011-12-14 18:17:29 UTC (rev 1521)
@@ -68,26 +68,26 @@
     retval
   }
 
-ci.mer <- function(x,
-                    confidence=0.95,
-                    alpha=1-confidence,
-                    sim.mer=TRUE,
-                    n.sim=1000,
-                    ...
-                    )
+ci.mer <- function (x, 
+                    confidence = 0.95, 
+                    alpha = 1 - confidence, 
+                    sim.mer = TRUE, 
+                    n.sim = 1e4,
+                    ...) 
 {
-##   if(!(require(coda, quietly=TRUE) & require(Matrix, quietly=TRUE)))
-##     stop("coda and Matrix packages required for ci.mer")
-  
-  x.effects <- fixef(x)
-  n <- length(x.effects)
-  
-  retval <- est.mer(obj = x, cm = diag(n), beta0 = rep(0, n),
-                     conf.int = confidence, show.beta0 = FALSE,
-                     n.sim = n.sim)[,c("Estimate", "Lower.CI", "Upper.CI",
-                                     "Std. Error", "p value")]
-  
-  colnames(retval)[c(2:3, 5)] <- c("CI lower", "CI upper", "p-value")
-  rownames(retval) <- names(x.effects)
-  retval
+    x.effects <- x@fixef
+    n <- length(x.effects)
+
+    retval <- gmodels:::est.mer(obj = x, 
+                                cm = diag(n),
+                                beta0 = rep(0, n), 
+                                conf.int = confidence,
+                                show.beta0 = FALSE,
+                                n.sim = n.sim)
+
+    retval <- retval[, c("Estimate", "Lower.CI", "Upper.CI", "Std. Error", "p value")]
+    colnames(retval)[c(2:3, 5)] <- c("CI lower", "CI upper", "p-value")
+    rownames(retval) <- names(x.effects)
+    
+    retval
 }

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1520] trunk/gmodels/R/est.mer.R

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

Revision: 1520
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1520&view=rev
Author:   warnes
Date:     2011-12-14 18:14:03 +0000 (Wed, 14 Dec 2011)
Log Message:
-----------
Modify est.mer to work with recent lme4 'mer' S4 objects.

Modified Paths:
--------------
    trunk/gmodels/R/est.mer.R

Modified: trunk/gmodels/R/est.mer.R
===================================================================
--- trunk/gmodels/R/est.mer.R	2011-12-09 09:22:25 UTC (rev 1519)
+++ trunk/gmodels/R/est.mer.R	2011-12-14 18:14:03 UTC (rev 1520)
@@ -7,19 +7,18 @@
 
 est.mer <- function(obj, cm, beta0, conf.int, show.beta0, n.sim)
 {
-##   if(!require(coda, quietly=TRUE))
-##     stop("coda package required when sim.mer == TRUE")
 
   samp <- mcmcsamp(obj, n.sim)
-##  samp.summ <- summary(samp)
+  ##  samp.summ <- summary(samp)
 
   if(is.null(dim(cm)))
     n <- length(cm)
   else
     n <- dim(cm)[2]
-                               # drop extra information on end
-  samp.cm <- as.matrix(samp)[, 1:n] %*% t(cm)
 
+  ## drop extra information on end
+  samp.cm <- as.matrix(samp@fixef)[, 1:n] %*% t(cm)
+
   # calculate requested statistics
   est <- apply(samp.cm, 2, mean)
   stderr <- sd(samp.cm)

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

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

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

Revision: 1519
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1519&view=rev
Author:   warnes
Date:     2011-12-09 09:22:25 +0000 (Fri, 09 Dec 2011)
Log Message:
-----------
Add 'lwd' (linewidth) to arguments handled by plotmeans.

Modified Paths:
--------------
    trunk/gplots/R/plotmeans.R
    trunk/gplots/man/plotmeans.Rd

Modified: trunk/gplots/R/plotmeans.R
===================================================================
--- trunk/gplots/R/plotmeans.R	2011-10-05 17:05:54 UTC (rev 1518)
+++ trunk/gplots/R/plotmeans.R	2011-12-09 09:22:25 UTC (rev 1519)
@@ -13,6 +13,7 @@
                         legends=names(means),
                         xaxt,
                         use.t = TRUE,
+                        lwd,
                         ...)
 {
   is.R <- get("is.R")
@@ -47,7 +48,7 @@
   m$col  <- m$barwidth  <- NULL
   m$digits  <- m$mean.labels  <- m$ci.label  <- m$n.label <- NULL
   m$connect  <- m$ccol  <-  m$legends <- m$labels<- NULL
-  m$xaxt <- m$use.t <- NULL
+  m$xaxt <- m$use.t <- m$lwd <- NULL
   m[[1]] <- as.name("model.frame")
   mf <- eval(m, parent.frame())
   response <- attr(attr(mf, "terms"), "response")
@@ -141,7 +142,7 @@
             lines(x=connect[[which]],y=means[connect[[which]]],col=ccol[which])
         }
       else
-        lines(means, ..., col=ccol)
+        lines(means, ..., lwd=lwd, col=ccol)
     }
 
 

Modified: trunk/gplots/man/plotmeans.Rd
===================================================================
--- trunk/gplots/man/plotmeans.Rd	2011-10-05 17:05:54 UTC (rev 1518)
+++ trunk/gplots/man/plotmeans.Rd	2011-12-09 09:22:25 UTC (rev 1519)
@@ -11,7 +11,8 @@
           xlab=names(mf)[2], ylab=names(mf)[1], mean.labels=FALSE,
           ci.label=FALSE, n.label=TRUE, digits=getOption("digits"),
           col="black", barwidth=1, barcol="blue",
-          connect=TRUE, ccol=col, legends=names(means), xaxt, use.t=TRUE, ...)
+          connect=TRUE, ccol=col, legends=names(means), xaxt,
+          use.t=TRUE, lwd, ...)
 }
 %
 %\usage{
@@ -91,7 +92,9 @@
     default, a t distribution will the correct number of degrees of
     freedom for each group be used.  If \code{FALSE}, the a normal
     distribution will be used.}
-
+  
+  \item{lwd}{Width of connecting lines  }
+  
   \item{\dots}{ optional plotting parameters. }
 
   }

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1518] trunk/gtools/DESCRIPTION

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

Revision: 1518
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1518&view=rev
Author:   warnes
Date:     2011-10-05 17:05:54 +0000 (Wed, 05 Oct 2011)
Log Message:
-----------
Update version number for release

Modified Paths:
--------------
    trunk/gtools/DESCRIPTION

Modified: trunk/gtools/DESCRIPTION
===================================================================
--- trunk/gtools/DESCRIPTION	2011-10-05 16:53:39 UTC (rev 1517)
+++ trunk/gtools/DESCRIPTION	2011-10-05 17:05:54 UTC (rev 1518)
@@ -1,8 +1,8 @@
 Package: gtools
 Title: Various R programming tools
 Description: Various R programming tools
-Version: 2.6.3
-Date: 2010-09-28
+Version: 2.6.4
+Date: 2010-10-05
 Author: Gregory R. Warnes. Includes R source code and/or documentation
         contributed by Ben Bolker and Thomas Lumley
 Maintainer: Gregory R. Warnes <gr...@wa...>

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1517] trunk/gtools

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

Revision: 1517
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1517&view=rev
Author:   warnes
Date:     2011-10-05 16:53:39 +0000 (Wed, 05 Oct 2011)
Log Message:
-----------
Add 'sep' argument to smartbind() to allow specification of character used to separate components of constructed names

Modified Paths:
--------------
    trunk/gtools/R/smartbind.R
    trunk/gtools/man/smartbind.Rd

Modified: trunk/gtools/R/smartbind.R
===================================================================
--- trunk/gtools/R/smartbind.R	2011-10-05 15:31:55 UTC (rev 1516)
+++ trunk/gtools/R/smartbind.R	2011-10-05 16:53:39 UTC (rev 1517)
@@ -2,7 +2,7 @@
 ## Function to do rbind of data frames quickly, even if the columns don't match
 ##
 
-smartbind <- function(..., fill=NA)
+smartbind <- function(..., fill=NA, sep=':')
   {
     verbose <- FALSE
     
@@ -26,7 +26,7 @@
     rowNameList <- unlist(lapply( names(data),
                                  function(x) 
                                    if(rowLens[x]<=1) x
-                                   else paste(x, seq(1,rowLens[x]),sep='.'))
+                                   else paste(x, seq(1,rowLens[x]),sep=sep))
                           )
 
        

Modified: trunk/gtools/man/smartbind.Rd
===================================================================
--- trunk/gtools/man/smartbind.Rd	2011-10-05 15:31:55 UTC (rev 1516)
+++ trunk/gtools/man/smartbind.Rd	2011-10-05 16:53:39 UTC (rev 1517)
@@ -5,12 +5,14 @@
   Efficient rbind of data frames, even if the column names don't match
 }
 \usage{
-smartbind(..., fill=NA)
+smartbind(..., fill=NA, sep=':')
 }
 \arguments{
   \item{\dots}{Data frames to combine}
   \item{fill}{Value to use when 'filling' missing columns.
     Defaults to \code{NA}. }
+  \item{sep}{Character string used to separate column names when pasting
+    them together.}
 }
 \value{
   The returned data frame will contain:

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1516] trunk/gdata/man/read.xls.Rd

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

Revision: 1516
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1516&view=rev
Author:   warnes
Date:     2011-10-05 15:31:55 +0000 (Wed, 05 Oct 2011)
Log Message:
-----------
Fix typo

Modified Paths:
--------------
    trunk/gdata/man/read.xls.Rd

Modified: trunk/gdata/man/read.xls.Rd
===================================================================
--- trunk/gdata/man/read.xls.Rd	2011-09-30 19:09:53 UTC (rev 1515)
+++ trunk/gdata/man/read.xls.Rd	2011-10-05 15:31:55 UTC (rev 1516)
@@ -103,7 +103,7 @@
    nba <- read.xls(nba.url)
    }
 
-   /dontrun{
+   \dontrun{
    # read xls file ignoring all lines prior to first containing State
    crime.url <- "http://www.jrsainfo.org/jabg/state_data2/Tribal_Data00.xls"
    crime <- read.xls(crime.url, pattern = "State")

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1515] trunk/gdata/inst/NEWS

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

Revision: 1515
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1515&view=rev
Author:   warnes
Date:     2011-09-30 19:09:53 +0000 (Fri, 30 Sep 2011)
Log Message:
-----------
Update DESCRIPTION and README for 2.9.0 release.

Modified Paths:
--------------
    trunk/gdata/inst/NEWS

Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS	2011-09-30 19:09:17 UTC (rev 1514)
+++ trunk/gdata/inst/NEWS	2011-09-30 19:09:53 UTC (rev 1515)
@@ -1,3 +1,18 @@
+Changes in 2.9.0 (2011-09-30)
+-----------------------------
+
+New features:
+
+- Add centerText() function to center text strings for a specified
+  width.
+
+- Add case() function, a vectorized variant of the base::switch()
+  function, which is useful for converting numeric codes into factors.
+
+Enhancements:
+
+- Minor improvements to xls2csv() man page.
+
 CHANGES IN 2.8.1 (2011-04-15)
 -----------------------------
 

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1514] trunk/gdata/DESCRIPTION

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

Revision: 1514
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1514&view=rev
Author:   warnes
Date:     2011-09-30 19:09:17 +0000 (Fri, 30 Sep 2011)
Log Message:
-----------
Update DESCRIPTION and README for 2.9.0 release.

Modified Paths:
--------------
    trunk/gdata/DESCRIPTION

Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION	2011-09-28 22:56:42 UTC (rev 1513)
+++ trunk/gdata/DESCRIPTION	2011-09-30 19:09:17 UTC (rev 1514)
@@ -3,8 +3,8 @@
 Description: Various R programming tools for data manipulation
 Depends: R (>= 2.6.0)
 Imports: gtools
-Version: 2.8.2
-Date: 2011-04-15
+Version: 2.9.0
+Date: 2011-09-30
 Author: Gregory R. Warnes, with contributions from Ben Bolker, Gregor Gorjanc, 
         Gabor Grothendieck, Ales Korosec, Thomas Lumley, Don MacQueen, 
         Arni Magnusson, Jim Rogers, and others

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1513] trunk/gtools/R/smartbind.R

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

Revision: 1513
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1513&view=rev
Author:   warnes
Date:     2011-09-28 22:56:42 +0000 (Wed, 28 Sep 2011)
Log Message:
-----------
smartbind(): Prevent coersion to data frame from mangling column names.

Modified Paths:
--------------
    trunk/gtools/R/smartbind.R

Modified: trunk/gtools/R/smartbind.R
===================================================================
--- trunk/gtools/R/smartbind.R	2011-09-28 22:53:47 UTC (rev 1512)
+++ trunk/gtools/R/smartbind.R	2011-09-28 22:56:42 UTC (rev 1513)
@@ -15,7 +15,7 @@
                    if(is.matrix(x) || is.data.frame(x))
                      x
                    else
-                     data.frame(as.list(x))
+                     data.frame(as.list(x), check.names=FALSE)
                    )
 
     #retval <- new.env()

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

[R-gregmisc-users] SF.net SVN: r-gregmisc:[1512] trunk/gtools

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

Revision: 1512
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1512&view=rev
Author:   warnes
Date:     2011-09-28 22:53:47 +0000 (Wed, 28 Sep 2011)
Log Message:
-----------
Add 'fill' argument to smartbind() to specify a value to use for
missing entries.

Modified Paths:
--------------
    trunk/gtools/R/smartbind.R
    trunk/gtools/inst/NEWS

Modified: trunk/gtools/R/smartbind.R
===================================================================
--- trunk/gtools/R/smartbind.R	2011-09-28 22:53:02 UTC (rev 1511)
+++ trunk/gtools/R/smartbind.R	2011-09-28 22:53:47 UTC (rev 1512)
@@ -2,7 +2,7 @@
 ## Function to do rbind of data frames quickly, even if the columns don't match
 ##
 
-smartbind <- function(...)
+smartbind <- function(..., fill=NA)
   {
     verbose <- FALSE
     
@@ -47,7 +47,7 @@
                   newclass <- "character"
                 else
                   newclass <- class(block[,col])
-                retval[[col]] <- as.vector(rep(NA,nrows), mode=newclass)
+                retval[[col]] <- as.vector(rep(fill,nrows), mode=newclass)
               }
             
             retval[[col]][start:end] <- as.vector(block[,col],

Modified: trunk/gtools/inst/NEWS
===================================================================
--- trunk/gtools/inst/NEWS	2011-09-28 22:53:02 UTC (rev 1511)
+++ trunk/gtools/inst/NEWS	2011-09-28 22:53:47 UTC (rev 1512)
@@ -1,4 +1,11 @@
+gtools 2.6.2 - 2011-09-28
+-------------------------
 
+New features:
+
+- Add 'fill' argument to smartbind() to specify a value to use for
+  missing entries.
+
 gtools 2.6.1
 ------------
 

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