Thread: [R-gregmisc-users] SF.net SVN: r-gregmisc: [940] trunk/gdata
Brought to you by:
warnes
Menu
▾
▴
r-gregmisc-users
|
From: <nj...@us...> - 2006-03-14 18:00:27
|
Revision: 940 Author: nj7w Date: 2006-03-14 10:00:18 -0800 (Tue, 14 Mar 2006) ViewCVS: http://svn.sourceforge.net/r-gregmisc/?rev=940&view=rev Log Message: ----------- Fixed R CMD check errors and added trim.default to NAMESPACE Modified Paths: -------------- trunk/gdata/NAMESPACE trunk/gdata/R/trim.R trunk/gdata/man/resample.Rd Modified: trunk/gdata/NAMESPACE =================================================================== --- trunk/gdata/NAMESPACE 2006-03-13 19:50:48 UTC (rev 939) +++ trunk/gdata/NAMESPACE 2006-03-14 18:00:18 UTC (rev 940) @@ -33,5 +33,8 @@ S3method(nobs,data.frame) S3method(nobs,default) S3method(nobs,lm) +S3method(trim, character) +S3method(trim, default) +S3method(trim, factor) S3method(reorder,factor) Modified: trunk/gdata/R/trim.R =================================================================== --- trunk/gdata/R/trim.R 2006-03-13 19:50:48 UTC (rev 939) +++ trunk/gdata/R/trim.R 2006-03-14 18:00:18 UTC (rev 940) @@ -1,6 +1,9 @@ # $Id$ trim <- function(s) + UseMethod("trim",s) + +trim.default <- function(s) { s <- sub("^ +","",s) s <- sub(" +$","",s) @@ -9,12 +12,12 @@ trim.character <- function(s) { - return(trim(s)) + return(trim.default(s)) } trim.factor <- function(s) { - levels(s) <- trim(levels(s)) + levels(s) <- trim.default(levels(s)) return(s) } Modified: trunk/gdata/man/resample.Rd =================================================================== --- trunk/gdata/man/resample.Rd 2006-03-13 19:50:48 UTC (rev 939) +++ trunk/gdata/man/resample.Rd 2006-03-14 18:00:18 UTC (rev 940) @@ -57,5 +57,4 @@ sample(x, n, ...) } } -\keyword{ ~kwd1 }% at least one, from doc/KEYWORDS -\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line +\keyword{misc}% at least one, from doc/KEYWORDS This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <wa...@us...> - 2006-08-02 19:04:59
|
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. |
|
From: <wa...@us...> - 2006-08-03 22:26:45
|
Revision: 978 Author: warnes Date: 2006-08-03 15:26:30 -0700 (Thu, 03 Aug 2006) ViewCVS: http://svn.sourceforge.net/r-gregmisc/?rev=978&view=rev Log Message: ----------- Add Gregor Gorjanc's mapFactor() and combineLevels() functions. Modified Paths: -------------- trunk/gdata/DESCRIPTION trunk/gdata/NAMESPACE Added Paths: ----------- trunk/gdata/R/combineLevels.R trunk/gdata/R/mapFactor.R trunk/gdata/man/combineLevels.Rd trunk/gdata/man/mapFactor.Rd Modified: trunk/gdata/DESCRIPTION =================================================================== --- trunk/gdata/DESCRIPTION 2006-08-02 22:21:49 UTC (rev 977) +++ trunk/gdata/DESCRIPTION 2006-08-03 22:26:30 UTC (rev 978) @@ -3,9 +3,8 @@ Description: Various R programming tools for data manipulation Depends: R (>= 1.9.0) Imports: gtools -Version: 2.1.3 -Date: 2005-10-27 +Version: 2.2.0 Author: Gregory R. Warnes. Includes R source code and/or documentation - contributed by Ben Bolker and Thomas Lumley + contributed by Ben Bolker, Gregor Gorjanc, and Thomas Lumley Maintainer: Gregory Warnes <gre...@ur...> License: GPL (version 2 or later) Modified: trunk/gdata/NAMESPACE =================================================================== --- trunk/gdata/NAMESPACE 2006-08-02 22:21:49 UTC (rev 977) +++ trunk/gdata/NAMESPACE 2006-08-03 22:26:30 UTC (rev 978) @@ -3,6 +3,7 @@ Args, aggregate.table, combine, + combineLevels, ConvertMedUnits, drop.levels, elem, @@ -13,7 +14,8 @@ keep, ll, lowerTriangle, - "lowerTriangle<-", + "lowerTriangle<-", + mapFactor, matchcols, nobs, read.xls, Added: trunk/gdata/R/combineLevels.R =================================================================== --- trunk/gdata/R/combineLevels.R (rev 0) +++ trunk/gdata/R/combineLevels.R 2006-08-03 22:26:30 UTC (rev 978) @@ -0,0 +1,26 @@ +## combineLevels.R +###------------------------------------------------------------------------ +## What: Joint levels of given factors +## $Id: combineLevels.R,v 1.1 2006/04/08 01:58:36 ggorjan Exp $ +## Time-stamp: <2006-04-08 03:57:53 ggorjan> +###------------------------------------------------------------------------ + +combineLevels <- function(x, apply=TRUE, drop=FALSE) +{ + if (!is.factor(x)) { + if (sum(!(c("data.frame", "list") %in% class(x))) == 2) + stop(paste(sQuote("x"), "must be a", dQuote("data.frame"), "or a", dQuote("list"))) + if (any(!(unlist((lapply(x, is.factor)))))) + stop(paste("only", dQuote("factors"), "are supported")) + if (drop) x <- lapply(x, factor) + levs <- sort(unique(unlist(lapply(x, levels)))) + if (!apply) return(levs) + return(lapply(x, "levels<-", mapFactor(levs, codes=FALSE))) + } + if (drop) x <- factor(x) + if (!apply) return(levels(x)) + return(x) +} + +###------------------------------------------------------------------------ +## combineLevels.R ends here Added: trunk/gdata/R/mapFactor.R =================================================================== --- trunk/gdata/R/mapFactor.R (rev 0) +++ trunk/gdata/R/mapFactor.R 2006-08-03 22:26:30 UTC (rev 978) @@ -0,0 +1,38 @@ +## mapFactor.R +###------------------------------------------------------------------------ +## What: Get a map of levels in a factor +## $Id: mapFactor.R,v 1.1 2006/03/29 13:47:15 ggorjan Exp ggorjan $ +## Time-stamp: <2006-04-06 01:35:30 ggorjan> +###------------------------------------------------------------------------ + +mapFactor <- function(x, codes=TRUE, sort=TRUE, drop=FALSE, ...) +{ + ## --- Check --- + msg <- "x must be a factor or character" + if (!is.factor(x)) { + if (!is.character(x)) stop(msg) + } + + ## --- Create a map --- + if (is.factor(x)) { # factor + if (drop) x <- factor(x) + nlevs <- nlevels(x) + levs <- levels(x) + if (sort) levs <- sort(levs, ...) + } else { # character + levs <- unique(x) + if (sort) levs <- sort(levs, ...) + nlevs <- length(levs) + } + tmp <- vector("list", nlevs) + names(tmp) <- levs + if (codes) { + tmp[1:nlevs] <- 1:nlevs + } else { + tmp[1:nlevs] <- levs + } + return(tmp) +} + +###------------------------------------------------------------------------ +## mapFactor.R ends here Added: trunk/gdata/man/combineLevels.Rd =================================================================== --- trunk/gdata/man/combineLevels.Rd (rev 0) +++ trunk/gdata/man/combineLevels.Rd 2006-08-03 22:26:30 UTC (rev 978) @@ -0,0 +1,61 @@ +% combineLevels.Rd +%-------------------------------------------------------------------------- +% What: Combine levels of given factors +% $Id: combineLevels.Rd,v 1.1 2006/03/29 13:47:10 ggorjan Exp ggorjan $ +% Time-stamp: <2006-06-27 09:30:42 ggorjan> +%-------------------------------------------------------------------------- + +\name{combineLevels} + +\alias{combineLevels} + +\title{Combine levels of given factors} + +\description{ +\code{combineLevels} combines levels of given factors and applies this +levels to given factors. This eases the work with factors since all +factors have the same levels. +} + +\usage{ +combineLevels(x, apply=TRUE, drop=FALSE) +} + +\arguments{ + \item{x}{data.frame or list, object with factors} + \item{apply}{boolean, apply combined levels to \code{x} or just return + combined levels} + \item{drop}{boolean, drop unused levels} +} + +\value{\code{apply} handles the output. If \code{apply=TRUE} the output + is a modified \code{x}, where all factors have the same set of + levels. If \code{apply=FALSE} only combined levels are returned. +} + +\author{Gregor Gorjanc} + +\seealso{ + \code{\link{factor}}, \code{\link{levels}}, \code{\link[ggmisc]{mapFactor}} +} + +\examples{ + +(f1 <- factor(letters[1:5])) +(f2 <- factor(letters[3:10])) +tmp <- list(f1, f2) +combineLevels(tmp) +combineLevels(tmp, apply=FALSE) + +f1[2] <- NA +f1 <- factor(f1) +tmp <- list(f1, f2) +combineLevels(tmp, apply=FALSE, drop=TRUE) + +} + +\keyword{misc} +\keyword{manip} + +%-------------------------------------------------------------------------- +% combineLevels.Rd ends here Added: trunk/gdata/man/mapFactor.Rd =================================================================== --- trunk/gdata/man/mapFactor.Rd (rev 0) +++ trunk/gdata/man/mapFactor.Rd 2006-08-03 22:26:30 UTC (rev 978) @@ -0,0 +1,81 @@ +% mapFactor.Rd +%-------------------------------------------------------------------------- +% What: Get a map of levels in a factor man page +% $Id: mapFactor.Rd,v 1.1 2006/03/29 13:47:10 ggorjan Exp ggorjan $ +% Time-stamp: <2006-06-27 09:31:03 ggorjan> +%-------------------------------------------------------------------------- + +\name{mapFactor} + +\alias{mapFactor} + +\title{Get a map of levels in a factor} + +\description{ +\code{mapFactor} produces a list with information on levels and internal +integer codes. As such can be conveniently used to store factor map when +one needs to work with internal codes of a factor and later transfrorm +back to factor. +} + +\usage{ +mapFactor(x, codes=TRUE, sort=TRUE, drop=FALSE, ...) +} + +\arguments{ + \item{x}{factor, the object to be mapped} + \item{codes}{boolean, create map with internal codes or with + levels, look into value and examples} + \item{sort}{boolean, sort levels for a character, look into details} + \item{drop}{boolean, drop unused levels of a factor} + \item{...}{additional arguments for \code{sort}} +} + +\details{ + \code{sort} and \code{...} arguments provides possibility to "order" + levels and can only be used for characters and not for factors. +} + +\value{A list with names equal to levels and entries equal to internal +codes, when \code{codes=TRUE}, or entries equal to levels +otherwise. The later case is usefull, when one would like to combine +two factors with different levels. +} + +\author{Gregor Gorjanc} + +\seealso{ + \code{\link{factor}}, \code{\link{levels}}, \code{\link{unclass}}, + \code{\link{attributes}} +} + +\examples{ + +## Example with codes=TRUE +(f <- factor(letters[c(1, 1, 2, 3, 4, 5, 7, 8, 9, 8, 8, 10)])) +map <- mapFactor(f) +int <- as.integer(f) +fNew <- factor(int) +levels(fNew) <- map +fNew + +## Example with codes=FALSE +f1 <- factor(f[1:5]) +f2 <- factor(f[5:length(f)]) +map1 <- mapFactor(f1, codes=FALSE) +map2 <- mapFactor(f2, codes=FALSE) +map <- c(map1, map2) +levels(f1) <- map +levels(f2) <- map +as.integer(f1) +as.integer(f2) + +## x <- unique(map) +## names(x) <- unlist(x) +} + +\keyword{misc} +\keyword{manip} + +%-------------------------------------------------------------------------- +% mapFactor.Rd ends here This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <wa...@us...> - 2006-09-13 14:55:47
|
Revision: 979
http://svn.sourceforge.net/r-gregmisc/?rev=979&view=rev
Author: warnes
Date: 2006-09-13 07:55:37 -0700 (Wed, 13 Sep 2006)
Log Message:
-----------
Add mapLevels functions from Gregor Gorjanc, along with associated unit tests.
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/NAMESPACE
Added Paths:
-----------
trunk/gdata/R/mapLevels.R
trunk/gdata/man/mapLevels.Rd
Removed Paths:
-------------
trunk/gdata/R/combineLevels.R
trunk/gdata/R/mapFactor.R
trunk/gdata/man/combineLevels.Rd
trunk/gdata/man/mapFactor.Rd
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2006-08-03 22:26:30 UTC (rev 978)
+++ trunk/gdata/DESCRIPTION 2006-09-13 14:55:37 UTC (rev 979)
@@ -3,7 +3,7 @@
Description: Various R programming tools for data manipulation
Depends: R (>= 1.9.0)
Imports: gtools
-Version: 2.2.0
+Version: 2.3.0
Author: Gregory R. Warnes. Includes R source code and/or documentation
contributed by Ben Bolker, Gregor Gorjanc, and Thomas Lumley
Maintainer: Gregory Warnes <gre...@ur...>
Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE 2006-08-03 22:26:30 UTC (rev 978)
+++ trunk/gdata/NAMESPACE 2006-09-13 14:55:37 UTC (rev 979)
@@ -3,7 +3,6 @@
Args,
aggregate.table,
combine,
- combineLevels,
ConvertMedUnits,
drop.levels,
elem,
@@ -15,7 +14,6 @@
ll,
lowerTriangle,
"lowerTriangle<-",
- mapFactor,
matchcols,
nobs,
read.xls,
@@ -26,7 +24,16 @@
trim,
unmatrix,
upperTriangle,
- "upperTriangle<-"
+ "upperTriangle<-",
+
+ ## mapLevels stuff
+ mapLevels,
+ as.levelsMap,
+ as.listLevelsMap,
+ is.levelsMap,
+ is.listLevelsMap,
+ sort.levelsMap, ## remove in R 2.4
+ "mapLevels<-"
)
importFrom(stats, reorder, na.omit)
@@ -46,3 +53,25 @@
S3method(drop.levels, factor)
S3method(drop.levels, list)
S3method(drop.levels, data.frame)
+
+S3method(mapLevels, default)
+S3method(mapLevels, character)
+S3method(mapLevels, factor)
+S3method(mapLevels, list)
+S3method(mapLevels, data.frame)
+
+S3method(print, levelsMap)
+S3method(print, listLevelsMap)
+
+S3method("[", levelsMap)
+S3method("[", listLevelsMap)
+
+S3method(c, levelsMap)
+S3method(c, listLevelsMap)
+
+S3method(unique, levelsMap)
+## S3method(sort, levelsMap) ## uncomment in R 2.4
+
+S3method("mapLevels<-", default)
+S3method("mapLevels<-", list)
+S3method("mapLevels<-", data.frame)
Deleted: trunk/gdata/R/combineLevels.R
===================================================================
--- trunk/gdata/R/combineLevels.R 2006-08-03 22:26:30 UTC (rev 978)
+++ trunk/gdata/R/combineLevels.R 2006-09-13 14:55:37 UTC (rev 979)
@@ -1,26 +0,0 @@
-## combineLevels.R
-###------------------------------------------------------------------------
-## What: Joint levels of given factors
-## $Id: combineLevels.R,v 1.1 2006/04/08 01:58:36 ggorjan Exp $
-## Time-stamp: <2006-04-08 03:57:53 ggorjan>
-###------------------------------------------------------------------------
-
-combineLevels <- function(x, apply=TRUE, drop=FALSE)
-{
- if (!is.factor(x)) {
- if (sum(!(c("data.frame", "list") %in% class(x))) == 2)
- stop(paste(sQuote("x"), "must be a", dQuote("data.frame"), "or a", dQuote("list")))
- if (any(!(unlist((lapply(x, is.factor))))))
- stop(paste("only", dQuote("factors"), "are supported"))
- if (drop) x <- lapply(x, factor)
- levs <- sort(unique(unlist(lapply(x, levels))))
- if (!apply) return(levs)
- return(lapply(x, "levels<-", mapFactor(levs, codes=FALSE)))
- }
- if (drop) x <- factor(x)
- if (!apply) return(levels(x))
- return(x)
-}
-
-###------------------------------------------------------------------------
-## combineLevels.R ends here
Deleted: trunk/gdata/R/mapFactor.R
===================================================================
--- trunk/gdata/R/mapFactor.R 2006-08-03 22:26:30 UTC (rev 978)
+++ trunk/gdata/R/mapFactor.R 2006-09-13 14:55:37 UTC (rev 979)
@@ -1,38 +0,0 @@
-## mapFactor.R
-###------------------------------------------------------------------------
-## What: Get a map of levels in a factor
-## $Id: mapFactor.R,v 1.1 2006/03/29 13:47:15 ggorjan Exp ggorjan $
-## Time-stamp: <2006-04-06 01:35:30 ggorjan>
-###------------------------------------------------------------------------
-
-mapFactor <- function(x, codes=TRUE, sort=TRUE, drop=FALSE, ...)
-{
- ## --- Check ---
- msg <- "x must be a factor or character"
- if (!is.factor(x)) {
- if (!is.character(x)) stop(msg)
- }
-
- ## --- Create a map ---
- if (is.factor(x)) { # factor
- if (drop) x <- factor(x)
- nlevs <- nlevels(x)
- levs <- levels(x)
- if (sort) levs <- sort(levs, ...)
- } else { # character
- levs <- unique(x)
- if (sort) levs <- sort(levs, ...)
- nlevs <- length(levs)
- }
- tmp <- vector("list", nlevs)
- names(tmp) <- levs
- if (codes) {
- tmp[1:nlevs] <- 1:nlevs
- } else {
- tmp[1:nlevs] <- levs
- }
- return(tmp)
-}
-
-###------------------------------------------------------------------------
-## mapFactor.R ends here
Added: trunk/gdata/R/mapLevels.R
===================================================================
--- trunk/gdata/R/mapLevels.R (rev 0)
+++ trunk/gdata/R/mapLevels.R 2006-09-13 14:55:37 UTC (rev 979)
@@ -0,0 +1,359 @@
+### mapLevels.R
+###------------------------------------------------------------------------
+### What: Mapping levels
+### $Id: mapLevels.R,v 1.1 2006/03/29 13:47:15 ggorjan Exp ggorjan $
+### Time-stamp: <2006-08-31 02:24:45 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ mapLevels
+
+###------------------------------------------------------------------------
+
+mapLevels <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
+ combine=FALSE, ...)
+{
+ UseMethod("mapLevels")
+}
+
+mapLevels.default <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
+ combine=FALSE, ...)
+{
+ stop(sprintf("mapLevels can only be used on %s and %s atomic 'x'",
+ dQuote("factor"), dQuote("character")))
+}
+
+mapLevels.character <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
+ combine=FALSE, ...)
+{
+ return(mapLevels.factor(x=x, codes=codes, sort=sort, drop=drop, ...))
+}
+
+## Could coerce character to factor and then use factor method, but that
+## is more expensive than simple unique and length used bellow in factor
+## method
+
+mapLevels.factor <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
+ combine=FALSE, ...)
+{
+ ## --- Argument actions ----
+
+ if(is.factor(x)) { # factor
+ if(drop) x <- factor(x)
+ nlevs <- nlevels(x)
+ levs <- levels(x)
+ } else { # character
+ levs <- unique(x)
+ nlevs <- length(levs)
+ if(sort) levs <- sort(levs, ...)
+ }
+
+ ## --- Create a map ---
+
+ map <- vector(mode="list", length=nlevs)
+ names(map) <- levs
+ if(codes) {
+ map[1:nlevs] <- 1:nlevs
+ } else {
+ map[1:nlevs] <- levs
+ }
+ class(map) <- "levelsMap"
+ return(map)
+}
+
+mapLevels.list <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
+ combine=FALSE, ...)
+{
+ map <- lapply(x, mapLevels, codes=codes, sort=sort, drop=drop, ...)
+ class(map) <- "listLevelsMap"
+ if(combine) {
+ if(!codes) {
+ return(c(map, sort=sort, recursive=TRUE))
+ } else {
+ stop(sprintf("can not combine integer %s", dQuote("levelsMaps")))
+ }
+ }
+ return(map)
+}
+
+mapLevels.data.frame <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
+ combine=FALSE, ...)
+{
+ return(mapLevels.list(x, codes=codes, sort=sort, drop=drop,
+ combine=combine, ...))
+}
+
+### }}}
+### {{{ print.*
+###------------------------------------------------------------------------
+
+.unlistLevelsMap <- function(x, ind=FALSE)
+{
+ y <- unlist(x, use.names=FALSE)
+ length <- sapply(x, FUN=length)
+ names(y) <- rep(names(x), times=length)
+ if(ind) {
+ return(list(y, rep(1:length(x), times=length), length))
+ } else {
+ return(y)
+ }
+}
+
+print.levelsMap <- function(x, ...)
+{
+ x <- gdata:::.unlistLevelsMap(x)
+ print(x, ...)
+}
+
+print.listLevelsMap <- function(x, ...)
+{
+ class(x) <- "list"
+ print(x, ...)
+}
+
+### }}}
+### {{{ [.*
+###------------------------------------------------------------------------
+
+## We need these two since [.list method drops class
+
+"[.levelsMap" <- function(x, i)
+{
+ classX <- class(x)
+ class(x) <- "list"
+ x <- x[i]
+ class(x) <- classX
+ return(x)
+}
+
+"[.listLevelsMap" <- function(x, i)
+{
+ classX <- class(x)
+ class(x) <- "list"
+ x <- x[i]
+ class(x) <- classX
+ return(x)
+}
+
+### }}}
+### {{{ is.*
+###------------------------------------------------------------------------
+
+is.levelsMap <- function(x)
+ inherits(x=x, what="levelsMap")
+
+is.listLevelsMap <- function(x)
+ inherits(x=x, what="listLevelsMap")
+
+.isCharacterMap <- function(x)
+{
+ if(is(x) == "levelsMap") {
+ return(inherits(x=unlist(x), what="character"))
+ } else {
+ stop(sprintf("can be used only on %s", dQuote("levelsMap")))
+ }
+}
+
+### }}}
+### {{{ as.*
+###------------------------------------------------------------------------
+
+as.levelsMap <- function(x, check=TRUE, ...)
+{
+ if(check)
+ gdata:::.checkLevelsMap(x, method="raw")
+ class(x) <- "levelsMap"
+ return(unique(x, ...))
+}
+
+as.listLevelsMap <- function(x, check=TRUE)
+{
+ if(check)
+ gdata:::.checkListLevelsMap(x, method="raw")
+ class(x) <- "listLevelsMap"
+ return(x)
+}
+
+### }}}
+### {{{ .check*
+###------------------------------------------------------------------------
+
+.checkLevelsMap <- function(x, method) {
+ xLab <- deparse(substitute(x))
+ also <- "\b"
+ if(method == "class") {
+ also <- "also"
+ if(!is.levelsMap(x))
+ stop(sprintf("'%s' must be a %s", xLab, dQuote("levelsMap")))
+ }
+ if(!is.list(x) || is.null(names(x)))
+ stop(sprintf("'%s' must be %s a named list", xLab, also))
+
+ ## Components can be of different length
+ ## if(!all(sapply(x, FUN=length) == 1))
+ ## stop(sprintf("all components of '%s' must have length 1", xLab))
+}
+
+.checkListLevelsMap <- function(x, method) {
+ xLab <- deparse(substitute(x))
+ also <- "\b"
+ if(method == "class") {
+ also <- "also"
+ if(!is.listLevelsMap(x))
+ stop(sprintf("'%s' must be a %s", xLab, dQuote("listLevelsMap")))
+ }
+ if(!is.list(x) || any(!sapply(x, FUN=is.levelsMap)))
+ stop(sprintf("'%s' must be %s a list of %s", xLab, also,
+ dQuote("levelsMap")))
+ lapply(x, FUN=gdata:::.checkLevelsMap, method=method)
+}
+
+### }}}
+### {{{ c.*
+###------------------------------------------------------------------------
+
+c.levelsMap <- function(..., sort=TRUE, recursive=FALSE)
+{
+ x <- list(...)
+ class(x) <- "listLevelsMap"
+ return(c(x, sort=sort, recursive=TRUE))
+}
+
+c.listLevelsMap <- function(..., sort=TRUE, recursive=FALSE)
+{
+ x <- list(...)
+ lapply(x, FUN=gdata:::.checkListLevelsMap, method="class")
+ x <- unlist(x, recursive=FALSE)
+ if(!recursive) {
+ class(x) <- "listLevelsMap"
+ } else {
+ if(any(!sapply(x, FUN=gdata:::.isCharacterMap)))
+ stop(sprintf("can not combine integer %s", dQuote("levelsMaps")))
+ if(!is.null(names(x))) names(x) <- NULL
+ x <- unlist(x, recursive=FALSE)
+ ## how to merge components with the same name?
+ class(x) <- "levelsMap"
+ if(sort) x <- sort.levelsMap(x)
+ x <- unique(x)
+ }
+ return(x)
+}
+
+### }}}
+### {{{ sort
+###------------------------------------------------------------------------
+
+sort.levelsMap <- function(x, decreasing=FALSE, na.last=TRUE, ...)
+ return(x[order(names(x), na.last=na.last, decreasing=decreasing)])
+
+### }}}
+### {{{ unique
+###------------------------------------------------------------------------
+
+unique.levelsMap <- function(x, incomparables=FALSE, ...)
+{
+ ## Find duplicates
+ y <- gdata:::.unlistLevelsMap(x, ind=TRUE)
+ ## Duplicates for values and names combinations
+ test <- duplicated(cbind(y[[1]], names(y[[1]])),
+ incomparables=incomparables, ...)
+ if(any(test)) {
+ if(any(y[[3]] > 1)) { # work with the same structure as in x
+ j <- 1
+ k <- y[[3]][1]
+ empty <- NULL
+ for(i in seq(along=x)) { # how slow is this loop?
+ tmp <- !test[j:k]
+ if(all(!tmp)) { # these components will be empty
+ empty <- c(empty, i)
+ } else {
+ x[[i]] <- x[[i]][tmp]
+ }
+ j <- j + y[[3]][i]
+ k <- k + y[[3]][i + 1]
+ }
+ if(!is.null(empty))
+ x[empty] <- NULL
+ } else { # simple one-length components
+ x <- x[!test]
+ }
+ }
+ return(x)
+}
+
+### }}}
+### {{{ mapLevels<-
+###------------------------------------------------------------------------
+
+"mapLevels<-" <- function(x, value)
+ UseMethod("mapLevels<-")
+
+"mapLevels<-.default" <- function(x, value)
+{
+ ## --- Checks ---
+
+ classX <- c("integer", "character", "factor")
+ if(any(!(class(x) %in% classX)))
+ stop(sprintf("'x' must be either: %s", paste(dQuote(classX), collapse=", ")))
+
+ gdata:::.checkLevelsMap(x=value, method="class")
+
+ ## --- Mapping levels in x ---
+
+ char <- all(lapply(value, is.character))
+ int <- all(lapply(value, is.integer))
+
+ if(int) { # codes=TRUE
+ if(is.integer(x)) x <- factor(x)
+ if(is.factor(x)) levels(x) <- value
+ if(is.character(x))
+ stop(sprintf("can not apply integer %s to %s",
+ dQuote("levelsMap"), dQuote("character")))
+ } else { # codes=FALSE
+ if(!char)
+ stop("all components of 'value' must be of the same class")
+ if(is.character(x)) x <- factor(x)
+ if(is.factor(x)) levels(x) <- value
+ if(is.integer(x))
+ stop(sprintf("can not apply character %s to %s",
+ dQuote("levelsMap"), dQuote("integer")))
+ }
+
+ return(x)
+}
+
+"mapLevels<-.list" <- function(x, value)
+{
+ if(!is.listLevelsMap(value)) {
+ if(is.levelsMap(value)) {
+ value <- as.listLevelsMap(list(value), check=FALSE)
+ ## no need for check as default method does checking anyway
+ } else {
+ stop(sprintf("'x' must be either %s or %s",
+ dQuote("listLevelsMap"), dQuote("levelsMap")))
+ }
+ }
+ ## FIXME: mapply drops names
+ if(!is.null(names(x))) {
+ isNamed <- TRUE
+ namesX <- names(x)
+ }
+ x <- mapply(FUN="mapLevels<-", x=x, value=value, SIMPLIFY=FALSE)
+ if(isNamed) names(x) <- namesX
+ return(x)
+}
+
+"mapLevels<-.data.frame" <- function(x, value)
+{
+ x[] <- "mapLevels<-.list"(x, value)
+ return(x)
+}
+
+### }}}
+### {{{ Dear Emacs
+## Local variables:
+## folded-file: t
+## End:
+### }}}
+
+###------------------------------------------------------------------------
+### mapLevels.R ends here
Deleted: trunk/gdata/man/combineLevels.Rd
===================================================================
--- trunk/gdata/man/combineLevels.Rd 2006-08-03 22:26:30 UTC (rev 978)
+++ trunk/gdata/man/combineLevels.Rd 2006-09-13 14:55:37 UTC (rev 979)
@@ -1,61 +0,0 @@
-% combineLevels.Rd
-%--------------------------------------------------------------------------
-% What: Combine levels of given factors
-% $Id: combineLevels.Rd,v 1.1 2006/03/29 13:47:10 ggorjan Exp ggorjan $
-% Time-stamp: <2006-06-27 09:30:42 ggorjan>
-%--------------------------------------------------------------------------
-
-\name{combineLevels}
-
-\alias{combineLevels}
-
-\title{Combine levels of given factors}
-
-\description{
-\code{combineLevels} combines levels of given factors and applies this
-levels to given factors. This eases the work with factors since all
-factors have the same levels.
-}
-
-\usage{
-combineLevels(x, apply=TRUE, drop=FALSE)
-}
-
-\arguments{
- \item{x}{data.frame or list, object with factors}
- \item{apply}{boolean, apply combined levels to \code{x} or just return
- combined levels}
- \item{drop}{boolean, drop unused levels}
-}
-
-\value{\code{apply} handles the output. If \code{apply=TRUE} the output
- is a modified \code{x}, where all factors have the same set of
- levels. If \code{apply=FALSE} only combined levels are returned.
-}
-
-\author{Gregor Gorjanc}
-
-\seealso{
- \code{\link{factor}}, \code{\link{levels}}, \code{\link[ggmisc]{mapFactor}}
-}
-
-\examples{
-
-(f1 <- factor(letters[1:5]))
-(f2 <- factor(letters[3:10]))
-tmp <- list(f1, f2)
-combineLevels(tmp)
-combineLevels(tmp, apply=FALSE)
-
-f1[2] <- NA
-f1 <- factor(f1)
-tmp <- list(f1, f2)
-combineLevels(tmp, apply=FALSE, drop=TRUE)
-
-}
-
-\keyword{misc}
-\keyword{manip}
-
-%--------------------------------------------------------------------------
-% combineLevels.Rd ends here
Deleted: trunk/gdata/man/mapFactor.Rd
===================================================================
--- trunk/gdata/man/mapFactor.Rd 2006-08-03 22:26:30 UTC (rev 978)
+++ trunk/gdata/man/mapFactor.Rd 2006-09-13 14:55:37 UTC (rev 979)
@@ -1,81 +0,0 @@
-% mapFactor.Rd
-%--------------------------------------------------------------------------
-% What: Get a map of levels in a factor man page
-% $Id: mapFactor.Rd,v 1.1 2006/03/29 13:47:10 ggorjan Exp ggorjan $
-% Time-stamp: <2006-06-27 09:31:03 ggorjan>
-%--------------------------------------------------------------------------
-
-\name{mapFactor}
-
-\alias{mapFactor}
-
-\title{Get a map of levels in a factor}
-
-\description{
-\code{mapFactor} produces a list with information on levels and internal
-integer codes. As such can be conveniently used to store factor map when
-one needs to work with internal codes of a factor and later transfrorm
-back to factor.
-}
-
-\usage{
-mapFactor(x, codes=TRUE, sort=TRUE, drop=FALSE, ...)
-}
-
-\arguments{
- \item{x}{factor, the object to be mapped}
- \item{codes}{boolean, create map with internal codes or with
- levels, look into value and examples}
- \item{sort}{boolean, sort levels for a character, look into details}
- \item{drop}{boolean, drop unused levels of a factor}
- \item{...}{additional arguments for \code{sort}}
-}
-
-\details{
- \code{sort} and \code{...} arguments provides possibility to "order"
- levels and can only be used for characters and not for factors.
-}
-
-\value{A list with names equal to levels and entries equal to internal
-codes, when \code{codes=TRUE}, or entries equal to levels
-otherwise. The later case is usefull, when one would like to combine
-two factors with different levels.
-}
-
-\author{Gregor Gorjanc}
-
-\seealso{
- \code{\link{factor}}, \code{\link{levels}}, \code{\link{unclass}},
- \code{\link{attributes}}
-}
-
-\examples{
-
-## Example with codes=TRUE
-(f <- factor(letters[c(1, 1, 2, 3, 4, 5, 7, 8, 9, 8, 8, 10)]))
-map <- mapFactor(f)
-int <- as.integer(f)
-fNew <- factor(int)
-levels(fNew) <- map
-fNew
-
-## Example with codes=FALSE
-f1 <- factor(f[1:5])
-f2 <- factor(f[5:length(f)])
-map1 <- mapFactor(f1, codes=FALSE)
-map2 <- mapFactor(f2, codes=FALSE)
-map <- c(map1, map2)
-levels(f1) <- map
-levels(f2) <- map
-as.integer(f1)
-as.integer(f2)
-
-## x <- unique(map)
-## names(x) <- unlist(x)
-}
-
-\keyword{misc}
-\keyword{manip}
-
-%--------------------------------------------------------------------------
-% mapFactor.Rd ends here
Added: trunk/gdata/man/mapLevels.Rd
===================================================================
--- trunk/gdata/man/mapLevels.Rd (rev 0)
+++ trunk/gdata/man/mapLevels.Rd 2006-09-13 14:55:37 UTC (rev 979)
@@ -0,0 +1,221 @@
+% mapLevels.Rd
+%--------------------------------------------------------------------------
+% What: Mapping levels
+% $Id: mapLevels.Rd,v 1.1 2006/03/29 13:47:10 ggorjan Exp ggorjan $
+% Time-stamp: <2006-08-31 02:43:29 ggorjan>
+%--------------------------------------------------------------------------
+
+\name{mapLevels}
+
+\alias{mapLevels}
+\alias{mapLevels.default}
+\alias{mapLevels.factor}
+\alias{mapLevels.character}
+\alias{mapLevels.list}
+\alias{mapLevels.data.frame}
+
+\alias{print.levelsMap}
+\alias{print.listLevelsMap}
+
+\alias{is.levelsMap}
+\alias{is.listLevelsMap}
+
+\alias{as.levelsMap}
+\alias{as.listLevelsMap}
+
+\alias{.checkLevelsMap}
+\alias{.checkListLevelsMap}
+
+\alias{"[.levelsMap"}
+\alias{"[.listLevelsMap"}
+
+\alias{c.levelsMap}
+\alias{c.listLevelsMap}
+
+\alias{unique.levelsMap}
+\alias{sort.levelsMap}
+
+\alias{mapLevels<-}
+\alias{mapLevels<-.default}
+\alias{mapLevels<-.factor}
+\alias{mapLevels<-.character}
+\alias{mapLevels<-.list}
+\alias{mapLevels<-.data.frame}
+
+\title{Mapping levels}
+
+\description{
+
+\code{mapLevels} produces a map with information on levels and/or
+internal integer codes. As such can be conveniently used to store level
+mapping when one needs to work with internal codes of a factor and later
+transfrorm back to factor or when working with several factors that
+should have the same levels and therefore the same internal coding.
+
+}
+
+\usage{
+
+mapLevels(x, codes=TRUE, sort=TRUE, drop=FALSE, combine=FALSE, \ldots)
+mapLevels(x) <- value
+
+}
+
+\arguments{
+ \item{x}{object whose levels will be mapped, look into details}
+ \item{codes}{boolean, create integer levelsMap (with internal
+ codes) or character levelsMap (with level names)}
+ \item{sort}{boolean, sort levels of character \code{x}, look into
+ details}
+ \item{drop}{boolean, drop unused levels}
+ \item{combine}{boolean, combine levels, look into details}
+ \item{\ldots}{additional arguments for \code{sort}}
+ \item{value}{levelsMap or listLevelsMap, output of \code{mapLevels}
+ methods or constructed by user, look into details}
+}
+
+\section{mapLevels}{
+
+\code{mapLevels} function was written primarly for work with
+\dQuote{factors}, but is generic and can also be used with
+\dQuote{character}, \dQuote{list} and \dQuote{data.frame}, while
+\dQuote{default} method produces error. Here the term levels is also
+used for unique character values.
+
+When \code{codes=TRUE} \bold{integer \dQuote{levelsMap}} with
+information on mapping internal codes with levels is produced. Output
+can be used to transform integer to factor or remap factor levels as
+described bellow. With \code{codes=FALSE} \bold{character
+\dQuote{levelsMap}} is produced. The later is usefull, when one would
+like to remap factors or combine factors with some overlap in levels as
+described in \code{mapLevels<-} section and shown in examples.
+
+\code{sort} argument provides possibility to sort levels of
+\dQuote{character} \code{x} and has no effect when \code{x} is a
+\dQuote{factor}.
+
+Argument \code{combine} has effect only in \dQuote{list} and
+\dQuote{data.frame} methods and when \code{codes=FALSE} i.e. with
+\bold{character \dQuote{levelsMaps}}. The later condition is necesarry
+as it is not possible to combine maps with different mapping of level
+names and integer codes. It is assumed that passed \dQuote{list} and
+\dQuote{data.frame} have all components for which methods
+exist. Otherwise error is produced.
+
+}
+
+\section{levelsMap and listLevelsMap}{
+
+Function \code{mapLevels} returns a map of levels. This map is of class
+\dQuote{levelsMap}, which is actually a list of length equal to number
+of levels and with each component of length 1. Components need not be of
+length 1. There can be either integer or character
+\dQuote{levelsMap}. \bold{Integer \dQuote{levelsMap}} (when
+\code{codes=TRUE}) has names equal to levels and components equal to
+internal codes. \bold{Character \dQuote{levelsMap}} (when
+\code{codes=FALSE}) has names and components equal to levels. When
+\code{mapLevels} is applied to \dQuote{list} or \dQuote{data.frame},
+result is of class \dQuote{listLevelsMap}, which is a list of
+\dQuote{levelsMap} components described previously. If
+\code{combine=TRUE}, result is a \dQuote{levelsMap} with all levels in
+\code{x} components.
+
+For ease of inspection, print methods unlists \dQuote{levelsMap} with
+proper names. \code{mapLevels<-} methods are fairly general and
+therefore additional convenience methods are implemented to ease the
+work with maps: \code{is.levelsMap} and \code{is.listLevelsMap};
+\code{as.levelsMap} and \code{as.listLevelsMap} for coercion of user
+defined maps; generic \code{"["} and \code{c} for both classes (argument
+\code{recursive} can be used in \code{c} to coerce
+\dQuote{listLevelsMap} to \dQuote{levelsMap}) and generic \code{unique}
+and \code{sort} (generic from \R 2.4) for \dQuote{levelsMap}.
+
+}
+
+\section{mapLevels<-}{
+
+Workhorse under \code{mapLevels<-} methods is
+\code{\link{levels<-}}. \code{mapLevels<-} just control the assignment
+of \dQuote{levelsMap} (integer or character) or \dQuote{listLevelsMap}
+to \code{x}. The idea is that map values are changed to map names as
+indicated in \code{\link{levels}} examples. \bold{Integer
+\dQuote{levelsMap}} can be applied to \dQuote{integer} or
+\dQuote{factor}, while \bold{character \dQuote{levelsMap}} can be
+applied to \dQuote{character} or \dQuote{factor}. Methods for
+\dQuote{list} and \dQuote{data.frame} can work only on mentioned atomic
+components/columns and can accept either \dQuote{levelsMap} or
+\dQuote{levelsMap}. Recycling occours, if length of \code{value} is not
+the same as number of components/columns of a \dQuote{list/data.frame}.
+}
+
+\value{
+
+\code{mapLevels()} returns \dQuote{levelsMap} or \dQuote{listLevelsMap}
+objects as described in levelsMap and listLevelsMap section.
+
+Result of \code{mapLevels<-} is always a factor with remapped levels or
+a \dQuote{list/data.frame} with remapped factors.
+
+}
+
+\author{Gregor Gorjanc}
+
+\seealso{
+ \code{\link{factor}}, \code{\link{levels}} and \code{\link{unclass}}
+}
+
+\examples{
+
+## --- Integer levelsMap ---
+
+(f <- factor(sample(letters, size=20, replace=TRUE)))
+(mapInt <- mapLevels(f))
+
+## Integer to factor
+(int <- as.integer(f))
+(mapLevels(int) <- mapInt)
+all.equal(int, f)
+
+## Remap levels of a factor
+(fac <- factor(as.integer(f)))
+(mapLevels(fac) <- mapInt) # the same as levels(fac) <- mapInt
+all.equal(fac, f)
+
+## --- Character levelesMap ---
+
+f1 <- factor(letters[1:10])
+f2 <- factor(letters[5:14])
+
+## Internal codes are the same, but levels are not
+as.integer(f1)
+as.integer(f2)
+
+## Get character levelsMaps and combine them
+mapCha1 <- mapLevels(f1, codes=FALSE)
+mapCha2 <- mapLevels(f2, codes=FALSE)
+(mapCha <- c(mapCha1, mapCha2))
+
+## Remap factors
+mapLevels(f1) <- mapCha # the same as levels(f1) <- mapCha
+mapLevels(f2) <- mapCha # the same as levels(f2) <- mapCha
+
+## Internal codes are now "consistent" among factors
+as.integer(f1)
+as.integer(f2)
+
+## Remap characters to get factors
+f1 <- as.character(f1); f2 <- as.character(f2)
+mapLevels(f1) <- mapCha
+mapLevels(f2) <- mapCha
+
+## Internal codes are now "consistent" among factors
+as.integer(f1)
+as.integer(f2)
+
+}
+
+\keyword{misc}
+\keyword{manip}
+
+%--------------------------------------------------------------------------
+% mapLevels.Rd ends here
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2006-09-13 18:16:05
|
Revision: 980
http://svn.sourceforge.net/r-gregmisc/?rev=980&view=rev
Author: warnes
Date: 2006-09-13 11:15:55 -0700 (Wed, 13 Sep 2006)
Log Message:
-----------
More fixes from Gregor Gorjanc
Modified Paths:
--------------
trunk/gdata/NAMESPACE
trunk/gdata/R/drop.levels.R
trunk/gdata/R/mapLevels.R
trunk/gdata/R/trim.R
Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE 2006-09-13 14:55:37 UTC (rev 979)
+++ trunk/gdata/NAMESPACE 2006-09-13 18:15:55 UTC (rev 980)
@@ -32,8 +32,13 @@
as.listLevelsMap,
is.levelsMap,
is.listLevelsMap,
- sort.levelsMap, ## remove in R 2.4
- "mapLevels<-"
+ sort.levelsMap, ## FIXME remove in R 2.4
+ "mapLevels<-",
+
+ ## unknown stuff
+ isUnknown,
+ unknownToNA,
+ NAToUnknown
)
importFrom(stats, reorder, na.omit)
@@ -70,8 +75,23 @@
S3method(c, listLevelsMap)
S3method(unique, levelsMap)
-## S3method(sort, levelsMap) ## uncomment in R 2.4
+## S3method(sort, levelsMap) ## FIXME uncomment in R 2.4
S3method("mapLevels<-", default)
S3method("mapLevels<-", list)
S3method("mapLevels<-", data.frame)
+
+S3method(isUnknown, default)
+S3method(isUnknown, POSIXlt)
+S3method(isUnknown, list)
+S3method(isUnknown, data.frame)
+
+S3method(unknownToNA, default)
+S3method(unknownToNA, factor)
+S3method(unknownToNA, list)
+S3method(unknownToNA, data.frame)
+
+S3method(NAToUnknown, default)
+S3method(NAToUnknown, factor)
+S3method(NAToUnknown, list)
+S3method(NAToUnknown, data.frame)
Modified: trunk/gdata/R/drop.levels.R
===================================================================
--- trunk/gdata/R/drop.levels.R 2006-09-13 14:55:37 UTC (rev 979)
+++ trunk/gdata/R/drop.levels.R 2006-09-13 18:15:55 UTC (rev 980)
@@ -3,22 +3,22 @@
UseMethod("drop.levels")
drop.levels.default <- function(x, reorder=TRUE, ...)
- return(x)
+ x
drop.levels.factor <- function(x, reorder=TRUE, ...)
{
x <- factor(x)
if(reorder) x <- reorder(x, ...)
- return(x)
+ x
}
drop.levels.list <- function(x, reorder=TRUE, ...)
{
- return(lapply(x, drop.levels, reorder=reorder, ...))
+ lapply(x, drop.levels, reorder=reorder, ...)
}
drop.levels.data.frame <- function(x, reorder=TRUE, ...)
{
x[] <- drop.levels.list(x, reorder=reorder, ...)
- return(x)
+ x
}
Modified: trunk/gdata/R/mapLevels.R
===================================================================
--- trunk/gdata/R/mapLevels.R 2006-09-13 14:55:37 UTC (rev 979)
+++ trunk/gdata/R/mapLevels.R 2006-09-13 18:15:55 UTC (rev 980)
@@ -2,7 +2,7 @@
###------------------------------------------------------------------------
### What: Mapping levels
### $Id: mapLevels.R,v 1.1 2006/03/29 13:47:15 ggorjan Exp ggorjan $
-### Time-stamp: <2006-08-31 02:24:45 ggorjan>
+### Time-stamp: <2006-09-10 03:54:56 ggorjan>
###------------------------------------------------------------------------
### {{{ mapLevels
@@ -25,7 +25,7 @@
mapLevels.character <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
combine=FALSE, ...)
{
- return(mapLevels.factor(x=x, codes=codes, sort=sort, drop=drop, ...))
+ mapLevels.factor(x=x, codes=codes, sort=sort, drop=drop, ...)
}
## Could coerce character to factor and then use factor method, but that
@@ -57,7 +57,7 @@
map[1:nlevs] <- levs
}
class(map) <- "levelsMap"
- return(map)
+ map
}
mapLevels.list <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
@@ -72,14 +72,13 @@
stop(sprintf("can not combine integer %s", dQuote("levelsMaps")))
}
}
- return(map)
+ map
}
mapLevels.data.frame <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
combine=FALSE, ...)
{
- return(mapLevels.list(x, codes=codes, sort=sort, drop=drop,
- combine=combine, ...))
+ mapLevels.list(x, codes=codes, sort=sort, drop=drop, combine=combine, ...)
}
### }}}
@@ -122,7 +121,7 @@
class(x) <- "list"
x <- x[i]
class(x) <- classX
- return(x)
+ x
}
"[.listLevelsMap" <- function(x, i)
@@ -131,7 +130,7 @@
class(x) <- "list"
x <- x[i]
class(x) <- classX
- return(x)
+ x
}
### }}}
@@ -162,7 +161,7 @@
if(check)
gdata:::.checkLevelsMap(x, method="raw")
class(x) <- "levelsMap"
- return(unique(x, ...))
+ unique(x, ...)
}
as.listLevelsMap <- function(x, check=TRUE)
@@ -170,7 +169,7 @@
if(check)
gdata:::.checkListLevelsMap(x, method="raw")
class(x) <- "listLevelsMap"
- return(x)
+ x
}
### }}}
@@ -215,7 +214,7 @@
{
x <- list(...)
class(x) <- "listLevelsMap"
- return(c(x, sort=sort, recursive=TRUE))
+ c(x, sort=sort, recursive=TRUE)
}
c.listLevelsMap <- function(..., sort=TRUE, recursive=FALSE)
@@ -235,7 +234,7 @@
if(sort) x <- sort.levelsMap(x)
x <- unique(x)
}
- return(x)
+ x
}
### }}}
@@ -243,7 +242,7 @@
###------------------------------------------------------------------------
sort.levelsMap <- function(x, decreasing=FALSE, na.last=TRUE, ...)
- return(x[order(names(x), na.last=na.last, decreasing=decreasing)])
+ x[order(names(x), na.last=na.last, decreasing=decreasing)]
### }}}
### {{{ unique
@@ -277,7 +276,7 @@
x <- x[!test]
}
}
- return(x)
+ x
}
### }}}
@@ -317,8 +316,7 @@
stop(sprintf("can not apply character %s to %s",
dQuote("levelsMap"), dQuote("integer")))
}
-
- return(x)
+ x
}
"mapLevels<-.list" <- function(x, value)
@@ -339,13 +337,13 @@
}
x <- mapply(FUN="mapLevels<-", x=x, value=value, SIMPLIFY=FALSE)
if(isNamed) names(x) <- namesX
- return(x)
+ x
}
"mapLevels<-.data.frame" <- function(x, value)
{
x[] <- "mapLevels<-.list"(x, value)
- return(x)
+ x
}
### }}}
Modified: trunk/gdata/R/trim.R
===================================================================
--- trunk/gdata/R/trim.R 2006-09-13 14:55:37 UTC (rev 979)
+++ trunk/gdata/R/trim.R 2006-09-13 18:15:55 UTC (rev 980)
@@ -4,26 +4,26 @@
UseMethod("trim", s)
trim.default <- function(s)
- return(s)
+ s
trim.character <- function(s)
{
s <- sub(pattern="^ +", replacement="", x=s)
s <- sub(pattern=" +$", replacement="", x=s)
- return(s)
+ s
}
trim.factor <- function(s)
{
levels(s) <- trim(levels(s))
- return(s)
+ s
}
trim.list <- function(s)
- return(lapply(s, trim))
+ lapply(s, trim)
trim.data.frame <- function(s)
{
s[] <- trim.list(s)
- return(s)
+ s
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2006-09-18 20:24:33
|
Revision: 983
http://svn.sourceforge.net/r-gregmisc/?rev=983&view=rev
Author: warnes
Date: 2006-09-18 13:24:18 -0700 (Mon, 18 Sep 2006)
Log Message:
-----------
Integrate fixes for trim() from Gregor and myself.
Modified Paths:
--------------
trunk/gdata/R/trim.R
trunk/gdata/inst/unitTests/Makefile
trunk/gdata/inst/unitTests/runit.trim.R
trunk/gdata/man/trim.Rd
trunk/gdata/tests/doRUnit.R
Modified: trunk/gdata/R/trim.R
===================================================================
--- trunk/gdata/R/trim.R 2006-09-18 19:32:26 UTC (rev 982)
+++ trunk/gdata/R/trim.R 2006-09-18 20:24:18 UTC (rev 983)
@@ -1,29 +1,30 @@
# $Id$
-trim <- function(s)
+trim <- function(s, recode.factor=TRUE)
UseMethod("trim", s)
-trim.default <- function(s)
+trim.default <- function(s, recode.factor=TRUE)
s
-trim.character <- function(s)
+trim.character <- function(s, recode.factor=TRUE)
{
s <- sub(pattern="^ +", replacement="", x=s)
s <- sub(pattern=" +$", replacement="", x=s)
s
}
-trim.factor <- function(s)
+trim.factor <- function(s, recode.factor=TRUE)
{
levels(s) <- trim(levels(s))
+ if(recode.factor) s <- reorder.factor(s, sort=sort)
s
}
-trim.list <- function(s)
- lapply(s, trim)
+trim.list <- function(s, recode.factor=TRUE)
+ lapply(s, trim, recode.factor=recode.factor)
-trim.data.frame <- function(s)
+trim.data.frame <- function(s, recode.factor=TRUE)
{
- s[] <- trim.list(s)
+ s[] <- trim.list(s, recode.factor=recode.factor)
s
}
Modified: trunk/gdata/inst/unitTests/Makefile
===================================================================
--- trunk/gdata/inst/unitTests/Makefile 2006-09-18 19:32:26 UTC (rev 982)
+++ trunk/gdata/inst/unitTests/Makefile 2006-09-18 20:24:18 UTC (rev 983)
@@ -1,14 +1,15 @@
PKG=gdata
TOP=../..
SUITE=doRUnit.R
+R=R
all: inst test
inst: # Install package
cd ${TOP}/..;\
- R CMD INSTALL ${PKG}
+ ${R} CMD INSTALL ${PKG}
test: # Run unit tests
export RCMDCHECK=FALSE;\
cd ${TOP}/tests;\
- R --vanilla --slave < ${SUITE}
+ ${R} --vanilla --slave < ${SUITE}
Modified: trunk/gdata/inst/unitTests/runit.trim.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.trim.R 2006-09-18 19:32:26 UTC (rev 982)
+++ trunk/gdata/inst/unitTests/runit.trim.R 2006-09-18 20:24:18 UTC (rev 983)
@@ -20,8 +20,8 @@
sTrim <- " this is an example string "
sTrimR <- "this is an example string"
- fTrim <- c(sTrim, sTrim, " A", " B ", " C ", "D ")
- fTrimR <- c(sTrimR, sTrimR, "A", "B", "C", "D")
+ fTrim <- factor(c(sTrim, sTrim, " A", " B ", " C ", "D "))
+ fTrimR <- factor(c(sTrimR, sTrimR, "A", "B", "C", "D"))
lTrim <- list(s=rep(sTrim, times=6), f=fTrim, i=1:6)
lTrimR <- list(s=rep(sTrimR, times=6), f=fTrimR, i=1:6)
@@ -31,6 +31,10 @@
checkIdentical(trim(sTrim), sTrimR)
checkIdentical(trim(fTrim), fTrimR)
+ checkIdentical(
+ levels(trim(fTrim, recode.factor=FALSE)),
+ c("this is an example string", "C", "A", "B", "D")
+ )
checkIdentical(trim(lTrim), lTrimR)
checkIdentical(trim(dfTrim), dfTrimR)
}
Modified: trunk/gdata/man/trim.Rd
===================================================================
--- trunk/gdata/man/trim.Rd 2006-09-18 19:32:26 UTC (rev 982)
+++ trunk/gdata/man/trim.Rd 2006-09-18 20:24:18 UTC (rev 983)
@@ -2,13 +2,15 @@
\alias{trim}
\title{Remove leading and trailing spaces from character strings}
\description{
- Remove leading and traling spaces from character strings
+ Remove leading and trailing spaces from character strings and other
+ related objects.
}
\usage{
-trim(s)
+trim(s, recode.factor=TRUE)
}
\arguments{
\item{s}{object to be processed}
+ \item{recode.factor}{Should levels of a factor be recoded, see below}
}
\details{
@@ -18,24 +20,40 @@
factor \code{s} trims \code{\link{levels}}. There are also methods for
\code{list} and \code{data.frame}.
+Trimming character strings can change the sort order in some
+locales. For factors, this can affect the coding of levels. By
+default, factor levels are recoded to match the trimmed sort order, but
+this can be disabled by setting \code{recode.factor=FALSE}.
+
}
\value{
- \code{s} with all leading and traling spaces removed in its elements.
+ \code{s} with all leading and trailing spaces removed in its elements.
}
-\author{ Gregory R. Warnes \email{wa...@bs...} }
-\seealso{ \code{\link[base]{sub}}, \code{\link[base]{gsub}} }
+\author{ Gregory R. Warnes \email{wa...@bs...} with
+ contributions by Gregor Gorjanc}
+\seealso{ \code{\link[base]{sub}}, \code{\link[base]{gsub}} as well as
+ argument \code{strip.white} in \code{\link{read.table}}}
\examples{
s <- " this is an example string "
trim(s)
-f <- c(s, s, " A", " B ", " C ", "D ")
+f <- factor(c(s, s, " A", " B ", " C ", "D "))
+levels(f)
+
trim(f)
+levels(trim(f))
+trim(f,recode.factor=FALSE)
+levels(trim(f,recode.factor=FALSE))
+
+
l <- list(s=rep(s, times=6), f=f, i=1:6)
trim(l)
df <- as.data.frame(l)
trim(df)
+
}
+\keyword{manip}
\keyword{character}
Modified: trunk/gdata/tests/doRUnit.R
===================================================================
--- trunk/gdata/tests/doRUnit.R 2006-09-18 19:32:26 UTC (rev 982)
+++ trunk/gdata/tests/doRUnit.R 2006-09-18 20:24:18 UTC (rev 983)
@@ -1,8 +1,8 @@
-## doRUnit.R
+### doRUnit.R
###------------------------------------------------------------------------
-## What: Run RUnit tests
-## $Id$
-## Time-stamp: <2006-08-09 23:27:21 ggorjan>
+### What: Run RUnit tests
+### $Id$
+### Time-stamp: <2006-09-18 13:14:34 ggorjan>
###------------------------------------------------------------------------
if(require("RUnit", quietly=TRUE)) {
@@ -46,4 +46,4 @@
}
###------------------------------------------------------------------------
-## doRUnit.R ends here
+### doRUnit.R ends here
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2006-10-27 21:15:40
|
Revision: 987
http://svn.sourceforge.net/r-gregmisc/?rev=987&view=rev
Author: warnes
Date: 2006-10-27 14:15:22 -0700 (Fri, 27 Oct 2006)
Log Message:
-----------
Add c() method for factor objects, submitted by Gregor Gorjanc
Added Paths:
-----------
trunk/gdata/R/c.factor.R
trunk/gdata/man/c.factor.Rd
Added: trunk/gdata/R/c.factor.R
===================================================================
--- trunk/gdata/R/c.factor.R (rev 0)
+++ trunk/gdata/R/c.factor.R 2006-10-27 21:15:22 UTC (rev 987)
@@ -0,0 +1,18 @@
+# $Id$
+
+c.factor <- function(...,
+ recursive=FALSE # ignored
+ )
+{
+ dots <- list(...) # recursive below is not related to one above!
+ mapCha <- c(mapLevels(dots, codes=FALSE), recursive=TRUE)
+ class(mapCha) <- "levelsMap"
+ dots <- unlist(lapply(dots, "mapLevels<-", mapCha))
+ mapLevels(dots) <- mapLevels(as.character(mapCha))
+ dots
+}
+
+
+
+
+
Added: trunk/gdata/man/c.factor.Rd
===================================================================
--- trunk/gdata/man/c.factor.Rd (rev 0)
+++ trunk/gdata/man/c.factor.Rd 2006-10-27 21:15:22 UTC (rev 987)
@@ -0,0 +1,35 @@
+%% $Id$
+
+\name{c.factor}
+\alias{c.factor}
+\title{Combine factors, properly handling levels}
+\description{
+ This method for \code{c} combines factors while properly preserves level
+ information.
+}
+\usage{
+c.factor(..., recursive = FALSE)
+}
+\arguments{
+ \item{\dots}{ factors to be combined }
+ \item{recursive}{ ignored }
+}
+\details{
+
+}
+\value{
+ A single factor object. The levels on the new object are created by
+ concatinating the levels of the provided factors, with any duplicate
+ level names merged, and with the factor coding modified appropriately.
+}
+\author{Gregor Gorjan}
+\seealso{ \code{\link[base]{c}} }
+\examples{
+f1 <- factor(letters[1:10])
+f2 <- factor(letters[5:14])
+
+c(f1,f2)
+
+}
+\keyword{manip}
+
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2006-10-29 12:55:20
|
Revision: 988
http://svn.sourceforge.net/r-gregmisc/?rev=988&view=rev
Author: ggorjan
Date: 2006-10-29 04:55:08 -0800 (Sun, 29 Oct 2006)
Log Message:
-----------
Fixed collision bug with stats version of reorder.factor
Modified Paths:
--------------
trunk/gdata/NEWS
trunk/gdata/R/reorder.R
trunk/gdata/man/reorder.Rd
Modified: trunk/gdata/NEWS
===================================================================
--- trunk/gdata/NEWS 2006-10-27 21:15:22 UTC (rev 987)
+++ trunk/gdata/NEWS 2006-10-29 12:55:08 UTC (rev 988)
@@ -1,3 +1,13 @@
+CHANGES IN 2.3.1 (2006-10-29)
+---------------------------------------
+
+- Arguments as well as their position of reorder.factor have been changed
+ to conform with reorder.factor method in stats package, due to collision
+ bug. Argument 'make.ordered' is now 'order' and old argument 'order' is
+ now 'new.order'! Therefore, you have to implicitly specify new.order i.e.
+
+ reorder(trt, new.order=c("PLACEBO", "300 MG", "600 MG", "1200 MG"))
+
CHANGES FROM 2.1.X to 2.3.0 (2006-09-19)
---------------------------------------
@@ -12,7 +22,7 @@
- Extended trim() to handle a variety of data types data.frames,
lists, factors, etc. Code changes contributed by Gregor Gorjanc.
-
+
- Added resample() command that acts like sample() except that it
_always_ samples from the arguments provided, even if only a single
argument is present. This differs from sample() which behaves
@@ -54,6 +64,4 @@
- Updated ll.Rd documentation
- - Fixed bug in Args.R, is.what.R, ll.R
-
-
+ - Fixed bug in Args.R, is.what.R, ll.R
Modified: trunk/gdata/R/reorder.R
===================================================================
--- trunk/gdata/R/reorder.R 2006-10-27 21:15:22 UTC (rev 987)
+++ trunk/gdata/R/reorder.R 2006-10-29 12:55:08 UTC (rev 988)
@@ -3,31 +3,26 @@
# Reorder the levels of a factor.
reorder.factor <- function(x,
- order,
X,
FUN,
- sort=mixedsort,
- make.ordered = is.ordered(x),
- ... )
- {
- constructor <- if (make.ordered) ordered else factor
+ ...,
+ order=is.ordered(x),
+ new.order,
+ sort=mixedsort)
+{
+ constructor <- if (order) ordered else factor
- if (!missing(order))
+ if (!missing(new.order))
{
- if (is.numeric(order))
- order = levels(x)[order]
+ if (is.numeric(new.order))
+ new.order <- levels(x)[new.order]
else
- order = order
+ new.order <- new.order
}
else if (!missing(FUN))
- order = names(sort(tapply(X, x, FUN, ...)))
+ new.order <- names(sort(tapply(X, x, FUN, ...)))
else
- order = sort(levels(x))
+ new.order <- sort(levels(x))
- constructor( x, levels=order)
-
- }
-
-
-
-
+ constructor(x, levels=new.order)
+}
Modified: trunk/gdata/man/reorder.Rd
===================================================================
--- trunk/gdata/man/reorder.Rd 2006-10-27 21:15:22 UTC (rev 987)
+++ trunk/gdata/man/reorder.Rd 2006-10-29 12:55:08 UTC (rev 988)
@@ -1,6 +1,5 @@
% $Id$
-
\name{reorder.factor}
\alias{reorder.factor}
\title{Reorder the Levels of a Factor}
@@ -9,61 +8,61 @@
}
\usage{
\method{reorder}{factor}(x,
- order,
X,
FUN,
- sort=mixedsort,
- make.ordered = is.ordered(x),
- ... )
+ ...,
+ order=is.ordered(x),
+ new.order,
+ sort=mixedsort)
}
\arguments{
- \item{x}{factor.}
- \item{order}{A vector of indexes or a vector of label names giving the
- order of the new factor levels.}
+ \item{x}{factor}
\item{X}{auxillary data vector}
\item{FUN}{function to be applied to subsets of \code{X} determined by
- \code{x}, to determine factor order.}
- \item{sort}{function to use to sort the factor level names}
- \item{make.ordered}{logical value indicating whether the returned
- object should be an \code{'ordered'} factor.}
- \item{...}{Optional parameters to FUN.}
+ \code{x}, to determine factor order}
+ \item{...}{optional parameters to \code{FUN}}
+ \item{order}{logical value indicating whether the returned
+ object should be an \code{\link{ordered}} factor}
+ \item{new.order}{a vector of indexes or a vector of label names giving
+ the order of the new factor levels}
+ \item{sort}{function to use to sort the factor level names, used only
+ when \code{new.order} is missing}
}
\details{
- This function changes the order of the levels of a factor. It can do
- so via three different mechanisms, depending on whether \code{order},
- \code{X} \emph{and} \code{FUN}, or \code{sort} are provided.
+ This function changes the order of the levels of a factor. It can do
+ so via three different mechanisms, depending on whether, \code{X}
+ \emph{and} \code{FUN}, \code{new.order} or \code{sort} are provided.
- If \code{order} is provided: For a numeric vector, the new factor level names
- are constructed by reordering the factor levels according to the
- numeric values. For vectors, \code{order} gives the list of new factor
- level names. In either case levels omitted from \code{order} will
- become missing values.
-
If \code{X} \emph{and} \code{Fun} are provided: The data in \code{X}
- is grouped by the levels of \code{data} and \code{FUN} is applied.
+ is grouped by the levels of \code{x} and \code{FUN} is applied.
The groups are then sorted by this value, and the resulting order is
used for the new factor level names.
+ If \code{new.order} is provided: For a numeric vector, the new factor
+ level names are constructed by reordering the factor levels according
+ to the numeric values. For vectors, \code{new.order} gives the list of
+ new factor level names. In either case levels omitted from
+ \code{new.order} will become missing (\code{NA}) values.
+
If \code{sort} is provided (as it is by default): The new
factor level names are generated by applying the supplied function
- to the existing factor level names. With \code{order="mixedsort"} the
+ to the existing factor level names. With \code{sort=mixedsort} the
factor levels are sorted so that combined numeric and character
strings are sorted in according to character rules on the character
- sections (including ignoring case), and be numeric rules for the
- numeric sections. See \code{mixedsort} for details.
-
+ sections (including ignoring case), and the numeric rules for the
+ numeric sections. See \code{\link[gtools]{mixedsort}} for details.
}
\value{
- A new factor with the levels ordered as specified.
+ A new factor with reordered levels
}
-\author{ Gregory R. Warnes \email{wa...@bs...}}
+\author{Gregory R. Warnes \email{wa...@bs...}}
-\seealso{ \code{\link{factor}}, \code{\link[stats]{reorder}} }
+\seealso{\code{\link{factor}} and \code{\link[stats]{reorder}}}
\examples{
# Create a 4 level example factor
- trt <- factor( sample( c("PLACEBO","300 MG", "600 MG", "1200 MG"),
+ trt <- factor( sample( c("PLACEBO", "300 MG", "600 MG", "1200 MG"),
100, replace=TRUE ) )
summary(trt)
# Note that the levels are not in a meaningful order.
@@ -73,18 +72,17 @@
trt2 <- reorder(trt)
summary(trt2)
# using indexes:
- trt3 <- reorder(trt, c(4,2,3,1))
+ trt3 <- reorder(trt, new.order=c(4, 2, 3, 1))
summary(trt3)
# using label names:
- trt4 <- reorder(trt, c("PLACEBO","300 MG", "600 MG", "1200 MG") )
+ trt4 <- reorder(trt, new.order=c("PLACEBO", "300 MG", "600 MG", "1200 MG"))
summary(trt4)
# using frequency
trt5 <- reorder(trt, X=as.numeric(trt), FUN=length)
summary(trt5)
-
# drop out the '300 MG' level
- trt6 <- reorder(trt, c("PLACEBO", "600 MG", "1200 MG") )
+ trt6 <- reorder(trt, new.order=c("PLACEBO", "600 MG", "1200 MG"))
summary(trt6)
}
\keyword{ manip }
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2006-10-29 15:28:35
|
Revision: 989
http://svn.sourceforge.net/r-gregmisc/?rev=989&view=rev
Author: ggorjan
Date: 2006-10-29 07:28:26 -0800 (Sun, 29 Oct 2006)
Log Message:
-----------
trim() gains ... argument; version bump
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/NEWS
trunk/gdata/R/trim.R
trunk/gdata/man/trim.Rd
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2006-10-29 12:55:08 UTC (rev 988)
+++ trunk/gdata/DESCRIPTION 2006-10-29 15:28:26 UTC (rev 989)
@@ -3,7 +3,7 @@
Description: Various R programming tools for data manipulation
Depends: R (>= 1.9.0)
Imports: gtools
-Version: 2.3.0
+Version: 2.3.1
Author: Gregory R. Warnes. Includes R source code and/or documentation
contributed by Ben Bolker, Gregor Gorjanc, and Thomas Lumley
Maintainer: Gregory Warnes <gre...@ur...>
Modified: trunk/gdata/NEWS
===================================================================
--- trunk/gdata/NEWS 2006-10-29 12:55:08 UTC (rev 988)
+++ trunk/gdata/NEWS 2006-10-29 15:28:26 UTC (rev 989)
@@ -8,6 +8,8 @@
reorder(trt, new.order=c("PLACEBO", "300 MG", "600 MG", "1200 MG"))
+- trim() gains ... argument.
+
CHANGES FROM 2.1.X to 2.3.0 (2006-09-19)
---------------------------------------
Modified: trunk/gdata/R/trim.R
===================================================================
--- trunk/gdata/R/trim.R 2006-10-29 12:55:08 UTC (rev 988)
+++ trunk/gdata/R/trim.R 2006-10-29 15:28:26 UTC (rev 989)
@@ -1,30 +1,34 @@
# $Id$
-trim <- function(s, recode.factor=TRUE)
+trim <- function(s, recode.factor=TRUE, ...)
UseMethod("trim", s)
-trim.default <- function(s, recode.factor=TRUE)
+trim.default <- function(s, recode.factor=TRUE, ...)
s
-trim.character <- function(s, recode.factor=TRUE)
+trim.character <- function(s, recode.factor=TRUE, ...)
{
s <- sub(pattern="^ +", replacement="", x=s)
s <- sub(pattern=" +$", replacement="", x=s)
s
}
-trim.factor <- function(s, recode.factor=TRUE)
+trim.factor <- function(s, recode.factor=TRUE, ...)
{
levels(s) <- trim(levels(s))
- if(recode.factor) s <- reorder.factor(s, sort=sort)
+ if(recode.factor) {
+ dots <- list(x=s, ...)
+ if(is.null(dots$sort)) dots$sort <- sort
+ s <- do.call(what=reorder.factor, args=dots)
+ }
s
}
-trim.list <- function(s, recode.factor=TRUE)
- lapply(s, trim, recode.factor=recode.factor)
+trim.list <- function(s, recode.factor=TRUE, ...)
+ lapply(s, trim, recode.factor=recode.factor, ...)
-trim.data.frame <- function(s, recode.factor=TRUE)
+trim.data.frame <- function(s, recode.factor=TRUE, ...)
{
- s[] <- trim.list(s, recode.factor=recode.factor)
+ s[] <- trim.list(s, recode.factor=recode.factor, ...)
s
}
Modified: trunk/gdata/man/trim.Rd
===================================================================
--- trunk/gdata/man/trim.Rd 2006-10-29 12:55:08 UTC (rev 988)
+++ trunk/gdata/man/trim.Rd 2006-10-29 15:28:26 UTC (rev 989)
@@ -6,11 +6,13 @@
related objects.
}
\usage{
-trim(s, recode.factor=TRUE)
+trim(s, recode.factor=TRUE, \ldots)
}
\arguments{
\item{s}{object to be processed}
- \item{recode.factor}{Should levels of a factor be recoded, see below}
+ \item{recode.factor}{should levels of a factor be recoded, see below}
+ \item{\ldots}{arguments passed to other methods, currently only to
+ \code{\link{reorder.factor}} for factors}
}
\details{
@@ -20,19 +22,22 @@
factor \code{s} trims \code{\link{levels}}. There are also methods for
\code{list} and \code{data.frame}.
-Trimming character strings can change the sort order in some
-locales. For factors, this can affect the coding of levels. By
-default, factor levels are recoded to match the trimmed sort order, but
-this can be disabled by setting \code{recode.factor=FALSE}.
+Trimming character strings can change the sort order in some locales.
+For factors, this can affect the coding of levels. By default, factor
+levels are recoded to match the trimmed sort order, but this can be
+disabled by setting \code{recode.factor=FALSE}. Recoding is done with
+\code{\link{reorder.factor}}.
}
\value{
\code{s} with all leading and trailing spaces removed in its elements.
}
-\author{ Gregory R. Warnes \email{wa...@bs...} with
+\author{Gregory R. Warnes \email{wa...@bs...} with
contributions by Gregor Gorjanc}
\seealso{ \code{\link[base]{sub}}, \code{\link[base]{gsub}} as well as
- argument \code{strip.white} in \code{\link{read.table}}}
+ argument \code{strip.white} in \code{\link{read.table}} and
+ \code{\link{reorder.factor}}
+}
\examples{
s <- " this is an example string "
trim(s)
@@ -43,17 +48,14 @@
trim(f)
levels(trim(f))
-trim(f,recode.factor=FALSE)
-levels(trim(f,recode.factor=FALSE))
+trim(f, recode.factor=FALSE)
+levels(trim(f, recode.factor=FALSE))
-
l <- list(s=rep(s, times=6), f=f, i=1:6)
trim(l)
df <- as.data.frame(l)
trim(df)
-
-
}
\keyword{manip}
\keyword{character}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2006-10-29 15:34:33
|
Revision: 990
http://svn.sourceforge.net/r-gregmisc/?rev=990&view=rev
Author: ggorjan
Date: 2006-10-29 07:34:19 -0800 (Sun, 29 Oct 2006)
Log Message:
-----------
sort is generic from R 2.4.0
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/NAMESPACE
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2006-10-29 15:28:26 UTC (rev 989)
+++ trunk/gdata/DESCRIPTION 2006-10-29 15:34:19 UTC (rev 990)
@@ -1,7 +1,7 @@
Package: gdata
Title: Various R programming tools for data manipulation
Description: Various R programming tools for data manipulation
-Depends: R (>= 1.9.0)
+Depends: R (>= 2.4.0)
Imports: gtools
Version: 2.3.1
Author: Gregory R. Warnes. Includes R source code and/or documentation
Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE 2006-10-29 15:28:26 UTC (rev 989)
+++ trunk/gdata/NAMESPACE 2006-10-29 15:34:19 UTC (rev 990)
@@ -25,6 +25,7 @@
unmatrix,
upperTriangle,
"upperTriangle<-",
+## write.fwf,
## mapLevels stuff
mapLevels,
@@ -32,7 +33,6 @@
as.listLevelsMap,
is.levelsMap,
is.listLevelsMap,
- sort.levelsMap, ## FIXME remove in R 2.4
"mapLevels<-",
## unknown stuff
@@ -44,15 +44,15 @@
importFrom(stats, reorder, na.omit)
importFrom(gtools, mixedsort)
-S3method(nobs,data.frame)
-S3method(nobs,default)
-S3method(nobs,lm)
+S3method(nobs, data.frame)
+S3method(nobs, default)
+S3method(nobs, lm)
S3method(trim, character)
S3method(trim, default)
S3method(trim, factor)
S3method(trim, list)
S3method(trim, data.frame)
-S3method(reorder,factor)
+S3method(reorder, factor)
S3method(drop.levels, default)
S3method(drop.levels, factor)
@@ -75,7 +75,7 @@
S3method(c, listLevelsMap)
S3method(unique, levelsMap)
-## S3method(sort, levelsMap) ## FIXME uncomment in R 2.4
+S3method(sort, levelsMap)
S3method("mapLevels<-", default)
S3method("mapLevels<-", list)
@@ -85,6 +85,7 @@
S3method(isUnknown, POSIXlt)
S3method(isUnknown, list)
S3method(isUnknown, data.frame)
+## S3method(isUnknown, matrix)
S3method(unknownToNA, default)
S3method(unknownToNA, factor)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2006-10-29 15:47:44
|
Revision: 991
http://svn.sourceforge.net/r-gregmisc/?rev=991&view=rev
Author: ggorjan
Date: 2006-10-29 07:47:33 -0800 (Sun, 29 Oct 2006)
Log Message:
-----------
sort is generic now; mapply keeps names in R 2.4.0; some codetools suggestions fixed
Modified Paths:
--------------
trunk/gdata/R/drop.levels.R
trunk/gdata/R/mapLevels.R
trunk/gdata/inst/unitTests/runit.mapLevels.R
trunk/gdata/man/mapLevels.Rd
trunk/gdata/tests/doRUnit.R
Modified: trunk/gdata/R/drop.levels.R
===================================================================
--- trunk/gdata/R/drop.levels.R 2006-10-29 15:34:19 UTC (rev 990)
+++ trunk/gdata/R/drop.levels.R 2006-10-29 15:47:33 UTC (rev 991)
@@ -1,6 +1,6 @@
drop.levels <- function(x, reorder=TRUE, ...)
- UseMethod("drop.levels")
+ UseMethod("drop.levels", x=x)
drop.levels.default <- function(x, reorder=TRUE, ...)
x
Modified: trunk/gdata/R/mapLevels.R
===================================================================
--- trunk/gdata/R/mapLevels.R 2006-10-29 15:34:19 UTC (rev 990)
+++ trunk/gdata/R/mapLevels.R 2006-10-29 15:47:33 UTC (rev 991)
@@ -2,7 +2,7 @@
###------------------------------------------------------------------------
### What: Mapping levels
### $Id: mapLevels.R,v 1.1 2006/03/29 13:47:15 ggorjan Exp ggorjan $
-### Time-stamp: <2006-09-10 03:54:56 ggorjan>
+### Time-stamp: <2006-10-29 16:45:20 ggorjan>
###------------------------------------------------------------------------
### {{{ mapLevels
@@ -12,7 +12,7 @@
mapLevels <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
combine=FALSE, ...)
{
- UseMethod("mapLevels")
+ UseMethod("mapLevels", x=x)
}
mapLevels.default <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
@@ -88,10 +88,10 @@
.unlistLevelsMap <- function(x, ind=FALSE)
{
y <- unlist(x, use.names=FALSE)
- length <- sapply(x, FUN=length)
- names(y) <- rep(names(x), times=length)
+ len <- sapply(x, FUN=length)
+ names(y) <- rep(names(x), times=len)
if(ind) {
- return(list(y, rep(1:length(x), times=length), length))
+ return(list(y, rep(1:length(x), times=len), len))
} else {
return(y)
}
@@ -214,6 +214,7 @@
{
x <- list(...)
class(x) <- "listLevelsMap"
+ ## we use recursive=TRUE here because ... is a lists of lists
c(x, sort=sort, recursive=TRUE)
}
@@ -231,7 +232,7 @@
x <- unlist(x, recursive=FALSE)
## how to merge components with the same name?
class(x) <- "levelsMap"
- if(sort) x <- sort.levelsMap(x)
+ if(sort) x <- sort(x)
x <- unique(x)
}
x
@@ -330,13 +331,7 @@
dQuote("listLevelsMap"), dQuote("levelsMap")))
}
}
- ## FIXME: mapply drops names
- if(!is.null(names(x))) {
- isNamed <- TRUE
- namesX <- names(x)
- }
x <- mapply(FUN="mapLevels<-", x=x, value=value, SIMPLIFY=FALSE)
- if(isNamed) names(x) <- namesX
x
}
Modified: trunk/gdata/inst/unitTests/runit.mapLevels.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.mapLevels.R 2006-10-29 15:34:19 UTC (rev 990)
+++ trunk/gdata/inst/unitTests/runit.mapLevels.R 2006-10-29 15:47:33 UTC (rev 991)
@@ -2,16 +2,280 @@
###------------------------------------------------------------------------
### What: Unit tests for mapLevels et al.
### $Id$
-### Time-stamp: <2006-08-31 02:24:20 ggorjan>
+### Time-stamp: <2006-10-29 16:41:41 ggorjan>
###------------------------------------------------------------------------
-### {{{ --- Test setup ---
if(FALSE) {
library("RUnit")
library("gdata")
}
### }}}
-### {{{ mapLevels, is.*, as.*, [.*
test.mapLevels <- function()
{
## Integer and numeric
checkException(mapLevels(1:3)) # wrong class(x)
checkException(mapLevels(1.5)) # wrong class(x)
## Factor
f <- factor(c("B", "C", "A"))
fMapInt <- list(A=as.integer(1), B=as.integer(2), C=as.integer(3))
fMapInt1 <- list(B=as.integer(1), C=as.integer(2))
fMapCha <- list(A="A", B="B", C="C")
fMapInt <- as.levelsMap(fMapInt)
fMapInt1 <- as.levelsMap(fMapInt1)
fMapCha <- as.levelsMap(fMapCha)
fMapCha1 <- fMapCha[c(1, 3)] # this will test also [.levelsMap
checkIdentical(mapLevels(f), fMapInt)
checkTrue(is.levelsMap(mapLevels(f))) # test for is.levelsMap
checkTrue(is.levelsMap(fMapInt)) # test for as.levelsMap
checkTrue(!gdata:::.isCharacterMap(fMapInt))
checkIdentical(mapLevels(f, sort=FALSE), fMapInt) # sort is not used for factors
checkIdentical(mapLevels(f[1:2], drop=TRUE), fMapInt1)
checkIdentical(mapLevels(f, codes=FALSE), fMapCha)
checkIdentical(mapLevels(f[c(2, 3)], drop=TRUE, codes=FALSE), fMapCha1)
## Character
cha <- c("Z", "M", "A")
chaMapInt <- list(A=as.integer(1), M=as.integer(2), Z=as.integer(3))
chaMapIntO <- list(Z=as.integer(1), M=as.integer(2), A=as.integer(3))
chaMapInt1 <- list(M=as.integer(1), Z=as.integer(2))
chaMapCha <- list(A="A", M="M", Z="Z")
chaMapInt <- as.levelsMap(chaMapInt)
chaMapIntO <- as.levelsMap(chaMapIntO)
chaMapInt1 <- as.levelsMap(chaMapInt1)
chaMapCha <- as.levelsMap(chaMapCha)
checkIdentical(mapLevels(cha), chaMapInt)
checkIdentical(mapLevels(cha, sort=FALSE), chaMapIntO) # sort works for characters
checkIdentical(mapLevels(cha[1:2], drop=TRUE), chaMapInt1)
checkIdentical(mapLevels(cha, codes=FALSE), chaMapCha)
## List
l <- list(f=f, cha=cha)
l1 <- list(cha=cha, f=f)
l2 <- list(cha=cha, f=f, i=1:10)
lMapInt <- list(f=fMapInt, cha=chaMapInt)
lMapCha <- list(f=fMapCha, cha=chaMapCha)
lMapInt <- as.listLevelsMap(lMapInt)
lMapCha <- as.listLevelsMap(lMapCha)
lMapChaC <- as.list(sort(unique(c(cha, as.character(f)))))
lMapChaCO <- as.list(unique(c(cha, as.character(f))))
names(lMapChaC) <- unlist(lMapChaC)
names(lMapChaCO) <- unlist(lMapChaCO)
lMapChaC <- as.levelsMap(lMapChaC)
lMapChaCO <- as.levelsMap(lMapChaCO)
checkIdentical(mapLevels(l), lMapInt)
checkTrue(is.listLevelsMap(mapLevels(l))) # test for is.listLevelsMap
checkTrue(is.listLevelsMap(lMapInt)) # test for as.listLevelsMap
checkIdentical(mapLevels(l, codes=FALSE), lMapCha)
checkException(mapLevels(l, combine=TRUE)) # can not combine integer maps
checkIdentical(mapLevels(l, codes=FALSE, combine=TRUE), lMapChaC)
checkIdentical(mapLevels(l1, codes=FALSE, combine=TRUE), lMapChaC)
checkIdentical(mapLevels(l1, codes=FALSE, combine=TRUE, sort=FALSE), lMapChaCO)
checkException(mapLevels(l2)) # only char and factor
## Data.frame
df <- data.frame(f1=factor(c("G", "Abc", "Abc", "D", "F")),
f2=factor(c("Abc", "Abc", "B", "D", "K")),
cha=c("jkl", "A", "D", "K", "L"),
int=1:5)
dfMapInt <- list(f1=mapLevels(df$f1), f2=mapLevels(df$f2), cha=mapLevels(df$cha))
dfMapInt <- as.listLevelsMap(dfMapInt)
dfMapInt1 <- dfMapInt[c(1, 3)] # this will test also [.listLevelsMap
checkException(mapLevels(df)) # wrong class of int
checkIdentical(mapLevels(df[, 1:3]), dfMapInt)
checkIdentical(mapLevels(df[, c(1, 3)]), dfMapInt1)
}
### }}}
-### {{{ .check*
test.checkLevelsMap <- function(x)
{
## --- levelsMap ---
## not a list
checkException(gdata:::.checkLevelsMap(x="A", method="raw"))
## list without names
checkException(gdata:::.checkLevelsMap(x=list("A"), method="raw"))
fMapInt <- list(A=as.integer(1), B=as.integer(2), C=as.integer(3))
## x should be levelsMap
checkException(gdata:::.checkLevelsMap(x=fMapInt, method="class"))
## --- listLevelsMap ---
map <- list(as.levelsMap(fMapInt), as.levelsMap(fMapInt))
map1 <- list(fMapInt, fMapInt)
class(map1) <- "listLevelsMap"
## x should be a listLevelsMap
checkException(gdata:::.checkListLevelsMap(x=map, method="class"))
## x should be also a list of levelsMaps
checkException(gdata:::.checkListLevelsMap(x=map1, method="class"))
## the rest is done with levelsMap tests
}
### }}}
-### {{{ c.*
test.cLevelsMap <- function()
{
f1 <- factor(letters[c(2, 1)])
f2 <- factor(letters[c(3, 1, 2)])
mapCha1 <- mapLevels(f1, codes=FALSE) # get maps
mapCha2 <- mapLevels(f2, codes=FALSE)
mapCha1S <- mapLevels(as.character(f1), codes=FALSE, sort=FALSE)
mapCha2S <- mapLevels(as.character(f2), codes=FALSE, sort=FALSE)
mapChaTest <- list(a="a", b="b")
mapChaTest1 <- list(a="a", b="b", c="c")
mapChaTest2 <- list(c="c", a="a", b="b")
class(mapChaTest) <- class(mapChaTest1) <- class(mapChaTest2) <- "levelsMap"
mapChaTest3 <- list(mapChaTest, mapChaTest1, mapChaTest, mapChaTest1)
class(mapChaTest3) <- "listLevelsMap"
checkIdentical(c(mapCha1), mapChaTest)
checkIdentical(c(mapCha2, mapCha1), mapChaTest1)
checkIdentical(c(mapCha2S, mapCha1S, sort=FALSE), mapChaTest2)
l <- list(f1, f2)
mapCha <- mapLevels(l, codes=FALSE)
checkIdentical(c(mapCha, mapCha), mapChaTest3)
checkIdentical(c(mapCha, recursive=TRUE), mapChaTest1)
checkException(c(mapLevels(f1))) # can not combine integer “levelsMaps”
## Example with maps of different length of components
map1 <- list(A=c("a", "e", "i", "o", "u"), B="b", C="c", C="m",
D=c("d", "e"), F="f")
map2 <- list(A=c("a", "z", "w", "y", "x"), F="f", G=c("g", "h", "j"),
i="i", k=c("k", "l"), B="B")
map0Test <- list(A=c("a", "e", "i", "o", "u"), B="b", C="c", C="m",
D=c("d", "e"), F="f",
A=c("z", "w", "y", "x"), G=c("g", "h", "j"),
i="i", k=c("k", "l"), B="B")
map0Test <- as.levelsMap(map0Test)
mapTest <- sort.levelsMap(map0Test)
map1 <- as.levelsMap(map1)
map2 <- as.levelsMap(map2)
map <- c(map1, map2)
map0 <- c(map1, map2, sort=FALSE)
checkIdentical(map, mapTest)
checkIdentical(map0, map0Test)
}
### }}}
-### {{{ unique
test.uniqueLevelsMap <- function()
{
map <- list(A=c(1, 2, 1, 3), B=4, C=1, C=5, D=c(6, 8), E=7, B=4,
D=c(6, 8))
map1 <- map
map1[[1]] <- map[[1]][c(1, 2, 4)]
map1[[7]] <- NULL # remove B=4
map1[[7]] <- NULL # remove D=c(6, 8)
## unique (used in as.levelsMap), will remove duplicates (A=1)
checkIdentical(as.levelsMap(map1), as.levelsMap(map))
}
### }}}
-### {{{ mapLevels<-
"test.mapLevels<-" <- function()
{
## Some errors
checkException("mapLevels<-"(1.1, value=2)) # wrong class(x)
checkException("mapLevels<-"(complex(1.1), value=2)) # wrong class(x)
f <- factor(c("A", "B", "C"))
fMapInt <- mapLevels(f)
## can not apply integer "levelsMap" to "character"
checkException("mapLevels<-"(as.character(f), value=fMapInt))
fMapCha <- mapLevels(f, codes=FALSE)
## can not apply character levelsMap to "integer"
checkException("mapLevels<-"(as.integer(f), value=chaMapCha))
fMapFuzz <- fMapInt
fMapFuzz[[1]] <- "A"
## all components of 'value' must be of the same class
checkException("mapLevels<-"(as.character(f), value=fMapFuzz))
checkException("mapLevels<-"(as.integer(f), value=fMapFuzz))
## x integer, value integer levelsMap
f <- factor(letters[c(10, 15, 1, 2)])
fMapInt <- mapLevels(f)
fInt <- as.integer(f)
mapLevels(fInt) <- fMapInt
checkIdentical(fInt, f)
## x factor, value integer levelsMap
fInt <- factor(as.integer(f))
mapLevels(fInt) <- fMapInt
checkIdentical(fInt, f)
## above is essentially the same as levels<-.factor
fInt1 <- factor(as.integer(f))
levels(fInt1) <- fMapInt
checkIdentical(fInt1, f)
## x character, value character levelsMap
cha <- c("B", "A", "C")
chaMapCha <- as.levelsMap(list(A1="A", B2="B", C3="C"))
mapLevels(cha) <- chaMapCha
chaTest <- factor(c("B2", "A1", "C3"))
checkIdentical(cha, chaTest)
## and a bit more for components of length > 1
cha <- c("G", "I", "B", "A", "C", "D", "Z")
chaMapCha <- as.levelsMap(list(A1=c("A", "G", "I"), B2="B", C3=c("C", "D")))
mapLevels(cha) <- chaMapCha
chaTest <- factor(c("A1", "A1", "B2", "A1", "C3", "C3", NA))
checkIdentical(cha, chaTest)
## x factor, value character levelsMap
f <- factor(c("G", "I", "B", "A", "C", "D", "Z"))
fMapCha <- as.levelsMap(list(A1=c("A", "G", "I"), B2="B", C3=c("C", "D")))
mapLevels(f) <- fMapCha
fTest <- factor(c("A1", "A1", "B2", "A1", "C3", "C3", NA))
checkIdentical(f, fTest)
## Two factors and character map
f1 <- factor(letters[1:10])
f2 <- factor(letters[5:14])
checkIdentical(as.integer(f1), as.integer(f2)) # the same integer codes
mapCha1 <- mapLevels(f1, codes=FALSE) # get maps
mapCha2 <- mapLevels(f2, codes=FALSE)
mapCha <- c(mapCha1, mapCha2) # combine maps
## apply map
mapLevels(f1) <- mapCha # the same as levels(f1) <- mapCha
mapLevels(f2) <- mapCha # the same as levels(f2) <- mapCha
checkIdentical(as.integer(f1), 1:10) # \ internal codes are now
checkIdentical(as.integer(f2), 5:14) # / "consistent" among factors
## The same with list
l <- list(f1=f1, f2=f2)
mapCha <- mapLevels(l, codes=FALSE, combine=TRUE)
mapLevels(l) <- mapCha
checkIdentical(as.integer(l$f1), 1:10) # \ internal codes are now
checkIdentical(as.integer(l$f2), 5:14) # / "consistent" among factors
## and data.frame
df <- data.frame(f1=f1, f2=f2)
mapCha <- mapLevels(df, codes=FALSE, combine=TRUE)
mapLevels(df) <- mapCha
checkIdentical(as.integer(df$f1), 1:10) # \ internal codes are now
checkIdentical(as.integer(df$f2), 5:14) # / "consistent" among factors
}
### }}}
-### {{{ Dear Emacs
## Local variables:
## folded-file: t
## End:
### }}}
+### {{{ --- Test setup ---
+if(FALSE) {
+ library("RUnit")
+ library("gdata")
+}
+
+### }}}
+### {{{ mapLevels, is.*, as.*, [.*
+
+test.mapLevels <- function()
+{
+ ## Integer and numeric
+ checkException(mapLevels(1:3)) # wrong class(x)
+ checkException(mapLevels(1.5)) # wrong class(x)
+
+ ## Factor
+ f <- factor(c("B", "C", "A"))
+ fMapInt <- list(A=as.integer(1), B=as.integer(2), C=as.integer(3))
+ fMapInt1 <- list(B=as.integer(1), C=as.integer(2))
+ fMapCha <- list(A="A", B="B", C="C")
+ fMapInt <- as.levelsMap(fMapInt)
+ fMapInt1 <- as.levelsMap(fMapInt1)
+ fMapCha <- as.levelsMap(fMapCha)
+ fMapCha1 <- fMapCha[c(1, 3)] # this will test also [.levelsMap
+ checkIdentical(mapLevels(f), fMapInt)
+ checkTrue(is.levelsMap(mapLevels(f))) # test for is.levelsMap
+ checkTrue(is.levelsMap(fMapInt)) # test for as.levelsMap
+ checkTrue(!gdata:::.isCharacterMap(fMapInt))
+ checkIdentical(mapLevels(f, sort=FALSE), fMapInt) # sort is not used for factors
+ checkIdentical(mapLevels(f[1:2], drop=TRUE), fMapInt1)
+ checkIdentical(mapLevels(f, codes=FALSE), fMapCha)
+ checkIdentical(mapLevels(f[c(2, 3)], drop=TRUE, codes=FALSE), fMapCha1)
+
+ ## Character
+ cha <- c("Z", "M", "A")
+ chaMapInt <- list(A=as.integer(1), M=as.integer(2), Z=as.integer(3))
+ chaMapIntO <- list(Z=as.integer(1), M=as.integer(2), A=as.integer(3))
+ chaMapInt1 <- list(M=as.integer(1), Z=as.integer(2))
+ chaMapCha <- list(A="A", M="M", Z="Z")
+ chaMapInt <- as.levelsMap(chaMapInt)
+ chaMapIntO <- as.levelsMap(chaMapIntO)
+ chaMapInt1 <- as.levelsMap(chaMapInt1)
+ chaMapCha <- as.levelsMap(chaMapCha)
+ checkIdentical(mapLevels(cha), chaMapInt)
+ checkIdentical(mapLevels(cha, sort=FALSE), chaMapIntO) # sort works for characters
+ checkIdentical(mapLevels(cha[1:2], drop=TRUE), chaMapInt1)
+ checkIdentical(mapLevels(cha, codes=FALSE), chaMapCha)
+
+ ## List
+ l <- list(f=f, cha=cha)
+ l1 <- list(cha=cha, f=f)
+ l2 <- list(cha=cha, f=f, i=1:10)
+ lMapInt <- list(f=fMapInt, cha=chaMapInt)
+ lMapCha <- list(f=fMapCha, cha=chaMapCha)
+ lMapInt <- as.listLevelsMap(lMapInt)
+ lMapCha <- as.listLevelsMap(lMapCha)
+ lMapChaC <- as.list(sort(unique(c(cha, as.character(f)))))
+ lMapChaCO <- as.list(unique(c(cha, as.character(f))))
+ names(lMapChaC) <- unlist(lMapChaC)
+ names(lMapChaCO) <- unlist(lMapChaCO)
+ lMapChaC <- as.levelsMap(lMapChaC)
+ lMapChaCO <- as.levelsMap(lMapChaCO)
+ checkIdentical(mapLevels(l), lMapInt)
+ checkTrue(is.listLevelsMap(mapLevels(l))) # test for is.listLevelsMap
+ checkTrue(is.listLevelsMap(lMapInt)) # test for as.listLevelsMap
+ checkIdentical(mapLevels(l, codes=FALSE), lMapCha)
+ checkException(mapLevels(l, combine=TRUE)) # can not combine integer maps
+ checkIdentical(mapLevels(l, codes=FALSE, combine=TRUE), lMapChaC)
+ checkIdentical(mapLevels(l1, codes=FALSE, combine=TRUE), lMapChaC)
+ checkIdentical(mapLevels(l1, codes=FALSE, combine=TRUE, sort=FALSE), lMapChaCO)
+ checkException(mapLevels(l2)) # only char and factor
+
+ ## Data.frame
+ df <- data.frame(f1=factor(c("G", "Abc", "Abc", "D", "F")),
+ f2=factor(c("Abc", "Abc", "B", "D", "K")),
+ cha=c("jkl", "A", "D", "K", "L"),
+ int=1:5)
+ dfMapInt <- list(f1=mapLevels(df$f1), f2=mapLevels(df$f2), cha=mapLevels(df$cha))
+ dfMapInt <- as.listLevelsMap(dfMapInt)
+ dfMapInt1 <- dfMapInt[c(1, 3)] # this will test also [.listLevelsMap
+ checkException(mapLevels(df)) # wrong class of int
+ checkIdentical(mapLevels(df[, 1:3]), dfMapInt)
+ checkIdentical(mapLevels(df[, c(1, 3)]), dfMapInt1)
+}
+
+### }}}
+### {{{ .check*
+
+test.checkLevelsMap <- function(x)
+{
+ ## --- levelsMap ---
+
+ ## not a list
+ checkException(gdata:::.checkLevelsMap(x="A", method="raw"))
+ ## list without names
+ checkException(gdata:::.checkLevelsMap(x=list("A"), method="raw"))
+ fMapInt <- list(A=as.integer(1), B=as.integer(2), C=as.integer(3))
+ ## x should be levelsMap
+ checkException(gdata:::.checkLevelsMap(x=fMapInt, method="class"))
+
+ ## --- listLevelsMap ---
+
+ map <- list(as.levelsMap(fMapInt), as.levelsMap(fMapInt))
+ map1 <- list(fMapInt, fMapInt)
+ class(map1) <- "listLevelsMap"
+ ## x should be a listLevelsMap
+ checkException(gdata:::.checkListLevelsMap(x=map, method="class"))
+ ## x should be also a list of levelsMaps
+ checkException(gdata:::.checkListLevelsMap(x=map1, method="class"))
+ ## the rest is done with levelsMap tests
+}
+
+### }}}
+### {{{ c.*
+
+test.cLevelsMap <- function()
+{
+ f1 <- factor(letters[c(2, 1)])
+ f2 <- factor(letters[c(3, 1, 2)])
+ mapCha1 <- mapLevels(f1, codes=FALSE) # get maps
+ mapCha2 <- mapLevels(f2, codes=FALSE)
+ mapCha1S <- mapLevels(as.character(f1), codes=FALSE, sort=FALSE)
+ mapCha2S <- mapLevels(as.character(f2), codes=FALSE, sort=FALSE)
+ mapChaTest <- list(a="a", b="b")
+ mapChaTest1 <- list(a="a", b="b", c="c")
+ mapChaTest2 <- list(c="c", a="a", b="b")
+ class(mapChaTest) <- class(mapChaTest1) <- class(mapChaTest2) <- "levelsMap"
+ mapChaTest3 <- list(mapChaTest, mapChaTest1, mapChaTest, mapChaTest1)
+ class(mapChaTest3) <- "listLevelsMap"
+ checkIdentical(c(mapCha1), mapChaTest)
+ checkIdentical(c(mapCha2, mapCha1), mapChaTest1)
+ checkIdentical(c(mapCha2S, mapCha1S, sort=FALSE), mapChaTest2)
+
+ l <- list(f1, f2)
+ mapCha <- mapLevels(l, codes=FALSE)
+ checkIdentical(c(mapCha, mapCha), mapChaTest3)
+ checkIdentical(c(mapCha, recursive=TRUE), mapChaTest1)
+
+ checkException(c(mapLevels(f1))) # can not combine integer “levelsMaps”
+
+ ## Example with maps of different length of components
+ map1 <- list(A=c("a", "e", "i", "o", "u"), B="b", C="c", C="m",
+ D=c("d", "e"), F="f")
+ map2 <- list(A=c("a", "z", "w", "y", "x"), F="f", G=c("g", "h", "j"),
+ i="i", k=c("k", "l"), B="B")
+ map0Test <- list(A=c("a", "e", "i", "o", "u"), B="b", C="c", C="m",
+ D=c("d", "e"), F="f",
+ A=c("z", "w", "y", "x"), G=c("g", "h", "j"),
+ i="i", k=c("k", "l"), B="B")
+ map0Test <- as.levelsMap(map0Test)
+ mapTest <- sort(map0Test)
+ map1 <- as.levelsMap(map1)
+ map2 <- as.levelsMap(map2)
+ map <- c(map1, map2)
+ map0 <- c(map1, map2, sort=FALSE)
+ checkIdentical(map, mapTest)
+ checkIdentical(map0, map0Test)
+}
+
+### }}}
+### {{{ unique
+
+test.uniqueLevelsMap <- function()
+{
+ map <- list(A=c(1, 2, 1, 3), B=4, C=1, C=5, D=c(6, 8), E=7, B=4,
+ D=c(6, 8))
+ map1 <- map
+ map1[[1]] <- map[[1]][c(1, 2, 4)]
+ map1[[7]] <- NULL # remove B=4
+ map1[[7]] <- NULL # remove D=c(6, 8)
+ ## unique (used in as.levelsMap), will remove duplicates (A=1)
+ checkIdentical(as.levelsMap(map1), as.levelsMap(map))
+}
+
+### }}}
+### {{{ mapLevels<-
+
+"test.mapLevels<-" <- function()
+{
+ ## Some errors
+ checkException("mapLevels<-"(1.1, value=2)) # wrong class(x)
+ checkException("mapLevels<-"(complex(1.1), value=2)) # wrong class(x)
+
+ f <- factor(c("A", "B", "C"))
+ fMapInt <- mapLevels(f)
+ ## can not apply integer "levelsMap" to "character"
+ checkException("mapLevels<-"(as.character(f), value=fMapInt))
+
+ fMapCha <- mapLevels(f, codes=FALSE)
+ ## can not apply character levelsMap to "integer"
+ checkException("mapLevels<-"(as.integer(f), value=chaMapCha))
+
+ fMapFuzz <- fMapInt
+ fMapFuzz[[1]] <- "A"
+ ## all components of 'value' must be of the same class
+ checkException("mapLevels<-"(as.character(f), value=fMapFuzz))
+ checkException("mapLevels<-"(as.integer(f), value=fMapFuzz))
+
+ ## x integer, value integer levelsMap
+ f <- factor(letters[c(10, 15, 1, 2)])
+ fMapInt <- mapLevels(f)
+ fInt <- as.integer(f)
+ mapLevels(fInt) <- fMapInt
+ checkIdentical(fInt, f)
+
+ ## x factor, value integer levelsMap
+ fInt <- factor(as.integer(f))
+ mapLevels(fInt) <- fMapInt
+ checkIdentical(fInt, f)
+
+ ## above is essentially the same as levels<-.factor
+ fInt1 <- factor(as.integer(f))
+ levels(fInt1) <- fMapInt
+ checkIdentical(fInt1, f)
+
+ ## x character, value character levelsMap
+ cha <- c("B", "A", "C")
+ chaMapCha <- as.levelsMap(list(A1="A", B2="B", C3="C"))
+ mapLevels(cha) <- chaMapCha
+ chaTest <- factor(c("B2", "A1", "C3"))
+ checkIdentical(cha, chaTest)
+ ## and a bit more for components of length > 1
+ cha <- c("G", "I", "B", "A", "C", "D", "Z")
+ chaMapCha <- as.levelsMap(list(A1=c("A", "G", "I"), B2="B", C3=c("C", "D")))
+ mapLevels(cha) <- chaMapCha
+ chaTest <- factor(c("A1", "A1", "B2", "A1", "C3", "C3", NA))
+ checkIdentical(cha, chaTest)
+
+ ## x factor, value character levelsMap
+ f <- factor(c("G", "I", "B", "A", "C", "D", "Z"))
+ fMapCha <- as.levelsMap(list(A1=c("A", "G", "I"), B2="B", C3=c("C", "D")))
+ mapLevels(f) <- fMapCha
+ fTest <- factor(c("A1", "A1", "B2", "A1", "C3", "C3", NA))
+ checkIdentical(f, fTest)
+
+ ## Two factors and character map
+ f1 <- factor(letters[1:10])
+ f2 <- factor(letters[5:14])
+ checkIdentical(as.integer(f1), as.integer(f2)) # the same integer codes
+ mapCha1 <- mapLevels(f1, codes=FALSE) # get maps
+ mapCha2 <- mapLevels(f2, codes=FALSE)
+ mapCha <- c(mapCha1, mapCha2) # combine maps
+ ## apply map
+ mapLevels(f1) <- mapCha # the same as levels(f1) <- mapCha
+ mapLevels(f2) <- mapCha # the same as levels(f2) <- mapCha
+ checkIdentical(as.integer(f1), 1:10) # \ internal codes are now
+ checkIdentical(as.integer(f2), 5:14) # / "consistent" among factors
+
+ ## The same with list
+ l <- list(f1=f1, f2=f2)
+ mapCha <- mapLevels(l, codes=FALSE, combine=TRUE)
+ mapLevels(l) <- mapCha
+ checkIdentical(as.integer(l$f1), 1:10) # \ internal codes are now
+ checkIdentical(as.integer(l$f2), 5:14) # / "consistent" among factors
+
+ ## and data.frame
+ df <- data.frame(f1=f1, f2=f2)
+ mapCha <- mapLevels(df, codes=FALSE, combine=TRUE)
+ mapLevels(df) <- mapCha
+ checkIdentical(as.integer(df$f1), 1:10) # \ internal codes are now
+ checkIdentical(as.integer(df$f2), 5:14) # / "consistent" among factors
+
+}
+
+### }}}
+### {{{ Dear Emacs
+## Local variables:
+## folded-file: t
+## End:
+### }}}
+
###------------------------------------------------------------------------
### runit.mapLevels.R ends here
Modified: trunk/gdata/man/mapLevels.Rd
===================================================================
--- trunk/gdata/man/mapLevels.Rd 2006-10-29 15:34:19 UTC (rev 990)
+++ trunk/gdata/man/mapLevels.Rd 2006-10-29 15:47:33 UTC (rev 991)
@@ -2,7 +2,7 @@
%--------------------------------------------------------------------------
% What: Mapping levels
% $Id: mapLevels.Rd,v 1.1 2006/03/29 13:47:10 ggorjan Exp ggorjan $
-% Time-stamp: <2006-08-31 02:43:29 ggorjan>
+% Time-stamp: <2006-10-15 18:36:28 ggorjan>
%--------------------------------------------------------------------------
\name{mapLevels}
@@ -144,7 +144,7 @@
applied to \dQuote{character} or \dQuote{factor}. Methods for
\dQuote{list} and \dQuote{data.frame} can work only on mentioned atomic
components/columns and can accept either \dQuote{levelsMap} or
-\dQuote{levelsMap}. Recycling occours, if length of \code{value} is not
+\dQuote{listLevelsMap}. Recycling occours, if length of \code{value} is not
the same as number of components/columns of a \dQuote{list/data.frame}.
}
Modified: trunk/gdata/tests/doRUnit.R
===================================================================
--- trunk/gdata/tests/doRUnit.R 2006-10-29 15:34:19 UTC (rev 990)
+++ trunk/gdata/tests/doRUnit.R 2006-10-29 15:47:33 UTC (rev 991)
@@ -2,7 +2,7 @@
###------------------------------------------------------------------------
### What: Run RUnit tests
### $Id$
-### Time-stamp: <2006-09-18 13:14:34 ggorjan>
+### Time-stamp: <2006-10-29 16:37:40 ggorjan>
###------------------------------------------------------------------------
if(require("RUnit", quietly=TRUE)) {
@@ -26,8 +26,7 @@
## --- Testing ---
## Define tests
- testSuite <- defineTestSuite(name=paste(pkg, "unit testing"),
- dirs=path)
+ testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), dirs=path)
## Run
tests <- runTestSuite(testSuite)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2006-10-29 16:08:52
|
Revision: 992
http://svn.sourceforge.net/r-gregmisc/?rev=992&view=rev
Author: ggorjan
Date: 2006-10-29 08:08:40 -0800 (Sun, 29 Oct 2006)
Log Message:
-----------
fixed problem in tests; added unknown methods and tests for matrices
Modified Paths:
--------------
trunk/gdata/NEWS
trunk/gdata/R/unknown.R
trunk/gdata/inst/unitTests/runit.unknown.R
trunk/gdata/man/unknown.Rd
Modified: trunk/gdata/NEWS
===================================================================
--- trunk/gdata/NEWS 2006-10-29 15:47:33 UTC (rev 991)
+++ trunk/gdata/NEWS 2006-10-29 16:08:40 UTC (rev 992)
@@ -10,6 +10,8 @@
- trim() gains ... argument.
+- Added "unknown" methods for matrices.
+
CHANGES FROM 2.1.X to 2.3.0 (2006-09-19)
---------------------------------------
Modified: trunk/gdata/R/unknown.R
===================================================================
--- trunk/gdata/R/unknown.R 2006-10-29 15:47:33 UTC (rev 991)
+++ trunk/gdata/R/unknown.R 2006-10-29 16:08:40 UTC (rev 992)
@@ -2,14 +2,15 @@
###------------------------------------------------------------------------
### What: Change given unknown value to NA and vice versa
### $Id$
-### Time-stamp: <2006-09-10 03:52:39 ggorjan>
+### Time-stamp: <2006-10-29 17:08:21 ggorjan>
###------------------------------------------------------------------------
### {{{ isUnknown
+
###------------------------------------------------------------------------
isUnknown <- function(x, unknown=NA, ...)
- UseMethod("isUnknown")
+ UseMethod("isUnknown", x=x)
isUnknown.default <- function(x, unknown=NA, ...)
{
@@ -21,10 +22,12 @@
isUnknown.POSIXlt <- function(x, unknown=NA, ...)
{
+ ## FIXME: codetools say
+ ## isUnknown.POSIXlt: wrong number of arguments to as.character
if(is.list(unknown) && !inherits(x=unknown, what="POSIXlt")) {
unknown <- lapply(unknown, FUN=as.character, ...)
} else {
- unknown <- as.character(unknown, ...)
+ unknown <- as.character(x=unknown, ...)
}
isUnknown.default(x=as.character(x), unknown=unknown)
}
@@ -32,9 +35,9 @@
isUnknown.list <- function(x, unknown=NA, ...) {
unknown <- gdata:::.unknownList(x=x, unknown=unknown)
## FIXME - do I still need attributes here; R 2.4
- attrX <- attributes(x)
+ ## attrX <- attributes(x)
x <- mapply(FUN="isUnknown", x=x, unknown=unknown, ..., SIMPLIFY=FALSE)
- attributes(x) <- attrX
+ ## attributes(x) <- attrX
x
}
@@ -44,14 +47,19 @@
x
}
+isUnknown.matrix <- function(x, unknown=NA, ...)
+ apply(X=x, MARGIN=ifelse(ncol(x) > nrow(x), 1, 2), FUN=isUnknown,
+ unknown=unknown)
+
### }}}
### {{{ unknownToNA
+
###------------------------------------------------------------------------
-unknownToNA <- function(x, unknown, warning=FALSE)
+unknownToNA <- function(x, unknown, warning=FALSE, ...)
UseMethod("unknownToNA")
-unknownToNA.default <- function(x, unknown, warning=FALSE)
+unknownToNA.default <- function(x, unknown, warning=FALSE, ...)
{
if(warning) {
if(any(is.na(x)))
@@ -61,7 +69,7 @@
x
}
-unknownToNA.factor <- function(x, unknown, warning=FALSE)
+unknownToNA.factor <- function(x, unknown, warning=FALSE, ...)
{
## could put this func into default method, but I need unlisted unknown
## for levels handling
@@ -76,18 +84,18 @@
factor(x, levels=levs)
}
-unknownToNA.list <- function(x, unknown, warning=FALSE)
+unknownToNA.list <- function(x, unknown, warning=FALSE, ...)
{
unknown <- gdata:::.unknownList(x=x, unknown=unknown)
## FIXME - do I still need attributes here; R 2.4
- attrX <- attributes(x)
+ ## attrX <- attributes(x)
x <- mapply(FUN="unknownToNA", x=x, unknown=unknown, warning=warning,
SIMPLIFY=FALSE)
- attributes(x) <- attrX
+ ## attributes(x) <- attrX
return(x)
}
-unknownToNA.data.frame <- function(x, unknown, warning=FALSE)
+unknownToNA.data.frame <- function(x, unknown, warning=FALSE, ...)
{
x[] <- unknownToNA.list(x=x, unknown=unknown, warning=warning)
x
@@ -95,12 +103,13 @@
### }}}
### {{{ NAToUnknown
+
###------------------------------------------------------------------------
-NAToUnknown <- function(x, unknown, force=FALSE, call.=FALSE)
+NAToUnknown <- function(x, unknown, force=FALSE, call.=FALSE, ...)
UseMethod("NAToUnknown")
-NAToUnknown.default <- function(x, unknown, force=FALSE, call.=FALSE)
+NAToUnknown.default <- function(x, unknown, force=FALSE, call.=FALSE, ...)
{
if(length(as.character(unknown)) != 1) # as.character allows also POSIXlt
stop("'unknown' must be a single value")
@@ -120,7 +129,7 @@
x
}
-NAToUnknown.factor <- function(x, unknown, force=FALSE, call.=FALSE)
+NAToUnknown.factor <- function(x, unknown, force=FALSE, call.=FALSE, ...)
{
if(length(unknown) != 1)
stop("'unknown' must be a single value")
@@ -136,18 +145,18 @@
x
}
-NAToUnknown.list <- function(x, unknown, force=FALSE, call.=FALSE)
+NAToUnknown.list <- function(x, unknown, force=FALSE, call.=FALSE, ...)
{
unknown <- gdata:::.unknownList(x=x, unknown=unknown)
## FIXME - do I still need attributes here; R 2.4
- attrX <- attributes(x)
+ ## attrX <- attributes(x)
x <- mapply(FUN="NAToUnknown", x=x, unknown=unknown, force=force,
call.=call., SIMPLIFY=FALSE)
- attributes(x) <- attrX
+ ## attributes(x) <- attrX
x
}
-NAToUnknown.data.frame <- function(x, unknown, force=FALSE, call.=FALSE)
+NAToUnknown.data.frame <- function(x, unknown, force=FALSE, call.=FALSE, ...)
{
x[] <- NAToUnknown.list(x=x, unknown=unknown, force=force, call.=call.)
x
Modified: trunk/gdata/inst/unitTests/runit.unknown.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.unknown.R 2006-10-29 15:47:33 UTC (rev 991)
+++ trunk/gdata/inst/unitTests/runit.unknown.R 2006-10-29 16:08:40 UTC (rev 992)
@@ -2,7 +2,7 @@
###------------------------------------------------------------------------
### What: Tests for Change given unknown value to NA and vice versa methods
### $Id$
-### Time-stamp: <2006-09-07 15:33:50 ggorjan>
+### Time-stamp: <2006-10-29 17:06:04 ggorjan>
###------------------------------------------------------------------------
### {{{ --- Test setup ---
@@ -125,7 +125,7 @@
xDFUnk1 <- as.data.frame(xListNUnk1)
xDFUnk1$cha <- as.character(xDFUnk1$cha)
xDFUnk1Test <- as.data.frame(xListUnk1Test)
-colnames(xDFUnk1Test) <- names(xListNUnk1)
+names(xDFUnk1Test) <- names(xListNUnk1)
unkC2 <- c(0, "notAvail")
xListUnk2 <- list(as.integer(c(unkC2[1], 1, 2, unkC2[1], 5, 6, 7, 8, 9)),
@@ -165,6 +165,20 @@
factor(c("A", NA, NA, "NA", "NA", 9999, NA, "-", NA)))
### }}}
+### {{{ --- Matrix ---
+
+matUnk <- 9999
+mat <- matrix(1:25, nrow=5, ncol=5)
+mat[1, 2] <- NA; mat[1, 4] <- NA; mat[2, 2] <- NA;
+mat[3, 2] <- NA; mat[3, 5] <- NA; mat[5, 4] <- NA;
+matUnk1 <- mat
+matUnk1[1, 2] <- matUnk; matUnk1[1, 4] <- matUnk; matUnk1[2, 2] <- matUnk;
+matUnk1[3, 2] <- matUnk; matUnk1[3, 5] <- matUnk; matUnk1[5, 4] <- matUnk;
+matUnkTest <- matUnk1Test <- is.na(mat)
+
+matUnk2Test <- matUnkTest | mat == 1
+
+### }}}
### {{{ --- Use of unknown=list(.default=, ...) or similarly named vector ---
D1 <- "notAvail"
@@ -280,6 +294,11 @@
## list(.default=, 99) ERROR as we do not know where to apply 99
checkException(isUnknown(x=xListNUnk, unknown=unkLND2E))
+ ## --- matrix ---
+
+ checkIdentical(isUnknown(x=mat, unknown=NA), matUnkTest)
+ checkIdentical(isUnknown(x=matUnk1, unknown=matUnk), matUnkTest)
+ checkIdentical(isUnknown(x=matUnk1, unknown=c(1, matUnk)), matUnk2Test)
}
### }}}
@@ -310,8 +329,7 @@
## Date-time classes
checkIdentical(unknownToNA(xDateUnk, unknown=dateUnk), xDate)
- ## FIXME uncomment in R 2.4
- ## checkIdentical(unknownToNA(xPOSIXltUnk, unknown=POSIXltUnk), xPOSIXlt)
+ checkIdentical(unknownToNA(xPOSIXltUnk, unknown=POSIXltUnk), xPOSIXlt)
checkIdentical(unknownToNA(xPOSIXctUnk, unknown=POSIXctUnk), xPOSIXct)
## --- lists and data.frames ---
@@ -368,6 +386,10 @@
checkIdentical(unknownToNA(x=xListNUnkD3, unknown=unkLND3), xListN)
## list(.default=, 99) ERROR as we do not know where to apply 99
checkException(unknownToNA(x=xListNUnk, unknown=unkLND2E))
+
+ ## --- matrix ---
+
+ checkEquals(unknownToNA(x=matUnk1, unknown=matUnk), mat)
}
### }}}
@@ -405,7 +427,7 @@
## Date-time classes
checkIdentical(NAToUnknown(xDate, unknown=dateUnk), xDateUnk)
- ## FIXME uncomment in R 2.4
+ ## FIXME
## checkIdentical(NAToUnknown(xPOSIXlt, unknown=POSIXltUnk), xPOSIXltUnk)
checkIdentical(NAToUnknown(xPOSIXct, unknown=POSIXctUnk), xPOSIXctUnk)
@@ -464,6 +486,9 @@
## list(.default=, 99) ERROR as we do not know where to apply 99
checkException(NAToUnknown(x=xListN, unknown=unkLND2E))
+ ## --- matrix ---
+
+ checkEquals(NAToUnknown(x=mat, unknown=matUnk), matUnk1)
}
### }}}
Modified: trunk/gdata/man/unknown.Rd
===================================================================
--- trunk/gdata/man/unknown.Rd 2006-10-29 15:47:33 UTC (rev 991)
+++ trunk/gdata/man/unknown.Rd 2006-10-29 16:08:40 UTC (rev 992)
@@ -2,7 +2,7 @@
%--------------------------------------------------------------------------
% What: Change given unknown value to NA and vice versa man page
% $Id$
-% Time-stamp: <2006-09-07 15:38:12 ggorjan>
+% Time-stamp: <2006-10-15 03:52:48 ggorjan>
%--------------------------------------------------------------------------
\name{unknownToNA}
@@ -12,6 +12,7 @@
\alias{isUnknown.POSIXlt}
\alias{isUnknown.list}
\alias{isUnknown.data.frame}
+\alias{isUnknown.matrix}
\alias{unknownToNA}
\alias{unknownToNA.default}
@@ -39,8 +40,8 @@
\usage{
isUnknown(x, unknown=NA, \ldots)
-unknownToNA(x, unknown, warning=FALSE)
-NAToUnknown(x, unknown, force=FALSE, call.=FALSE)
+unknownToNA(x, unknown, warning=FALSE, \ldots)
+NAToUnknown(x, unknown, force=FALSE, call.=FALSE, \ldots)
}
@@ -49,7 +50,8 @@
\item{unknown}{generic, value used instead of \code{NA}}
\item{warning}{logical, issue warning if \code{x} already has \code{NA}}
\item{force}{logical, force to apply already existing value in \code{x}}
- \item{\ldots}{arguments pased to as.character POSIXlt method}
+ \item{\ldots}{arguments pased to other methods (as.character for POSIXlt
+ in case of isUnknown)}
\item{call.}{logical, look in \code{\link{warning}}}
}
@@ -65,8 +67,8 @@
All functions are generic and the following classes were tested to work
with latest version: \dQuote{integer}, \dQuote{numeric},
\dQuote{character}, \dQuote{factor}, \dQuote{Date}, \dQuote{POSIXct},
-\dQuote{POSIXlt}, \dQuote{list}, \dQuote{data.frame}. For others default
-method might work just fine.
+\dQuote{POSIXlt}, \dQuote{list}, \dQuote{data.frame} and
+\dQuote{matrix}. For others default method might work just fine.
\code{unknownToNA} and \code{isUnknown} can cope with multiple values in
\code{unknown}, but those should be given as a \dQuote{vector}. If not,
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2006-10-30 17:10:39
|
Revision: 993
http://svn.sourceforge.net/r-gregmisc/?rev=993&view=rev
Author: ggorjan
Date: 2006-10-30 09:10:08 -0800 (Mon, 30 Oct 2006)
Log Message:
-----------
mapply keeps names in R 2.4; POSIX unit tests solved; $ should work now
Modified Paths:
--------------
trunk/gdata/R/mapLevels.R
trunk/gdata/R/unknown.R
trunk/gdata/inst/unitTests/runit.unknown.R
Property Changed:
----------------
trunk/gdata/R/c.factor.R
trunk/gdata/R/mapLevels.R
trunk/gdata/R/unknown.R
trunk/gdata/inst/unitTests/runit.drop.levels.R
trunk/gdata/inst/unitTests/runit.mapLevels.R
trunk/gdata/inst/unitTests/runit.trim.R
trunk/gdata/inst/unitTests/runit.unknown.R
trunk/gdata/man/c.factor.Rd
trunk/gdata/man/unknown.Rd
trunk/gdata/tests/doRUnit.R
Property changes on: trunk/gdata/R/c.factor.R
___________________________________________________________________
Name: svn:keywords
+ Id
Modified: trunk/gdata/R/mapLevels.R
===================================================================
--- trunk/gdata/R/mapLevels.R 2006-10-29 16:08:40 UTC (rev 992)
+++ trunk/gdata/R/mapLevels.R 2006-10-30 17:10:08 UTC (rev 993)
@@ -1,7 +1,7 @@
### mapLevels.R
###------------------------------------------------------------------------
### What: Mapping levels
-### $Id: mapLevels.R,v 1.1 2006/03/29 13:47:15 ggorjan Exp ggorjan $
+### $Id$
### Time-stamp: <2006-10-29 16:45:20 ggorjan>
###------------------------------------------------------------------------
Property changes on: trunk/gdata/R/mapLevels.R
___________________________________________________________________
Name: svn:keywords
+ Id
Modified: trunk/gdata/R/unknown.R
===================================================================
--- trunk/gdata/R/unknown.R 2006-10-29 16:08:40 UTC (rev 992)
+++ trunk/gdata/R/unknown.R 2006-10-30 17:10:08 UTC (rev 993)
@@ -1,12 +1,11 @@
### unknown.R
###------------------------------------------------------------------------
### What: Change given unknown value to NA and vice versa
-### $Id$
-### Time-stamp: <2006-10-29 17:08:21 ggorjan>
+### $Id:$
+### Time-stamp: <2006-10-30 18:06:17 ggorjan>
###------------------------------------------------------------------------
### {{{ isUnknown
-
###------------------------------------------------------------------------
isUnknown <- function(x, unknown=NA, ...)
@@ -34,10 +33,7 @@
isUnknown.list <- function(x, unknown=NA, ...) {
unknown <- gdata:::.unknownList(x=x, unknown=unknown)
- ## FIXME - do I still need attributes here; R 2.4
- ## attrX <- attributes(x)
x <- mapply(FUN="isUnknown", x=x, unknown=unknown, ..., SIMPLIFY=FALSE)
- ## attributes(x) <- attrX
x
}
@@ -53,7 +49,6 @@
### }}}
### {{{ unknownToNA
-
###------------------------------------------------------------------------
unknownToNA <- function(x, unknown, warning=FALSE, ...)
@@ -87,11 +82,8 @@
unknownToNA.list <- function(x, unknown, warning=FALSE, ...)
{
unknown <- gdata:::.unknownList(x=x, unknown=unknown)
- ## FIXME - do I still need attributes here; R 2.4
- ## attrX <- attributes(x)
x <- mapply(FUN="unknownToNA", x=x, unknown=unknown, warning=warning,
SIMPLIFY=FALSE)
- ## attributes(x) <- attrX
return(x)
}
@@ -103,7 +95,6 @@
### }}}
### {{{ NAToUnknown
-
###------------------------------------------------------------------------
NAToUnknown <- function(x, unknown, force=FALSE, call.=FALSE, ...)
@@ -148,11 +139,8 @@
NAToUnknown.list <- function(x, unknown, force=FALSE, call.=FALSE, ...)
{
unknown <- gdata:::.unknownList(x=x, unknown=unknown)
- ## FIXME - do I still need attributes here; R 2.4
- ## attrX <- attributes(x)
x <- mapply(FUN="NAToUnknown", x=x, unknown=unknown, force=force,
call.=call., SIMPLIFY=FALSE)
- ## attributes(x) <- attrX
x
}
Property changes on: trunk/gdata/R/unknown.R
___________________________________________________________________
Name: svn:keywords
+ Id
Property changes on: trunk/gdata/inst/unitTests/runit.drop.levels.R
___________________________________________________________________
Name: svn:keywords
+ Id
Property changes on: trunk/gdata/inst/unitTests/runit.mapLevels.R
___________________________________________________________________
Name: svn:keywords
+ Id
Property changes on: trunk/gdata/inst/unitTests/runit.trim.R
___________________________________________________________________
Name: svn:keywords
+ Id
Modified: trunk/gdata/inst/unitTests/runit.unknown.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.unknown.R 2006-10-29 16:08:40 UTC (rev 992)
+++ trunk/gdata/inst/unitTests/runit.unknown.R 2006-10-30 17:10:08 UTC (rev 993)
@@ -2,7 +2,7 @@
###------------------------------------------------------------------------
### What: Tests for Change given unknown value to NA and vice versa methods
### $Id$
-### Time-stamp: <2006-10-29 17:06:04 ggorjan>
+### Time-stamp: <2006-10-30 17:46:21 ggorjan>
###------------------------------------------------------------------------
### {{{ --- Test setup ---
@@ -48,28 +48,31 @@
xFacUnkLevTest <- c(1, 0, 0, 0, 0, 0, 0, 0, 1)
xFacUnkLevTest <- as.logical(xFacUnkLevTest)
-dateUnk <- as.Date("1900-1-1")
-xDate <- c(as.Date("2006-08-31"), NA)
-xDateUnk <- c(as.Date("2006-08-31"), dateUnk)
-xDateTest <- c(FALSE, TRUE)
+dateUnk <- as.Date("2006-08-14")
+tmp <- as.Date("2006-08-15")
+xDate <- c(tmp, NA)
+xDateUnk <- c(tmp, dateUnk)
+xDateTest <- c(FALSE, TRUE)
-xDate1Unk <- c(as.Date("2006-08-31"), dateUnk, NA)
-xDate1Test <- c(FALSE, TRUE, FALSE)
+xDate1Unk <- c(tmp, dateUnk, NA)
+xDate1Test <- c(FALSE, TRUE, FALSE)
-POSIXltUnk <- strptime("1900-1-1", format="%Y-%m-%d")
-xPOSIXlt <- c(strptime("2006-08-31", format="%Y-%m-%d"), NA)
-xPOSIXltUnk <- c(strptime("2006-08-31", format="%Y-%m-%d"), POSIXltUnk)
-xPOSIXltTest <- c(FALSE, TRUE)
+POSIXltUnk <- strptime("2006-08-14", format="%Y-%m-%d")
+tmp <- strptime("2006-08-15", format="%Y-%m-%d")
+xPOSIXlt <- c(tmp, NA)
+xPOSIXltUnk <- c(tmp, POSIXltUnk)
+xPOSIXltTest <- c(FALSE, TRUE)
-xPOSIXlt1Unk <- c(strptime("2006-08-31", format="%Y-%m-%d"), POSIXltUnk, NA)
-xPOSIXlt1Test <- c(FALSE, TRUE, FALSE)
+xPOSIXlt1Unk <- c(tmp, POSIXltUnk, NA)
+xPOSIXlt1Test <- c(FALSE, TRUE, FALSE)
-POSIXctUnk <- as.POSIXct(strptime("1900-1-1 01:01:01", format="%Y-%m-%d %H:%M:%S"))
-xPOSIXct <- c(as.POSIXct(strptime("2006-08-31 01:01:01", format="%Y-%m-%d %H:%M:%S")), NA)
-xPOSIXctUnk <- c(as.POSIXct(strptime("2006-08-31 01:01:01", format="%Y-%m-%d %H:%M:%S")), POSIXctUnk)
+POSIXctUnk <- as.POSIXct(strptime("2006-08-14 01:01:01", format="%Y-%m-%d %H:%M:%S"))
+tmp <- as.POSIXct(strptime("2006-08-15 01:01:01", format="%Y-%m-%d %H:%M:%S"))
+xPOSIXct <- c(tmp, NA)
+xPOSIXctUnk <- c(tmp, POSIXctUnk)
xPOSIXctTest <- xPOSIXltTest
-xPOSIXct1Unk <- c(as.POSIXct(strptime("2006-08-31 01:01:01", format="%Y-%m-%d %H:%M:%S")), POSIXctUnk, NA)
+xPOSIXct1Unk <- c(tmp, POSIXctUnk, NA)
xPOSIXct1Test <- xPOSIXlt1Test
### }}}
@@ -427,8 +430,7 @@
## Date-time classes
checkIdentical(NAToUnknown(xDate, unknown=dateUnk), xDateUnk)
- ## FIXME
- ## checkIdentical(NAToUnknown(xPOSIXlt, unknown=POSIXltUnk), xPOSIXltUnk)
+ checkIdentical(NAToUnknown(xPOSIXlt, unknown=POSIXltUnk), xPOSIXltUnk)
checkIdentical(NAToUnknown(xPOSIXct, unknown=POSIXctUnk), xPOSIXctUnk)
## --- lists and data.frames ---
Property changes on: trunk/gdata/inst/unitTests/runit.unknown.R
___________________________________________________________________
Name: svn:keywords
+ Id
Property changes on: trunk/gdata/man/c.factor.Rd
___________________________________________________________________
Name: svn:keywords
+ Id
Property changes on: trunk/gdata/man/unknown.Rd
___________________________________________________________________
Name: svn:keywords
+ Id
Property changes on: trunk/gdata/tests/doRUnit.R
___________________________________________________________________
Name: svn:keywords
+ Id
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2008-01-30 19:55:13
|
Revision: 1241
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1241&view=rev
Author: warnes
Date: 2008-01-30 11:55:08 -0800 (Wed, 30 Jan 2008)
Log Message:
-----------
Update DESCRIPTION and NEWS for release 2.4.0
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/inst/NEWS
Added Paths:
-----------
trunk/gdata/ChangeLog
Added: trunk/gdata/ChangeLog
===================================================================
--- trunk/gdata/ChangeLog (rev 0)
+++ trunk/gdata/ChangeLog 2008-01-30 19:55:08 UTC (rev 1241)
@@ -0,0 +1 @@
+link inst/ChangeLog
\ No newline at end of file
Property changes on: trunk/gdata/ChangeLog
___________________________________________________________________
Name: svn:special
+ *
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2008-01-29 11:26:03 UTC (rev 1240)
+++ trunk/gdata/DESCRIPTION 2008-01-30 19:55:08 UTC (rev 1241)
@@ -3,8 +3,9 @@
Description: Various R programming tools for data manipulation
Depends: R (>= 2.4.0)
Imports: gtools
-Version: 2.3.1
-Author: Gregory R. Warnes. Includes R source code and/or documentation
- contributed by Ben Bolker, Gregor Gorjanc, and Thomas Lumley
+Version: 2.4.0
+Date: 2008-01-30
+Author: Gregory R. Warnes and Gregor Gorjanc. Includes R source code
+ and/or documentation contributed by Ben Bolker and Thomas Lumley.
Maintainer: Gregory Warnes <gre...@ur...>
License: GPL-2
Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS 2008-01-29 11:26:03 UTC (rev 1240)
+++ trunk/gdata/inst/NEWS 2008-01-30 19:55:08 UTC (rev 1241)
@@ -1,5 +1,40 @@
+CHANGES IN 2.4.0 (2008-01-30)
+-----------------------------
+
+- The keep() function now includes an 'all' argument to specify how
+ objects with names starting with '.' are handled.
+
+- keep() now shows an informative warning message when a requested
+ object does not exist
+
+- New vignette "Mapping Levels of a Factor" describing the use of
+ mapLevels().
+
+- New vignette "Working with Unknown Values" describing the use of
+ isUnknown() and unknownToNA().
+
+- Several enhancements to read.xls() (thanks to Gabor Grothendieck):
+
+ - New function xls2csv(), which handles converting an xls file
+ to a csv file and returns a connection to the
+ temporary csv file
+
+ - xls2csv() and read.xls() both allow a file or a url to be specified
+
+ - read.xls() has a new 'pattern' argument which, if supplied,
+ will ignore everything prior to the first line in th csv file
+ that matches the pattern. This is typically used if there
+ are a variable number of comment lines prior to the header
+ in which case one can specify one of the column
+ headings as the pattern. read.xls should
+ be compatible with the old read.xls.
+
+- Minor fixes to drop.levels(), is.what().
+
+- Implementation of unit tests for most functions.
+
CHANGES IN 2.3.1 (2006-10-29)
----------------------------------------
+-----------------------------
- Arguments as well as their position of reorder.factor have been changed
to conform with reorder.factor method in stats package, due to collision
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2006-10-30 19:02:47
|
Revision: 996
http://svn.sourceforge.net/r-gregmisc/?rev=996&view=rev
Author: ggorjan
Date: 2006-10-30 11:02:13 -0800 (Mon, 30 Oct 2006)
Log Message:
-----------
write.fwf
Modified Paths:
--------------
trunk/gdata/NAMESPACE
trunk/gdata/NEWS
Added Paths:
-----------
trunk/gdata/R/write.fwf.R
trunk/gdata/inst/unitTests/runit.write.fwf.R
trunk/gdata/man/write.fwf.Rd
trunk/gdata/tests/tests.write.fwf.R
trunk/gdata/tests/tests.write.fwf.Rout.save
Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE 2006-10-30 17:27:38 UTC (rev 995)
+++ trunk/gdata/NAMESPACE 2006-10-30 19:02:13 UTC (rev 996)
@@ -25,7 +25,7 @@
unmatrix,
upperTriangle,
"upperTriangle<-",
-## write.fwf,
+ write.fwf,
## mapLevels stuff
mapLevels,
@@ -85,7 +85,7 @@
S3method(isUnknown, POSIXlt)
S3method(isUnknown, list)
S3method(isUnknown, data.frame)
-## S3method(isUnknown, matrix)
+S3method(isUnknown, matrix)
S3method(unknownToNA, default)
S3method(unknownToNA, factor)
Modified: trunk/gdata/NEWS
===================================================================
--- trunk/gdata/NEWS 2006-10-30 17:27:38 UTC (rev 995)
+++ trunk/gdata/NEWS 2006-10-30 19:02:13 UTC (rev 996)
@@ -12,6 +12,10 @@
- Added "unknown" methods for matrices.
+- Added c() method for factors based on mapLevels() functions.
+
+- Added write.fwf, which writes file in *F*ixed *W*idth *f*ormat.
+
CHANGES FROM 2.1.X to 2.3.0 (2006-09-19)
---------------------------------------
Added: trunk/gdata/R/write.fwf.R
===================================================================
--- trunk/gdata/R/write.fwf.R (rev 0)
+++ trunk/gdata/R/write.fwf.R 2006-10-30 19:02:13 UTC (rev 996)
@@ -0,0 +1,104 @@
+### write.fwf.R
+###------------------------------------------------------------------------
+### What: Write fixed width format
+### $Id$
+### Time-stamp: <2006-10-30 18:58:40 ggorjan>
+###------------------------------------------------------------------------
+
+write.fwf <- function(x, file="", append=FALSE, quote=FALSE, sep=" ",
+ na="", rownames=FALSE, colnames=TRUE, rowCol=NULL,
+ justify="right", formatInfo=FALSE, quoteInfo=TRUE, ...)
+{
+ if(!(is.data.frame(x) || is.matrix(x)))
+ stop("'x' must be a data.frame or matrix")
+ if(rownames) {
+ x <- cbind(rownames(x), x)
+ rowColVal <- ifelse(!is.null(rowCol), rowCol, "row")
+ colnames(x)[1] <- rowColVal
+ }
+ colnamesMy <- colnames(x)
+
+ ## --- Format info ---
+
+ if(formatInfo) {
+ retFormat <- data.frame(colname=colnamesMy,
+ nlevels=0,
+ position=0,
+ width=0,
+ digits=0,
+ exp=0)
+ retFormat$colname <- as.character(retFormat$colname)
+
+ isNum <- sapply(x, is.numeric)
+ ## is.numeric picks also Date and POSIXt
+ isNum <- isNum & !(sapply(x, inherits, what="Date") |
+ sapply(x, inherits, what="POSIXt"))
+
+ ## Numeric is a bit special and we need to get info before format turns
+ ## all to character
+ if(any(isNum)) {
+ tmp <- lapply(x[, isNum, drop=FALSE], format.info, ...)
+ tmp1 <- sapply(tmp, length)
+ tmp <- t(as.data.frame(tmp))
+ j <- 1
+ for(i in which(isNum)) {
+ retFormat[i, 4:(3+tmp1[j])] <- tmp[j, 1:tmp1[j]]
+ ## length 1 for exp should mean 1 and not 1+1
+ if(tmp1[j] > 2 && tmp[j, 3] > 1)
+ retFormat[i, "exp"] <- retFormat[i, "exp"] + 1
+ j <- j + 1
+ }
+ }
+ }
+
+ ## --- Format ---
+
+ x <- apply(X=x, MARGIN=2,
+ FUN=function(z) {
+ ## NAToUnknown is used since format corces NA to "NA" and
+ ## then argument na in write.table does not do its job
+ format(gdata:::NAToUnknown.default(as.character(z),
+ unknown=as.character(na)),
+ justify=justify, ...) })
+ if(formatInfo) {
+ if(any(!isNum)) { # need apply as x is now a matrix
+ retFormat[!isNum, "width"] <- apply(X=x[, !isNum, drop=FALSE], MARGIN=2,
+ FUN=function(z) format.info(z)[1])
+ retFormat[!isNum, "nlevels"] <- apply(X=x[, !isNum, drop=FALSE], MARGIN=2,
+ FUN=function(z) length(unique(z)))
+ }
+ }
+
+ ## --- Write ---
+
+ if(colnames) {
+ if(rownames && is.null(rowCol)) colnamesMy <- colnamesMy[-1]
+ write.table(t(as.matrix(colnamesMy)), file=file, append=append,
+ quote=quote, sep=sep, row.names=FALSE, col.names=FALSE, ...)
+ }
+
+ write.table(x=x, file=file, append=(colnames || append), quote=quote,
+ sep=sep, row.names=FALSE, col.names=FALSE, ...)
+
+ ## --- Return format and fixed width information ---
+
+ if(formatInfo) {
+ ## be carefull with these ifelse constructs
+ retFormat$position[1] <- ifelse(quote, ifelse(quoteInfo, 1, 2), 1)
+ if(ifelse(quote, quoteInfo, FALSE)) retFormat$width <- retFormat$width + 2
+ N <- nrow(retFormat)
+ for(i in 2:N) {
+ retFormat$position[i] <- retFormat$position[i - 1] +
+ retFormat$width[i - 1] + nchar(x=sep, type="chars") +
+ ifelse(quote, ifelse(quoteInfo, 0, 1), 0)
+ }
+ if(rownames && is.null(rowCol)) {
+ retFormat <- retFormat[-1,]
+ rownames(retFormat) <- 1:(N-1)
+ }
+ return(retFormat)
+ }
+}
+
+###------------------------------------------------------------------------
+### write.fwf.R ends here
Added: trunk/gdata/inst/unitTests/runit.write.fwf.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.write.fwf.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.write.fwf.R 2006-10-30 19:02:13 UTC (rev 996)
@@ -0,0 +1,97 @@
+### runit.write.fwf.R
+###------------------------------------------------------------------------
+### What: Unit tests for write.fwf
+### $Id$
+### Time-stamp: <2006-10-30 18:49:04 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ --- Test setup ---
+
+if(FALSE) {
+ library("RUnit")
+ library("gdata")
+}
+
+### }}}
+### {{{ --- write.fwf ---
+
+test.write.fwf <- function()
+{
+
+ ## 'x' must be a data.frame or matrix
+ checkException(write.fwf(1:10))
+ checkException(write.fwf(list(1:10)))
+
+ testData <- data.frame(num1=c(1:10, NA),
+ num2=c(NA, seq(from=1, to=5.5, by=0.5)),
+ num3=c(NA, rnorm(n=10, mean=1e6, sd=3e5)),
+ int1=c(as.integer(1:4), NA, as.integer(5:10)),
+ fac1=factor(c(NA, letters[1:10])),
+ fac2=factor(c(letters[6:15], NA)),
+ cha1=c(letters[17:26], NA),
+ cha2=c(NA, letters[26:17]),
+ stringsAsFactors=FALSE)
+ levels(testData$fac1) <- c(levels(testData$fac1), "unusedLevel")
+ testData$Date <- as.Date("1900-1-1")
+ testData$Date[2] <- NA
+ testData$POSIXt <- as.POSIXct(strptime("1900-1-1 01:01:01", format="%Y-%m-%d %H:%M:%S"))
+ testData$POSIXt[5] <- NA
+
+ ## --- output ---
+ ## in regular tests
+
+ ## --- formatInfo ---
+
+ ## default output
+ formatInfoT <- data.frame(colname=c("num1", "num2"),
+ nlevels=c(0, 0),
+ position=c(1, 4),
+ width=c(2, 3),
+ digits=c(0, 1),
+ exp=c(0, 0),
+ stringsAsFactors=FALSE)
+ formatInfo <- write.fwf(testData[, c("num1", "num2")], formatInfo=TRUE)
+ checkEquals(formatInfo, formatInfoT)
+
+ ## rowCol
+ formatInfoTR <- data.frame(colname=c("row", "num1", "num2"),
+ nlevels=c(11, 0, 0),
+ position=c(1, 4, 7),
+ width=c(2, 2, 3),
+ digits=c(0, 0, 1),
+ exp=c(0, 0, 0),
+ stringsAsFactors=FALSE)
+ formatInfoR <- write.fwf(testData[, c("num1", "num2")], formatInfo=TRUE,
+ rownames=TRUE, rowCol="row")
+ checkEquals(formatInfoR, formatInfoTR)
+
+ ## quoteInfo alone does not have any effect
+ formatInfoI <- write.fwf(testData[, c("num1", "num2")], formatInfo=TRUE,
+ quoteInfo=TRUE)
+ checkEquals(formatInfoI, formatInfoT)
+
+ ## quote
+ formatInfoQ <- write.fwf(testData[, c("num1", "num2")], formatInfo=TRUE,
+ quote=TRUE)
+ formatInfoTQ <- formatInfoT
+ formatInfoTQ$position <- c(1, 6)
+ formatInfoTQ$width <- c(4, 5)
+ checkEquals(formatInfoQ, formatInfoTQ)
+
+ ## quote without quoteInfo
+ formatInfoQI <- write.fwf(testData[, c("num1", "num2")], formatInfo=TRUE,
+ quote=TRUE, quoteInfo=FALSE)
+ formatInfoTQI <- formatInfoT
+ formatInfoTQI$position <- c(2, 6)
+ checkEquals(formatInfoQI, formatInfoTQI)
+}
+
+### }}}
+### {{{ Dear Emacs
+## Local variables:
+## folded-file: t
+## End:
+### }}}
+
+###------------------------------------------------------------------------
+### runit.write.fwf.R ends here
Added: trunk/gdata/man/write.fwf.Rd
===================================================================
--- trunk/gdata/man/write.fwf.Rd (rev 0)
+++ trunk/gdata/man/write.fwf.Rd 2006-10-30 19:02:13 UTC (rev 996)
@@ -0,0 +1,208 @@
+% write.fwf.Rd
+%--------------------------------------------------------------------------
+% What: Write fixed width format man page
+% $Id$
+% Time-stamp: <2006-10-30 20:01:16 ggorjan>
+%--------------------------------------------------------------------------
+
+\name{write.fwf}
+
+\alias{write.fwf}
+
+\concept{data output}
+\concept{data export}
+
+\title{Write object in fixed width format}
+
+\description{
+\code{write.fwf} writes object in *f*ixed *w*idth *f*ormat.
+}
+
+\usage{
+
+write.fwf(x, file="", append=FALSE, quote=FALSE, sep=" ", na="",
+ rownames=FALSE, colnames=TRUE, rowCol=NULL, justify="right",
+ formatInfo=FALSE, quoteInfo=TRUE, \ldots)
+
+}
+
+\arguments{
+ \item{x}{data.frame or matrix, the object to be written}
+ \item{file}{character, name of file or connection, look in
+ \code{\link{write.table}} for more}
+ \item{append}{logical, append to existing data in \code{file}}
+ \item{quote}{logical, quote data in output}
+ \item{na}{character, the string to use for missing values
+ i.e. \code{NA} in the output}
+ \item{sep}{character, separator between columns in output}
+ \item{rownames}{logical, print row names}
+ \item{colnames}{logical, print column names}
+ \item{rowCol}{character, rownames column name}
+ \item{justify}{character, allignment of character columns}
+ \item{formatInfo}{logical, return information on number of levels,
+ widths and format}
+ \item{quoteInfo}{logical, should \code{formatInfo} account for quotes}
+ \item{\ldots}{further arguments to \code{\link{format.info}},
+ \code{\link{format}} and \code{\link{write.table}}}
+}
+
+\details{
+
+Output is similar to \code{print(x)} or \code{format(x)}. Formating is
+done completely by \code{\link{format}} on a column basis. Columns in
+the output are by default separated with a space i.e. empty column with
+a width of one character, but that can be changed with \code{sep}
+argument as passed to \code{\link{write.table}} via \ldots.
+
+\code{quote} can be used to quote fields in the output. Since all
+columns of \code{x} are converted to character during the output, all
+columns will be quoted! The following is needed for \code{read.fwf} or
+any other tools outside \R. If quotes are used, \code{\link{read.table}}
+can be easily used to read the data back into \R. Check examples. Do read
+details on \code{quoteInfo}.
+
+Use only *true* character i.e. not "\t" or similar for \code{sep} as
+number of characters in \code{sep} is needed internally.
+
+Use \code{na} to convert missing/unknown values. Only single value can
+be specified. Take a look at \code{\link{NAToUnknown}} if you need
+greater flexibility.
+
+If \code{rowCol} is not \code{NULL} and \code{rownames=TRUE} rownames
+will also have column name with \code{rowCol} value. This is mainly for
+flexibility with tools outside \R. Note that (at least in \R 2.4.0) it
+is not "easy" to import data back to \R with \code{\link{read.fwf}} if
+you also export rownames. That is the reason, that default is
+\code{rownames=FALSE}.
+
+Information about format of output can be returned if
+\code{formatInfo=TRUE}. Returned value is described in value
+section. Result is provided by \code{\link{format.info}} and care was
+taken to handle numeric properly. If output contains rownames, returned
+value accounts for this. Additionally, if \code{rowCol} is not
+\code{NULL} then returned value contains also information about format
+of rownames.
+
+If \code{quote=TRUE} output is wider due to quotes. Return value (with
+\code{formatInfo=TRUE}) can account for this in two ways; controlled
+with argument \code{quoteInfo}. However, note that there is no way to
+properly read data back to \R if \code{quote=TRUE & quoteInfo=FALSE} was
+specifed for export. \code{quoteInfo} applies only when
+\code{quote=TRUE}. Assume there is a file with quoted data as shown
+bellow (column numbers in first three line are only for demonstration of
+the values in the output).
+
+\preformatted{
+123456789 12345678 # for position
+123 1234567 123456 # for width with quoteInfo=TRUE
+ 1 12345 1234 # for width with quoteInfo=FALSE
+"a" "hsgdh" " 9"
+" " " bb" " 123"
+}
+
+With \code{quoteInfo=TRUE} \code{write.fwf} will return (symbolically)
+
+\preformatted{
+colname position width
+V1 1 3
+V2 5 7
+V3 13 6
+}
+
+or (with \code{quoteInfo=FALSE})
+
+\preformatted{
+colname position width
+V1 2 1
+V2 6 5
+V3 14 4
+}
+
+}
+
+\value{
+
+Besides its effect to write/export data \code{write.fwf} can provide
+information on format and width. A data.frame is returned with the
+following columns:
+ \item{colname}{name of the column}
+ \item{nlevels}{number of unique values (unused levels of factors are
+ dropped), 0 for numeric column}
+ \item{position}{starting column number in the output}
+ \item{width}{width of the column}
+ \item{digits}{number of digits after the decimal point}
+ \item{exp}{width of exponent in exponential representation; 0 means
+ there is no exponential representation, while 1 represents exponent
+ of length one i.e. \code{1e+6} and 2 \code{1e+06} or \code{1e+16}}
+}
+
+\author{Gregor Gorjanc}
+
+\seealso{
+ \code{\link{format.info}}, \code{\link{format}},
+ \code{\link{NAToUnknown}}, \code{\link{write.table}},
+ \code{\link{read.fwf}}, \code{\link{read.table}} and
+ \code{\link{trim}}
+}
+
+\examples{
+
+ ## Some data
+ testData <- data.frame(num1=c(1:10, NA),
+ num2=c(NA, seq(from=1, to=5.5, by=0.5)),
+ num3=c(NA, rnorm(n=10, mean=1e6, sd=3e5)),
+ int1=c(as.integer(1:4), NA, as.integer(5:10)),
+ fac1=factor(c(NA, letters[1:10])),
+ fac2=factor(c(letters[6:15], NA)),
+ cha1=c(letters[17:26], NA),
+ cha2=c(NA, letters[26:17]),
+ stringsAsFactors=FALSE)
+ levels(testData$fac1) <- c(levels(testData$fac1), "unusedLevel")
+ testData$Date <- as.Date("1900-1-1")
+ testData$Date[2] <- NA
+ testData$POSIXt <- as.POSIXct(strptime("1900-1-1 01:01:01",
+ format="\%Y-\%m-\%d \%H:\%M:\%S"))
+ testData$POSIXt[5] <- NA
+
+ ## Default
+ write.fwf(x=testData)
+
+ ## NA should be - or ------------
+ write.fwf(x=testData, na="-")
+ write.fwf(x=testData, na="------------")
+
+ ## Some other separator than space
+ write.fwf(x=testData[, 1:4], sep="-mySep-")
+
+ ## Write to file and report format and fixed width information
+ file <- tempfile("test.txt")
+ formatInfo <- write.fwf(x=testData, file=file, formatInfo=TRUE)
+
+ ## Read exported data back to R (note +1 due to separator)
+ tmp <- read.fwf(file=file, widths=formatInfo$width + 1, skip=1,
+ strip.white=TRUE)
+ colnames(tmp) <- unlist(strsplit(readLines(con=file, n=1), split=" "))
+ tmp
+
+ \dontrun{
+ ## How to persuade read.fwf to accept header properly?
+ read.fwf(file=file, widths=formatInfo$width + 1, header=TRUE)
+
+ }
+
+ ## This works, but without header
+ read.fwf(file=file, widths=formatInfo$width + 1, header=FALSE, skip=1)
+
+ ## This works, but we have to use quotes
+ write.fwf(x=testData, file=file, quote=TRUE)
+ read.table(file=file, header=TRUE, strip.white=TRUE)
+
+ ## Tidy up
+ unlink(file)
+}
+
+\keyword{print}
+\keyword{file}
+
+%--------------------------------------------------------------------------
+% write.fwf.Rd ends here
Added: trunk/gdata/tests/tests.write.fwf.R
===================================================================
--- trunk/gdata/tests/tests.write.fwf.R (rev 0)
+++ trunk/gdata/tests/tests.write.fwf.R 2006-10-30 19:02:13 UTC (rev 996)
@@ -0,0 +1,61 @@
+### tests.write.fwf.R
+###------------------------------------------------------------------------
+### What: Tests for write.fwf
+### $Id$
+### Time-stamp: <2006-10-30 19:54:59 ggorjan>
+###------------------------------------------------------------------------
+
+library(gdata)
+
+## --- Test data ---
+
+num <- c(733070.345678, 1214213.78765456, 553823.798765678,
+ 1085022.8876545678, 571063.88765456, 606718.3876545678,
+ 1053686.6, 971024.187656, 631193.398765456, 879431.1)
+
+testData <- data.frame(num1=c(1:10, NA),
+ num2=c(NA, seq(from=1, to=5.5, by=0.5)),
+ num3=c(NA, num),
+ int1=c(as.integer(1:4), NA, as.integer(5:10)),
+ fac1=factor(c(NA, letters[1:10])),
+ fac2=factor(c(letters[6:15], NA)),
+ cha1=c(letters[17:26], NA),
+ cha2=c(NA, letters[26:17]),
+ stringsAsFactors=FALSE)
+levels(testData$fac1) <- c(levels(testData$fac1), "unusedLevel")
+testData$Date <- as.Date("1900-1-1")
+testData$Date[2] <- NA
+testData$POSIXt <- as.POSIXct(strptime("1900-1-1 01:01:01", format="%Y-%m-%d %H:%M:%S"))
+testData$POSIXt[5] <- NA
+
+## --- Tests ---
+
+## Default
+write.fwf(testData)
+
+## NA should be - or ------------
+write.fwf(x=testData, na="-")
+write.fwf(x=testData, na="------------")
+
+## Some other separator than space
+write.fwf(testData[, 1:4], sep="-mySep-")
+
+## With quotes
+write.fwf(testData, quote=TRUE)
+
+## Without rownames
+write.fwf(testData, rownames=FALSE)
+
+## Without colnames
+write.fwf(testData, colnames=FALSE)
+
+## Without rownames and colnames
+write.fwf(testData, rownames=FALSE, colnames=FALSE)
+
+## With rownames and colnames and rowCol
+write.fwf(testData, rowCol="HI!")
+
+## formatInfo in unit tests
+
+###------------------------------------------------------------------------
+### tests.write.fwf.R ends
Added: trunk/gdata/tests/tests.write.fwf.Rout.save
===================================================================
--- trunk/gdata/tests/tests.write.fwf.Rout.save (rev 0)
+++ trunk/gdata/tests/tests.write.fwf.Rout.save 2006-10-30 19:02:13 UTC (rev 996)
@@ -0,0 +1,191 @@
+
+R version 2.4.0 (2006-10-03)
+Copyright (C) 2006 The R Foundation for Statistical Computing
+ISBN 3-900051-07-0
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+ Natural language support but running in an English locale
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> invisible(options(echo = TRUE))
+> ### tests.write.fwf.R
+> ###------------------------------------------------------------------------
+> ### What: Tests for write.fwf
+> ### $Id$
+> ### Time-stamp: <2006-10-30 19:54:59 ggorjan>
+> ###------------------------------------------------------------------------
+>
+> library(gdata)
+>
+> ## --- Test data ---
+>
+> num <- c(733070.345678, 1214213.78765456, 553823.798765678,
++ 1085022.8876545678, 571063.88765456, 606718.3876545678,
++ 1053686.6, 971024.187656, 631193.398765456, 879431.1)
+>
+> testData <- data.frame(num1=c(1:10, NA),
++ num2=c(NA, seq(from=1, to=5.5, by=0.5)),
++ num3=c(NA, num),
++ int1=c(as.integer(1:4), NA, as.integer(5:10)),
++ fac1=factor(c(NA, letters[1:10])),
++ fac2=factor(c(letters[6:15], NA)),
++ cha1=c(letters[17:26], NA),
++ cha2=c(NA, letters[26:17]),
++ stringsAsFactors=FALSE)
+> levels(testData$fac1) <- c(levels(testData$fac1), "unusedLevel")
+> testData$Date <- as.Date("1900-1-1")
+> testData$Date[2] <- NA
+> testData$POSIXt <- as.POSIXct(strptime("1900-1-1 01:01:01", format="%Y-%m-%d %H:%M:%S"))
+> testData$POSIXt[5] <- NA
+>
+> ## --- Tests ---
+>
+> ## Default
+> write.fwf(testData)
+num1 num2 num3 int1 fac1 fac2 cha1 cha2 Date POSIXt
+ 1 1 f q 1900-01-01 1900-01-01 01:01:01
+ 2 1.0 733070.3 2 a g r z 1900-01-01 01:01:01
+ 3 1.5 1214213.8 3 b h s y 1900-01-01 1900-01-01 01:01:01
+ 4 2.0 553823.8 4 c i t x 1900-01-01 1900-01-01 01:01:01
+ 5 2.5 1085022.9 d j u w 1900-01-01
+ 6 3.0 571063.9 5 e k v v 1900-01-01 1900-01-01 01:01:01
+ 7 3.5 606718.4 6 f l w u 1900-01-01 1900-01-01 01:01:01
+ 8 4.0 1053686.6 7 g m x t 1900-01-01 1900-01-01 01:01:01
+ 9 4.5 971024.2 8 h n y s 1900-01-01 1900-01-01 01:01:01
+10 5.0 631193.4 9 i o z r 1900-01-01 1900-01-01 01:01:01
+ 5.5 879431.1 10 j q 1900-01-01 1900-01-01 01:01:01
+>
+> ## NA should be - or ------------
+> write.fwf(x=testData, na="-")
+num1 num2 num3 int1 fac1 fac2 cha1 cha2 Date POSIXt
+ 1 - - 1 - f q - 1900-01-01 1900-01-01 01:01:01
+ 2 1.0 733070.3 2 a g r z - 1900-01-01 01:01:01
+ 3 1.5 1214213.8 3 b h s y 1900-01-01 1900-01-01 01:01:01
+ 4 2.0 553823.8 4 c i t x 1900-01-01 1900-01-01 01:01:01
+ 5 2.5 1085022.9 - d j u w 1900-01-01 -
+ 6 3.0 571063.9 5 e k v v 1900-01-01 1900-01-01 01:01:01
+ 7 3.5 606718.4 6 f l w u 1900-01-01 1900-01-01 01:01:01
+ 8 4.0 1053686.6 7 g m x t 1900-01-01 1900-01-01 01:01:01
+ 9 4.5 971024.2 8 h n y s 1900-01-01 1900-01-01 01:01:01
+10 5.0 631193.4 9 i o z r 1900-01-01 1900-01-01 01:01:01
+ - 5.5 879431.1 10 j - - q 1900-01-01 1900-01-01 01:01:01
+> write.fwf(x=testData, na="------------")
+num1 num2 num3 int1 fac1 fac2 cha1 cha2 Date POSIXt
+ 1 ------------ ------------ 1 ------------ f q ------------ 1900-01-01 1900-01-01 01:01:01
+ 2 1.0 733070.3 2 a g r z ------------ 1900-01-01 01:01:01
+ 3 1.5 1214213.8 3 b h s y 1900-01-01 1900-01-01 01:01:01
+ 4 2.0 553823.8 4 c i t x 1900-01-01 1900-01-01 01:01:01
+ 5 2.5 1085022.9 ------------ d j u w 1900-01-01 ------------
+ 6 3.0 571063.9 5 e k v v 1900-01-01 1900-01-01 01:01:01
+ 7 3.5 606718.4 6 f l w u 1900-01-01 1900-01-01 01:01:01
+ 8 4.0 1053686.6 7 g m x t 1900-01-01 1900-01-01 01:01:01
+ 9 4.5 971024.2 8 h n y s 1900-01-01 1900-01-01 01:01:01
+ 10 5.0 631193.4 9 i o z r 1900-01-01 1900-01-01 01:01:01
+------------ 5.5 879431.1 10 j ------------ ------------ q 1900-01-01 1900-01-01 01:01:01
+>
+> ## Some other separator than space
+> write.fwf(testData[, 1:4], sep="-mySep-")
+num1-mySep-num2-mySep-num3-mySep-int1
+ 1-mySep- -mySep- -mySep- 1
+ 2-mySep- 1-mySep- 733070.345678-mySep- 2
+ 3-mySep-1.5-mySep-1214213.78765456-mySep- 3
+ 4-mySep- 2-mySep-553823.798765678-mySep- 4
+ 5-mySep-2.5-mySep-1085022.88765457-mySep-
+ 6-mySep- 3-mySep- 571063.88765456-mySep- 5
+ 7-mySep-3.5-mySep-606718.387654568-mySep- 6
+ 8-mySep- 4-mySep- 1053686.6-mySep- 7
+ 9-mySep-4.5-mySep- 971024.187656-mySep- 8
+10-mySep- 5-mySep-631193.398765456-mySep- 9
+ -mySep-5.5-mySep- 879431.1-mySep-10
+>
+> ## With quotes
+> write.fwf(testData, quote=TRUE)
+"num1" "num2" "num3" "int1" "fac1" "fac2" "cha1" "cha2" "Date" "POSIXt"
+" 1" " " " " " 1" " " "f" "q" " " "1900-01-01" "1900-01-01 01:01:01"
+" 2" "1.0" " 733070.3" " 2" "a" "g" "r" "z" " " "1900-01-01 01:01:01"
+" 3" "1.5" "1214213.8" " 3" "b" "h" "s" "y" "1900-01-01" "1900-01-01 01:01:01"
+" 4" "2.0" " 553823.8" " 4" "c" "i" "t" "x" "1900-01-01" "1900-01-01 01:01:01"
+" 5" "2.5" "1085022.9" " " "d" "j" "u" "w" "1900-01-01" " "
+" 6" "3.0" " 571063.9" " 5" "e" "k" "v" "v" "1900-01-01" "1900-01-01 01:01:01"
+" 7" "3.5" " 606718.4" " 6" "f" "l" "w" "u" "1900-01-01" "1900-01-01 01:01:01"
+" 8" "4.0" "1053686.6" " 7" "g" "m" "x" "t" "1900-01-01" "1900-01-01 01:01:01"
+" 9" "4.5" " 971024.2" " 8" "h" "n" "y" "s" "1900-01-01" "1900-01-01 01:01:01"
+"10" "5.0" " 631193.4" " 9" "i" "o" "z" "r" "1900-01-01" "1900-01-01 01:01:01"
+" " "5.5" " 879431.1" "10" "j" " " " " "q" "1900-01-01" "1900-01-01 01:01:01"
+>
+> ## Without rownames
+> write.fwf(testData, rownames=FALSE)
+num1 num2 num3 int1 fac1 fac2 cha1 cha2 Date POSIXt
+ 1 1 f q 1900-01-01 1900-01-01 01:01:01
+ 2 1.0 733070.3 2 a g r z 1900-01-01 01:01:01
+ 3 1.5 1214213.8 3 b h s y 1900-01-01 1900-01-01 01:01:01
+ 4 2.0 553823.8 4 c i t x 1900-01-01 1900-01-01 01:01:01
+ 5 2.5 1085022.9 d j u w 1900-01-01
+ 6 3.0 571063.9 5 e k v v 1900-01-01 1900-01-01 01:01:01
+ 7 3.5 606718.4 6 f l w u 1900-01-01 1900-01-01 01:01:01
+ 8 4.0 1053686.6 7 g m x t 1900-01-01 1900-01-01 01:01:01
+ 9 4.5 971024.2 8 h n y s 1900-01-01 1900-01-01 01:01:01
+10 5.0 631193.4 9 i o z r 1900-01-01 1900-01-01 01:01:01
+ 5.5 879431.1 10 j q 1900-01-01 1900-01-01 01:01:01
+>
+> ## Without colnames
+> write.fwf(testData, colnames=FALSE)
+ 1 1 f q 1900-01-01 1900-01-01 01:01:01
+ 2 1.0 733070.3 2 a g r z 1900-01-01 01:01:01
+ 3 1.5 1214213.8 3 b h s y 1900-01-01 1900-01-01 01:01:01
+ 4 2.0 553823.8 4 c i t x 1900-01-01 1900-01-01 01:01:01
+ 5 2.5 1085022.9 d j u w 1900-01-01
+ 6 3.0 571063.9 5 e k v v 1900-01-01 1900-01-01 01:01:01
+ 7 3.5 606718.4 6 f l w u 1900-01-01 1900-01-01 01:01:01
+ 8 4.0 1053686.6 7 g m x t 1900-01-01 1900-01-01 01:01:01
+ 9 4.5 971024.2 8 h n y s 1900-01-01 1900-01-01 01:01:01
+10 5.0 631193.4 9 i o z r 1900-01-01 1900-01-01 01:01:01
+ 5.5 879431.1 10 j q 1900-01-01 1900-01-01 01:01:01
+>
+> ## Without rownames and colnames
+> write.fwf(testData, rownames=FALSE, colnames=FALSE)
+ 1 1 f q 1900-01-01 1900-01-01 01:01:01
+ 2 1.0 733070.3 2 a g r z 1900-01-01 01:01:01
+ 3 1.5 1214213.8 3 b h s y 1900-01-01 1900-01-01 01:01:01
+ 4 2.0 553823.8 4 c i t x 1900-01-01 1900-01-01 01:01:01
+ 5 2.5 1085022.9 d j u w 1900-01-01
+ 6 3.0 571063.9 5 e k v v 1900-01-01 1900-01-01 01:01:01
+ 7 3.5 606718.4 6 f l w u 1900-01-01 1900-01-01 01:01:01
+ 8 4.0 1053686.6 7 g m x t 1900-01-01 1900-01-01 01:01:01
+ 9 4.5 971024.2 8 h n y s 1900-01-01 1900-01-01 01:01:01
+10 5.0 631193.4 9 i o z r 1900-01-01 1900-01-01 01:01:01
+ 5.5 879431.1 10 j q 1900-01-01 1900-01-01 01:01:01
+>
+> ## With rownames and colnames and rowCol
+> write.fwf(testData, rowCol="HI!")
+num1 num2 num3 int1 fac1 fac2 cha1 cha2 Date POSIXt
+ 1 1 f q 1900-01-01 1900-01-01 01:01:01
+ 2 1.0 733070.3 2 a g r z 1900-01-01 01:01:01
+ 3 1.5 1214213.8 3 b h s y 1900-01-01 1900-01-01 01:01:01
+ 4 2.0 553823.8 4 c i t x 1900-01-01 1900-01-01 01:01:01
+ 5 2.5 1085022.9 d j u w 1900-01-01
+ 6 3.0 571063.9 5 e k v v 1900-01-01 1900-01-01 01:01:01
+ 7 3.5 606718.4 6 f l w u 1900-01-01 1900-01-01 01:01:01
+ 8 4.0 1053686.6 7 g m x t 1900-01-01 1900-01-01 01:01:01
+ 9 4.5 971024.2 8 h n y s 1900-01-01 1900-01-01 01:01:01
+10 5.0 631193.4 9 i o z r 1900-01-01 1900-01-01 01:01:01
+ 5.5 879431.1 10 j q 1900-01-01 1900-01-01 01:01:01
+>
+> ## formatInfo in unit tests
+>
+> ###------------------------------------------------------------------------
+> ### tests.write.fwf.R ends
+>
+> proc.time()
+[1] 1.283 0.028 1.311 0.000 0.000
+>
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2006-10-30 19:05:08
|
Revision: 997
http://svn.sourceforge.net/r-gregmisc/?rev=997&view=rev
Author: ggorjan
Date: 2006-10-30 11:04:53 -0800 (Mon, 30 Oct 2006)
Log Message:
-----------
Id tag
Property Changed:
----------------
trunk/gdata/R/write.fwf.R
trunk/gdata/inst/unitTests/runit.write.fwf.R
trunk/gdata/man/write.fwf.Rd
trunk/gdata/tests/tests.write.fwf.R
Property changes on: trunk/gdata/R/write.fwf.R
___________________________________________________________________
Name: svn:keywords
+ Id
Property changes on: trunk/gdata/inst/unitTests/runit.write.fwf.R
___________________________________________________________________
Name: svn:keywords
+ Id
Property changes on: trunk/gdata/man/write.fwf.Rd
___________________________________________________________________
Name: svn:keywords
+ Id
Property changes on: trunk/gdata/tests/tests.write.fwf.R
___________________________________________________________________
Name: svn:keywords
+ Id
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2006-11-10 23:52:04
|
Revision: 1004
http://svn.sourceforge.net/r-gregmisc/?rev=1004&view=rev
Author: ggorjan
Date: 2006-11-10 15:51:57 -0800 (Fri, 10 Nov 2006)
Log Message:
-----------
just formatting
Modified Paths:
--------------
trunk/gdata/NAMESPACE
trunk/gdata/NEWS
Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE 2006-11-03 01:49:02 UTC (rev 1003)
+++ trunk/gdata/NAMESPACE 2006-11-10 23:51:57 UTC (rev 1004)
@@ -44,27 +44,25 @@
importFrom(stats, reorder)
importFrom(gtools, mixedsort)
-S3method(nobs, data.frame)
-S3method(nobs, default)
-S3method(nobs, lm)
-S3method(trim, character)
-S3method(trim, default)
-S3method(trim, factor)
-S3method(trim, list)
-S3method(trim, data.frame)
S3method(reorder, factor)
+## drop.levels stuff
S3method(drop.levels, default)
S3method(drop.levels, factor)
S3method(drop.levels, list)
S3method(drop.levels, data.frame)
+## mapLevels stuff
S3method(mapLevels, default)
S3method(mapLevels, character)
S3method(mapLevels, factor)
S3method(mapLevels, list)
S3method(mapLevels, data.frame)
+S3method("mapLevels<-", default)
+S3method("mapLevels<-", list)
+S3method("mapLevels<-", data.frame)
+
S3method(print, levelsMap)
S3method(print, listLevelsMap)
@@ -77,10 +75,12 @@
S3method(unique, levelsMap)
S3method(sort, levelsMap)
-S3method("mapLevels<-", default)
-S3method("mapLevels<-", list)
-S3method("mapLevels<-", data.frame)
+## nobs stuff
+S3method(nobs, data.frame)
+S3method(nobs, default)
+S3method(nobs, lm)
+## unknown stuff
S3method(isUnknown, default)
S3method(isUnknown, POSIXlt)
S3method(isUnknown, list)
@@ -96,3 +96,10 @@
S3method(NAToUnknown, factor)
S3method(NAToUnknown, list)
S3method(NAToUnknown, data.frame)
+
+## trim stuff
+S3method(trim, character)
+S3method(trim, default)
+S3method(trim, factor)
+S3method(trim, list)
+S3method(trim, data.frame)
Modified: trunk/gdata/NEWS
===================================================================
--- trunk/gdata/NEWS 2006-11-03 01:49:02 UTC (rev 1003)
+++ trunk/gdata/NEWS 2006-11-10 23:51:57 UTC (rev 1004)
@@ -14,7 +14,7 @@
- Added c() method for factors based on mapLevels() functions.
-- Added write.fwf, which writes file in *F*ixed *W*idth *f*ormat.
+- Added write.fwf, which writes file in *F*ixed *W*idth *F*ormat.
CHANGES FROM 2.1.X to 2.3.0 (2006-09-19)
---------------------------------------
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2006-11-16 13:05:18
|
Revision: 1013
http://svn.sourceforge.net/r-gregmisc/?rev=1013&view=rev
Author: ggorjan
Date: 2006-11-16 05:05:05 -0800 (Thu, 16 Nov 2006)
Log Message:
-----------
seems that c.factor was not a good idea and there were better examples posted on r-devel list
Removed Paths:
-------------
trunk/gdata/R/c.factor.R
trunk/gdata/man/c.factor.Rd
Deleted: trunk/gdata/R/c.factor.R
===================================================================
--- trunk/gdata/R/c.factor.R 2006-11-14 22:25:06 UTC (rev 1012)
+++ trunk/gdata/R/c.factor.R 2006-11-16 13:05:05 UTC (rev 1013)
@@ -1,18 +0,0 @@
-# $Id$
-
-c.factor <- function(...,
- recursive=FALSE # ignored
- )
-{
- dots <- list(...) # recursive below is not related to one above!
- mapCha <- c(mapLevels(dots, codes=FALSE), recursive=TRUE)
- class(mapCha) <- "levelsMap"
- dots <- unlist(lapply(dots, "mapLevels<-", mapCha))
- mapLevels(dots) <- mapLevels(as.character(mapCha))
- dots
-}
-
-
-
-
-
Deleted: trunk/gdata/man/c.factor.Rd
===================================================================
--- trunk/gdata/man/c.factor.Rd 2006-11-14 22:25:06 UTC (rev 1012)
+++ trunk/gdata/man/c.factor.Rd 2006-11-16 13:05:05 UTC (rev 1013)
@@ -1,35 +0,0 @@
-%% $Id$
-
-\name{c.factor}
-\alias{c.factor}
-\title{Combine factors, properly handling levels}
-\description{
- This method for \code{c} combines factors while properly preserves level
- information.
-}
-\usage{
-c.factor(..., recursive = FALSE)
-}
-\arguments{
- \item{\dots}{ factors to be combined }
- \item{recursive}{ ignored }
-}
-\details{
-
-}
-\value{
- A single factor object. The levels on the new object are created by
- concatinating the levels of the provided factors, with any duplicate
- level names merged, and with the factor coding modified appropriately.
-}
-\author{Gregor Gorjan}
-\seealso{ \code{\link[base]{c}} }
-\examples{
-f1 <- factor(letters[1:10])
-f2 <- factor(letters[5:14])
-
-c(f1,f2)
-
-}
-\keyword{manip}
-
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2007-06-06 10:17:53
|
Revision: 1095
http://svn.sourceforge.net/r-gregmisc/?rev=1095&view=rev
Author: ggorjan
Date: 2007-06-06 03:17:52 -0700 (Wed, 06 Jun 2007)
Log Message:
-----------
better integration of unit tests
Modified Paths:
--------------
trunk/gdata/inst/unitTests/Makefile
trunk/gdata/tests/doRUnit.R
Modified: trunk/gdata/inst/unitTests/Makefile
===================================================================
--- trunk/gdata/inst/unitTests/Makefile 2007-06-06 10:15:49 UTC (rev 1094)
+++ trunk/gdata/inst/unitTests/Makefile 2007-06-06 10:17:52 UTC (rev 1095)
@@ -1,7 +1,7 @@
-PKG=gdata
TOP=../..
+PKG=${shell cd ${TOP};pwd}
SUITE=doRUnit.R
-R=R
+R=${R_HOME}/bin/R
all: inst test
@@ -13,3 +13,12 @@
export RCMDCHECK=FALSE;\
cd ${TOP}/tests;\
${R} --vanilla --slave < ${SUITE}
+
+echo: # Echo env. variables
+ @echo "Package folder: ${PKG}"
+ @echo "R binary: ${R}"
+
+help: # Help
+ @echo -e '\nTarget: Dependency # Description'; \
+ echo '=================================================='; \
+ egrep '^[[:alnum:].+_()%]*:' ./Makefile
Modified: trunk/gdata/tests/doRUnit.R
===================================================================
--- trunk/gdata/tests/doRUnit.R 2007-06-06 10:15:49 UTC (rev 1094)
+++ trunk/gdata/tests/doRUnit.R 2007-06-06 10:17:52 UTC (rev 1095)
@@ -1,47 +1,62 @@
### doRUnit.R
###------------------------------------------------------------------------
-### What: Run RUnit tests
+### What: Run unit tests with RUnit
### $Id$
-### Time-stamp: <2006-10-29 16:37:40 ggorjan>
+### Time-stamp: <2007-06-06 14:02:41 ggorjan>
###------------------------------------------------------------------------
+## unit tests will not be done if RUnit is not available
if(require("RUnit", quietly=TRUE)) {
## --- Setup ---
- wd <- getwd()
- pkg <- basename(sub(pattern="tests$", replacement="", wd))
- ## Path for standalone i.e. not by R CMD check testing
+ pkg <- "gdata"
if(Sys.getenv("RCMDCHECK") == "FALSE") {
- path <- file.path("..", "inst")
+ ## Path to unit tests for standalone running under Makefile (not R CMD check)
+ ## PKG/tests/../inst/unitTests
+ path <- file.path(getwd(), "..", "inst", "unitTests")
} else {
- pkg <- sub(pattern="\.Rcheck$", replacement="", pkg)
- path <- file.path("..", pkg)
+ ## Path to unit tests for R CMD check
+ ## PKG.Rcheck/tests/../PKG/unitTests
+ path <- system.file(package=pkg, "unitTests")
}
- path <- file.path(wd, path, "unitTests")
- pathReport <- file.path(path, "report")
+ cat("\nRunning unit tests\n")
+ print(list(pkg=pkg, getwd=getwd(), pathToUnitTests=path))
library(package=pkg, character.only=TRUE)
## --- Testing ---
## Define tests
- testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), dirs=path)
+ testSuite <- defineTestSuite(name=paste(pkg, "unit testing"),
+ dirs=path)
## Run
tests <- runTestSuite(testSuite)
- ## Print results
- printTextProtocol(tests)
- printTextProtocol(tests, fileName=paste(pathReport, ".txt", sep=""))
+ ## Default report name
+ pathReport <- file.path(path, "report")
- ## Print HTML version to a file
+ ## Report to stdout and text files
+ cat("------------------- UNIT TEST SUMMARY ---------------------\n\n")
+ printTextProtocol(tests, showDetails=FALSE)
+ printTextProtocol(tests, showDetails=FALSE,
+ fileName=paste(pathReport, "Summary.txt", sep=""))
+ printTextProtocol(tests, showDetails=TRUE,
+ fileName=paste(pathReport, ".txt", sep=""))
+
+ ## Report to HTML file
printHTMLProtocol(tests, fileName=paste(pathReport, ".html", sep=""))
- ## Return stop() if there are any failures i.e. FALSE to unit test.
- ## This will cause R CMD check to return error and stop
- if(getErrors(tests)$nFail > 0) {
- stop("one of unit tests failed")
+ ## Return stop() to cause R CMD check stop in case of
+ ## - failures i.e. FALSE to unit tests or
+ ## - errors i.e. R errors
+ tmp <- getErrors(tests)
+ if(tmp$nFail > 0 | tmp$nErr > 0) {
+ stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail,
+ ", #R errors: ", tmp$nErr, ")\n\n", sep=""))
}
+} else {
+ warning("cannot run unit tests -- package RUnit is not available")
}
###------------------------------------------------------------------------
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2007-06-06 10:19:17
|
Revision: 1096
http://svn.sourceforge.net/r-gregmisc/?rev=1096&view=rev
Author: ggorjan
Date: 2007-06-06 03:19:15 -0700 (Wed, 06 Jun 2007)
Log Message:
-----------
drop levels as suggested by Brian Ripley
Modified Paths:
--------------
trunk/gdata/R/drop.levels.R
trunk/gdata/man/drop.levels.Rd
Modified: trunk/gdata/R/drop.levels.R
===================================================================
--- trunk/gdata/R/drop.levels.R 2007-06-06 10:17:52 UTC (rev 1095)
+++ trunk/gdata/R/drop.levels.R 2007-06-06 10:19:15 UTC (rev 1096)
@@ -1,13 +1,13 @@
drop.levels <- function(x, reorder=TRUE, ...)
- UseMethod("drop.levels", x=x)
+ UseMethod("drop.levels")
drop.levels.default <- function(x, reorder=TRUE, ...)
x
drop.levels.factor <- function(x, reorder=TRUE, ...)
{
- x <- factor(x)
+ x <- x[, drop=TRUE]
if(reorder) x <- reorder(x, ...)
x
}
Modified: trunk/gdata/man/drop.levels.Rd
===================================================================
--- trunk/gdata/man/drop.levels.Rd 2007-06-06 10:17:52 UTC (rev 1095)
+++ trunk/gdata/man/drop.levels.Rd 2007-06-06 10:19:15 UTC (rev 1096)
@@ -1,9 +1,9 @@
% $Id$
-%
+
\name{drop.levels}
\alias{drop.levels}
\title{Drop unused factor levels}
-\description{Drop unused levels in a factor.}
+\description{Drop unused levels in a factor}
\usage{
drop.levels(x, reorder=TRUE, ...)
}
@@ -11,22 +11,24 @@
\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}}
+ \item{...}{additional arguments to \code{\link{reorder.factor}}}
}
\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
+nothing, while method for factor \code{s} drops all unused levels. Drop
+is done with \code{x[, drop=TRUE]}.
+
+There are also convenient methods for \code{list} and \code{data.frame},
+where all unused levels are dropped in all factors (one by one) in a
\code{list} or a \code{data.frame}.
}
-\value{a data frame}
+\value{Input object without unused levels.}
-\author{Jim Rogers \email{jam...@pf...}}
+\author{Jim Rogers \email{jam...@pf...} and Gregor Gorjanc}
\examples{
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2007-07-10 17:51:11
|
Revision: 1099
http://svn.sourceforge.net/r-gregmisc/?rev=1099&view=rev
Author: warnes
Date: 2007-07-10 10:51:08 -0700 (Tue, 10 Jul 2007)
Log Message:
-----------
Update read.xls() code and docs with enhacements by Gabor Grothendieck
Modified Paths:
--------------
trunk/gdata/R/read.xls.R
trunk/gdata/man/read.xls.Rd
Modified: trunk/gdata/R/read.xls.R
===================================================================
--- trunk/gdata/R/read.xls.R 2007-06-27 18:34:24 UTC (rev 1098)
+++ trunk/gdata/R/read.xls.R 2007-07-10 17:51:08 UTC (rev 1099)
@@ -1,6 +1,6 @@
# $Id$
-read.xls <- function(xls, sheet = 1, verbose=FALSE, ..., perl="perl")
+xls2csv <- function(xls, sheet = 1, verbose=FALSE, ..., perl="perl")
{
# Creating a temporary function to quote the string
@@ -16,6 +16,12 @@
###
# files
+ tf <- NULL
+ if (substring(xls, 1, 7) == "http://") {
+ tf <- paste(tempfile(), "xls", sep = ".")
+ download.file(xls, tf, mode = "wb")
+ xls <- tf
+ }
xls <- dQuote.ascii(xls) # dQuote.ascii in case of spaces in path
xls2csv <- file.path(perl.dir,'xls2csv.pl')
csv <- paste(tempfile(), "csv", sep = ".")
@@ -39,13 +45,29 @@
###
# prepare for cleanup now, in case of error reading file
- on.exit(file.remove(csv))
-
- # now read the csv file
- out <- read.csv(csv, ...)
+ file(csv)
+}
- # clean up
- file.remove(csv)
-
- return(out)
+
+read.xls <- function(xls, sheet = 1, verbose=FALSE, pattern, ..., perl="perl") {
+ con <- tfn <- NULL
+ on.exit({
+ if (inherits(con, "connection") && isOpen(con)) close(con)
+ if (file.exists(tfn)) file.remove(tfn)
+ })
+ con <- xls2csv(xls, sheet, verbose, ..., perl = perl)
+ open(con)
+ tfn <- summary(con)$description
+ print(tfn)
+ if (missing(pattern)) read.csv(con, ...)
+ else {
+ idx <- grep(pattern, readLines(con))
+ if (length(idx) == 0) {
+ warning("pattern not found")
+ return(NULL)
+ }
+ seek(con, 0)
+ read.csv(con, skip = idx[1]-1, ...)
+ }
}
+
Modified: trunk/gdata/man/read.xls.Rd
===================================================================
--- trunk/gdata/man/read.xls.Rd 2007-06-27 18:34:24 UTC (rev 1098)
+++ trunk/gdata/man/read.xls.Rd 2007-07-10 17:51:08 UTC (rev 1099)
@@ -1,22 +1,28 @@
\name{read.xls}
\alias{read.xls}
+\alias{xls2csv}
\title{Read Excel files}
\description{Reads a Microsoft Excel file into a data frame}
\usage{
-read.xls(xls, sheet=1, verbose=FALSE, ..., perl="perl")
+read.xls(xls, sheet=1, verbose=FALSE, pattern, ..., perl="perl")
+xls2csv(xls, sheet=1, verbose=FALSE, ..., perl="perl")
}
\arguments{
- \item{xls}{name of the Microsoft Excel file}
+ \item{xls}{name of the Microsoft Excel file. If on internet it
+ should begin with code{"http://"}.}
\item{sheet}{number of sheet within the Excel file from which data are
to be read}
\item{verbose}{logical flag indicating whether details should be
printed as the file is processed.}
+ \item{pattern}{if specified, them skip all lines before the first
+ containing this string}
\item{perl}{name of the perl executable to be called.}
\item{...}{additional arguments to read.table. The defaults of
read.csv are used.}
}
\value{
- a data frame
+ \code{"read.xls"} returns a data frame. \code{"xls2csv"} returns a
+ connection to a temporary file in csv format.
}
\details{
This function works translating the named Microsoft Excel file into a
@@ -27,6 +33,9 @@
problem if you are trying to use the \code{comment.char} option of
\code{read.table} since the first character of all lines (including
comment lines) will be "\"" after conversion.
+
+ Caution: With \code{"xls2csv"} it is the responsibility of the user
+ to close and delete the file after using it.
}
\references{http://www.analytics.washington.edu/statcomp/downloads/xls2csv}
\note{ Either a working version of Perl must be present in the executable
@@ -49,9 +58,24 @@
# Example specifying exact Perl path for Unix systems
iris <- read.xls(xlsfile, perl="/usr/bin/perl")
+
+ # read xls file from net
+ nba.url <- "http://lcb1.uoregon.edu/sergiok/DSC330HSP04/week5/NBA.xls"
+ nba <- read.xls(nba.url)
+
+ # 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")
+
+ # use of xls2csv - open con, print two lines, close con
+ con <- xls2csv(nba.url)
+ print(readLines(con, 2))
+ file.remove(summary(con)$description)
+
}
}
\author{Jim Rogers \email{jam...@pf...}, modified
- and extended by Gregory R. Warnes \email{wa...@bs...}.
+ and extended by Gregory R. Warnes \email{gr...@ra...}
+ Gabor Grothendiek \email{ggr...@gm...}.
}
\keyword{file}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2007-08-21 15:30:46
|
Revision: 1153
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1153&view=rev
Author: ggorjan
Date: 2007-08-21 08:30:40 -0700 (Tue, 21 Aug 2007)
Log Message:
-----------
move
Added Paths:
-----------
trunk/gdata/NEWS
trunk/gdata/inst/NEWS
Added: trunk/gdata/NEWS
===================================================================
--- trunk/gdata/NEWS (rev 0)
+++ trunk/gdata/NEWS 2007-08-21 15:30:40 UTC (rev 1153)
@@ -0,0 +1 @@
+link inst/NEWS
\ No newline at end of file
Property changes on: trunk/gdata/NEWS
___________________________________________________________________
Name: svn:special
+ *
Added: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS (rev 0)
+++ trunk/gdata/inst/NEWS 2007-08-21 15:30:40 UTC (rev 1153)
@@ -0,0 +1,75 @@
+CHANGES IN 2.3.1 (2006-10-29)
+---------------------------------------
+
+- Arguments as well as their position of reorder.factor have been changed
+ to conform with reorder.factor method in stats package, due to collision
+ bug. Argument 'make.ordered' is now 'order' and old argument 'order' is
+ now 'new.order'! Therefore, you have to implicitly specify new.order i.e.
+
+ reorder(trt, new.order=c("PLACEBO", "300 MG", "600 MG", "1200 MG"))
+
+- trim() gains ... argument.
+
+- Added "unknown" methods for matrices.
+
+- Added c() method for factors based on mapLevels() functions.
+
+- Added write.fwf, which writes file in *F*ixed *W*idth *F*ormat.
+
+CHANGES FROM 2.1.X to 2.3.0 (2006-09-19)
+---------------------------------------
+
+- Added mapLevels(), which produces a map with information on levels and/or
+ internal integer codes. Contributed by Gregor Gorjanc.
+
+- Extended dropLevels() to work on the factors contained in a data
+ frame, as well as individual factors.
+
+- Add unknown(), which changes given unknown value to NA and vice
+ versa. Contributed by Gregor Gorjanc.
+
+- Extended trim() to handle a variety of data types data.frames,
+ lists, factors, etc. Code changes contributed by Gregor Gorjanc.
+
+- Added resample() command that acts like sample() except that it
+ _always_ samples from the arguments provided, even if only a single
+ argument is present. This differs from sample() which behaves
+ differently in this case.
+
+- Updated my email address.
+
+CHANGES IN GDATA 2.1.2
+-----------------------
+
+ - Fixed bug in interleave.R - option to covert 1-column matrices to
+ vector (based on Andrew Burgess's suggestion)
+
+ - Updated Greg and Jim's email adresses
+
+ - ll.R: Suppressed warning message in attach() call.
+
+ - frameApply.Rd, reorder.Rd: Remove explicit loading of
+ gtools in examples, so that failure to import functions from
+ gtools gets properly caught by running the examples.
+
+ - upperTriangle.R, man/upperTriangle.Rd: Add functions for
+ extracting and modifying the upper and lower trianglular components of
+ matrices.
+
+ - is.what.R: Replaced the "not.using" vector with a more robust
+ try(get(test)) to find out whether a particular is.* function
+ returns a logical of length one.
+
+- DESCRIPTION: Added Suggests field
+
+ - Updated the example in frameApply
+
+
+CHANGES IN GDATA 2.0.8
+-----------------------
+
+ - Added DESCRIPTION and removed DESCRIPTION.in
+
+ - Updated ll.Rd documentation
+
+ - Fixed bug in Args.R, is.what.R, ll.R
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2008-03-25 01:01:59
|
Revision: 1250
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1250&view=rev
Author: warnes
Date: 2008-03-24 18:01:53 -0700 (Mon, 24 Mar 2008)
Log Message:
-----------
Update for version 2.4.1
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/inst/NEWS
trunk/gdata/inst/doc/mapLevels.pdf
trunk/gdata/inst/doc/unknown.pdf
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2008-03-25 00:57:15 UTC (rev 1249)
+++ trunk/gdata/DESCRIPTION 2008-03-25 01:01:53 UTC (rev 1250)
@@ -3,8 +3,8 @@
Description: Various R programming tools for data manipulation
Depends: R (>= 2.4.0)
Imports: gtools
-Version: 2.4.0
-Date: 2008-01-30
+Version: 2.4.1
+Date: 2008-03-24
Author: Gregory R. Warnes and Gregor Gorjanc. Includes R source code
and/or documentation contributed by Ben Bolker and Thomas Lumley.
Maintainer: Gregory Warnes <gre...@ur...>
Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS 2008-03-25 00:57:15 UTC (rev 1249)
+++ trunk/gdata/inst/NEWS 2008-03-25 01:01:53 UTC (rev 1250)
@@ -1,3 +1,16 @@
+CHANGES IN 2.4.1 (2008-03-24)
+-----------------------------
+
+- Update perl libraries needed by xls2csv() and read.xls()
+ to latest available versions on CRAN.
+
+- Add read.xls() to exported function list
+
+- Correct iris.xls example file. It didn't contain the complete
+ & properly formatted iris data set. Fixed.
+
+- Fix typo in win32 example for read.xls()
+
CHANGES IN 2.4.0 (2008-01-30)
-----------------------------
Modified: trunk/gdata/inst/doc/mapLevels.pdf
===================================================================
(Binary files differ)
Modified: trunk/gdata/inst/doc/unknown.pdf
===================================================================
(Binary files differ)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2008-05-13 02:40:14
|
Revision: 1266
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1266&view=rev
Author: warnes
Date: 2008-05-12 19:40:12 -0700 (Mon, 12 May 2008)
Log Message:
-----------
For read.xls() and xls2csv():
- Implement more informative log messages when verbose=TRUE
- Quote temporary file name to avoid errors when calling perl to do the work.
- Add better error messages, particularly when perl fails to generate an
output .csv file.
Update version number in DESCRIPTION.
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/R/read.xls.R
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2008-05-12 00:00:56 UTC (rev 1265)
+++ trunk/gdata/DESCRIPTION 2008-05-13 02:40:12 UTC (rev 1266)
@@ -3,8 +3,8 @@
Description: Various R programming tools for data manipulation
Depends: R (>= 2.4.0)
Imports: gtools
-Version: 2.4.1
-Date: 2008-03-24
+Version: 2.4.2
+Date: 2008-05-12
Author: Gregory R. Warnes and Gregor Gorjanc. Includes R source code
and/or documentation contributed by Ben Bolker and Thomas Lumley.
Maintainer: Gregory Warnes <gre...@ur...>
Modified: trunk/gdata/R/read.xls.R
===================================================================
--- trunk/gdata/R/read.xls.R 2008-05-12 00:00:56 UTC (rev 1265)
+++ trunk/gdata/R/read.xls.R 2008-05-13 02:40:12 UTC (rev 1266)
@@ -1,10 +1,12 @@
-# $Id$
+## $Id$
+## Creating a temporary function to quote the string
+dQuote.ascii <- function(x) paste('"',x,'"',sep='')
+
+
xls2csv <- function(xls, sheet = 1, verbose=FALSE, ..., perl="perl")
{
- # Creating a temporary function to quote the string
- dQuote.ascii <- function(x) paste('"',x,'"',sep='')
###
# directories
@@ -19,10 +21,20 @@
tf <- NULL
if (substring(xls, 1, 7) == "http://") {
tf <- paste(tempfile(), "xls", sep = ".")
- download.file(xls, tf, mode = "wb")
+ if(verbose)
+ cat("Downloading",
+ dQuote.ascii(xls), " to ",
+ dQuote.ascii(tf), "...\n")
+ else
+ cat("Downloading...\n")
+ download.file(xls, tf, mode = "wb")
+ cat("Done.\n")
xls <- tf
}
- xls <- dQuote.ascii(xls) # dQuote.ascii in case of spaces in path
+
+ if(file.access(xls, 4)!=0)
+ stop("Unable to read xls file '", xls, "'." )
+
xls2csv <- file.path(perl.dir,'xls2csv.pl')
csv <- paste(tempfile(), "csv", sep = ".")
#
@@ -30,20 +42,39 @@
###
# execution command
- cmd <- paste(perl, xls2csv, xls, dQuote.ascii(csv), sheet, sep=" ")
+ cmd <- paste(perl, xls2csv, dQuote.ascii(xls), dQuote.ascii(csv),
+ sheet, sep=" ")
#
###
+ if(verbose)
+ {
+ cat("\n")
+ cat("Converting xls file\n")
+ cat(" ", dQuote.ascii(xls), "\n")
+ cat("to csv file \n")
+ cat(" ", dQuote.ascii(csv), "\n")
+ cat("... \n\n")
+ }
+ else
+ cat("Converting xls file to csv file... ")
+
###
# do the translation
- if(verbose) cat("Executing ", cmd, "... \n")
+ if(verbose) cat("Executing ", cmd, "... \n\n")
#
results <- system(cmd, intern=!verbose)
#
- if (verbose) cat("done.\n")
+ if (verbose) cat("Done.\n\n")
#
###
+ if(file.access(csv, 4)!=0)
+ stop("Unable to read translated csv file '", csv, "'." )
+
+ cat("Done.\n")
+
+
# prepare for cleanup now, in case of error reading file
file(csv)
}
@@ -55,19 +86,35 @@
if (inherits(con, "connection") && isOpen(con)) close(con)
if (file.exists(tfn)) file.remove(tfn)
})
- con <- xls2csv(xls, sheet, verbose, ..., perl = perl)
+ con <- xls2csv(xls, sheet, verbose=verbose, ..., perl = perl)
open(con)
tfn <- summary(con)$description
- print(tfn)
- if (missing(pattern)) read.csv(con, ...)
+ if (missing(pattern))
+ {
+ if(verbose)
+ cat("Reading csv file ", dQuote.ascii(tfn), "...\n")
+ else
+ cat("Reading csv file... ")
+ read.csv(con, ...)
+ cat("Done.\n")
+ }
else {
+ cat("Searching for lines containing pattern ", pattern, "... ")
idx <- grep(pattern, readLines(con))
if (length(idx) == 0) {
warning("pattern not found")
return(NULL)
}
+ cat("Done.\n")
+
seek(con, 0)
+
+ if(verbose)
+ cat("Reading csv file ", dQuote.ascii(tfn), "...\n")
+ else
+ cat("Reading csv file... ")
read.csv(con, skip = idx[1]-1, ...)
+ cat("Done.\n")
}
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ar...@us...> - 2008-06-30 22:29:39
|
Revision: 1299
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1299&view=rev
Author: arnima
Date: 2008-06-30 15:29:35 -0700 (Mon, 30 Jun 2008)
Log Message:
-----------
Simplified default 'unit' argument from c("KB","MB","bytes") to "KB".
Modified Paths:
--------------
trunk/gdata/R/env.R
trunk/gdata/R/ll.R
trunk/gdata/man/env.Rd
trunk/gdata/man/ll.Rd
Modified: trunk/gdata/R/env.R
===================================================================
--- trunk/gdata/R/env.R 2008-06-23 23:51:13 UTC (rev 1298)
+++ trunk/gdata/R/env.R 2008-06-30 22:29:35 UTC (rev 1299)
@@ -1,6 +1,4 @@
-# $Id$
-
-env <- function(unit=c("KB","MB","bytes"), digits=0)
+env <- function(unit="KB", digits=0)
{
get.object.size <- function(object.name, pos)
{
@@ -26,7 +24,7 @@
return(nobjects)
}
- unit <- match.arg(unit)
+ unit <- match.arg(unit, c("bytes","KB","MB"))
denominator <- switch(unit, "KB"=1024, "MB"=1024^2, 1)
size.vector <- sapply(seq(along=search()), get.environment.size)
size.vector <- round(size.vector/denominator, digits)
Modified: trunk/gdata/R/ll.R
===================================================================
--- trunk/gdata/R/ll.R 2008-06-23 23:51:13 UTC (rev 1298)
+++ trunk/gdata/R/ll.R 2008-06-30 22:29:35 UTC (rev 1299)
@@ -1,5 +1,5 @@
-ll <- function(pos=1, unit=c("KB","MB","bytes"), digits=0, dimensions=FALSE,
- function.dim="", sort.elements=FALSE, ...)
+ll <- function(pos=1, unit="KB", digits=0, dimensions=FALSE, function.dim="",
+ sort.elements=FALSE, ...)
{
get.object.classname <- function(object.name, pos)
{
@@ -29,7 +29,7 @@
return(size)
}
- unit <- match.arg(unit)
+ unit <- match.arg(unit, c("bytes","KB","MB"))
denominator <- switch(unit, "KB"=1024, "MB"=1024^2, 1)
if(is.character(pos)) # pos is an environment name
Modified: trunk/gdata/man/env.Rd
===================================================================
--- trunk/gdata/man/env.Rd 2008-06-23 23:51:13 UTC (rev 1298)
+++ trunk/gdata/man/env.Rd 2008-06-30 22:29:35 UTC (rev 1299)
@@ -7,7 +7,7 @@
Display name, number of objects, and size of all loaded environments.
}
\usage{
-env(unit=c("KB","MB","bytes"), digits=0)
+env(unit="KB", digits=0)
}
\arguments{
\item{unit}{required unit for displaying environment size: "bytes",
Modified: trunk/gdata/man/ll.Rd
===================================================================
--- trunk/gdata/man/ll.Rd 2008-06-23 23:51:13 UTC (rev 1298)
+++ trunk/gdata/man/ll.Rd 2008-06-30 22:29:35 UTC (rev 1299)
@@ -9,8 +9,8 @@
object, its elements are listed and described.
}
\usage{
-ll(pos=1, unit=c("KB","MB","bytes"), digits=0, dimensions=FALSE,
- function.dim="", sort.elements=FALSE, ...)
+ll(pos=1, unit="KB", digits=0, dimensions=FALSE, function.dim="",
+ sort.elements=FALSE, ...)
}
\arguments{
\item{pos}{environment position number, environment name, data frame,
@@ -39,8 +39,7 @@
}
\author{Arni Magnusson \email{arnima@u.washington.edu}, with a
- contribution by Jim Rogers
- \email{jam...@pf...}}
+ contribution by Jim Rogers \email{jam...@pf...}}
\seealso{
\code{\link{ls}} displays names of objects in a given environment.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X