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

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

Revision: 973
Author:   warnes
Date:     2006-08-02 12:04:55 -0700 (Wed, 02 Aug 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=973&view=rev

Log Message:
-----------
Integrate changes suggested by Gregor Gorjanc

Modified Paths:
--------------
    trunk/gdata/NAMESPACE
    trunk/gdata/R/drop.levels.R
    trunk/gdata/R/trim.R
    trunk/gdata/man/drop.levels.Rd
    trunk/gdata/man/trim.Rd
Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE	2006-07-28 23:21:13 UTC (rev 972)
+++ trunk/gdata/NAMESPACE	2006-08-02 19:04:55 UTC (rev 973)
@@ -36,5 +36,11 @@
 S3method(trim, character)
 S3method(trim, default)
 S3method(trim, factor)
+S3method(trim, list)
+S3method(trim, data.frame)
 S3method(reorder,factor)
 
+S3method(drop.levels, default)
+S3method(drop.levels, factor)
+S3method(drop.levels, list)
+S3method(drop.levels, data.frame)

Modified: trunk/gdata/R/drop.levels.R
===================================================================
--- trunk/gdata/R/drop.levels.R	2006-07-28 23:21:13 UTC (rev 972)
+++ trunk/gdata/R/drop.levels.R	2006-08-02 19:04:55 UTC (rev 973)
@@ -1,10 +1,24 @@
-drop.levels <- function(x, reorder = TRUE, ...) {
- as.data.frame(lapply(x, function(xi) {
-    if(is.factor(xi)) {
-      xi <- factor(xi)
-      if(reorder)
-        xi <- reorder(xi, ...)
-    }
-    xi
-  }))
+
+drop.levels  <- function(x, reorder=TRUE, ...)
+  UseMethod("drop.levels")
+
+drop.levels.default <- function(x, reorder=TRUE, ...)
+  return(x)
+
+drop.levels.factor <- function(x, reorder=TRUE, ...)
+{
+  x <- factor(x)
+  if(reorder) x <- reorder(x, ...)
+  return(x)
 }
+
+drop.levels.list <- function(x, reorder=TRUE, ...)
+{
+  return(lapply(x, drop.levels, reorder=reorder, ...))
+}
+
+drop.levels.data.frame <- function(x, reorder=TRUE, ...)
+{
+  x[] <- drop.levels.list(x, reorder=reorder, ...)
+  return(x)
+}

Modified: trunk/gdata/R/trim.R
===================================================================
--- trunk/gdata/R/trim.R	2006-07-28 23:21:13 UTC (rev 972)
+++ trunk/gdata/R/trim.R	2006-08-02 19:04:55 UTC (rev 973)
@@ -1,23 +1,29 @@
 # $Id$
 
 trim <- function(s)
-  UseMethod("trim",s)
+  UseMethod("trim", s)
 
 trim.default <- function(s)
-  {
-    s <- sub("^ +","",s)
-    s <- sub(" +$","",s)
-    s
-  }
+  return(s)
 
 trim.character <- function(s)
 {
-  return(trim.default(s))
+  s <- sub(pattern="^ +", replacement="", x=s)
+  s <- sub(pattern=" +$", replacement="", x=s)
+  return(s)
 }
 
 trim.factor <- function(s)
 {
-  levels(s) <- trim.default(levels(s))
+  levels(s) <- trim(levels(s))
   return(s)
 }
 
+trim.list <- function(s)
+  return(lapply(s, trim))
+
+trim.data.frame <- function(s)
+{
+  s[] <- trim.list(s)
+  return(s)
+}

Modified: trunk/gdata/man/drop.levels.Rd
===================================================================
--- trunk/gdata/man/drop.levels.Rd	2006-07-28 23:21:13 UTC (rev 972)
+++ trunk/gdata/man/drop.levels.Rd	2006-08-02 19:04:55 UTC (rev 973)
@@ -3,18 +3,43 @@
 \name{drop.levels}
 \alias{drop.levels}
 \title{Drop unused factor levels}
-\description{Drop unused factor levels for every factor variable in a data frame.
-}
+\description{Drop unused levels in a factor.}
 \usage{
-drop.levels(x, reorder = TRUE, ...)
+drop.levels(x, reorder=TRUE, ...)
 }
 \arguments{
-  \item{x}{a data frame}
+  \item{x}{object to be processed}
   \item{reorder}{should factor levels be reordered using
     \code{\link{reorder.factor}}?}
   \item{...}{additional arguments to \code{reorder.factor}}
 }
-\value{a data frame
+
+\details{
+
+\code{drop.levels} is a generic function, where default method does
+nothing, while method for factor \code{s} drops all unused levels. There
+are also convinient methods for \code{list} and \code{data.frame}, where
+all unused levels are droped in all factors (one by one) in a
+\code{list} or a \code{data.frame}.
+
 }
+
+\value{a data frame}
+
 \author{Jim Rogers \email{jam...@pf...}}
+
+\examples{
+
+f <- factor(c("A", "B", "C", "D"))[1:3]
+drop.levels(f)
+
+l <- list(f=f, i=1:3, c=c("A", "B", "D"))
+drop.levels(l)
+
+df <- as.data.frame(l)
+str(df)
+str(drop.levels(df))
+
+}
+
 \keyword{manip}

Modified: trunk/gdata/man/trim.Rd
===================================================================
--- trunk/gdata/man/trim.Rd	2006-07-28 23:21:13 UTC (rev 972)
+++ trunk/gdata/man/trim.Rd	2006-08-02 19:04:55 UTC (rev 973)
@@ -8,15 +8,34 @@
 trim(s)
 }
 \arguments{
-  \item{s}{character string(s) to be processed}
+  \item{s}{object to be processed}
 }
+
+\details{
+
+\code{trim} is a generic function, where default method does nothing,
+while method for character \code{s} trims its elements and method for
+factor \code{s} trims \code{\link{levels}}. There are also methods for
+\code{list} and \code{data.frame}.
+
+}
 \value{
-  Elements of \code{s} with all leading and traling spaces removed.
+  \code{s} with all leading and traling spaces removed in its elements.
 }
 \author{ Gregory R. Warnes \email{gre...@pf...} }
 \seealso{ \code{\link[base]{sub}}, \code{\link[base]{gsub}} }
 \examples{
 s <- "    this is an example string    "
 trim(s)
+
+f <- c(s, s, " A", " B ", "  C ", "D ")
+trim(f)
+
+l <- list(s=rep(s, times=6), f=f, i=1:6)
+trim(l)
+
+df <- as.data.frame(l)
+trim(df)
+
 }
 \keyword{character}


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