Thread: [R-gregmisc-users] SF.net SVN: r-gregmisc:[1499] trunk/gdata (Page 2)
Brought to you by:
warnes
Menu
▾
▴
r-gregmisc-users
|
From: <wa...@us...> - 2011-09-02 17:24:55
|
Revision: 1499
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1499&view=rev
Author: warnes
Date: 2011-09-02 17:24:49 +0000 (Fri, 02 Sep 2011)
Log Message:
-----------
Add 'centerText' function to center text strings for a specified width.
Added Paths:
-----------
trunk/gdata/R/centerText.R
trunk/gdata/man/centerText.Rd
Added: trunk/gdata/R/centerText.R
===================================================================
--- trunk/gdata/R/centerText.R (rev 0)
+++ trunk/gdata/R/centerText.R 2011-09-02 17:24:49 UTC (rev 1499)
@@ -0,0 +1,16 @@
+## Function to center text strings for display on the text console
+## by prepending the necessary number of spaces to each element.
+centerText <- function(x, width=getOption("width"))
+ {
+ retval <- vector(length=length(x), mode="character")
+ for( i in 1:length(x) )
+ {
+ text <- trim(x[i])
+ textWidth <- nchar(text)
+ nspaces <- floor((width - textWidth)/2)
+ spaces <- paste( rep(" ",nspaces), sep="", collapse="")
+ retval[i] <- paste( spaces, text, sep="", collapse="\n" )
+ }
+ retval
+ }
+
Added: trunk/gdata/man/centerText.Rd
===================================================================
--- trunk/gdata/man/centerText.Rd (rev 0)
+++ trunk/gdata/man/centerText.Rd 2011-09-02 17:24:49 UTC (rev 1499)
@@ -0,0 +1,47 @@
+\name{centerText}
+\alias{centerText}
+\title{
+Center Text Strings
+}
+\description{
+Function to center text strings for display on the text console
+by prepending the necessary number of spaces to each element.
+}
+\usage{
+centerText(x, width = getOption("width"))
+}
+\arguments{
+ \item{x}{Character vector containing text strings to be centered.}
+ \item{width}{Desired display width. Defaults to the R display width
+ given by \code{getOption("width")}. }
+}
+\details{
+ Each element will be centered individually by prepending the
+ necessary number of spaces to center the text in the specified
+ display width assuming a fixed width font.
+}
+\value{
+Vector of character strings.
+}
+\author{
+Gregory R. Warnes \email{gr...@wa...}
+}
+\seealso{
+ \code{\link[base]{strwrap}}
+}
+\examples{
+cat(centerText("One Line Test"), "\n\n")
+
+mText <-c("This", "is an example",
+ " of a multiline text ",
+ "with ",
+ " leading",
+ " and trailing ",
+ "spaces.")
+cat("\n", centerText(mText), "\n", sep="\n")
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{manip}
+\keyword{character}
+
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2011-09-20 18:07:13
|
Revision: 1506
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1506&view=rev
Author: warnes
Date: 2011-09-20 18:07:07 +0000 (Tue, 20 Sep 2011)
Log Message:
-----------
Add case() function, a vector equivalent of the switch() function
Added Paths:
-----------
trunk/gdata/R/case.R
trunk/gdata/man/case.Rd
Added: trunk/gdata/R/case.R
===================================================================
--- trunk/gdata/R/case.R (rev 0)
+++ trunk/gdata/R/case.R 2011-09-20 18:07:07 UTC (rev 1506)
@@ -0,0 +1,16 @@
+case <- function(x, ..., default=NA)
+{
+ magic <- "....default...."
+ alternatives <- c(...,"....default...."=magic)
+
+ x <- as.character(x)
+ retval <- factor(
+ x,
+ levels=alternatives,
+ labels=names(alternatives)
+ )
+ levels(retval)[length(alternatives)] <- as.character(default)
+ retval[is.na(retval) & !is.na(x)] <- default
+
+ retval
+}
Added: trunk/gdata/man/case.Rd
===================================================================
--- trunk/gdata/man/case.Rd (rev 0)
+++ trunk/gdata/man/case.Rd 2011-09-20 18:07:07 UTC (rev 1506)
@@ -0,0 +1,37 @@
+\name{case}
+\alias{case}
+\title{Map elements of a vector according to the provided 'cases'}
+\description{
+ Map elements of a vector according to the provided 'cases'. This
+ function is useful for mapping discrete values to factor labels and
+ is the vector equivalent to the \code{switch} function.
+}
+\usage{
+case(x, ..., default = NA)
+}
+\arguments{
+ \item{x}{Vector to be converted}
+ \item{\dots}{Map of alternatives, specified as "name"=value}
+ \item{default}{Value to be assigned to elements of \code{x} not
+ matching any of the alternatives. Defaults to \code{NA}.}
+}
+\details{
+ This function is to \code{switch} what \code{ifelse} is to \code{if},
+ and is a convenience wrapper for \code{factor}.
+}
+\value{
+ A factor variables with each element of \code{x} mapped into the
+ corresponding level of specified in the mapping.
+}
+\author{Gregory R. Warnes \email{gr...@wa...}}
+\seealso{\code{factor}, \code{switch}, \code{ifelse}}
+\examples{
+## default = NA
+case( c(1,1,4,3), "a"=1, "b"=2, "c"=3)
+
+## default = "foo"
+case( c(1,1,4,3), "a"=1, "b"=2, "c"=3, default="foo" )
+
+
+}
+\keyword{ manip }
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-05-04 19:39:30
|
Revision: 1531
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1531&view=rev
Author: warnes
Date: 2012-05-04 19:39:23 +0000 (Fri, 04 May 2012)
Log Message:
-----------
Add ls.funs() to show functions defined in the specified environment.
Modified Paths:
--------------
trunk/gdata/NAMESPACE
Added Paths:
-----------
trunk/gdata/R/ls.funs.R
trunk/gdata/man/ls.funs.Rd
Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE 2012-05-04 19:38:20 UTC (rev 1530)
+++ trunk/gdata/NAMESPACE 2012-05-04 19:39:23 UTC (rev 1531)
@@ -18,6 +18,7 @@
is.what,
keep,
ll,
+ ls.funs,
lowerTriangle,
"lowerTriangle<-",
matchcols,
Added: trunk/gdata/R/ls.funs.R
===================================================================
--- trunk/gdata/R/ls.funs.R (rev 0)
+++ trunk/gdata/R/ls.funs.R 2012-05-04 19:39:23 UTC (rev 1531)
@@ -0,0 +1,9 @@
+ls.funs <- function (...)
+ {
+ mycall <- match.call()
+ mycall[[1]] <- as.name("ls")
+ nameList <- eval.parent(mycall)
+ funcFlags <- sapply( nameList, function(x) is.function(get(x)) )
+ nameList[funcFlags]
+ }
+
Added: trunk/gdata/man/ls.funs.Rd
===================================================================
--- trunk/gdata/man/ls.funs.Rd (rev 0)
+++ trunk/gdata/man/ls.funs.Rd 2012-05-04 19:39:23 UTC (rev 1531)
@@ -0,0 +1,38 @@
+\name{ls.funs}
+\alias{ls.funs}
+\title{List function objects}
+\description{
+ Return a character vector giving the names of function objects in the
+ specified environment.
+}
+\usage{
+ls.funs(...)
+}
+\arguments{
+ \item{\dots}{Arguments passed to \code{ls}. See the help for
+ \code{\link[base]{ls}} for details.}
+}
+\details{
+ This function calls \code{ls} and then returns a character vector
+ containing only the names of only function objects.
+}
+\value{
+ character vector
+}
+\author{
+ Gregory R. Warnes \email{gr...@wa...}
+}
+\seealso{
+ \code{\link[base]{ls}}, \code{\link[base]{is.function}}
+}
+\examples{
+## List functions defined in the global environment:
+ls.funs()
+
+## List functions available in the base package:
+ls.funs("package:base")
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{misc}
+\keyword{environment}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-05-31 22:14:50
|
Revision: 1534
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1534&view=rev
Author: warnes
Date: 2012-05-31 22:14:44 +0000 (Thu, 31 May 2012)
Log Message:
-----------
- Remove dispatch function 'nobs' and method 'nobs.lm' since these are
now provided by the R 'stats' package.
Modified Paths:
--------------
trunk/gdata/R/nobs.R
trunk/gdata/man/nobs.Rd
Modified: trunk/gdata/R/nobs.R
===================================================================
--- trunk/gdata/R/nobs.R 2012-05-31 22:03:07 UTC (rev 1533)
+++ trunk/gdata/R/nobs.R 2012-05-31 22:14:44 UTC (rev 1534)
@@ -1,12 +1,14 @@
# $Id$
-nobs <- function(x,...)
- UseMethod("nobs",x)
+## Now provided by 'stats' package
+## nobs <- function(x,...)
+## UseMethod("nobs",x)
-nobs.default <- function(x, ...) sum( !is.na(x) )
+nobs.default <- function(object, ...) sum( !is.na(object) )
-nobs.data.frame <- function(x, ...)
- sapply(x, nobs.default)
+nobs.data.frame <- function(object, ...)
+ sapply(object, nobs.default)
-nobs.lm <- function(x, ...)
- nobs.default(x$residuals)
+## Now provided by the 'stats' package
+## nobs.lm <- function(x, ...)
+## nobs.default(x$residuals)
Modified: trunk/gdata/man/nobs.Rd
===================================================================
--- trunk/gdata/man/nobs.Rd 2012-05-31 22:03:07 UTC (rev 1533)
+++ trunk/gdata/man/nobs.Rd 2012-05-31 22:14:44 UTC (rev 1534)
@@ -28,30 +28,30 @@
%
\name{nobs}
-\alias{nobs}
-\alias{nobs.default}
+%% \alias{nobs} % Now provided by stats
\alias{nobs.data.frame}
-\alias{nobs.lm}
+\alias{nobs.default}
+%% \alias{nobs.lm} % Now provided by stats
%- Also NEED an `\alias' for EACH other topic documented here.
\title{ Compute the Number of Non-missing Observations }
\description{
- Compute the number of non-missing observations. Special methods exist for
- data frames, and lm objects.
+ Compute the number of non-missing observations. New 'default' method,
+ and method for data frames.
}
\usage{
-nobs(x, ...)
-\method{nobs}{default}(x, ...)
-\method{nobs}{data.frame}(x, ...)
-\method{nobs}{lm}(x, ...)
+%% nobs(object, ...)
+\method{nobs}{default}(object, ...)
+\method{nobs}{data.frame}(object, ...)
+%% \method{nobs}{lm}(object, ...)
}
\arguments{
- \item{x}{ Target Object }
+ \item{object}{ Target Object }
\item{\dots}{ Optional parameters (currently ignored)}
}
\details{
In the simplest case, this is really just wrapper code for
- \code{sum(!is.na(x))}.
+ \code{sum(!is.na(object))}.
}
\value{
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-06-06 01:21:51
|
Revision: 1541
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1541&view=rev
Author: warnes
Date: 2012-06-06 01:21:44 +0000 (Wed, 06 Jun 2012)
Log Message:
-----------
Add na.strings to read.xls call to convert "#DIV/0!" to NA.
Modified Paths:
--------------
trunk/gdata/R/read.xls.R
trunk/gdata/man/read.xls.Rd
trunk/gdata/tests/test.read.xls.R
Modified: trunk/gdata/R/read.xls.R
===================================================================
--- trunk/gdata/R/read.xls.R 2012-06-05 20:09:50 UTC (rev 1540)
+++ trunk/gdata/R/read.xls.R 2012-06-06 01:21:44 UTC (rev 1541)
@@ -1,7 +1,9 @@
## s$Id$
-read.xls <- function(xls, sheet = 1, verbose=FALSE, pattern, ...,
- method=c("csv","tsv","tab"), perl="perl")
+read.xls <- function(xls, sheet = 1, verbose=FALSE, pattern,
+ na.strings = c("NA","#DIV/0!"), ...,
+ method=c("csv","tsv","tab"),
+ perl="perl")
{
con <- tfn <- NULL
on.exit({
@@ -36,9 +38,9 @@
cat("Reading", method, "file ", dQuote(tfn), "...\n")
if(method=="csv")
- retval <- read.csv(con, ...)
+ retval <- read.csv(con, na.strings=na.strings, ...)
else if (method %in% c("tsv","tab") )
- retval <- read.delim(con, ...)
+ retval <- read.delim(con, na.strings=na.strings, ...)
else
stop("Unknown method", method)
@@ -62,9 +64,9 @@
cat("Reading", method, "file ", dQuote(tfn), "...\n")
if(method=="csv")
- retval <- read.csv(con, skip = idx[1]-1, ...)
+ retval <- read.csv(con, skip = idx[1]-1, na.strings=na.strings, ...)
else if (method %in% c("tsv","tab") )
- retval <- read.delim(con, skip = idx[1]-1, ...)
+ retval <- read.delim(con, skip = idx[1]-1, na.strings=na.strings, ...)
else
stop("Unknown method", method)
Modified: trunk/gdata/man/read.xls.Rd
===================================================================
--- trunk/gdata/man/read.xls.Rd 2012-06-05 20:09:50 UTC (rev 1540)
+++ trunk/gdata/man/read.xls.Rd 2012-06-06 01:21:44 UTC (rev 1541)
@@ -7,8 +7,8 @@
\title{Read Excel files}
\description{Read a Microsoft Excel file into a data frame}
\usage{
-read.xls(xls, sheet = 1, verbose=FALSE, pattern, ...,
- method=c("csv","tsv","tab"), perl="perl")
+read.xls(xls, sheet=1, verbose=FALSE, pattern, na.strings=c("NA","#DIV/0!"),
+ ..., method=c("csv","tsv","tab"), perl="perl")
xls2csv(xls, sheet=1, verbose=FALSE, ..., perl="perl")
xls2tab(xls, sheet=1, verbose=FALSE, ..., perl="perl")
xls2tsv(xls, sheet=1, verbose=FALSE, ..., perl="perl")
@@ -26,6 +26,8 @@
\item{perl}{name of the perl executable to be called.}
\item{method}{intermediate file format, "csv" for comma-separated and
"tab" for tab-separated}
+ \item{na.strings}{a character vector of strings which are to be interpreted
+ as ‘NA’ values. See \code{\link[utils]{read.table}} for details.}
\item{...}{additional arguments to read.table. The defaults for
read.csv() are used.}
}
Modified: trunk/gdata/tests/test.read.xls.R
===================================================================
--- trunk/gdata/tests/test.read.xls.R 2012-06-05 20:09:50 UTC (rev 1540)
+++ trunk/gdata/tests/test.read.xls.R 2012-06-06 01:21:44 UTC (rev 1541)
@@ -43,10 +43,10 @@
example.2 <- read.xls(exampleFile, sheet=2) # second worksheet by number
example.2
-example.3 <- read.xls(exampleFile, sheet=3) # second worksheet by number
+example.3 <- read.xls(exampleFile, sheet=3, header=FALSE) # third worksheet by number
example.3
-example.4 <- read.xls(exampleFile, sheet=3) # second worksheet by number
+example.4 <- read.xls(exampleFile, sheet=3, header=FALSE) # third worksheet by number
example.4
if( 'XLSX' %in% xlsFormats() )
@@ -57,10 +57,10 @@
example.x.2 <- read.xls(exampleFile2007, sheet=2) # second worksheet by number
print(example.x.2)
- example.x.3 <- read.xls(exampleFile2007, sheet=3) # second worksheet by number
+ example.x.3 <- read.xls(exampleFile2007, sheet=3, header=FALSE) # third worksheet by number
print(example.x.3)
- example.x.4 <- read.xls(exampleFile2007, sheet=3) # second worksheet by number
+ example.x.4 <- read.xls(exampleFile2007, sheet=3, header=FALSE) # third worksheet by number
print(example.x.4)
data <- read.xls(exampleFile2007, sheet="Sheet Second") # and by name
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-06-06 01:53:32
|
Revision: 1544
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1544&view=rev
Author: warnes
Date: 2012-06-06 01:53:25 +0000 (Wed, 06 Jun 2012)
Log Message:
-----------
- Add manual page and NAMESPACE entry for startsWith().
- Add 'ignore.case' argument to startsWith().
Modified Paths:
--------------
trunk/gdata/NAMESPACE
trunk/gdata/R/startsWith.R
Added Paths:
-----------
trunk/gdata/man/startsWith.Rd
Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE 2012-06-06 01:26:07 UTC (rev 1543)
+++ trunk/gdata/NAMESPACE 2012-06-06 01:53:25 UTC (rev 1544)
@@ -31,6 +31,7 @@
resample,
sheetCount,
sheetNames,
+ startsWith,
trim,
trimSum,
unmatrix,
Modified: trunk/gdata/R/startsWith.R
===================================================================
--- trunk/gdata/R/startsWith.R 2012-06-06 01:26:07 UTC (rev 1543)
+++ trunk/gdata/R/startsWith.R 2012-06-06 01:53:25 UTC (rev 1544)
@@ -1,5 +1,10 @@
-startsWith <- function(str, pattern, trim=FALSE)
+startsWith <- function(str, pattern, trim=FALSE, ignore.case=FALSE)
{
if(trim) str <- trim(str)
+ if(ignore.case)
+ {
+ str <- toupper(str)
+ pattern <- toupper(pattern)
+ }
substr(str,start=1,stop=nchar(pattern))==pattern
}
Added: trunk/gdata/man/startsWith.Rd
===================================================================
--- trunk/gdata/man/startsWith.Rd (rev 0)
+++ trunk/gdata/man/startsWith.Rd 2012-06-06 01:53:25 UTC (rev 1544)
@@ -0,0 +1,48 @@
+\name{startsWith}
+\alias{startsWith}
+\title{
+ Determine if a character string "starts with" with the specified characters.
+}
+\description{
+ Determine if a character string "starts with" with the specified characters.
+}
+\usage{
+startsWith(str, pattern, trim=FALSE, ignore.case=FALSE)
+}
+\arguments{
+ \item{str}{character vector to test}
+ \item{pattern}{characters to check for}
+ \item{trim}{Logical flag indicating whether leading whitespace should
+ be removed from \code{str} before testing for a match.}
+ \item{ignore.case}{Logical flag indicating whether case should be
+ ignored when testing for a match.}
+}
+\details{
+ This function returns TRUE for each element of the vector \code{str}
+ where \code{pattern} occurs at the beginning of the string. If
+ \code{trim} is TRUE, leading whitespace is removed from the elements
+ of \code{str} before the test is performed. If \code{ignore.case} is
+ TRUE, character case is ignored.
+}
+\value{
+ Boolean vector of the same length as \code{str}.
+}
+\author{
+ Gregory R. Warnes \email{gr...@wa...}
+}
+\seealso{
+ \code{\link[base]{substr}}, \code{\link{trim}}
+}
+\examples{
+## simplest example:
+startsWith( 'Testing', 'Test')
+
+## vector examples
+s <- c('Testing', ' Testing', 'testing', 'Texting')
+names(s) <- s
+
+startsWith(s, 'Test') # ' Testing', 'testing', and 'Texting' do not match
+startsWith(s, 'Test', trim=TRUE) # Now ' Testing' matches
+startsWith(s, 'Test', ignore.case=TRUE) # Now 'testing' matches
+}
+\keyword{character}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-06-06 01:59:15
|
Revision: 1545
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1545&view=rev
Author: warnes
Date: 2012-06-06 01:59:09 +0000 (Wed, 06 Jun 2012)
Log Message:
-----------
Update DESCRIPTION and NEWS for 2.10.0 release
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/inst/NEWS
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2012-06-06 01:53:25 UTC (rev 1544)
+++ trunk/gdata/DESCRIPTION 2012-06-06 01:59:09 UTC (rev 1545)
@@ -4,7 +4,7 @@
Depends: R (>= 2.6.0)
Imports: gtools
Version: 2.10.0
-Date: 2012-05-04
+Date: 2012-06-05
Author: Gregory R. Warnes, with contributions from Ben Bolker, Gregor Gorjanc,
Gabor Grothendieck, Ales Korosec, Thomas Lumley, Don MacQueen,
Arni Magnusson, Jim Rogers, and others
Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS 2012-06-06 01:53:25 UTC (rev 1544)
+++ trunk/gdata/inst/NEWS 2012-06-06 01:59:09 UTC (rev 1545)
@@ -1,3 +1,31 @@
+Changes in 2.10.0 (2012-06-05)
+------------------------------
+
+New features:
+
+- New ls.funs() function to list all objects of class function in the
+ specified environment.
+
+- New startsWith() function to determine if a string "starts with" the
+ specified characters.
+
+
+Enhancements:
+
+- Add 'na.strings' argument to read.xls() to convert Excel's '#DIV/0!' to NA.
+
+
+Bug fixes:
+
+- Correct various R CMD check warnings
+
+
+Other changes:
+
+- Base S3 method for nobs() and nobs.lm() method removed since these
+ are now provided in the stats package.
+
+
Changes in 2.9.0 (2011-09-30)
-----------------------------
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-06-06 20:26:12
|
Revision: 1546
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1546&view=rev
Author: warnes
Date: 2012-06-06 20:26:01 +0000 (Wed, 06 Jun 2012)
Log Message:
-----------
Define aliases for 'nobs' and 'nobs.lm' to support backward
compatibility for packages depending on gdata.
Modified Paths:
--------------
trunk/gdata/NAMESPACE
trunk/gdata/R/nobs.R
trunk/gdata/man/nobs.Rd
Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE 2012-06-06 01:59:09 UTC (rev 1545)
+++ trunk/gdata/NAMESPACE 2012-06-06 20:26:01 UTC (rev 1546)
@@ -22,7 +22,7 @@
lowerTriangle,
"lowerTriangle<-",
matchcols,
- #nobs, # default method now provided by stats package
+ nobs, # default method now provided by stats package
nPairs,
read.xls,
rename.vars,
@@ -123,7 +123,7 @@
## nobs stuff
S3method(nobs, data.frame)
S3method(nobs, default)
-##S3method(nobs, lm) # now provided by stats package
+S3method(nobs, lm) # now provided by stats package
## Object size stuff
S3method(print, object_size)
Modified: trunk/gdata/R/nobs.R
===================================================================
--- trunk/gdata/R/nobs.R 2012-06-06 01:59:09 UTC (rev 1545)
+++ trunk/gdata/R/nobs.R 2012-06-06 20:26:01 UTC (rev 1546)
@@ -1,14 +1,22 @@
# $Id$
-## Now provided by 'stats' package
-## nobs <- function(x,...)
-## UseMethod("nobs",x)
+## Now provided by 'stats' package, provide aliase here to satisfy
+## dependencies
+nobs <- stats::nobs
-nobs.default <- function(object, ...) sum( !is.na(object) )
+nobs.default <- function(object, ...)
+ {
+ if(is.vector(object))
+ sum( !is.na(object) )
+ else
+ stats::nobs.default(object, ...)
+ }
+
nobs.data.frame <- function(object, ...)
sapply(object, nobs.default)
-## Now provided by the 'stats' package
-## nobs.lm <- function(x, ...)
-## nobs.default(x$residuals)
+## Now provided by 'stats' package, provide 'alias' to satisfy
+## dependencies
+nobs.lm <- stats:::nobs.lm
+
Modified: trunk/gdata/man/nobs.Rd
===================================================================
--- trunk/gdata/man/nobs.Rd 2012-06-06 01:59:09 UTC (rev 1545)
+++ trunk/gdata/man/nobs.Rd 2012-06-06 20:26:01 UTC (rev 1546)
@@ -28,42 +28,65 @@
%
\name{nobs}
-%% \alias{nobs} % Now provided by stats
+\alias{nobs} % Now provided by stats
\alias{nobs.data.frame}
\alias{nobs.default}
-%% \alias{nobs.lm} % Now provided by stats
+\alias{nobs.lm} % Now provided by stats
%- Also NEED an `\alias' for EACH other topic documented here.
\title{ Compute the Number of Non-missing Observations }
\description{
- Compute the number of non-missing observations. New 'default' method,
- and method for data frames.
+ Compute the number of non-missing observations. Provides a 'default'
+ method to handle vectors, and a method for data frames.
}
\usage{
-%% nobs(object, ...)
+nobs(object, ...)
\method{nobs}{default}(object, ...)
\method{nobs}{data.frame}(object, ...)
-%% \method{nobs}{lm}(object, ...)
+\method{nobs}{lm}(object, ...)
}
\arguments{
\item{object}{ Target Object }
\item{\dots}{ Optional parameters (currently ignored)}
}
\details{
+ Calculate the number of observations in \code{object}.
- In the simplest case, this is really just wrapper code for
- \code{sum(!is.na(object))}.
-
+ \itemize{
+ \item{For numeric vectors, this is simply the number of non-NA elements, as computed by
+ \code{sum(!is.na(object))}. }
+ \item{For dataframe objects, the result is a vector containing the
+ number of non-NA elementes of each column. }
+ }
+
+ The \code{nobs} and \code{nobs.lm} functions defined in gtools are
+ simply aliases for the functions in the base R \code{stats} package,
+ provided for backwards compatibility.
}
\value{
- A single numeric value or a vector of values (for data.frames) giving
- the number of non-missing values.
+ Either single numeric value (for vectors) or a vector of numeric
+ values (for data.frames) giving the number of non-missing values.
}
+\note{
+ The base R package \code{stats} now provides a S3 dispatch function for
+ \code{nobs}, and methods for for objects of classes ‘"lm"’, ‘"glm"’,
+ ‘"nls"’ and ‘"logLik", as well as a default method.
+
+ Since they provided a subset of the the functionality, the base
+ method dispatch (\code{nobs}) function and method for "lm" objects
+ (\code{nobs.lm}) are, as of \code{gdata} version 2.10.1, simply
+ aliases for the equivalent functions in the base R \code{stats}
+ package.
+
+ Since \code{gdata}'s default method (\code{nobs.default}) processes
+ vectors and hands any other data/object types to
+ \code{stats:::nobs.default}.
+}
+
\author{ Gregory R. Warnes \email{gr...@wa...} }
\seealso{ \code{\link{is.na}}, \code{\link{length}} }
\examples{
-
x <- c(1,2,3,5,NA,6,7,1,NA )
length(x)
nobs(x)
@@ -74,5 +97,8 @@
df[2,1] <- NA
nobs(df)
+
+fit <- lm(y ~ x, data=df)
+nobs(fit)
}
\keyword{attribute}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-06-06 20:30:28
|
Revision: 1547
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1547&view=rev
Author: warnes
Date: 2012-06-06 20:30:17 +0000 (Wed, 06 Jun 2012)
Log Message:
-----------
Update DESCRIPTION and NEWS for 2.10.1 release.
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/inst/NEWS
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2012-06-06 20:26:01 UTC (rev 1546)
+++ trunk/gdata/DESCRIPTION 2012-06-06 20:30:17 UTC (rev 1547)
@@ -3,8 +3,8 @@
Description: Various R programming tools for data manipulation
Depends: R (>= 2.6.0)
Imports: gtools
-Version: 2.10.0
-Date: 2012-06-05
+Version: 2.10.1
+Date: 2012-06-06
Author: Gregory R. Warnes, with contributions from Ben Bolker, Gregor Gorjanc,
Gabor Grothendieck, Ales Korosec, Thomas Lumley, Don MacQueen,
Arni Magnusson, Jim Rogers, and others
Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS 2012-06-06 20:26:01 UTC (rev 1546)
+++ trunk/gdata/inst/NEWS 2012-06-06 20:30:17 UTC (rev 1547)
@@ -1,3 +1,13 @@
+Changes in 2.10.1 (2012-06-05)
+------------------------------
+
+Bug fixes:
+
+- Undo removal of 'nobs' and 'nobs.lm'. Instead define aliases for
+ 'nobs' and 'nobs.lm' to support backward compatibility for packages
+ depending on gdata.
+
+
Changes in 2.10.0 (2012-06-05)
------------------------------
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-06-06 22:10:45
|
Revision: 1552
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1552&view=rev
Author: warnes
Date: 2012-06-06 22:10:39 +0000 (Wed, 06 Jun 2012)
Log Message:
-----------
Update for release 2.10.2
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/inst/NEWS
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2012-06-06 22:09:04 UTC (rev 1551)
+++ trunk/gdata/DESCRIPTION 2012-06-06 22:10:39 UTC (rev 1552)
@@ -3,7 +3,7 @@
Description: Various R programming tools for data manipulation
Depends: R (>= 2.6.0)
Imports: gtools
-Version: 2.10.1
+Version: 2.10.2
Date: 2012-06-06
Author: Gregory R. Warnes, with contributions from Ben Bolker, Gregor Gorjanc,
Gabor Grothendieck, Ales Korosec, Thomas Lumley, Don MacQueen,
Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS 2012-06-06 22:09:04 UTC (rev 1551)
+++ trunk/gdata/inst/NEWS 2012-06-06 22:10:39 UTC (rev 1552)
@@ -1,8 +1,16 @@
-Changes in 2.10.1 (2012-06-05)
+Changes in 2.10.2 (2012-06-06)
------------------------------
Bug fixes:
+- Fix issues in nobs.default identified in testing with the gmodels package.
+
+
+Changes in 2.10.1 (2012-06-06)
+------------------------------
+
+Bug fixes:
+
- Undo removal of 'nobs' and 'nobs.lm'. Instead define aliases for
'nobs' and 'nobs.lm' to support backward compatibility for packages
depending on gdata.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-06-08 20:02:27
|
Revision: 1560
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1560&view=rev
Author: warnes
Date: 2012-06-08 20:02:21 +0000 (Fri, 08 Jun 2012)
Log Message:
-----------
Mark example for installXLSXsupport() to not be executed durin R CMD check.
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/man/installXLSXsupport.Rd
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2012-06-08 19:01:50 UTC (rev 1559)
+++ trunk/gdata/DESCRIPTION 2012-06-08 20:02:21 UTC (rev 1560)
@@ -3,7 +3,7 @@
Description: Various R programming tools for data manipulation
Depends: R (>= 2.13.0)
Imports: gtools
-Version: 2.10.3
+Version: 2.10.4
Date: 2012-06-08
Author: Gregory R. Warnes, with contributions from Ben Bolker, Gregor Gorjanc,
Gabor Grothendieck, Ales Korosec, Thomas Lumley, Don MacQueen,
Modified: trunk/gdata/man/installXLSXsupport.Rd
===================================================================
--- trunk/gdata/man/installXLSXsupport.Rd 2012-06-08 19:01:50 UTC (rev 1559)
+++ trunk/gdata/man/installXLSXsupport.Rd 2012-06-08 20:02:21 UTC (rev 1560)
@@ -63,6 +63,8 @@
\code{\link{read.xls}}, \code{\link{xls2csv}}, \code{\link{xlsFormats}}
}
\examples{
+\dontrun{
installXLSXsupport()
}
+}
\keyword{ misc }
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-06-08 23:14:51
|
Revision: 1562
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1562&view=rev
Author: warnes
Date: 2012-06-08 22:04:34 +0000 (Fri, 08 Jun 2012)
Log Message:
-----------
Update DESCRIPTION and tests
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/tests/test.read.xls.Rout.save
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2012-06-08 21:59:52 UTC (rev 1561)
+++ trunk/gdata/DESCRIPTION 2012-06-08 22:04:34 UTC (rev 1562)
@@ -3,7 +3,7 @@
Description: Various R programming tools for data manipulation
Depends: R (>= 2.13.0)
Imports: gtools
-Version: 2.10.4
+Version: 2.10.5
Date: 2012-06-08
Author: Gregory R. Warnes, with contributions from Ben Bolker, Gregor Gorjanc,
Gabor Grothendieck, Ales Korosec, Thomas Lumley, Don MacQueen,
Modified: trunk/gdata/tests/test.read.xls.Rout.save
===================================================================
--- trunk/gdata/tests/test.read.xls.Rout.save 2012-06-08 21:59:52 UTC (rev 1561)
+++ trunk/gdata/tests/test.read.xls.Rout.save 2012-06-08 22:04:34 UTC (rev 1562)
@@ -34,7 +34,7 @@
>
> if ( ! 'XLSX' %in% xlsFormats() )
+ {
-+ try( installXLSXModules() )
++ try( installXLSXsupport() )
+ }
>
> # iris.xls is included in the gregmisc package for use as an example
@@ -644,4 +644,4 @@
>
> proc.time()
user system elapsed
- 3.054 0.376 3.563
+ 2.916 0.357 3.366
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-06-13 01:10:34
|
Revision: 1564
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1564&view=rev
Author: warnes
Date: 2012-06-13 01:10:28 +0000 (Wed, 13 Jun 2012)
Log Message:
-----------
- nobs.default needs to handle logical vectors in addition to numeric
vectors.
- update DESCRIPTION and NEWS for 2.10.6.
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/R/nobs.R
trunk/gdata/inst/NEWS
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2012-06-13 01:00:07 UTC (rev 1563)
+++ trunk/gdata/DESCRIPTION 2012-06-13 01:10:28 UTC (rev 1564)
@@ -3,7 +3,7 @@
Description: Various R programming tools for data manipulation
Depends: R (>= 2.13.0)
Imports: gtools
-Version: 2.10.5
+Version: 2.10.6
Date: 2012-06-08
Author: Gregory R. Warnes, with contributions from Ben Bolker, Gregor Gorjanc,
Gabor Grothendieck, Ales Korosec, Thomas Lumley, Don MacQueen,
Modified: trunk/gdata/R/nobs.R
===================================================================
--- trunk/gdata/R/nobs.R 2012-06-13 01:00:07 UTC (rev 1563)
+++ trunk/gdata/R/nobs.R 2012-06-13 01:10:28 UTC (rev 1564)
@@ -21,4 +21,3 @@
## Now provided by 'stats' package, so provide alias to satisfy
## dependencies
nobs.lm <- stats:::nobs.lm
-
Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS 2012-06-13 01:00:07 UTC (rev 1563)
+++ trunk/gdata/inst/NEWS 2012-06-13 01:10:28 UTC (rev 1564)
@@ -1,8 +1,31 @@
-Changes in 2.10.2 (2012-06-06)
+Changes in 2.10.6 (2012-06-12)
------------------------------
Bug fixes:
+- gdata::nobs.default() needs to handle logical vectors in addition to
+ numeric vectors.
+
+Changes in 2.10.{3,4,5} (2012-06-08)
+------------------------------------
+
+Bug fixes:
+
+- Mark example for installXLSsupport() as dontrun so R CMD check won't
+ fail on systems where PERL is not fully functional.
+
+- Correct name of installXLSsupport() in tests/test.read.xls.R.
+
+Other Changes:
+
+- Add dependency on R 2.13.0, since that is when stats::nobs appeared.
+
+
+Changes in 2.10.2 (2012-06-06)
+---------------------------------------
+
+Bug fixes:
+
- Fix issues in nobs.default identified in testing with the gmodels package.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-06-18 20:26:38
|
Revision: 1565
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1565&view=rev
Author: warnes
Date: 2012-06-18 20:26:32 +0000 (Mon, 18 Jun 2012)
Log Message:
-----------
read.xls() and supporting functions now allow blank lines to be
preserved, rather than skipped, by supplying the argument
"blank.lines.skip=FALSE". The underlying perl function has been
extended to suppor this via an optional "-s" argument which, when
present, *preserves* blank lines during the conversion.
Modified Paths:
--------------
trunk/gdata/R/xls2sep.R
trunk/gdata/inst/perl/xls2csv.pl
trunk/gdata/man/read.xls.Rd
trunk/gdata/tests/test.read.xls.R
trunk/gdata/tests/test.read.xls.Rout.save
Modified: trunk/gdata/R/xls2sep.R
===================================================================
--- trunk/gdata/R/xls2sep.R 2012-06-13 01:10:28 UTC (rev 1564)
+++ trunk/gdata/R/xls2sep.R 2012-06-18 20:26:32 UTC (rev 1565)
@@ -1,19 +1,30 @@
## s$Id$
-xls2csv <- function(xls, sheet=1, verbose=FALSE, ..., perl="perl")
- xls2sep(xls=xls, sheet=sheet, verbose=verbose, ..., method="csv",
+xls2csv <- function(xls, sheet=1, verbose=FALSE, blank.lines.skip=TRUE,
+ ..., perl="perl")
+ xls2sep(xls=xls, sheet=sheet, verbose=verbose,
+ blank.lines.skip=blank.lines.skip, ..., method="csv",
perl=perl)
-xls2tab <- function(xls, sheet=1, verbose=FALSE, ..., perl="perl")
- xls2sep(xls=xls, sheet=sheet, verbose=verbose, ..., method="tab",
+xls2tab <- function(xls, sheet=1, verbose=FALSE, blank.lines.skip=TRUE,
+ ..., perl="perl")
+ xls2sep(xls=xls, sheet=sheet, verbose=verbose,
+ blank.lines.skip=blank.lines.skip, ..., method="tab",
perl=perl)
-xls2tsv <- function(xls, sheet=1, verbose=FALSE, ..., perl="perl")
- xls2sep(xls=xls, sheet=sheet, verbose=verbose, ..., method="tsv",
+xls2tsv <- function(xls, sheet=1, verbose=FALSE, blank.lines.skip=TRUE,
+ ..., perl="perl")
+ xls2sep(xls=xls, sheet=sheet, verbose=verbose,
+ blank.lines.skip=blank.lines.skip, ..., method="tsv",
perl=perl)
-xls2sep <- function(xls, sheet=1, verbose=FALSE, ...,
- method=c("csv","tsv","tab"), perl = perl)
+xls2sep <- function(xls,
+ sheet=1,
+ verbose=FALSE,
+ blank.lines.skip=TRUE,
+ ...,
+ method=c("csv","tsv","tab"),
+ perl = perl)
{
method <- match.arg(method)
@@ -69,9 +80,18 @@
##
##
+ ## blank.lines.skip
+ ##
+ if (blank.lines.skip)
+ skipBlank=""
+ else
+ skipBlank="-s"
+
+ ##
## execution command
cmd <- paste(shQuote(perl),
shQuote(script),
+ skipBlank, # flag is not quoted
shQuote(xls),
shQuote(targetFile),
shQuote(sheet),
Modified: trunk/gdata/inst/perl/xls2csv.pl
===================================================================
--- trunk/gdata/inst/perl/xls2csv.pl 2012-06-13 01:10:28 UTC (rev 1564)
+++ trunk/gdata/inst/perl/xls2csv.pl 2012-06-18 20:26:32 UTC (rev 1565)
@@ -11,6 +11,7 @@
#use Spreadsheet::XLSX;
use POSIX;
use File::Spec::Functions;
+use Getopt::Std;
##
# Try to load the modules we need
@@ -26,7 +27,8 @@
my($row, $col, $sheet, $cell, $usage,
$targetfile,$basename, $sheetnumber,
$filename, $volume, $directories, $whoami,
- $sep, $sepName, $sepLabel, $sepExt);
+ $sep, $sepName, $sepLabel, $sepExt,
+ $skipBlankLines, %switches);
##
## Figure out whether I'm called as xls2csv.pl or xls2tab.pl
@@ -66,11 +68,11 @@
##
$usage = <<EOF;
-$whoami <excel file> [<output file>] [<worksheet number>]
+$whoami [-s] <excel file> [<output file>] [<worksheet number>]
-Translate the Microsoft Excel spreadsheet file contained in
-<excel file> into $sepName separated value format ($sepLabel) and
-store in <output file>.
+Translate the Microsoft Excel spreadsheet file contained in <excel
+file> into $sepName separated value format ($sepLabel) and store in
+<output file>, skipping blank lines unless "-s" is present.
If <output file> is not specified, the output file will have the same
name as the input file with '.xls', or 'xlsx' removed and '.$sepExt'
@@ -85,6 +87,12 @@
## parse arguments
##
+# Handle switches (currently, just -s)
+getopts('s', \%switches);
+$skipBlankLines=!$switches{s};
+
+# Now the rest of the arguments
+
if( !defined($ARGV[0]) )
{
print $usage;
@@ -253,12 +261,12 @@
}
# skip blank/empty lines
- if( $outputLine =~ /^[$sep ]*$/ )
- {
- $cumulativeBlankLines++
- }
+ if( $skipBlankLines && ($outputLine =~ /^[$sep ]*$/) )
+ {
+ $cumulativeBlankLines++
+ }
else
- {
+ {
print OutFile "$outputLine \n"
}
}
@@ -266,7 +274,7 @@
close OutFile;
print " (Ignored $cumulativeBlankLines blank lines.)\n"
- if ($cumulativeBlankLines);
+ if $skipBlankLines;
print "\n";
}
Modified: trunk/gdata/man/read.xls.Rd
===================================================================
--- trunk/gdata/man/read.xls.Rd 2012-06-13 01:10:28 UTC (rev 1564)
+++ trunk/gdata/man/read.xls.Rd 2012-06-18 20:26:32 UTC (rev 1565)
@@ -9,11 +9,11 @@
\usage{
read.xls(xls, sheet=1, verbose=FALSE, pattern, na.strings=c("NA","#DIV/0!"),
..., method=c("csv","tsv","tab"), perl="perl")
-xls2csv(xls, sheet=1, verbose=FALSE, ..., perl="perl")
-xls2tab(xls, sheet=1, verbose=FALSE, ..., perl="perl")
-xls2tsv(xls, sheet=1, verbose=FALSE, ..., perl="perl")
-xls2sep(xls, sheet=1, verbose=FALSE, ..., method=c("csv","tsv","tab"),
- perl="perl")
+xls2csv(xls, sheet=1, verbose=FALSE, blank.lines.skip=TRUE, ..., perl="perl")
+xls2tab(xls, sheet=1, verbose=FALSE, blank.lines.skip=TRUE, ..., perl="perl")
+xls2tsv(xls, sheet=1, verbose=FALSE, blank.lines.skip=TRUE, ..., perl="perl")
+xls2sep(xls, sheet=1, verbose=FALSE, blank.lines.skip=TRUE, ...,
+ method=c("csv","tsv","tab"), perl="perl")
}
\arguments{
\item{xls}{path to the Microsoft Excel file. Supports "http://",
@@ -27,7 +27,10 @@
\item{method}{intermediate file format, "csv" for comma-separated and
"tab" for tab-separated}
\item{na.strings}{a character vector of strings which are to be interpreted
- as 'NA' values. See \code{\link[utils]{read.table}} for details.}
+ as 'NA' values. See \code{\link[utils]{read.table}} for
+ details.}
+ \item{blank.lines.skip}{logical flag indicating whether blank lines in
+ the orginal file should be ignored.}
\item{...}{additional arguments to read.table. The defaults for
read.csv() are used.}
}
Modified: trunk/gdata/tests/test.read.xls.R
===================================================================
--- trunk/gdata/tests/test.read.xls.R 2012-06-13 01:10:28 UTC (rev 1564)
+++ trunk/gdata/tests/test.read.xls.R 2012-06-18 20:26:32 UTC (rev 1565)
@@ -70,3 +70,21 @@
data <- read.xls(exampleFile2007, sheet="Sheet with initial text", skip=2)
print(data)
}
+
+
+## Check handling of skip.blank.lines=FALSE
+
+example.skip <- read.xls(exampleFile, sheet=2, blank.lines.skip=FALSE)
+example.skip
+
+if( 'XLSX' %in% xlsFormats() )
+ {
+ example.x.skip <- read.xls(exampleFile2007, sheet=2, blank.lines.skip=FALSE)
+ example.x.skip
+ }
+
+
+
+
+
+
Modified: trunk/gdata/tests/test.read.xls.Rout.save
===================================================================
--- trunk/gdata/tests/test.read.xls.Rout.save 2012-06-13 01:10:28 UTC (rev 1564)
+++ trunk/gdata/tests/test.read.xls.Rout.save 2012-06-18 20:26:32 UTC (rev 1565)
@@ -642,6 +642,36 @@
3 NA ThirdRow 3 2 1 NA Red
4 NA FourthRow 4 3 2 1 Black
>
+>
+> ## Check handling of skip.blank.lines=FALSE
+>
+> example.skip <- read.xls(exampleFile, sheet=2, blank.lines.skip=FALSE)
+> example.skip
+ X D E. F G Factor
+1 FirstRow 1 NA NA NA Red
+2 SecondRow 2 1 NA NA Green
+3 NA NA NA NA
+4 ThirdRow 3 2 1 NA Red
+5 FourthRow 4 3 2 1 Black
+>
+> if( 'XLSX' %in% xlsFormats() )
++ {
++ example.x.skip <- read.xls(exampleFile2007, sheet=2, blank.lines.skip=FALSE)
++ example.x.skip
++ }
+ X D E. F G Factor
+1 FirstRow 1 NA NA NA Red
+2 SecondRow 2 1 NA NA Green
+3 NA NA NA NA
+4 ThirdRow 3 2 1 NA Red
+5 FourthRow 4 3 2 1 Black
+>
+>
+>
+>
+>
+>
+>
> proc.time()
user system elapsed
- 2.916 0.357 3.366
+ 3.259 0.383 3.748
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-08-22 16:47:34
|
Revision: 1601
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1601&view=rev
Author: warnes
Date: 2012-08-22 16:47:28 +0000 (Wed, 22 Aug 2012)
Log Message:
-----------
Update DESCRIPTION and NEWS for gdate 2.11.1.
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/inst/NEWS
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2012-08-22 16:42:48 UTC (rev 1600)
+++ trunk/gdata/DESCRIPTION 2012-08-22 16:47:28 UTC (rev 1601)
@@ -4,8 +4,8 @@
Depends: R (>= 2.13.0)
SystemRequirements: perl
Imports: gtools
-Version: 2.11.0
-Date: 2012-06-08
+Version: 2.11.1
+Date: 2012-09-22
Author: Gregory R. Warnes, with contributions from Ben Bolker, Gregor Gorjanc,
Gabor Grothendieck, Ales Korosec, Thomas Lumley, Don MacQueen,
Arni Magnusson, Jim Rogers, and others
Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS 2012-08-22 16:42:48 UTC (rev 1600)
+++ trunk/gdata/inst/NEWS 2012-08-22 16:47:28 UTC (rev 1601)
@@ -1,3 +1,18 @@
+Changes in 2.11.1 (2012-09-22)
+------------------------------
+
+Enhancements:
+
+- read.xls() now supports fileEncoding argument to allow non-ascii
+ encoded data to be handled. See the manual page for an example.
+
+Bug Fixes:
+
+- The perl script utilized by read.xls() was incorrectly appending a
+ space character at the end of each line, causing problems with
+ character and NA entries in the final column.
+
+
Changes in 2.11.0 (2012-06-18)
------------------------------
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-09-12 17:39:48
|
Revision: 1605
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1605&view=rev
Author: warnes
Date: 2012-09-12 17:39:42 +0000 (Wed, 12 Sep 2012)
Log Message:
-----------
'stats::aggregate' was made into a generic on 27-Jan-2010, so that
attempting to call 'aggregate' on a 'table' object will now
incorrectly call 'aggregate.table'. Since 'aggregate.table' can be
replaced by a call to tapply using two index vectors, e.g.
aggregate.table(x, by1=a, by2=b, mean)
can be replaced by
tapply(x, INDEX=list(a, b), FUN=mean),
the 'aggregate.table' function will now display a warning that it
is depreciated and recommending the equivalent call to tapply. It
will be removed entirely in a future version of gdata.
Modified Paths:
--------------
trunk/gdata/R/aggregate.table.R
trunk/gdata/man/aggregate.table.Rd
Modified: trunk/gdata/R/aggregate.table.R
===================================================================
--- trunk/gdata/R/aggregate.table.R 2012-09-12 17:29:38 UTC (rev 1604)
+++ trunk/gdata/R/aggregate.table.R 2012-09-12 17:39:42 UTC (rev 1605)
@@ -2,14 +2,36 @@
aggregate.table <- function(x, by1, by2, FUN=mean, ... )
{
- if(!is.factor(by1)) by1 <- as.factor(by1)
- if(!is.factor(by2)) by2 <- as.factor(by2)
+ warning("'aggregate.table' is depreciated.",
+ "Please use 'tapply(X=",
+ deparse(substitute(x)),
+ ", INDEX=list(",
+ deparse(substitute(by1)),
+ ", ",
+ deparse(substitute(by2)),
+ "), FUN=",
+ deparse(substitute(FUN)),
+ if(length(list(...))>0)
+ {
+ l <- list(...)
+ paste(", ",
+ paste(names(l),"=",
+ deparse(substitute(...)),
+ sep="",
+ collapse=", ")
+ )
+ },
+ ")' instead.")
+ tapply(X=x, INDEX=list(by1, by2), FUN=FUN, ...)
+ }
- ag <- aggregate(x, by=list(by1,by2), FUN=FUN, ... )
- tab <- matrix( nrow=nlevels(by1), ncol=nlevels(by2) )
- dimnames(tab) <- list(levels(by1),levels(by2))
-
- for(i in 1:nrow(ag))
- tab[ as.character(ag[i,1]), as.character(ag[i,2]) ] <- ag[i,3]
- tab
- }
+## aggregate.table <- function(x, by1, by2, FUN=mean, ... )
+## {
+##
+## tab <- matrix( nrow=nlevels(by1), ncol=nlevels(by2) )
+## dimnames(tab) <- list(levels(by1),levels(by2))
+##
+## for(i in 1:nrow(ag))
+## tab[ as.character(ag[i,1]), as.character(ag[i,2]) ] <- ag[i,3]
+## tab
+## }
Modified: trunk/gdata/man/aggregate.table.Rd
===================================================================
--- trunk/gdata/man/aggregate.table.Rd 2012-09-12 17:29:38 UTC (rev 1604)
+++ trunk/gdata/man/aggregate.table.Rd 2012-09-12 17:39:42 UTC (rev 1605)
@@ -53,21 +53,34 @@
\seealso{ \code{\link{aggregate}}, \code{\link{tapply}},
\code{\link{interleave}} }
-
+\note{This function is DEPRECIATED. Please use \code{tapply}
+ instead. See example for illustration.}
\examples{
# Useful example:
#
# Create a 2-way table of means, standard errors, and # obs
-
+set.seed(314159)
g1 <- sample(letters[1:5], 1000, replace=TRUE)
g2 <- sample(LETTERS[1:3], 1000, replace=TRUE )
dat <- rnorm(1000)
stderr <- function(x) sqrt( var(x,na.rm=TRUE) / nobs(x) )
+## Depreciated:
means <- aggregate.table( dat, g1, g2, mean )
+## Instead use:
+means <- tapply( dat, list(g1, g2), mean )
+
+## Depreciated
stderrs <- aggregate.table( dat, g1, g2, stderr )
+## Instead use:
+stderrs <- tapply( dat, list(g1, g2), stderr )
+
+## Depreciated
ns <- aggregate.table( dat, g1, g2, nobs )
+## Instead use:
+ns <- tapply( dat, list(g1, g2), nobs )
+
blanks <- matrix( " ", nrow=5, ncol=3)
tab <- interleave( "Mean"=round(means,2),
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-09-12 17:40:42
|
Revision: 1606
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1606&view=rev
Author: warnes
Date: 2012-09-12 17:40:36 +0000 (Wed, 12 Sep 2012)
Log Message:
-----------
Update for gdata 2.12.0
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/inst/NEWS
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2012-09-12 17:39:42 UTC (rev 1605)
+++ trunk/gdata/DESCRIPTION 2012-09-12 17:40:36 UTC (rev 1606)
@@ -4,8 +4,8 @@
Depends: R (>= 2.13.0)
SystemRequirements: perl
Imports: gtools
-Version: 2.11.1
-Date: 2012-09-22
+Version: 2.12.0
+Date: 2012-10-12
Author: Gregory R. Warnes, with contributions from Ben Bolker, Gregor Gorjanc,
Gabor Grothendieck, Ales Korosec, Thomas Lumley, Don MacQueen,
Arni Magnusson, Jim Rogers, and others
Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS 2012-09-12 17:39:42 UTC (rev 1605)
+++ trunk/gdata/inst/NEWS 2012-09-12 17:40:36 UTC (rev 1606)
@@ -1,3 +1,19 @@
+Changes in 2.12.0 (2012-10-12)
+------------------------------
+
+Other Changes:
+
+- 'stats::aggregate' was made into a generic on 27-Jan-2010, so that
+ attempting to call 'aggregate' on a 'table' object will now
+ incorrectly call 'aggregate.table'. Since 'aggregate.table' can be
+ replaced by a call to tapply using two index vectors, e.g.
+ aggregate.table(x, by1=a, by2=b, mean)
+ can be replaced by
+ tapply(x, INDEX=list(a, b), FUN=mean),
+ the 'aggregate.table' function will now display a warning that it
+ is depreciated and recommending the equivalent call to tapply. It
+ will be removed entirely in a future version of gdata.
+
Changes in 2.11.1 (2012-09-22)
------------------------------
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-09-20 15:39:54
|
Revision: 1618
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1618&view=rev
Author: warnes
Date: 2012-09-20 15:39:43 +0000 (Thu, 20 Sep 2012)
Log Message:
-----------
Add 'ans()' and 'duplicated()' contributed by Liviu Andronic.
Added Paths:
-----------
trunk/gdata/R/ans.R
trunk/gdata/R/duplicated2.R
trunk/gdata/man/ans.Rd
trunk/gdata/man/duplicated2.Rd
Added: trunk/gdata/R/ans.R
===================================================================
--- trunk/gdata/R/ans.R (rev 0)
+++ trunk/gdata/R/ans.R 2012-09-20 15:39:43 UTC (rev 1618)
@@ -0,0 +1 @@
+ans <- function() .Last.value
Added: trunk/gdata/R/duplicated2.R
===================================================================
--- trunk/gdata/R/duplicated2.R (rev 0)
+++ trunk/gdata/R/duplicated2.R 2012-09-20 15:39:43 UTC (rev 1618)
@@ -0,0 +1,8 @@
+duplicated2 <- function(x, bothWays=TRUE, ...)
+ {
+ if(!bothWays) {
+ return(duplicated(x, ...))
+ } else if(bothWays) {
+ return((duplicated(x, ...) | duplicated(x, fromLast=TRUE, ...)))
+ }
+ }
Added: trunk/gdata/man/ans.Rd
===================================================================
--- trunk/gdata/man/ans.Rd (rev 0)
+++ trunk/gdata/man/ans.Rd 2012-09-20 15:39:43 UTC (rev 1618)
@@ -0,0 +1,34 @@
+\name{ans}
+\alias{ans}
+\title{Value of Last Evaluated Expression}
+\usage{
+ans()
+}
+\description{
+ The functon returns the value of the last evaluated \emph{top-level}
+ expression, which is always assigned to \code{.Last.value} (in
+ \code{package:base}).
+}
+\details{
+ This function retrieves \code{.Last.value}. For more details see
+ \code{\link{Last.value}}.
+}
+\value{
+ \code{.Last.value}
+}
+\seealso{
+ \code{\link{Last.value}}, \code{\link{eval}}
+}
+\author{Liviu Andronic}
+\examples{
+ 2+2 # Trivial calculation...
+ ans() # See the answer again
+
+ gamma(1:15) # Some intensive calculation...
+ fac14 <- ans() # store the results into a variable
+
+ rnorm(20) # Generate some standard normal values
+ ans()^2 # Convert to Chi-square(1) values...
+ stem(ans()) # Now show a stem-and-leaf table
+}
+\keyword{programming}
Added: trunk/gdata/man/duplicated2.Rd
===================================================================
--- trunk/gdata/man/duplicated2.Rd (rev 0)
+++ trunk/gdata/man/duplicated2.Rd 2012-09-20 15:39:43 UTC (rev 1618)
@@ -0,0 +1,51 @@
+\name{duplicated2}
+\alias{duplicated2}
+\title{Determine Duplicate Elements}
+\description{
+ \code{duplicated2()} determines which elements of a vector or data
+ frame are duplicates, and returns a logical vector indicating which
+ elements (rows) are duplicates.
+}
+\usage{
+duplicated2(x, bothWays=TRUE, ...)
+}
+\arguments{
+ \item{x}{a vector or a data frame or an array or \code{NULL}.}
+ \item{bothWays}{if \code{TRUE} (the default), duplication should be
+ considered from both sides. For more information see the argument \code{fromLast}
+ to the function \code{\link{duplicated}}.}
+ \item{\dots}{further arguments passed down to \code{duplicated()} and
+ its methods.}
+}
+\details{
+ The standard \code{\link{duplicated}} function (in \code{package:base})
+ only returns \code{TRUE} for the second and following copies of each
+ duplicated value (second-to-last and earlier when
+ \code{fromLast=TRUE}). This function returns all duplicated
+ elementes, including the first (last) value.
+
+ When \code{bothWays} is \code{FALSE}, \code{duplicated2()} defaults to
+ a \code{\link{duplicated}} call. When \code{bothWays} is \code{TRUE},
+ the following call is being executed:
+ \code{duplicated(x, ...) | duplicated(x, fromLast=TRUE, ...)}
+}
+\value{
+ For a vector input, a logical vector of the same length as
+ \code{x}. For a data frame, a logical vector with one element for
+ each row. For a matrix or array, and when \code{MARGIN = 0}, a
+ logical array with the same dimensions and dimnames.
+
+ For more details see \code{\link{duplicated}}.
+}
+\seealso{
+ \code{\link{duplicated}}, \code{\link{unique}}
+}
+\author{Liviu Andronic}
+\examples{
+ data(iris)
+ iris[duplicated(iris), ] # 2nd duplicated value
+ iris[duplicated(iris, fromLast=TRUE), ] # 1st duplicated value
+ iris[duplicated2(iris), ] # both duplicated values
+}
+\keyword{logic}
+\keyword{manip}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2012-09-20 17:12:21
|
Revision: 1620
http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1620&view=rev
Author: warnes
Date: 2012-09-20 17:12:14 +0000 (Thu, 20 Sep 2012)
Log Message:
-----------
Update for gdata 2.13.0.
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/inst/NEWS
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2012-09-20 15:42:08 UTC (rev 1619)
+++ trunk/gdata/DESCRIPTION 2012-09-20 17:12:14 UTC (rev 1620)
@@ -4,10 +4,11 @@
Depends: R (>= 2.13.0)
SystemRequirements: perl
Imports: gtools
-Version: 2.12.0
-Date: 2012-10-12
-Author: Gregory R. Warnes, with contributions from Ben Bolker, Gregor Gorjanc,
- Gabor Grothendieck, Ales Korosec, Thomas Lumley, Don MacQueen,
- Arni Magnusson, Jim Rogers, and others
+Version: 2.13.0
+Date: 2012-09-20
+Author: Gregory R. Warnes, with contributions from Liviu Andronic, Ben
+ Bolker, Gregor Gorjanc, Gabor Grothendieck, Ales Korosec,
+ Thomas Lumley, Don MacQueen, Arni Magnusson, Jim Rogers, and
+ others
Maintainer: Gregory Warnes <gr...@wa...>
License: GPL-2
Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS 2012-09-20 15:42:08 UTC (rev 1619)
+++ trunk/gdata/inst/NEWS 2012-09-20 17:12:14 UTC (rev 1620)
@@ -1,4 +1,29 @@
-Changes in 2.12.0 (2012-10-12)
+Changes in 2.13.0 (2012-09-20)
+-----------------------------
+
+New features:
+
+- New 'duplicated2' function which returns TRUE for *all* elements
+ that are duplicated, including the first, contributed by Liviu
+ Andronic. This differs from 'duplicated', which only returns the
+ second and following (second-to last and previous when
+ 'fromLast=TRUE') duplicate elements.
+
+- New 'ans' functon to return the value of the last evaluated
+ top-level function (a convenience function for accessing
+ .Last.value), contributed by Liviu Andonic.
+
+Bug Fixes:
+
+- On windows, warning messages printed to stdout by perl were being
+ included in the return value from 'system', resulting in errors in
+ 'sheetCount' and 'sheetNames'. Corrected.
+
+- The 'MedUnits' column names 'SIUnits' and 'ConventionalUnits' were
+ reversed and misspelled.
+
+
+Changes in 2.12.0 (2012-09-12)
------------------------------
Other Changes:
@@ -14,7 +39,7 @@
is depreciated and recommending the equivalent call to tapply. It
will be removed entirely in a future version of gdata.
-Changes in 2.11.1 (2012-09-22)
+Changes in 2.11.1 (2012-08-22)
------------------------------
Enhancements:
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2013-03-24 04:34:48
|
Revision: 1643
http://sourceforge.net/p/r-gregmisc/code/1643
Author: warnes
Date: 2013-03-24 04:34:45 +0000 (Sun, 24 Mar 2013)
Log Message:
-----------
Replaced calls to depreciated function ".path.package" with the new public function "path.package".
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/inst/NEWS
trunk/gdata/man/read.xls.Rd
trunk/gdata/man/sheetCount.Rd
trunk/gdata/tests/test.read.xls.R
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2013-03-24 04:20:02 UTC (rev 1642)
+++ trunk/gdata/DESCRIPTION 2013-03-24 04:34:45 UTC (rev 1643)
@@ -4,8 +4,8 @@
Depends: R (>= 2.13.0)
SystemRequirements: perl
Imports: gtools
-Version: 2.13.0
-Date: 2012-09-20
+Version: 2.13.1
+Date: 2013-03-24
Author: Gregory R. Warnes, with contributions from Liviu Andronic, Ben
Bolker, Gregor Gorjanc, Gabor Grothendieck, Ales Korosec,
Thomas Lumley, Don MacQueen, Arni Magnusson, Jim Rogers, and
Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS 2013-03-24 04:20:02 UTC (rev 1642)
+++ trunk/gdata/inst/NEWS 2013-03-24 04:34:45 UTC (rev 1643)
@@ -1,3 +1,11 @@
+Changes in 2.13.1 (2013-03-24)
+------------------------------
+
+Enhancements:
+
+- Replaced calls to depreciated function ".path.package" with the new public function "path.package".
+
+
Changes in 2.13.0 (2012-09-20)
-----------------------------
@@ -31,9 +39,9 @@
- 'stats::aggregate' was made into a generic on 27-Jan-2010, so that
attempting to call 'aggregate' on a 'table' object will now
incorrectly call 'aggregate.table'. Since 'aggregate.table' can be
- replaced by a call to tapply using two index vectors, e.g.
- aggregate.table(x, by1=a, by2=b, mean)
- can be replaced by
+ replaced by a call to tapply using two index vectors, e.g.
+ aggregate.table(x, by1=a, by2=b, mean)
+ can be replaced by
tapply(x, INDEX=list(a, b), FUN=mean),
the 'aggregate.table' function will now display a warning that it
is depreciated and recommending the equivalent call to tapply. It
@@ -161,7 +169,7 @@
Enhancements:
-- nPairs() gains a summary method that shows how many times each variable
+- nPairs() gains a summary method that shows how many times each variable
is known, while the other variable of a pair is not
Bug fixes:
@@ -222,7 +230,7 @@
build issues, particularly on Windows.
- All perl code can now operate (but generate warnings) when perl modules Compress::Raw::Zlib and
- Spreadsheet::XLSX when are not installed.
+ Spreadsheet::XLSX when are not installed.
- Also update Greg's email address.
@@ -231,8 +239,8 @@
Enhancements:
-- on Windows attempts to locate ActiveState perl if perl= not specified and
- Rtools perl would have otherwise been used in read.xls and other perl
+- on Windows attempts to locate ActiveState perl if perl= not specified and
+ Rtools perl would have otherwise been used in read.xls and other perl
dependent functions.
CHANGES IN 2.7.0 (2010-01-25)
@@ -260,7 +268,7 @@
New Functions:
-- sheetCount() and sheetNames() to determine the number and names of
+- sheetCount() and sheetNames() to determine the number and names of
worksheets in an Excel file, respectively.
Bug Fixes:
@@ -285,7 +293,7 @@
Bug Fixes
- Correct minor typos & issues in man pages for write.fwf(),
- resample() (Greg Warnes)
+ resample() (Greg Warnes)
- Correct calculation of object sizes in env() and ll() (Gregor Gorjanc)
@@ -297,20 +305,20 @@
- Enhanced function object.size that returns the size of multiple
objects. There is also a handy print method that can print size of
an object in "human readable" format when
- options(humanReadable=TRUE)
- or
- print(object.size(x), humanReadable=TRUE).
- (Gregor Gorjanc)
+ options(humanReadable=TRUE)
+ or
+ print(object.size(x), humanReadable=TRUE).
+ (Gregor Gorjanc)
- New function wideByFactor that reshapes given dataset by a given
- factor - it creates a "multivariate" data.frame. (Gregor Gorjanc)
+ factor - it creates a "multivariate" data.frame. (Gregor Gorjanc)
- New function nPairs that gives the number of variable pairs in a
- data.frame or a matrix. (Gregor Gorjanc)
+ data.frame or a matrix. (Gregor Gorjanc)
- New functions getYear, getMonth, getDay, getHour, getMin, and getSec
for extracting the date/time parts from objects of a date/time
- class. (Gregor Gorjanc)
+ class. (Gregor Gorjanc)
- New function bindData that binds two data frames into a multivariate
data frame in a different way than merge. (Gregor Gorjanc)
@@ -332,7 +340,7 @@
- New function bindData that binds two data frames into a multivariate data frame
in a different way than merge.
-
+
- New function wideByFactor that reshapes given dataset by a given factor -
it creates a "multivariate" data.frame.
@@ -346,7 +354,7 @@
- New function cbindX that can bind objects with different number of rows.
-- write.fwf gains the width argument. The value for unknown can increase or
+- write.fwf gains the width argument. The value for unknown can increase or
decrease the width of the columns. Additional tests and documentation fixes.
CHANGES IN 2.4.2 (2008-05-11)
Modified: trunk/gdata/man/read.xls.Rd
===================================================================
--- trunk/gdata/man/read.xls.Rd 2013-03-24 04:20:02 UTC (rev 1642)
+++ trunk/gdata/man/read.xls.Rd 2013-03-24 04:34:45 UTC (rev 1643)
@@ -67,7 +67,7 @@
\examples{
# iris.xls is included in the gregmisc package for use as an example
- xlsfile <- file.path(.path.package('gdata'),'xls','iris.xls')
+ xlsfile <- file.path(path.package('gdata'),'xls','iris.xls')
xlsfile
iris <- read.xls(xlsfile) # defaults to csv format
@@ -121,9 +121,9 @@
## Examples demonstrating selection of specific 'sheets'
## from the example XLS file 'ExampleExcelFile.xls'
- exampleFile <- file.path(.path.package('gdata'),'xls',
+ exampleFile <- file.path(path.package('gdata'),'xls',
'ExampleExcelFile.xls')
- exampleFile2007 <- file.path(.path.package('gdata'),'xls',
+ exampleFile2007 <- file.path(path.package('gdata'),'xls',
'ExampleExcelFile.xlsx')
## see the number and names of sheets:
@@ -147,7 +147,7 @@
## load a file containing data and column names using latin-1
## characters
- latinFile <- file.path(.path.package('gdata'),'xls','latin-1.xls')
+ latinFile <- file.path(path.package('gdata'),'xls','latin-1.xls')
latin1 <- read.xls(latinFile, fileEncoding="latin1")
colnames(latin1)
Modified: trunk/gdata/man/sheetCount.Rd
===================================================================
--- trunk/gdata/man/sheetCount.Rd 2013-03-24 04:20:02 UTC (rev 1642)
+++ trunk/gdata/man/sheetCount.Rd 2013-03-24 04:34:45 UTC (rev 1643)
@@ -34,9 +34,9 @@
sheetCount(xlsfile)
- exampleFile <- file.path(.path.package('gdata'),'xls',
+ exampleFile <- file.path(path.package('gdata'),'xls',
'ExampleExcelFile.xls')
- exampleFile2007 <- file.path(.path.package('gdata'),'xls',
+ exampleFile2007 <- file.path(path.package('gdata'),'xls',
'ExampleExcelFile.xlsx')
sheetCount(exampleFile)
Modified: trunk/gdata/tests/test.read.xls.R
===================================================================
--- trunk/gdata/tests/test.read.xls.R 2013-03-24 04:20:02 UTC (rev 1642)
+++ trunk/gdata/tests/test.read.xls.R 2013-03-24 04:34:45 UTC (rev 1643)
@@ -6,7 +6,7 @@
}
# iris.xls is included in the gregmisc package for use as an example
-xlsfile <- file.path(.path.package('gdata'),'xls','iris.xls')
+xlsfile <- file.path(path.package('gdata'),'xls','iris.xls')
iris.1 <- read.xls(xlsfile) # defaults to csv format
iris.1
@@ -20,10 +20,10 @@
stopifnot(all.equal(iris.1, iris.2))
stopifnot(all.equal(iris.1, iris.3))
-exampleFile <- file.path(.path.package('gdata'),'xls',
+exampleFile <- file.path(path.package('gdata'),'xls',
'ExampleExcelFile.xls')
-exampleFile2007 <- file.path(.path.package('gdata'),'xls',
+exampleFile2007 <- file.path(path.package('gdata'),'xls',
'ExampleExcelFile.xlsx')
# see the number and names of sheets:
@@ -86,8 +86,8 @@
## Check handing of fileEncoding for latin-1 characters
-latin1File <- file.path(.path.package('gdata'),'xls', 'latin-1.xls')
-latin1FileX <- file.path(.path.package('gdata'),'xls', 'latin-1.xlsx')
+latin1File <- file.path(path.package('gdata'),'xls', 'latin-1.xls')
+latin1FileX <- file.path(path.package('gdata'),'xls', 'latin-1.xlsx')
example.latin1 <- read.xls(latin1File, fileEncoding='latin1')
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2014-04-05 01:08:34
|
Revision: 1782
http://sourceforge.net/p/r-gregmisc/code/1782
Author: warnes
Date: 2014-04-05 01:08:30 +0000 (Sat, 05 Apr 2014)
Log Message:
-----------
Move unit test code into the (now) standard location
Added Paths:
-----------
trunk/gdata/tests/Makefile
trunk/gdata/tests/runRUnitTests.R
trunk/gdata/tests/runit.bindData.R
trunk/gdata/tests/runit.cbindX.R
trunk/gdata/tests/runit.drop.levels.R
trunk/gdata/tests/runit.getDateTimeParts.R
trunk/gdata/tests/runit.mapLevels.R
trunk/gdata/tests/runit.nPairs.R
trunk/gdata/tests/runit.reorder.factor.R
trunk/gdata/tests/runit.trim.R
trunk/gdata/tests/runit.trimSum.R
trunk/gdata/tests/runit.unknown.R
trunk/gdata/tests/runit.wideByFactor.R
trunk/gdata/tests/runit.write.fwf.R
Removed Paths:
-------------
trunk/gdata/R/runRUnitTests.R
trunk/gdata/inst/unitTests/Makefile
trunk/gdata/inst/unitTests/runRUnitTests.R
trunk/gdata/inst/unitTests/runit.bindData.R
trunk/gdata/inst/unitTests/runit.cbindX.R
trunk/gdata/inst/unitTests/runit.drop.levels.R
trunk/gdata/inst/unitTests/runit.getDateTimeParts.R
trunk/gdata/inst/unitTests/runit.mapLevels.R
trunk/gdata/inst/unitTests/runit.nPairs.R
trunk/gdata/inst/unitTests/runit.reorder.factor.R
trunk/gdata/inst/unitTests/runit.trim.R
trunk/gdata/inst/unitTests/runit.trimSum.R
trunk/gdata/inst/unitTests/runit.unknown.R
trunk/gdata/inst/unitTests/runit.wideByFactor.R
trunk/gdata/inst/unitTests/runit.write.fwf.R
trunk/gdata/man/runRUnitTests.Rd
Deleted: trunk/gdata/R/runRUnitTests.R
===================================================================
--- trunk/gdata/R/runRUnitTests.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/R/runRUnitTests.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,27 +0,0 @@
-### runRUnitTests.R
-###------------------------------------------------------------------------
-### What: Run RUnit tests (wrapper function) - R code
-### $Id$
-### Time-stamp: <2008-12-30 20:59:11 ggorjan>
-###------------------------------------------------------------------------
-
-.runRUnitTestsGdata <- function(testFileRegexp="^runit.+\\.[rR]$")
-{
- ## Setup
- .pkg <- environmentName(environment(.runRUnitTestsGdata))
- .path <- system.file("unitTests", package=.pkg)
- .suite <- file.path(.path, "runRUnitTests.R")
-
- ## Some checks
- stopifnot(file.exists(.path),
- file.info(path.expand(.path))$isdir,
- file.exists(.suite))
-
- ## Run the suite
- .way <- "function"
- source(.suite, local=TRUE)
- ## local=TRUE since .pkg and other vars do not exists in .suite environment
-}
-
-###------------------------------------------------------------------------
-### runRUnitTests.R ends here
Deleted: trunk/gdata/inst/unitTests/Makefile
===================================================================
--- trunk/gdata/inst/unitTests/Makefile 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/Makefile 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,22 +0,0 @@
-TOP=../..
-PKG=${shell cd ${TOP};pwd}
-SUITE=runRUnitTests.R
-R=R
-
-test: # Run unit tests
- ${R} --vanilla --slave < ${SUITE}
-
-inst: # Install package
- cd ${TOP}/..;\
- ${R} CMD INSTALL ${PKG}
-
-all: inst test
-
-echo: # Echo env. variables
- @echo "Package folder: ${PKG}"
- @echo "R binary: ${R}"
-
-help: # Help
- @echo -e '\nTarget: Dependency # Description'; \
- echo '=================================================='; \
- egrep '^[[:alnum:].+_()%]*:' ./Makefile
Deleted: trunk/gdata/inst/unitTests/runRUnitTests.R
===================================================================
--- trunk/gdata/inst/unitTests/runRUnitTests.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/runRUnitTests.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,104 +0,0 @@
-### runRUnitTests.R
-###------------------------------------------------------------------------
-### What: Run RUnit tests (the core)- R code
-### $Id$
-### Time-stamp: <2008-12-30 12:52:51 ggorjan>
-###------------------------------------------------------------------------
-
-## The setup seems to be quite messy, but it is so to enable use of this in
-## several ways as shown bellow.
-
-## "R CMD check" way should be the most authoritative way to run the RUnit
-## tests for a developer. RUnit tests are issued during R CMD check of the
-## package due to example section of .runRUnitTests() function. If any test
-## fails (failure) or if there are any R errors during RUnit testing, R CMD
-## check fails. These are variable values specific for this way:
-## - .path DEVEL/PATH/PKG.Rcheck/PKG/unitTests
-## - .way function
-
-## ".runRUnitTests()" way from within R after library(PKG) is handy for
-## package useRs, since it enables useRs to be sure that all tests pass for
-## their installation. This is just a convenient wrapper function to run
-## the RUnit testing suite. These are variable values specific for this
-## way:
-## - .path INSTALL/PATH/PKG/unitTests
-## - .way function
-
-## "Shell" way is another possibility mainly for a developer in order to
-## skip possibly lengthy R CMD check and perform just RUnit testing with an
-## installed version of a pcakage. These are variable values specific for
-## this way:
-## - .path DEVEL/PATH/PKG/inst/unitTests
-## - .way shell
-##
-## Rscript runRUnitTests.R
-## R CMD BATCH runRUnitTests.R
-## make
-## make all
-
-## Sourced via shell (Makefile, Rscript, R CMD BATCH)
-if(!exists(".pkg")) {
- .path <- getwd()
- .way <- "shell"
- .pkg <- c(read.dcf(file="../../DESCRIPTION", fields="Package"))
- print(.pkg)
- testFileRegexp <- "^base.+\\.[rR]$"
-}
-
-if(require("RUnit", quietly=TRUE)) {
-
- ## Debugging echo
- cat("\nRunning RUnit tests\n")
- print(list(pkg=.pkg, getwd=getwd(), pathToRUnitTests=.path))
-
- ## Load the package - not needed for .runRUnitTests()
- if(.way %in% c("shell"))
- library(package=.pkg, character.only=TRUE)
-
- ## Define tests
- testSuite <- defineTestSuite(name=paste(.pkg, "RUnit testing"),
- dirs=.path, testFileRegexp=testFileRegexp)
-
- ## Run
- tests <- runTestSuite(testSuite)
-
- if(file.access(.path, 02) != 0) {
- ## cannot write to .path -> use writable one
- tdir <- tempfile(paste(.pkg, "RUnitTests", sep="_"))
- dir.create(tdir)
- pathReport <- file.path(tdir, "report")
- } else {
- pathReport <- file.path(.path, "report")
- }
-
- ## Print results:
- printTextProtocol(tests)
- printTextProtocol(tests,
- fileName=paste(pathReport, ".txt", sep=""))
-
- ## Print HTML Version of results:
- printHTMLProtocol(tests,
- fileName=paste(pathReport, ".html", sep=""))
-
- cat("\nRUnit reports also written to\n",
- pathReport, ".(txt|html)\n\n", sep="")
-
- ## Return stop() to cause R CMD check stop in case of
- ## - failures i.e. FALSE to RUnit tests or
- ## - errors i.e. R errors
- tmp <- getErrors(tests)
- if(tmp$nFail > 0 || tmp$nErr > 0) {
- stop(paste("\n\nRUnit testing failed:\n",
- " - #test failures: ", tmp$nFail, "\n",
- " - #R errors: ", tmp$nErr, "\n\n", sep=""))
- }
-
-} else {
-
- cat("R package 'RUnit' cannot be loaded - no unit tests run\n",
- "for package", .pkg,"\n")
-
-}
-
-###------------------------------------------------------------------------
-### runRUnitTests.R ends here
Deleted: trunk/gdata/inst/unitTests/runit.bindData.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.bindData.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/runit.bindData.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,75 +0,0 @@
-### runit.bindData.R
-###------------------------------------------------------------------------
-### What: Bind two data frames - unit tests
-### $Id$
-### Time-stamp: <2008-12-30 11:58:50 ggorjan>
-###------------------------------------------------------------------------
-
-### {{{ --- Test setup ---
-
-if(FALSE) {
- library("RUnit")
- library("gdata")
-}
-
-### }}}
-### {{{ --- bindData ---
-
-test.bindData <- function()
-{
- ## 'x'/'y' must be a data.frame
- checkException(bindData(x=1:10, y=1:10))
- checkException(bindData(x=matrix(1:10), y=matrix(1:10)))
-
- n1 <- 6; n2 <- 12; n3 <- 4
- ## Single trait 1
- num <- c(5:n1, 10:13)
- tmp1 <- data.frame(y1=rnorm(n=n1),
- f1=factor(rep(c("A", "B"), n1/2)),
- ch=letters[num],
- fa=factor(letters[num]),
- nu=(num) + 0.5,
- id=factor(num), stringsAsFactors=FALSE)
-
- ## Single trait 2 with repeated records, some subjects also in tmp1
- num <- 4:9
- tmp2 <- data.frame(y2=rnorm(n=n2),
- f2=factor(rep(c("C", "D"), n2/2)),
- ch=letters[rep(num, times=2)],
- fa=factor(letters[rep(c(num), times=2)]),
- nu=c((num) + 0.5, (num) + 0.25),
- id=factor(rep(num, times=2)), stringsAsFactors=FALSE)
-
- ## Single trait 3 with completely distinct set of subjects
- num <- 1:4
- tmp3 <- data.frame(y3=rnorm(n=n3),
- f3=factor(rep(c("E", "F"), n3/2)),
- ch=letters[num],
- fa=factor(letters[num]),
- nu=(num) + 0.5,
- id=factor(num), stringsAsFactors=FALSE)
-
- ## Combine all datasets
- tmp12 <- bindData(x=tmp1, y=tmp2, common=c("id", "nu", "ch", "fa"))
- tmp123 <- bindData(x=tmp12, y=tmp3, common=c("id", "nu", "ch", "fa"))
-
- checkEquals(names(tmp123), c("id", "nu", "ch", "fa", "y1", "f1", "y2", "f2", "y3", "f3"))
- checkEquals(rbind(tmp1["id"], tmp2["id"], tmp3["id"]), tmp123["id"])
- checkEquals(rbind(tmp1["fa"], tmp2["fa"], tmp3["fa"]), tmp123["fa"])
- checkEquals(is.na(tmp123$y1), c(rep(FALSE, times=n1), rep(TRUE, times=n2+n3)))
- checkEquals(is.na(tmp123$f1), c(rep(FALSE, times=n1), rep(TRUE, times=n2+n3)))
- checkEquals(is.na(tmp123$y2), c(rep(TRUE, times=n1), rep(FALSE, times=n2), rep(TRUE, times=n3)))
- checkEquals(is.na(tmp123$f2), c(rep(TRUE, times=n1), rep(FALSE, times=n2), rep(TRUE, times=n3)))
- checkEquals(is.na(tmp123$y3), c(rep(TRUE, times=n1+n2), rep(FALSE, times=n3)))
- checkEquals(is.na(tmp123$f3), c(rep(TRUE, times=n1+n2), rep(FALSE, times=n3)))
-}
-
-### }}}
-### {{{ Dear Emacs
-## Local variables:
-## folded-file: t
-## End:
-### }}}
-
-###------------------------------------------------------------------------
-### runit.bindData.R ends here
Deleted: trunk/gdata/inst/unitTests/runit.cbindX.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.cbindX.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/runit.cbindX.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,81 +0,0 @@
-### runit.cbindX.R
-###------------------------------------------------------------------------
-### What: Unit tests for cbindX
-### $Id:$
-### Time-stamp: <2008-08-05 13:40:49 ggorjan>
-###------------------------------------------------------------------------
-
-### {{{ --- Test setup ---
-
-if(FALSE) {
- library("RUnit")
- library("gdata")
-}
-
-### }}}
-### {{{ --- cbindX ---
-
-test.cbindX <- function()
-{
- df1 <- data.frame(a=1:3, b=c("A", "B", "C"))
- df2 <- data.frame(c=as.character(1:5), a=5:1)
-
- ma1 <- matrix(as.character(1:4), nrow=2, ncol=2)
- ma2 <- matrix(1:6, nrow=3, ncol=2)
-
- df12test <- cbindX(df1, df2)
- df12stand <- data.frame(a=c(1:3, NA, NA),
- b=c("A", "B", "C", NA, NA),
- c=as.character(1:5),
- a=5:1)
- names(df12stand)[4] <- "a"
- checkEquals(df12test, df12stand)
-
- ma12test <- cbindX(ma1, ma2)
- ma12stand <- matrix(as.character(c(1, 3, 1, 4,
- 2, 4, 2, 5,
- NA, NA, 3, 6)), nrow=3, ncol=4, byrow=TRUE)
- checkEquals(ma12test, ma12stand)
-
- da11test <- cbindX(df1, ma1)
- da11stand <- data.frame(a=1:3,
- b=c("A", "B", "C"),
- as.character(c(1:2, NA)),
- as.character(c(3:4, NA)))
- names(da11stand)[3:4] <- c("1", "2")
- checkEquals(da11test, da11stand)
-
- tmpTest <- cbindX(df1, df2, ma1, ma2)
- tmpStand <- data.frame(a=c(1:3, NA, NA),
- b=c("A", "B", "C", NA, NA),
- c=as.character(1:5),
- a=5:1,
- as.character(c(1:2, NA, NA, NA)),
- as.character(c(3:4, NA, NA, NA)),
- c(1:3, NA, NA),
- c(4:6, NA, NA))
- names(tmpStand)[4:8] <- c("a", "1", "2", "1", "2")
- checkEquals(tmpTest, tmpStand)
-
- tmpTest <- cbindX(ma1, ma2, df1, df2)
- tmpStand <- data.frame(as.character(c(1:2, NA, NA, NA)),
- as.character(c(3:4, NA, NA, NA)),
- as.character(c(1:3, NA, NA)),
- as.character(c(4:6, NA, NA)),
- a=c(1:3, NA, NA),
- b=c("A", "B", "C", NA, NA),
- c=as.character(1:5),
- a=5:1)
- names(tmpStand)[c(1:4, 8)] <- c("1", "2", "3", "4", "a")
- checkEquals(tmpTest, tmpStand)
-}
-
-### }}}
-### {{{ Dear Emacs
-### Local variables:
-### folded-file: t
-### end:
-### }}}
-
-###------------------------------------------------------------------------
-### runit.cbindX.R ends here
Deleted: trunk/gdata/inst/unitTests/runit.drop.levels.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.drop.levels.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/runit.drop.levels.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,42 +0,0 @@
-### runit.drop.levels.R
-###------------------------------------------------------------------------
-### What: Tests for drop.levels
-### $Id$
-### Time-stamp: <2006-08-29 14:21:12 ggorjan>
-###------------------------------------------------------------------------
-
-### {{{ --- Test setup ---
-
-if(FALSE) {
- library("RUnit")
- library("gdata")
-}
-
-### }}}
-### {{{ --- drop.levels ---
-
-test.drop.levels <- function()
-{
- f <- factor(c("A", "B", "C", "D"))[1:3]
- fDrop <- factor(c("A", "B", "C"))
-
- l <- list(f=f, i=1:3, c=c("A", "B", "D"))
- lDrop <- list(f=fDrop, i=1:3, c=c("A", "B", "D"))
-
- df <- as.data.frame(l)
- dfDrop <- as.data.frame(lDrop)
-
- checkIdentical(drop.levels(f), fDrop)
- checkIdentical(drop.levels(l), lDrop)
- checkIdentical(drop.levels(df), dfDrop)
-}
-
-### }}}
-### {{{ Dear Emacs
-## Local variables:
-## folded-file: t
-## End:
-### }}}
-
-###------------------------------------------------------------------------
-### runit.drop.levels.R ends here
Deleted: trunk/gdata/inst/unitTests/runit.getDateTimeParts.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.getDateTimeParts.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/runit.getDateTimeParts.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,119 +0,0 @@
-### runit.getDateTimeParts.R
-###------------------------------------------------------------------------
-### What: Extract date and time parts from ... - unit tests
-### $Id$
-### Time-stamp: <2008-12-30 22:41:18 ggorjan>
-###------------------------------------------------------------------------
-
-### {{{ --- Test setup ---
-
-if(FALSE) {
- library("RUnit")
- library("gdata")
-}
-
-num <- 1
-cha <- "a"
-fac <- factor(c("A"))
-
-tYear <- as.character(c(2006, 1995, 1005, 3067))
-tMonth <- c("01", "04", "06", "12")
-tDay <- c("01", "12", "22", "04")
-tDate <- paste( paste(tYear, tMonth, tDay, sep="-"), "GMT" )
-
-tHour <- c("05", "16", "20", "03")
-tMin <- c("16", "40", "06", "52")
-tSec <- c("56", "34", "05", "15")
-tTime <- paste(tHour, tMin, tSec, sep=":")
-
-cDate <- as.Date(tDate)
-cDatePOSIXct <- as.POSIXct(tDate)
-cDatePOSIXlt <- as.POSIXlt(tDate)
-
-### }}}
-### {{{ --- getYear ---
-
-test.getYear <- function()
-{
- checkException(getYear(x=num))
- checkException(getYear(x=cha))
- checkException(getYear(x=fac))
-
- checkIdentical(getYear(x=cDate), tYear)
- checkIdentical(getYear(x=cDatePOSIXct), tYear)
- checkIdentical(getYear(x=cDatePOSIXlt), tYear)
-}
-
-### }}}
-### {{{ --- getMonth ---
-
-test.getMonth <- function()
-{
- checkException(getMonth(x=num))
- checkException(getMonth(x=cha))
- checkException(getMonth(x=fac))
-
- checkIdentical(getMonth(x=cDate), tMonth)
- checkIdentical(getMonth(x=cDatePOSIXct), tMonth)
- checkIdentical(getMonth(x=cDatePOSIXlt), tMonth)
-}
-
-### }}}
-### {{{ --- getDay ---
-
-test.getDay <- function()
-{
- checkException(getDay(x=num))
- checkException(getDay(x=cha))
- checkException(getDay(x=fac))
-
- checkIdentical(getDay(x=cDate), tDay)
- checkIdentical(getDay(x=cDatePOSIXct), tDay)
- checkIdentical(getDay(x=cDatePOSIXlt), tDay)
-}
-
-### }}}
-### {{{ --- getHour ---
-
-test.getHour <- function()
-{
- checkException(getHour(x=num))
- checkException(getHour(x=cha))
- checkException(getHour(x=fac))
-
-## checkIdentical(getHour(x=cDate), tHour)
-}
-
-### }}}
-### {{{ --- getMin ---
-
-test.getMin <- function()
-{
- checkException(getMin(x=num))
- checkException(getMin(x=cha))
- checkException(getMin(x=fac))
-
-## checkIdentical(getMin(x=cDate), tMin)
-}
-
-### }}}
-### {{{ --- getSec ---
-
-test.getSec <- function()
-{
- checkException(getSec(x=num))
- checkException(getSec(x=cha))
- checkException(getSec(x=fac))
-
-## checkIdentical(getSec(x=cDate), tSec)
-}
-
-### }}}
-### {{{ Dear Emacs
-### Local variables:
-### folded-file: t
-### end:
-### }}}
-
-###------------------------------------------------------------------------
-### runit.getDateTimeParts.R ends here
Deleted: trunk/gdata/inst/unitTests/runit.mapLevels.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.mapLevels.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/runit.mapLevels.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,281 +0,0 @@
-### runit.mapLevels.R
-###------------------------------------------------------------------------
-### What: Unit tests for mapLevels et al.
-### $Id$
-### 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(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
Deleted: trunk/gdata/inst/unitTests/runit.nPairs.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.nPairs.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/runit.nPairs.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,68 +0,0 @@
-### runit.nPairs.R
-###------------------------------------------------------------------------
-### What: Number of variable pairs - unit tests
-### $Id$
-### Time-stamp: <2008-12-30 18:24:59 ggorjan>
-###------------------------------------------------------------------------
-
-### {{{ --- Test setup ---
-
-if(FALSE) {
- library("RUnit")
- library("gdata")
-}
-
-### }}}
-### {{{ --- nPairs ---
-
-test.nPairs <- function()
-{
- ## 'x' must be a data.frame or a matrix
- x <- rpois(100, lambda=10)
- checkException(nPairs(x=x))
- checkException(nPairs(x=table(x)))
-
- test <- data.frame(V1=c(1, 2, 3, 4, 5),
- V2=c(NA, 2, 3, 4, 5),
- V3=c(1, NA, NA, NA, NA),
- V4=c(1, 2, 3, NA, NA))
- testCheck <- matrix(data=as.integer(c(5, 4, 1, 3,
- 4, 4, 0, 2,
- 1, 0, 1, 1,
- 3, 2, 1, 3)),
- nrow=4, ncol=4, byrow=TRUE)
- class(testCheck) <- c("nPairs", class(testCheck))
-
- testCheckNames <- testCheck
- colnames(testCheckNames) <- rownames(testCheckNames) <- colnames(test)
-
- checkIdentical(nPairs(x=test), testCheckNames)
- checkIdentical(nPairs(x=test, names=FALSE), testCheck)
- checkIdentical(nPairs(x=as.matrix(test)), testCheckNames)
- checkIdentical(nPairs(x=as.matrix(test), names=FALSE), testCheck)
-
- testCheck <- cbind(testCheckNames, as.integer(c(5, 4, 0, 0)))
- class(testCheck) <- class(testCheckNames)
- colnames(testCheck) <- c(colnames(test), "all")
- checkIdentical(nPairs(x=test, margin=TRUE), testCheck)
-
- testCheckSumm <- matrix(data=as.integer(c(0, 1, 4, 2,
- 0, 0, 4, 2,
- 0, 1, 0, 0,
- 0, 1, 2, 0)),
- nrow=4, ncol=4, byrow=TRUE)
- dimnames(testCheckSumm) <- dimnames(testCheckNames)
- tmp <- summary(nPairs(x=test))
- checkEquals(tmp, testCheckSumm)
-}
-
-
-### }}}
-### {{{ Dear Emacs
-### Local variables:
-### folded-file: t
-### end:
-### }}}
-
-###------------------------------------------------------------------------
-### runit.nPairs.R ends here
Deleted: trunk/gdata/inst/unitTests/runit.reorder.factor.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.reorder.factor.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/runit.reorder.factor.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,64 +0,0 @@
-### runit.reorder.factor.R
-###------------------------------------------------------------------------
-### What: Tests for reorder.factor
-### $Id$
-### Time-stamp: <2006-10-30 18:25:05 ggorjan>
-###------------------------------------------------------------------------
-
-### {{{ --- Test setup ---
-
-if(FALSE) {
- library("RUnit")
- library("gdata")
-}
-
-### }}}
-### {{{ --- reorder.factor ---
-
-test.reorder.factor <- function()
-{
- tmp <- Sys.getlocale(category="LC_COLLATE")
- Sys.setlocale(category="LC_COLLATE", locale="C")
-
- ## Create a 4 level example factor
- levs <- c("PLACEBO", "300 MG", "600 MG", "1200 MG")
- trt <- factor(rep(x=levs, times=c(22, 24, 28, 26)))
-
- ## Change the order to something useful
- ## default "mixedsort" ordering
- trt2 <- reorder(trt)
- levsTest <- c("300 MG", "600 MG", "1200 MG", "PLACEBO")
- checkIdentical(levels(trt2), levsTest)
-
- ## using indexes:
- trt3 <- reorder(trt, new.order=c(4, 2, 3, 1))
- levsTest <- c("PLACEBO", "300 MG", "600 MG", "1200 MG")
- checkIdentical(levels(trt3), levsTest)
-
- ## using label names:
- trt4 <- reorder(trt, new.order=c("PLACEBO", "300 MG", "600 MG", "1200 MG"))
- levsTest <- c("PLACEBO", "300 MG", "600 MG", "1200 MG")
- checkIdentical(levels(trt4), levsTest)
-
- ## using frequency
- trt5 <- reorder(trt, X=as.numeric(trt), FUN=length)
- levsTest <- c("PLACEBO", "300 MG", "1200 MG", "600 MG")
- checkIdentical(levels(trt5), levsTest)
-
- ## drop out the '300 MG' level
- trt6 <- reorder(trt, new.order=c("PLACEBO", "600 MG", "1200 MG"))
- levsTest <- c("PLACEBO", "600 MG", "1200 MG")
- checkIdentical(levels(trt6), levsTest)
-
- Sys.setlocale(category="LC_COLLATE", locale=tmp)
-}
-
-### }}}
-### {{{ Dear Emacs
-## Local variables:
-## folded-file: t
-## End:
-### }}}
-
-###------------------------------------------------------------------------
-### runit.reorder.factor.R ends here
Deleted: trunk/gdata/inst/unitTests/runit.trim.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.trim.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/runit.trim.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,55 +0,0 @@
-### runit.trim.R
-###------------------------------------------------------------------------
-### What: Tests for trim
-### $Id$
-### Time-stamp: <2006-08-29 14:21:02 ggorjan>
-###------------------------------------------------------------------------
-
-### {{{ --- Test setup ---
-
-if(FALSE) {
- library("RUnit")
- library("gdata")
-}
-
-### }}}
-### {{{ --- trim ---
-
-test.trim <- function()
-{
- tmp <- Sys.getlocale(category="LC_COLLATE")
- Sys.setlocale(category="LC_COLLATE", locale="C")
-
- sTrim <- " this is an example string "
- sTrimR <- "this is an example string"
-
- 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)
-
- dfTrim <- as.data.frame(lTrim)
- dfTrimR <- as.data.frame(lTrimR)
-
- 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)
-
- Sys.setlocale(category="LC_COLLATE", locale=tmp)
-}
-
-### }}}
-### {{{ Dear Emacs
-## Local variables:
-## folded-file: t
-## End:
-### }}}
-
-###------------------------------------------------------------------------
-### runit.trim.R ends here
Deleted: trunk/gdata/inst/unitTests/runit.trimSum.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.trimSum.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/runit.trimSum.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,61 +0,0 @@
-### runit.trimSum.R
-###------------------------------------------------------------------------
-### What: Unit tests for trimSum
-### $Id$
-### Time-stamp: <2008-12-20 11:58:50 ggorjan>
-###------------------------------------------------------------------------
-
-### {{{ --- Test setup ---
-
-if(FALSE) {
- library("RUnit")
- library("gdata")
-}
-
-### }}}
-### {{{ --- trimSum ---
-
-test.trimSum <- function()
-{
-
- ## 'x' must be a vector - for now
- checkException(trimSum(matrix(1:10)))
- checkException(trimSum(data.frame(1:10)))
- checkException(trimSum(list(1:10)))
-
- ## 'x' must be numeric
- checkException(trimSum(letters))
-
- ## 'n' must be smaller than the length of x
- checkException(trimSum(x=1:10, n=11))
- checkException(trimSum(x=1, n=1))
-
- ## Default
- x <- trimSum(x=1:10, n=5)
- x2 <- c(1:4, 45)
- checkEquals(x, x2)
-
- ## Left
- x <- trimSum(x=1:10, n=5, right=FALSE)
- x2 <- c(21, 7:10)
- checkEquals(x, x2)
-
- ## NA
- x <- trimSum(x=c(1:9, NA), n=5)
- x2 <- c(1:4, NA)
- checkEquals(x, x2)
-
- x <- trimSum(x=c(1:9, NA), n=5, na.rm=TRUE)
- x2 <- c(1:4, 35)
- checkEquals(x, x2)
-}
-
-### }}}
-### {{{ Dear Emacs
-## Local variables:
-## folded-file: t
-## End:
-### }}}
-
-###------------------------------------------------------------------------
-### runit.trimSum.R ends here
Deleted: trunk/gdata/inst/unitTests/runit.unknown.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.unknown.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/runit.unknown.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,504 +0,0 @@
-### runit.unknown.R
-###------------------------------------------------------------------------
-### What: Tests for Change given unknown value to NA and vice versa methods
-### $Id$
-### Time-stamp: <2006-10-30 17:46:21 ggorjan>
-###------------------------------------------------------------------------
-
-### {{{ --- Test setup ---
-
-if(FALSE) {
- library("RUnit")
- library("gdata")
-}
-
-### {{{ --- Vectors ---
-
-intUnk <- 9999
-xInt <- as.integer(c(NA, 1:2, NA, 5, 6, 7, 8, 9))
-xIntUnk <- as.integer(c(intUnk, 1:2, intUnk, 5, 6, 7, 8, 9))
-xIntUnkTest <- xIntUnk %in% intUnk
-
-numUnk <- 0
-xNum <- c(9999, NA, 1.5, NA, 5, 6, 7, 8, 9)
-xNumUnk <- c(9999, 0, 1.5, 0, 5, 6, 7, 8, 9)
-xNumUnkTest <- xNumUnk %in% numUnk
-
-chaUnk <- "notAvail"
-chaUnk1 <- "-"
-xCha <- c("A", "B", NA, "C", NA, "-", "7", "8", "9")
-xChaUnk <- c("A", "B", chaUnk, "C", chaUnk, "-", "7", "8", "9")
-xChaUnk1 <- c("A", "B", chaUnk1, "C", chaUnk1, "-", "7", "8", "9")
-xChaUnkTest <- xChaUnk %in% chaUnk
-xChaUnk1Test <- xChaUnk %in% chaUnk1
-
-facUnk <- "notAvail"
-facUnk1 <- "NA"
-xFac <- factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", NA))
-xFacUnk <- factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", facUnk))
-xFacUnk1 <- factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", facUnk1))
-xFacUnkTest <- c(0, 0, 0, 0, 0, 0, 0, 0, 1)
-xFacUnkTest <- as.logical(xFacUnkTest)
-xFacUnk1Test <- c(0, 0, 0, 1, 1, 0, 0, 0, 1)
-xFacUnk1Test <- as.logical(xFacUnk1Test)
-xFac1 <- factor(c("A", "0", 0, NA, NA, intUnk, numUnk, "-", NA))
-
-facLev <- "A"
-xFacUnkLev <- factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", "A"))
-xFacUnkLevTest <- c(1, 0, 0, 0, 0, 0, 0, 0, 1)
-xFacUnkLevTest <- as.logical(xFacUnkLevTest)
-
-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(tmp, dateUnk, NA)
-xDate1Test <- c(FALSE, TRUE, FALSE)
-
-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(tmp, POSIXltUnk, NA)
-xPOSIXlt1Test <- c(FALSE, TRUE, FALSE)
-
-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(tmp, POSIXctUnk, NA)
-xPOSIXct1Test <- xPOSIXlt1Test
-
-### }}}
-### {{{ --- Lists and data.frames ---
-
-xList <- list(xInt, xCha, xNum, xFac)
-xListN <- list(int=xInt, cha=xCha, num=xNum, fac=xFac)
-xListUnk <- list(xIntUnk, xChaUnk, xNumUnk, xFacUnk)
-xListUnkTest <- list(xIntUnkTest, xChaUnkTest, xNumUnkTest, xFacUnkTest)
-xListNUnk <- list(int=xIntUnk, cha=xChaUnk, num=xNumUnk, fac=xFacUnk)
-xListNUnkTest <- list(int=xIntUnkTest, cha=xChaUnkTest, num=xNumUnkTest, fac=xFacUnkTest)
-
-xDF <- as.data.frame(xListN)
-xDF$cha <- as.character(xDF$cha)
-xDFUnk <- as.data.frame(xListNUnk)
-xDFUnk$cha <- as.character(xDFUnk$cha)
-xDFUnkTest <- as.data.frame(xListNUnkTest)
-
-unkC <- c(intUnk, chaUnk, numUnk, facUnk)
-unkL <- list(intUnk, chaUnk, numUnk, facUnk)
-unkLN <- list(num=numUnk, cha=chaUnk, fac=facUnk, int=intUnk) ## mixed as it is named
-unkLMN <- list(cha=chaUnk, int=intUnk, num=c(intUnk, numUnk),
- fac=c(chaUnk1, facUnk))
-
-xListMNUnkF <- list(int=as.integer(c(9999, 1, 2, 9999, 5, 6, 7, 8, 9)),
- cha=c("A", "B", "notAvail", "C", "notAvail", "-", "7", "8", "9"),
- num=c(9999, 0, 1.5, 0, 5, 6, 7, 8, 9),
- fac=factor(c("A", "0", "0", "NA", "NA", 9999, "0", "-", "notAvail")))
-xListMNUnkFTest <- list(int=c(1, 0, 0, 1, 0, 0, 0, 0, 0),
- cha=c(0, 0, 1, 0, 1, 0, 0, 0, 0),
- num=c(1, 1, 0, 1, 0, 0, 0, 0, 0),
- fac=c(0, 0, 0, 0, 0, 0, 0, 1, 1))
-xListMNUnkFTest <- lapply(xListMNUnkFTest, as.logical)
-xListMNF <- list(int=as.integer(c(NA, 1, 2, NA, 5, 6, 7, 8, 9)),
- cha=c("A", "B", NA, "C", NA, "-", "7", "8", "9"),
- num=c(NA, NA, 1.5, NA, 5, 6, 7, 8, 9),
- fac=factor(c("A", "0", "0", "NA", "NA", "9999", "0", NA, NA)))
-
-xDFMUnkF <- as.data.frame(xListMNUnkF)
-xDFMUnkF$cha <- as.character(xDFMUnkF$cha)
-xDFMUnkFTest <- as.data.frame(xListMNUnkFTest)
-xDFMF <- as.data.frame(xListMNF)
-xDFMF$cha <- as.character(xDFMF$cha)
-
-unk1 <- 555555
-xListUnk1 <- list(as.integer(c(unk1, 1, 2, unk1, 5, 6, 7, 8, 9)),
- c("A", "B", unk1, "C", unk1, "-", "7", "8", "9"),
- c(9999, unk1, 1.5, unk1, 5, 6, 7, 8, 9),
- factor(c("A", "0", "0", "NA", "NA", "9999", "0", "-", unk1)))
-xListUnk1Test <- lapply(xListUnk1, function(x) x %in% unk1)
-xListNUnk1 <- xListUnk1
-names(xListNUnk1) <- c("int", "cha", "num", "fac")
-xDFUnk1 <- as.data.frame(xListNUnk1)
-xDFUnk1$cha <- as.character(xDFUnk1$cha)
-xDFUnk1Test <- as.data.frame(xListUnk1Test)
-names(xDFUnk1Test) <- names(xListNUnk1)
-
-unkC2 <- c(0, "notAvail")
-xListUnk2 <- list(as.integer(c(unkC2[1], 1, 2, unkC2[1], 5, 6, 7, 8, 9)),
- c("A", "B", unkC2[2], "C", unkC2[2], "-", "7", "8", "9"),
- c(9999, as.numeric(unkC2[1]), 1.5, as.numeric(unkC2[1]), 5, 6, 7, 8, 9),
- factor(c("A", "0", "0", "NA", "NA", "9999", "0", "-", unkC2[2])))
-xListNUnk2 <- xListUnk2
-names(xListNUnk2) <- c("int", "cha", "num", "fac")
-xDFUnk2 <- as.data.frame(xListNUnk2)
-xDFUnk2$cha <- as.character(xDFUnk2$cha)
-
-xListUnk2Test <- xListUnk2
-xListUnk2Test[[1]] <- xListUnk2Test[[1]] %in% unkC2[1]
-xListUnk2Test[[2]] <- xListUnk2Test[[2]] %in% unkC2[2]
-xListUnk2Test[[3]] <- xListUnk2Test[[3]] %in% unkC2[1]
-xListUnk2Test[[4]] <- xListUnk2Test[[4]] %in% unkC2[2]
-xListNUnk2Test <- xListUnk2Test
-names(xListNUnk2Test) <- names(xListNUnk2)
-xDFUnk2Test <- as.data.frame(xListNUnk2Test)
-
-unkL2 <- as.list(unkC2)
-unkLN2 <- unkL2[c(2, 1)]
-names(unkLN2) <- c("cha", "int")
-xListUnk2a <- list(as.integer(c(NA, 1, 2, NA, 5, 6, 7, 8, 9)),
- c("A", "B", unkLN2[[2]], "C", unkLN2[[2]], "-", "7", "8", "9"),
- c(9999, NA, 1.5, NA, 5, 6, 7, 8, 9),
- factor(c("A", "0", "0", "NA", "NA", "9999", "0", "-", unkLN2[[2]])))
-xListUnk2aTest <- xListUnk2a
-xListUnk2aTest[[1]] <- xListUnk2aTest[[1]] %in% unkLN2[1]
-xListUnk2aTest[[2]] <- xListUnk2aTest[[2]] %in% unkLN2[2]
-xListUnk2aTest[[3]] <- xListUnk2aTest[[3]] %in% unkLN2[1]
-xListUnk2aTest[[4]] <- xListUnk2aTest[[4]] %in% unkLN2[2]
-
-xList2a <- list(xListUnk2a[[1]],
- c("A", "B", NA, "C", NA, "-", "7", "8", "9"),
- xListUnk2a[[3]],
- 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"
-unkLND1 <- list(.default=D1)
-xListUnkD1 <- list(as.integer(c(NA, 1:2, NA, 5, 6, 7, 8, 9)),
- c("A", "B", D1, "C", D1, "-", "7", "8", "9"),
- c(9999, NA, 1.5, NA, 5, 6, 7, 8, 9),
- factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", D1)))
-xListUnkD1Test <- lapply(xListUnkD1, function(x) x %in% D1)
-xListD1 <- xList
-
-xListNUnkD1 <- xListUnkD1
-xListNUnkD1Test <- xListUnkD1Test
-names(xListNUnkD1) <- names(xListNUnkD1Test) <- names(xListNUnk1)
-xListND1 <- xListN
-
-DSO2 <- c("notAvail", 5678)
-unkLNDSO2 <- as.list(DSO2)
-names(unkLNDSO2) <- c(".default", "someOther")
-xListUnkDSO2 <- list(as.integer(c(NA, 1:2, NA, 5, 6, 7, 8, 9)),
- c("A", "B", DSO2[1], "C", DSO2[1], "-", "7", "8", "9"),
- c(9999, NA, 1.5, NA, 5, 6, 7, 8, 9),
- factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", DSO2[2])))
-xListUnkDSO2Test <- lapply(xListUnkDSO2, function(x) x %in% DSO2)
-
-unkLND3 <- list(.default="notAvail", num=0, int=9999)
-xListNUnkD3 <- list(int=as.integer(c(unkLND3[[3]], 1:2, unkLND3[[3]], 5, 6, 7, 8, 9)),
- cha=c("A", "B", unkLND3[[1]], "C", unkLND3[[1]], "-", "7", "8", "9"),
- num=c(9999, unkLND3[[2]], 1.5, unkLND3[[2]], 5, 6, 7, 8, 9),
- fac=factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", unkLND3[[1]])))
-xListNUnkD3Test <- xListNUnkD3
-xListNUnkD3Test$int <- xListNUnkD3Test$int %in% unkLND3[[3]]
-xListNUnkD3Test$cha <- xListNUnkD3Test$cha %in% unkLND3[[1]]
-xListNUnkD3Test$num <- xListNUnkD3Test$num %in% unkLND3[[2]]
-xListNUnkD3Test$fac <- xListNUnkD3Test$fac %in% unkLND3[[1]]
-
-unkLND2E <- list(.default="notAvail", 9999)
-
-### }}}
-
-### }}}
-### {{{ --- isUnknown ---
-
-test.isUnknown <- function()
-{
- ## --- base methods for vectors ---
-
- ## base ...
- checkIdentical(isUnknown(xIntUnk, unknown=as.integer(intUnk)), xIntUnkTest)
- checkIdentical(isUnknown(xIntUnk, unknown=intUnk), xIntUnkTest)
- checkIdentical(isUnknown(xNumUnk, unknown=numUnk), xNumUnkTest)
- checkIdentical(isUnknown(xNumUnk, unknown=as.integer(numUnk)), xNumUnkTest)
- checkIdentical(isUnknown(xChaUnk, unknown=chaUnk), xChaUnkTest)
- checkIdentical(isUnknown(xFacUnk, unknown=facUnk), xFacUnkTest)
-
- ## multiple values are allowed for vector methods in vector or list form
- checkIdentical(isUnknown(xIntUnk, unknown=unkC), xIntUnkTest)
- checkIdentical(isUnknown(xIntUnk, unknown=unkL), xIntUnkTest)
-
- ## NA's in factors
- checkIdentical(isUnknown(xFacUnk1, unknown=facUnk1), xFacUnk1Test)
- facNA <- factor(c("0", 1, 2, 3, NA, "NA"))
- facNATest <- c(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE)
- checkIdentical(isUnknown(facNA), facNATest)
-
- ## Date-time classes
- checkIdentical(isUnknown(xDateUnk, unknown=dateUnk), xDateTest)
- checkIdentical(isUnknown(xDate1Unk, unknown=dateUnk), xDate1Test)
- checkIdentical(isUnknown(xPOSIXltUnk, unknown=POSIXltUnk), xPOSIXltTest)
- checkIdentical(isUnknown(xPOSIXlt1Unk, unknown=POSIXltUnk), xPOSIXlt1Test)
- checkIdentical(isUnknown(xPOSIXctUnk, unknown=POSIXctUnk), xPOSIXctTest)
- checkIdentical(isUnknown(xPOSIXct1Unk, unknown=POSIXctUnk), xPOSIXct1Test)
-
- ## --- lists and data.frames ---
-
- ## with vector of single unknown values
- checkIdentical(isUnknown(xListUnk, unknown=unkC), xListUnkTest)
- checkIdentical(isUnknown(xDFUnk, unknown=unkC), xDFUnkTest)
-
- ## with list of single unknown values
- checkIdentical(isUnknown(xListUnk, unknown=unkL), xListUnkTest)
- checkIdentical(isUnknown(xDFUnk, unknown=unkL), xDFUnkTest)
-
- ## with named list of single unknown values
- checkIdentical(isUnknown(xListNUnk, unknown=unkLN), xListNUnkTest)
- checkIdentical(isUnknown(xDFUnk, unknown=unkLN), xDFUnkTest)
-
- ## with named list of multiple unknown values - valid here
- checkIdentical(isUnknown(xListMNUnkF, unknown=unkLMN), xListMNUnkFTest)
- checkIdentical(isUnknown(xDFMUnkF, unknown=unkLMN), xDFMUnkFTest)
-
- ## with single unknown value - recycling
- checkIdentical(isUnknown(xListUnk1, unknown=unk1), xListUnk1Test)
- checkIdentical(isUnknown(xDFUnk1, unknown=unk1), xDFUnk1Test)
-
- ## with vector of two unknown values - recycling
- checkIdentical(isUnknown(xListUnk2, unknown=unkC2), xListUnk2Test)
- checkIdentical(isUnknown(xDFUnk2, unknown=unkC2), xDFUnk2Test)
-
- ## with list of two unknown values - recycling
- checkIdentical(isUnknown(xListUnk2, unknown=unkL2), xListUnk2Test)
- checkIdentical(isUnknown(xDFUnk2, unknown=unkL2), xDFUnk2Test)
-
- ## list(.default=)
- checkIdentical(isUnknown(x=xListUnkD1, unknown=unkLND1), xListUnkD1Test)
- ## list(.default=, someOther=) we do not know someOther, but should work
- ## as x is not named
- checkIdentical(isUnknown(x=xListUnkDSO2, unknown=unkLNDSO2), xListUnkDSO2Test)
- ## list(.default=) in named list
- checkIdentical(isUnknown(x=xListNUnkD1, unknown=unkLND1), xListNUnkD1Test)
- ## list(.default=, someOther=) OK if someOther is in the named list
- checkIdentical(isUnknown(x=xListNUnkD3, unknown=unkLND3), xListNUnkD3Test)
- ## 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)
-}
-
-### }}}
-### {{{ --- unknownToNA ---
-
-test.unknownToNA <- function()
-{
- ## --- base methods for vectors ---
-
- ## base ...
- checkIdentical(unknownToNA(xIntUnk, as.integer(intUnk)), xInt)
- checkIdentical(unknownToNA(xIntUnk, intUnk), xInt) ## with numeric
- checkIdentical(unknownToNA(xNumUnk, numUnk), xNum)
- checkIdentical(unknownToNA(xNumUnk, as.integer(numUnk)), xNum)
- checkIdentical(unknownToNA(xChaUnk, chaUnk), xCha)
- checkIdentical(unknownToNA(xChaUnk, chaUnk), xCha)
- checkIdentical(unknownToNA(xFacUnk, facUnk), xFac)
-
- ## multiple values are allowed for vector methods in vector or list form
- checkIdentical(unknownToNA(xIntUnk, unknown=unkC), xInt)
- checkIdentical(unknownToNA(xIntUnk, unknown=unkL), xInt)
-
- ## NA's in factors
- checkIdentical(unknownToNA(xFacUnk1, unknown=facUnk1), xFac1)
- facNA <- factor(c("0", 1, 2, 3, NA, "NA"))
- facNATest <- factor(c("0", 1, 2, 3, NA, NA))
- checkIdentical(unknownToNA(x=facNA, unknown="NA"), facNATest)
-
- ## Date-time classes
- checkIdentical(unknownToNA(xDateUnk, unknown=dateUnk), xDate)
- checkIdentical(unknownToNA(xPOSIXltUnk, unknown=POSIXltUnk), xPOSIXlt)
- checkIdentical(unknownToNA(xPOSIXctUnk, unknown=POSIXctUnk), xPOSIXct)
-
- ## --- lists and data.frames ---
-
- ## with vector of single unknown values
- checkIdentical(unknownToNA(xListUnk, unknown=unkC), xList)
- checkIdentical(unknownToNA(xDFUnk, unknown=unkC), xDF)
-
- ## with list of single unknown values
- checkIdentical(unknownToNA(xListUnk, unknown=unkL), xList)
- checkIdentical(unknownToNA(xDFUnk, unknown=unkL), xDF)
-
- ## with named list of single unknown values
- checkIdentical(unknownToNA(xListNUnk, unknown=unkLN), xListN)
- checkIdentical(unknownToNA(xDFUnk, unknown=unkLN), xDF)
-
- ## with names list of multiple unknown values - must be an error
- checkIdentical(unknownToNA(xListMNUnkF, unknown=unkLMN), xListMNF)
- checkIdentical(unknownToNA(xDFMUnkF, unknown=unkLMN), xDFMF)
-
- ## with single unknown value - recycling
- checkIdentical(unknownToNA(xListUnk1, unknown=unk1), xList)
- checkIdentical(unknownToNA(xDFUnk1, unknown=unk1), xDF)
-
- ## with vector of two unknown values - recycling
- checkIdentical(unknownToNA(xListUnk2, unknown=unkC2), xList)
- checkIdentical(unknownToNA(xDFUnk2, unknown=unkC2), xDF)
-
- ## with list of two unknown values - recycling
- checkIdentical(unknownToNA(xListUnk2, unknown=unkL2), xList)
- checkIdentical(unknownToNA(xDFUnk2, unknown=unkL2), xDF)
-
- ## with named list of two unknown values but x is not named so named list
- ## does not have any effect --> error as we do not know how to recycle
- checkException(unknownToNA(xListUnk2a, unknown=unkLN2))
-
- ## but we should get some results with named x
- checkIdentical(unknownToNA(xListNUnk2, unknown=unkL2), xListN)
- ## not also necesarilly with recycling of names lists, as it is
- ## not clear how to properly recycle named lists (only names that match
- ## can be really properly recycled)
- checkException(unknownToNA(xListNUnk2, unknown=unkLN2))
- checkIdentical(unknownToNA(xDFUnk2, unknown=unkL2), xDF)
- checkException(unknownToNA(xDFUnk2, unknown=unkLN2))
-
- ## list(.default=)
- checkIdentical(unknownToNA(x=xListUnkD1, unknown=unkLND1), xListD1)
- ## list(.default=, someOther=) we do not know someOther, but should work
- ## as x is not named
- checkIdentical(unknownToNA(x=xListUnkDSO2, unknown=unkLNDSO2), xList)
- ## list(.default=) in named list
- checkIdentical(unknownToNA(x=xListNUnkD1, unknown=unkLND1), xListND1)
- ## list(.default=, someOther=) OK if someOther is in the named list
- 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)
-}
-
-### }}}
-### {{{ --- NAToUnknown ---
-
-test.NAToUnknown <- function()
-{
- ## --- base methods for vectors ---
-
- ## base ...
- checkIdentical(NAToUnknown(xInt, as.integer(intUnk)), xIntUnk)
- checkIdentical(NAToUnknown(xInt, intUnk), xIntUnk) ## with numeric
- checkIdentical(NAToUnknown(xNum, numUnk), xNumUnk)
- checkIdentical(NAToUnknown(xNum, as.integer(numUnk)), xNumUnk)
- checkIdentical(NAToUnknown(xCha, chaUnk), xChaUnk)
- checkIdentical(NAToUnknown(xCha, chaUnk), xChaUnk)
- checkIdentical(NAToUnknown(xFac, facUnk), xFacUnk)
-
- ## only single values are allowed for vector methods
- checkException(NAToUnknown(xInt, unknown=unkC))
- checkException(NAToUnknown(xInt, unknown=unkL))
-
- ## and they should not already be in x unless force=TRUE
- checkException(NAToUnknown(xCha, unknown=chaUnk1))
- checkIdentical(NAToUnknown(xCha, unknown=chaUnk1, force=TRUE), xChaUnk1)
-
- checkException(NAToUnknown(xFac, unknown=facLev))
- checkIdentical(NAToUnknown(xFac, unknown=facLev, force=TRUE), xFacUnkLev)
-
- ## NA's in factors
- checkIdentical(NAToUnknown(xFac, unknown=facUnk1, force=TRUE), xFacUnk1)
- facNA <- factor(c("0", 1, 2, 3, NA, NA))
- facNATest <- factor(c("0", 1, 2, 3, "NA", "NA"))
- checkIdentical(NAToUnknown(x=facNA, unknown="NA"), facNATest)
-
- ## Date-time classes
- checkIdentical(NAToUnknown(xDate, unknown=dateUnk), xDateUnk)
- checkIdentical(NAToUnknown(xPOSIXlt, unknown=POSIXltUnk), xPOSIXltUnk)
- checkIdentical(NAToUnknown(xPOSIXct, unknown=POSIXctUnk), xPOSIXctUnk)
-
- ## --- lists and data.frames ---
-
- ## with vector of single unknown values
- checkIdentical(NAToUnknown(xList, unknown=unkC), xListUnk)
- checkIdentical(NAToUnknown(xDF, unknown=unkC), xDFUnk)
-
- ## with list of single unknown values
- checkIdentical(NAToUnknown(xList, unknown=unkL), xListUnk)
- checkIdentical(NAToUnknown(xDF, unknown=unkL), xDFUnk)
-
- ## with named list of single unknown values
- checkIdentical(NAToUnknown(xListN, unknown=unkLN), xListNUnk)
- checkIdentical(NAToUnknown(xDF, unknown=unkLN), xDFUnk)
-
- ## with names list of multiple unknown values - must be an error
- checkException(NAToUnknown(xListN, unknown=unkLMN))
- checkException(NAToUnknown(xDF, unknown=unkLMN))
-
- ## with single unknown value - recycling
- checkIdentical(NAToUnknown(xList, unknown=unk1), xListUnk1)
- checkIdentical(NAToUnknown(xDF, unknown=unk1), xDFUnk1)
-
- ## with vector of two unknown values - recycling
- checkIdentical(NAToUnknown(xList, unknown=unkC2), xListUnk2)
- checkIdentical(NAToUnknown(xDF, unknown=unkC2), xDFUnk2)
-
- ## with list of two unknown values - recycling
- checkIdentical(NAToUnknown(xList, unknown=unkL2), xListUnk2)
- checkIdentical(NAToUnknown(xDF, unknown=unkL2), xDFUnk2)
-
- ## with named list of two unknown values but x is not named so named list
- ## does not have any effect --> error as we do not know how to recycle
- checkException(NAToUnknown(xList, unknown=unkLN2))
-
- ## but we should get some results with named x
- checkIdentical(NAToUnknown(xListN, unknown=unkL2), xListNUnk2)
- ## not also necesarilly with recycling of names lists, as it is
- ## not clear how to properly recycle named lists (only names that match
- ## can be really properly recycled)
- checkException(NAToUnknown(xListN, unknown=unkLN2))
- checkIdentical(NAToUnknown(xDF, unknown=unkL2), xDFUnk2)
- checkException(NAToUnknown(xDF, unknown=unkLN2))
-
- ## list(.default=)
- checkIdentical(NAToUnknown(x=xList, unknown=unkLND1), xListUnkD1)
- ## list(.default=, someOther=) we do not know someOther, but should work
- ## as x is not named
- checkIdentical(NAToUnknown(x=xList, unknown=unkLNDSO2), xListUnkDSO2)
- ## list(.default=) in named list
- checkIdentical(NAToUnknown(x=xListN, unknown=unkLND1), xListNUnkD1)
- ## list(.default=, someOther=) OK if someOther is in the named list
- checkIdentical(NAToUnknown(x=xListN, unknown=unkLND3), xListNUnkD3)
- ## 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)
-}
-
-### }}}
-### {{{ Dear Emacs
-### Local variables:
-### folded-file: t
-### End:
-### }}}
-
-###------------------------------------------------------------------------
-### runit.unknown.R ends here
Deleted: trunk/gdata/inst/unitTests/runit.wideByFactor.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.wideByFactor.R 2014-04-05 00:14:24 UTC (rev 1781)
+++ trunk/gdata/inst/unitTests/runit.wideByFactor.R 2014-04-05 01:08:30 UTC (rev 1782)
@@ -1,55 +0,0 @@
-### runit.wideByFactor.R
-###------------------------------------------------------------------------
-### What: Reshape by factor levels - unit tests
-### $Id$
-### Time-stamp: <2008-12-30 11:58:50 ggorjan>
-###------------------------------------------------------------------------
-
-### {{{ --- Test setup ---
-
-if(FALSE) {
- library("RUnit")
- library("gdata")
-}
-
-### }}}
-### {{{ --- wideByFactor ---
-
-test.wideByFactor <- function()
-{
- n <- 10
- f <- 2
- tmp <- data.frame(y1=(1:n)/2,
- y2=(n:1)*2,
- f1=factor(rep(letters[1:f], n/2)),
- f2=factor(c(rep(c("M"), n/2), rep(c("F"), n/2))),
- c1=1:n,
- c2=2*(1:n))
-
- ## 'x' must be a data.frame
- checkException(wideByFactor(x=1:10))
- checkException(wideByFactor(x=matrix(1:10)))
- ## 'factor' can be only of length one
- checkException(wideByFactor(x=tmp, factor=c("f1", "f2")))
- ## column defined in 'factor' must be a factor
- checkException(wideByFactor(x=tmp, factor="c1"))
-
- tmp2 <- wideByFactor(x=tmp, factor="f1", common=c("c1", "c2"), sort=FALSE)
- checkEquals(tmp2[c("c1", "c2")], tmp[c("c1", "c2")])
- checkEquals(names(tmp2), c("c1", "c2", "f1", "y1.a", "y2.a", "f2.a", "y1.b", "y2.b", "f2.b"))
- checkEquals(tmp2$y1.a, c(0.5, NA, 1.5, NA, 2.5, NA, 3.5, NA, 4.5, NA))
- checkEquals(tmp2$f2.a, factor(c("M", NA, "M", NA, "M", NA, "F", NA, "F", NA)))
- tmp2 <- wideByFactor(x=tmp, factor="f1", common=c("c1", "c2...
[truncated message content] |
|
From: <wa...@us...> - 2014-04-05 02:23:50
|
Revision: 1784
http://sourceforge.net/p/r-gregmisc/code/1784
Author: warnes
Date: 2014-04-05 02:23:45 +0000 (Sat, 05 Apr 2014)
Log Message:
-----------
Move unit test files back to inst/unitTests. Fix up runRUnitTests.R to work properly in the new location
Modified Paths:
--------------
trunk/gdata/tests/runRUnitTests.R
Added Paths:
-----------
trunk/gdata/inst/unitTests/Makefile
trunk/gdata/inst/unitTests/runit.bindData.R
trunk/gdata/inst/unitTests/runit.cbindX.R
trunk/gdata/inst/unitTests/runit.drop.levels.R
trunk/gdata/inst/unitTests/runit.getDateTimeParts.R
trunk/gdata/inst/unitTests/runit.mapLevels.R
trunk/gdata/inst/unitTests/runit.nPairs.R
trunk/gdata/inst/unitTests/runit.reorder.factor.R
trunk/gdata/inst/unitTests/runit.trim.R
trunk/gdata/inst/unitTests/runit.trimSum.R
trunk/gdata/inst/unitTests/runit.unknown.R
trunk/gdata/inst/unitTests/runit.wideByFactor.R
trunk/gdata/inst/unitTests/runit.write.fwf.R
Removed Paths:
-------------
trunk/gdata/tests/Makefile
trunk/gdata/tests/runit.bindData.R
trunk/gdata/tests/runit.cbindX.R
trunk/gdata/tests/runit.drop.levels.R
trunk/gdata/tests/runit.getDateTimeParts.R
trunk/gdata/tests/runit.mapLevels.R
trunk/gdata/tests/runit.nPairs.R
trunk/gdata/tests/runit.reorder.factor.R
trunk/gdata/tests/runit.trim.R
trunk/gdata/tests/runit.trimSum.R
trunk/gdata/tests/runit.unknown.R
trunk/gdata/tests/runit.wideByFactor.R
trunk/gdata/tests/runit.write.fwf.R
Copied: trunk/gdata/inst/unitTests/Makefile (from rev 1782, trunk/gdata/tests/Makefile)
===================================================================
--- trunk/gdata/inst/unitTests/Makefile (rev 0)
+++ trunk/gdata/inst/unitTests/Makefile 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,18 @@
+TOP=../..
+PKG=${shell cd ${TOP};pwd}
+SUITE=runRUnitTests.R
+R=R
+
+test: # Run unit tests
+ ${R} --vanilla --slave < ${SUITE}
+
+all: inst test
+
+echo: # Echo env. variables
+ @echo "Package folder: ${PKG}"
+ @echo "R binary: ${R}"
+
+help: # Help
+ @echo -e '\nTarget: Dependency # Description'; \
+ echo '=================================================='; \
+ egrep '^[[:alnum:].+_()%]*:' ./Makefile
Copied: trunk/gdata/inst/unitTests/runit.bindData.R (from rev 1782, trunk/gdata/tests/runit.bindData.R)
===================================================================
--- trunk/gdata/inst/unitTests/runit.bindData.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.bindData.R 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,75 @@
+### runit.bindData.R
+###------------------------------------------------------------------------
+### What: Bind two data frames - unit tests
+### $Id$
+### Time-stamp: <2008-12-30 11:58:50 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ --- Test setup ---
+
+if(FALSE) {
+ library("RUnit")
+ library("gdata")
+}
+
+### }}}
+### {{{ --- bindData ---
+
+test.bindData <- function()
+{
+ ## 'x'/'y' must be a data.frame
+ checkException(bindData(x=1:10, y=1:10))
+ checkException(bindData(x=matrix(1:10), y=matrix(1:10)))
+
+ n1 <- 6; n2 <- 12; n3 <- 4
+ ## Single trait 1
+ num <- c(5:n1, 10:13)
+ tmp1 <- data.frame(y1=rnorm(n=n1),
+ f1=factor(rep(c("A", "B"), n1/2)),
+ ch=letters[num],
+ fa=factor(letters[num]),
+ nu=(num) + 0.5,
+ id=factor(num), stringsAsFactors=FALSE)
+
+ ## Single trait 2 with repeated records, some subjects also in tmp1
+ num <- 4:9
+ tmp2 <- data.frame(y2=rnorm(n=n2),
+ f2=factor(rep(c("C", "D"), n2/2)),
+ ch=letters[rep(num, times=2)],
+ fa=factor(letters[rep(c(num), times=2)]),
+ nu=c((num) + 0.5, (num) + 0.25),
+ id=factor(rep(num, times=2)), stringsAsFactors=FALSE)
+
+ ## Single trait 3 with completely distinct set of subjects
+ num <- 1:4
+ tmp3 <- data.frame(y3=rnorm(n=n3),
+ f3=factor(rep(c("E", "F"), n3/2)),
+ ch=letters[num],
+ fa=factor(letters[num]),
+ nu=(num) + 0.5,
+ id=factor(num), stringsAsFactors=FALSE)
+
+ ## Combine all datasets
+ tmp12 <- bindData(x=tmp1, y=tmp2, common=c("id", "nu", "ch", "fa"))
+ tmp123 <- bindData(x=tmp12, y=tmp3, common=c("id", "nu", "ch", "fa"))
+
+ checkEquals(names(tmp123), c("id", "nu", "ch", "fa", "y1", "f1", "y2", "f2", "y3", "f3"))
+ checkEquals(rbind(tmp1["id"], tmp2["id"], tmp3["id"]), tmp123["id"])
+ checkEquals(rbind(tmp1["fa"], tmp2["fa"], tmp3["fa"]), tmp123["fa"])
+ checkEquals(is.na(tmp123$y1), c(rep(FALSE, times=n1), rep(TRUE, times=n2+n3)))
+ checkEquals(is.na(tmp123$f1), c(rep(FALSE, times=n1), rep(TRUE, times=n2+n3)))
+ checkEquals(is.na(tmp123$y2), c(rep(TRUE, times=n1), rep(FALSE, times=n2), rep(TRUE, times=n3)))
+ checkEquals(is.na(tmp123$f2), c(rep(TRUE, times=n1), rep(FALSE, times=n2), rep(TRUE, times=n3)))
+ checkEquals(is.na(tmp123$y3), c(rep(TRUE, times=n1+n2), rep(FALSE, times=n3)))
+ checkEquals(is.na(tmp123$f3), c(rep(TRUE, times=n1+n2), rep(FALSE, times=n3)))
+}
+
+### }}}
+### {{{ Dear Emacs
+## Local variables:
+## folded-file: t
+## End:
+### }}}
+
+###------------------------------------------------------------------------
+### runit.bindData.R ends here
Copied: trunk/gdata/inst/unitTests/runit.cbindX.R (from rev 1782, trunk/gdata/tests/runit.cbindX.R)
===================================================================
--- trunk/gdata/inst/unitTests/runit.cbindX.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.cbindX.R 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,81 @@
+### runit.cbindX.R
+###------------------------------------------------------------------------
+### What: Unit tests for cbindX
+### $Id:$
+### Time-stamp: <2008-08-05 13:40:49 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ --- Test setup ---
+
+if(FALSE) {
+ library("RUnit")
+ library("gdata")
+}
+
+### }}}
+### {{{ --- cbindX ---
+
+test.cbindX <- function()
+{
+ df1 <- data.frame(a=1:3, b=c("A", "B", "C"))
+ df2 <- data.frame(c=as.character(1:5), a=5:1)
+
+ ma1 <- matrix(as.character(1:4), nrow=2, ncol=2)
+ ma2 <- matrix(1:6, nrow=3, ncol=2)
+
+ df12test <- cbindX(df1, df2)
+ df12stand <- data.frame(a=c(1:3, NA, NA),
+ b=c("A", "B", "C", NA, NA),
+ c=as.character(1:5),
+ a=5:1)
+ names(df12stand)[4] <- "a"
+ checkEquals(df12test, df12stand)
+
+ ma12test <- cbindX(ma1, ma2)
+ ma12stand <- matrix(as.character(c(1, 3, 1, 4,
+ 2, 4, 2, 5,
+ NA, NA, 3, 6)), nrow=3, ncol=4, byrow=TRUE)
+ checkEquals(ma12test, ma12stand)
+
+ da11test <- cbindX(df1, ma1)
+ da11stand <- data.frame(a=1:3,
+ b=c("A", "B", "C"),
+ as.character(c(1:2, NA)),
+ as.character(c(3:4, NA)))
+ names(da11stand)[3:4] <- c("1", "2")
+ checkEquals(da11test, da11stand)
+
+ tmpTest <- cbindX(df1, df2, ma1, ma2)
+ tmpStand <- data.frame(a=c(1:3, NA, NA),
+ b=c("A", "B", "C", NA, NA),
+ c=as.character(1:5),
+ a=5:1,
+ as.character(c(1:2, NA, NA, NA)),
+ as.character(c(3:4, NA, NA, NA)),
+ c(1:3, NA, NA),
+ c(4:6, NA, NA))
+ names(tmpStand)[4:8] <- c("a", "1", "2", "1", "2")
+ checkEquals(tmpTest, tmpStand)
+
+ tmpTest <- cbindX(ma1, ma2, df1, df2)
+ tmpStand <- data.frame(as.character(c(1:2, NA, NA, NA)),
+ as.character(c(3:4, NA, NA, NA)),
+ as.character(c(1:3, NA, NA)),
+ as.character(c(4:6, NA, NA)),
+ a=c(1:3, NA, NA),
+ b=c("A", "B", "C", NA, NA),
+ c=as.character(1:5),
+ a=5:1)
+ names(tmpStand)[c(1:4, 8)] <- c("1", "2", "3", "4", "a")
+ checkEquals(tmpTest, tmpStand)
+}
+
+### }}}
+### {{{ Dear Emacs
+### Local variables:
+### folded-file: t
+### end:
+### }}}
+
+###------------------------------------------------------------------------
+### runit.cbindX.R ends here
Copied: trunk/gdata/inst/unitTests/runit.drop.levels.R (from rev 1782, trunk/gdata/tests/runit.drop.levels.R)
===================================================================
--- trunk/gdata/inst/unitTests/runit.drop.levels.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.drop.levels.R 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,42 @@
+### runit.drop.levels.R
+###------------------------------------------------------------------------
+### What: Tests for drop.levels
+### $Id$
+### Time-stamp: <2006-08-29 14:21:12 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ --- Test setup ---
+
+if(FALSE) {
+ library("RUnit")
+ library("gdata")
+}
+
+### }}}
+### {{{ --- drop.levels ---
+
+test.drop.levels <- function()
+{
+ f <- factor(c("A", "B", "C", "D"))[1:3]
+ fDrop <- factor(c("A", "B", "C"))
+
+ l <- list(f=f, i=1:3, c=c("A", "B", "D"))
+ lDrop <- list(f=fDrop, i=1:3, c=c("A", "B", "D"))
+
+ df <- as.data.frame(l)
+ dfDrop <- as.data.frame(lDrop)
+
+ checkIdentical(drop.levels(f), fDrop)
+ checkIdentical(drop.levels(l), lDrop)
+ checkIdentical(drop.levels(df), dfDrop)
+}
+
+### }}}
+### {{{ Dear Emacs
+## Local variables:
+## folded-file: t
+## End:
+### }}}
+
+###------------------------------------------------------------------------
+### runit.drop.levels.R ends here
Copied: trunk/gdata/inst/unitTests/runit.getDateTimeParts.R (from rev 1782, trunk/gdata/tests/runit.getDateTimeParts.R)
===================================================================
--- trunk/gdata/inst/unitTests/runit.getDateTimeParts.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.getDateTimeParts.R 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,119 @@
+### runit.getDateTimeParts.R
+###------------------------------------------------------------------------
+### What: Extract date and time parts from ... - unit tests
+### $Id$
+### Time-stamp: <2008-12-30 22:41:18 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ --- Test setup ---
+
+if(FALSE) {
+ library("RUnit")
+ library("gdata")
+}
+
+num <- 1
+cha <- "a"
+fac <- factor(c("A"))
+
+tYear <- as.character(c(2006, 1995, 1005, 3067))
+tMonth <- c("01", "04", "06", "12")
+tDay <- c("01", "12", "22", "04")
+tDate <- paste( paste(tYear, tMonth, tDay, sep="-"), "GMT" )
+
+tHour <- c("05", "16", "20", "03")
+tMin <- c("16", "40", "06", "52")
+tSec <- c("56", "34", "05", "15")
+tTime <- paste(tHour, tMin, tSec, sep=":")
+
+cDate <- as.Date(tDate)
+cDatePOSIXct <- as.POSIXct(tDate)
+cDatePOSIXlt <- as.POSIXlt(tDate)
+
+### }}}
+### {{{ --- getYear ---
+
+test.getYear <- function()
+{
+ checkException(getYear(x=num))
+ checkException(getYear(x=cha))
+ checkException(getYear(x=fac))
+
+ checkIdentical(getYear(x=cDate), tYear)
+ checkIdentical(getYear(x=cDatePOSIXct), tYear)
+ checkIdentical(getYear(x=cDatePOSIXlt), tYear)
+}
+
+### }}}
+### {{{ --- getMonth ---
+
+test.getMonth <- function()
+{
+ checkException(getMonth(x=num))
+ checkException(getMonth(x=cha))
+ checkException(getMonth(x=fac))
+
+ checkIdentical(getMonth(x=cDate), tMonth)
+ checkIdentical(getMonth(x=cDatePOSIXct), tMonth)
+ checkIdentical(getMonth(x=cDatePOSIXlt), tMonth)
+}
+
+### }}}
+### {{{ --- getDay ---
+
+test.getDay <- function()
+{
+ checkException(getDay(x=num))
+ checkException(getDay(x=cha))
+ checkException(getDay(x=fac))
+
+ checkIdentical(getDay(x=cDate), tDay)
+ checkIdentical(getDay(x=cDatePOSIXct), tDay)
+ checkIdentical(getDay(x=cDatePOSIXlt), tDay)
+}
+
+### }}}
+### {{{ --- getHour ---
+
+test.getHour <- function()
+{
+ checkException(getHour(x=num))
+ checkException(getHour(x=cha))
+ checkException(getHour(x=fac))
+
+## checkIdentical(getHour(x=cDate), tHour)
+}
+
+### }}}
+### {{{ --- getMin ---
+
+test.getMin <- function()
+{
+ checkException(getMin(x=num))
+ checkException(getMin(x=cha))
+ checkException(getMin(x=fac))
+
+## checkIdentical(getMin(x=cDate), tMin)
+}
+
+### }}}
+### {{{ --- getSec ---
+
+test.getSec <- function()
+{
+ checkException(getSec(x=num))
+ checkException(getSec(x=cha))
+ checkException(getSec(x=fac))
+
+## checkIdentical(getSec(x=cDate), tSec)
+}
+
+### }}}
+### {{{ Dear Emacs
+### Local variables:
+### folded-file: t
+### end:
+### }}}
+
+###------------------------------------------------------------------------
+### runit.getDateTimeParts.R ends here
Copied: trunk/gdata/inst/unitTests/runit.mapLevels.R (from rev 1782, trunk/gdata/tests/runit.mapLevels.R)
===================================================================
--- trunk/gdata/inst/unitTests/runit.mapLevels.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.mapLevels.R 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,281 @@
+### runit.mapLevels.R
+###------------------------------------------------------------------------
+### What: Unit tests for mapLevels et al.
+### $Id$
+### 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(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
Copied: trunk/gdata/inst/unitTests/runit.nPairs.R (from rev 1782, trunk/gdata/tests/runit.nPairs.R)
===================================================================
--- trunk/gdata/inst/unitTests/runit.nPairs.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.nPairs.R 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,68 @@
+### runit.nPairs.R
+###------------------------------------------------------------------------
+### What: Number of variable pairs - unit tests
+### $Id$
+### Time-stamp: <2008-12-30 18:24:59 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ --- Test setup ---
+
+if(FALSE) {
+ library("RUnit")
+ library("gdata")
+}
+
+### }}}
+### {{{ --- nPairs ---
+
+test.nPairs <- function()
+{
+ ## 'x' must be a data.frame or a matrix
+ x <- rpois(100, lambda=10)
+ checkException(nPairs(x=x))
+ checkException(nPairs(x=table(x)))
+
+ test <- data.frame(V1=c(1, 2, 3, 4, 5),
+ V2=c(NA, 2, 3, 4, 5),
+ V3=c(1, NA, NA, NA, NA),
+ V4=c(1, 2, 3, NA, NA))
+ testCheck <- matrix(data=as.integer(c(5, 4, 1, 3,
+ 4, 4, 0, 2,
+ 1, 0, 1, 1,
+ 3, 2, 1, 3)),
+ nrow=4, ncol=4, byrow=TRUE)
+ class(testCheck) <- c("nPairs", class(testCheck))
+
+ testCheckNames <- testCheck
+ colnames(testCheckNames) <- rownames(testCheckNames) <- colnames(test)
+
+ checkIdentical(nPairs(x=test), testCheckNames)
+ checkIdentical(nPairs(x=test, names=FALSE), testCheck)
+ checkIdentical(nPairs(x=as.matrix(test)), testCheckNames)
+ checkIdentical(nPairs(x=as.matrix(test), names=FALSE), testCheck)
+
+ testCheck <- cbind(testCheckNames, as.integer(c(5, 4, 0, 0)))
+ class(testCheck) <- class(testCheckNames)
+ colnames(testCheck) <- c(colnames(test), "all")
+ checkIdentical(nPairs(x=test, margin=TRUE), testCheck)
+
+ testCheckSumm <- matrix(data=as.integer(c(0, 1, 4, 2,
+ 0, 0, 4, 2,
+ 0, 1, 0, 0,
+ 0, 1, 2, 0)),
+ nrow=4, ncol=4, byrow=TRUE)
+ dimnames(testCheckSumm) <- dimnames(testCheckNames)
+ tmp <- summary(nPairs(x=test))
+ checkEquals(tmp, testCheckSumm)
+}
+
+
+### }}}
+### {{{ Dear Emacs
+### Local variables:
+### folded-file: t
+### end:
+### }}}
+
+###------------------------------------------------------------------------
+### runit.nPairs.R ends here
Copied: trunk/gdata/inst/unitTests/runit.reorder.factor.R (from rev 1782, trunk/gdata/tests/runit.reorder.factor.R)
===================================================================
--- trunk/gdata/inst/unitTests/runit.reorder.factor.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.reorder.factor.R 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,64 @@
+### runit.reorder.factor.R
+###------------------------------------------------------------------------
+### What: Tests for reorder.factor
+### $Id$
+### Time-stamp: <2006-10-30 18:25:05 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ --- Test setup ---
+
+if(FALSE) {
+ library("RUnit")
+ library("gdata")
+}
+
+### }}}
+### {{{ --- reorder.factor ---
+
+test.reorder.factor <- function()
+{
+ tmp <- Sys.getlocale(category="LC_COLLATE")
+ Sys.setlocale(category="LC_COLLATE", locale="C")
+
+ ## Create a 4 level example factor
+ levs <- c("PLACEBO", "300 MG", "600 MG", "1200 MG")
+ trt <- factor(rep(x=levs, times=c(22, 24, 28, 26)))
+
+ ## Change the order to something useful
+ ## default "mixedsort" ordering
+ trt2 <- reorder(trt)
+ levsTest <- c("300 MG", "600 MG", "1200 MG", "PLACEBO")
+ checkIdentical(levels(trt2), levsTest)
+
+ ## using indexes:
+ trt3 <- reorder(trt, new.order=c(4, 2, 3, 1))
+ levsTest <- c("PLACEBO", "300 MG", "600 MG", "1200 MG")
+ checkIdentical(levels(trt3), levsTest)
+
+ ## using label names:
+ trt4 <- reorder(trt, new.order=c("PLACEBO", "300 MG", "600 MG", "1200 MG"))
+ levsTest <- c("PLACEBO", "300 MG", "600 MG", "1200 MG")
+ checkIdentical(levels(trt4), levsTest)
+
+ ## using frequency
+ trt5 <- reorder(trt, X=as.numeric(trt), FUN=length)
+ levsTest <- c("PLACEBO", "300 MG", "1200 MG", "600 MG")
+ checkIdentical(levels(trt5), levsTest)
+
+ ## drop out the '300 MG' level
+ trt6 <- reorder(trt, new.order=c("PLACEBO", "600 MG", "1200 MG"))
+ levsTest <- c("PLACEBO", "600 MG", "1200 MG")
+ checkIdentical(levels(trt6), levsTest)
+
+ Sys.setlocale(category="LC_COLLATE", locale=tmp)
+}
+
+### }}}
+### {{{ Dear Emacs
+## Local variables:
+## folded-file: t
+## End:
+### }}}
+
+###------------------------------------------------------------------------
+### runit.reorder.factor.R ends here
Copied: trunk/gdata/inst/unitTests/runit.trim.R (from rev 1782, trunk/gdata/tests/runit.trim.R)
===================================================================
--- trunk/gdata/inst/unitTests/runit.trim.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.trim.R 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,55 @@
+### runit.trim.R
+###------------------------------------------------------------------------
+### What: Tests for trim
+### $Id$
+### Time-stamp: <2006-08-29 14:21:02 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ --- Test setup ---
+
+if(FALSE) {
+ library("RUnit")
+ library("gdata")
+}
+
+### }}}
+### {{{ --- trim ---
+
+test.trim <- function()
+{
+ tmp <- Sys.getlocale(category="LC_COLLATE")
+ Sys.setlocale(category="LC_COLLATE", locale="C")
+
+ sTrim <- " this is an example string "
+ sTrimR <- "this is an example string"
+
+ 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)
+
+ dfTrim <- as.data.frame(lTrim)
+ dfTrimR <- as.data.frame(lTrimR)
+
+ 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)
+
+ Sys.setlocale(category="LC_COLLATE", locale=tmp)
+}
+
+### }}}
+### {{{ Dear Emacs
+## Local variables:
+## folded-file: t
+## End:
+### }}}
+
+###------------------------------------------------------------------------
+### runit.trim.R ends here
Copied: trunk/gdata/inst/unitTests/runit.trimSum.R (from rev 1782, trunk/gdata/tests/runit.trimSum.R)
===================================================================
--- trunk/gdata/inst/unitTests/runit.trimSum.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.trimSum.R 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,61 @@
+### runit.trimSum.R
+###------------------------------------------------------------------------
+### What: Unit tests for trimSum
+### $Id$
+### Time-stamp: <2008-12-20 11:58:50 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ --- Test setup ---
+
+if(FALSE) {
+ library("RUnit")
+ library("gdata")
+}
+
+### }}}
+### {{{ --- trimSum ---
+
+test.trimSum <- function()
+{
+
+ ## 'x' must be a vector - for now
+ checkException(trimSum(matrix(1:10)))
+ checkException(trimSum(data.frame(1:10)))
+ checkException(trimSum(list(1:10)))
+
+ ## 'x' must be numeric
+ checkException(trimSum(letters))
+
+ ## 'n' must be smaller than the length of x
+ checkException(trimSum(x=1:10, n=11))
+ checkException(trimSum(x=1, n=1))
+
+ ## Default
+ x <- trimSum(x=1:10, n=5)
+ x2 <- c(1:4, 45)
+ checkEquals(x, x2)
+
+ ## Left
+ x <- trimSum(x=1:10, n=5, right=FALSE)
+ x2 <- c(21, 7:10)
+ checkEquals(x, x2)
+
+ ## NA
+ x <- trimSum(x=c(1:9, NA), n=5)
+ x2 <- c(1:4, NA)
+ checkEquals(x, x2)
+
+ x <- trimSum(x=c(1:9, NA), n=5, na.rm=TRUE)
+ x2 <- c(1:4, 35)
+ checkEquals(x, x2)
+}
+
+### }}}
+### {{{ Dear Emacs
+## Local variables:
+## folded-file: t
+## End:
+### }}}
+
+###------------------------------------------------------------------------
+### runit.trimSum.R ends here
Copied: trunk/gdata/inst/unitTests/runit.unknown.R (from rev 1783, trunk/gdata/tests/runit.unknown.R)
===================================================================
--- trunk/gdata/inst/unitTests/runit.unknown.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.unknown.R 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,531 @@
+### runit.unknown.R
+###------------------------------------------------------------------------
+### What: Tests for Change given unknown value to NA and vice versa methods
+### $Id$
+### Time-stamp: <2006-10-30 17:46:21 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ --- Test setup ---
+
+library("RUnit")
+library("gdata")
+
+
+### {{{ --- Vectors ---
+
+intUnk <- 9999
+xInt <- as.integer(c(NA, 1:2, NA, 5, 6, 7, 8, 9))
+xIntUnk <- as.integer(c(intUnk, 1:2, intUnk, 5, 6, 7, 8, 9))
+xIntUnkTest <- xIntUnk %in% intUnk
+
+numUnk <- 0
+xNum <- c(9999, NA, 1.5, NA, 5, 6, 7, 8, 9)
+xNumUnk <- c(9999, 0, 1.5, 0, 5, 6, 7, 8, 9)
+xNumUnkTest <- xNumUnk %in% numUnk
+
+chaUnk <- "notAvail"
+chaUnk1 <- "-"
+xCha <- c("A", "B", NA, "C", NA, "-", "7", "8", "9")
+xChaUnk <- c("A", "B", chaUnk, "C", chaUnk, "-", "7", "8", "9")
+xChaUnk1 <- c("A", "B", chaUnk1, "C", chaUnk1, "-", "7", "8", "9")
+xChaUnkTest <- xChaUnk %in% chaUnk
+xChaUnk1Test <- xChaUnk %in% chaUnk1
+
+facUnk <- "notAvail"
+facUnk1 <- "NA"
+xFac <- factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", NA))
+xFacUnk <- factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", facUnk))
+xFacUnk1 <- factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", facUnk1))
+xFacUnkTest <- c(0, 0, 0, 0, 0, 0, 0, 0, 1)
+xFacUnkTest <- as.logical(xFacUnkTest)
+xFacUnk1Test <- c(0, 0, 0, 1, 1, 0, 0, 0, 1)
+xFacUnk1Test <- as.logical(xFacUnk1Test)
+xFac1 <- factor(c("A", "0", 0, NA, NA, intUnk, numUnk, "-", NA))
+
+facLev <- "A"
+xFacUnkLev <- factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", "A"))
+xFacUnkLevTest <- c(1, 0, 0, 0, 0, 0, 0, 0, 1)
+xFacUnkLevTest <- as.logical(xFacUnkLevTest)
+
+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(tmp, dateUnk, NA)
+xDate1Test <- c(FALSE, TRUE, FALSE)
+
+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(tmp, POSIXltUnk, NA)
+xPOSIXlt1Test <- c(FALSE, TRUE, FALSE)
+
+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(tmp, POSIXctUnk, NA)
+xPOSIXct1Test <- xPOSIXlt1Test
+
+### }}}
+### {{{ --- Lists and data.frames ---
+
+xList <- list(xInt, xCha, xNum, xFac)
+xListN <- list(int=xInt, cha=xCha, num=xNum, fac=xFac)
+xListUnk <- list(xIntUnk, xChaUnk, xNumUnk, xFacUnk)
+xListUnkTest <- list(xIntUnkTest, xChaUnkTest, xNumUnkTest, xFacUnkTest)
+xListNUnk <- list(int=xIntUnk, cha=xChaUnk, num=xNumUnk, fac=xFacUnk)
+xListNUnkTest <- list(int=xIntUnkTest, cha=xChaUnkTest, num=xNumUnkTest, fac=xFacUnkTest)
+
+xDF <- as.data.frame(xListN)
+xDF$cha <- as.character(xDF$cha)
+xDFUnk <- as.data.frame(xListNUnk)
+xDFUnk$cha <- as.character(xDFUnk$cha)
+xDFUnkTest <- as.data.frame(xListNUnkTest)
+
+unkC <- c(intUnk, chaUnk, numUnk, facUnk)
+unkL <- list(intUnk, chaUnk, numUnk, facUnk)
+unkLN <- list(num=numUnk, cha=chaUnk, fac=facUnk, int=intUnk) ## mixed as it is named
+unkLMN <- list(cha=chaUnk, int=intUnk, num=c(intUnk, numUnk),
+ fac=c(chaUnk1, facUnk))
+
+xListMNUnkF <- list(int=as.integer(c(9999, 1, 2, 9999, 5, 6, 7, 8, 9)),
+ cha=c("A", "B", "notAvail", "C", "notAvail", "-", "7", "8", "9"),
+ num=c(9999, 0, 1.5, 0, 5, 6, 7, 8, 9),
+ fac=factor(c("A", "0", "0", "NA", "NA", 9999, "0", "-", "notAvail")))
+xListMNUnkFTest <- list(int=c(1, 0, 0, 1, 0, 0, 0, 0, 0),
+ cha=c(0, 0, 1, 0, 1, 0, 0, 0, 0),
+ num=c(1, 1, 0, 1, 0, 0, 0, 0, 0),
+ fac=c(0, 0, 0, 0, 0, 0, 0, 1, 1))
+xListMNUnkFTest <- lapply(xListMNUnkFTest, as.logical)
+xListMNF <- list(int=as.integer(c(NA, 1, 2, NA, 5, 6, 7, 8, 9)),
+ cha=c("A", "B", NA, "C", NA, "-", "7", "8", "9"),
+ num=c(NA, NA, 1.5, NA, 5, 6, 7, 8, 9),
+ fac=factor(c("A", "0", "0", "NA", "NA", "9999", "0", NA, NA)))
+
+xDFMUnkF <- as.data.frame(xListMNUnkF)
+xDFMUnkF$cha <- as.character(xDFMUnkF$cha)
+xDFMUnkFTest <- as.data.frame(xListMNUnkFTest)
+xDFMF <- as.data.frame(xListMNF)
+xDFMF$cha <- as.character(xDFMF$cha)
+
+unk1 <- 555555
+xListUnk1 <- list(as.integer(c(unk1, 1, 2, unk1, 5, 6, 7, 8, 9)),
+ c("A", "B", unk1, "C", unk1, "-", "7", "8", "9"),
+ c(9999, unk1, 1.5, unk1, 5, 6, 7, 8, 9),
+ factor(c("A", "0", "0", "NA", "NA", "9999", "0", "-", unk1)))
+xListUnk1Test <- lapply(xListUnk1, function(x) x %in% unk1)
+xListNUnk1 <- xListUnk1
+names(xListNUnk1) <- c("int", "cha", "num", "fac")
+xDFUnk1 <- as.data.frame(xListNUnk1)
+xDFUnk1$cha <- as.character(xDFUnk1$cha)
+xDFUnk1Test <- as.data.frame(xListUnk1Test)
+names(xDFUnk1Test) <- names(xListNUnk1)
+
+unkC2 <- c(0, "notAvail")
+xListUnk2 <- list(as.integer(c(unkC2[1], 1, 2, unkC2[1], 5, 6, 7, 8, 9)),
+ c("A", "B", unkC2[2], "C", unkC2[2], "-", "7", "8", "9"),
+ c(9999, as.numeric(unkC2[1]), 1.5, as.numeric(unkC2[1]), 5, 6, 7, 8, 9),
+ factor(c("A", "0", "0", "NA", "NA", "9999", "0", "-", unkC2[2])))
+xListNUnk2 <- xListUnk2
+names(xListNUnk2) <- c("int", "cha", "num", "fac")
+xDFUnk2 <- as.data.frame(xListNUnk2)
+xDFUnk2$cha <- as.character(xDFUnk2$cha)
+
+xListUnk2Test <- xListUnk2
+xListUnk2Test[[1]] <- xListUnk2Test[[1]] %in% unkC2[1]
+xListUnk2Test[[2]] <- xListUnk2Test[[2]] %in% unkC2[2]
+xListUnk2Test[[3]] <- xListUnk2Test[[3]] %in% unkC2[1]
+xListUnk2Test[[4]] <- xListUnk2Test[[4]] %in% unkC2[2]
+xListNUnk2Test <- xListUnk2Test
+names(xListNUnk2Test) <- names(xListNUnk2)
+xDFUnk2Test <- as.data.frame(xListNUnk2Test)
+
+unkL2 <- as.list(unkC2)
+unkLN2 <- unkL2[c(2, 1)]
+names(unkLN2) <- c("cha", "int")
+xListUnk2a <- list(as.integer(c(NA, 1, 2, NA, 5, 6, 7, 8, 9)),
+ c("A", "B", unkLN2[[2]], "C", unkLN2[[2]], "-", "7", "8", "9"),
+ c(9999, NA, 1.5, NA, 5, 6, 7, 8, 9),
+ factor(c("A", "0", "0", "NA", "NA", "9999", "0", "-", unkLN2[[2]])))
+xListUnk2aTest <- xListUnk2a
+xListUnk2aTest[[1]] <- xListUnk2aTest[[1]] %in% unkLN2[1]
+xListUnk2aTest[[2]] <- xListUnk2aTest[[2]] %in% unkLN2[2]
+xListUnk2aTest[[3]] <- xListUnk2aTest[[3]] %in% unkLN2[1]
+xListUnk2aTest[[4]] <- xListUnk2aTest[[4]] %in% unkLN2[2]
+
+xList2a <- list(xListUnk2a[[1]],
+ c("A", "B", NA, "C", NA, "-", "7", "8", "9"),
+ xListUnk2a[[3]],
+ 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"
+unkLND1 <- list(.default=D1)
+xListUnkD1 <- list(as.integer(c(NA, 1:2, NA, 5, 6, 7, 8, 9)),
+ c("A", "B", D1, "C", D1, "-", "7", "8", "9"),
+ c(9999, NA, 1.5, NA, 5, 6, 7, 8, 9),
+ factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", D1)))
+xListUnkD1Test <- lapply(xListUnkD1, function(x) x %in% D1)
+xListD1 <- xList
+
+xListNUnkD1 <- xListUnkD1
+xListNUnkD1Test <- xListUnkD1Test
+names(xListNUnkD1) <- names(xListNUnkD1Test) <- names(xListNUnk1)
+xListND1 <- xListN
+
+DSO2 <- c("notAvail", 5678)
+unkLNDSO2 <- as.list(DSO2)
+names(unkLNDSO2) <- c(".default", "someOther")
+xListUnkDSO2 <- list(as.integer(c(NA, 1:2, NA, 5, 6, 7, 8, 9)),
+ c("A", "B", DSO2[1], "C", DSO2[1], "-", "7", "8", "9"),
+ c(9999, NA, 1.5, NA, 5, 6, 7, 8, 9),
+ factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", DSO2[2])))
+xListUnkDSO2Test <- lapply(xListUnkDSO2, function(x) x %in% DSO2)
+
+unkLND3 <- list(.default="notAvail", num=0, int=9999)
+xListNUnkD3 <- list(int=as.integer(c(unkLND3[[3]], 1:2, unkLND3[[3]], 5, 6, 7, 8, 9)),
+ cha=c("A", "B", unkLND3[[1]], "C", unkLND3[[1]], "-", "7", "8", "9"),
+ num=c(9999, unkLND3[[2]], 1.5, unkLND3[[2]], 5, 6, 7, 8, 9),
+ fac=factor(c("A", "0", 0, "NA", "NA", intUnk, numUnk, "-", unkLND3[[1]])))
+xListNUnkD3Test <- xListNUnkD3
+xListNUnkD3Test$int <- xListNUnkD3Test$int %in% unkLND3[[3]]
+xListNUnkD3Test$cha <- xListNUnkD3Test$cha %in% unkLND3[[1]]
+xListNUnkD3Test$num <- xListNUnkD3Test$num %in% unkLND3[[2]]
+xListNUnkD3Test$fac <- xListNUnkD3Test$fac %in% unkLND3[[1]]
+
+unkLND2E <- list(.default="notAvail", 9999)
+
+### }}}
+
+### }}}
+### {{{ --- isUnknown ---
+
+test.isUnknown <- function()
+{
+ ## --- base methods for vectors ---
+
+ ## base ...
+ checkIdentical(isUnknown(xIntUnk, unknown=as.integer(intUnk)), xIntUnkTest)
+ checkIdentical(isUnknown(xIntUnk, unknown=intUnk), xIntUnkTest)
+ checkIdentical(isUnknown(xNumUnk, unknown=numUnk), xNumUnkTest)
+ checkIdentical(isUnknown(xNumUnk, unknown=as.integer(numUnk)), xNumUnkTest)
+ checkIdentical(isUnknown(xChaUnk, unknown=chaUnk), xChaUnkTest)
+ checkIdentical(isUnknown(xFacUnk, unknown=facUnk), xFacUnkTest)
+
+ ## multiple values are allowed for vector methods in vector or list form
+ checkIdentical(isUnknown(xIntUnk, unknown=unkC), xIntUnkTest)
+ checkIdentical(isUnknown(xIntUnk, unknown=unkL), xIntUnkTest)
+
+ ## NA's in factors
+ checkIdentical(isUnknown(xFacUnk1, unknown=facUnk1), xFacUnk1Test)
+ facNA <- factor(c("0", 1, 2, 3, NA, "NA"))
+ facNATest <- c(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE)
+ checkIdentical(isUnknown(facNA), facNATest)
+
+ ## Date-time classes
+ checkIdentical(isUnknown(xDateUnk, unknown=dateUnk), xDateTest)
+ checkIdentical(isUnknown(xDate1Unk, unknown=dateUnk), xDate1Test)
+ checkIdentical(isUnknown(xPOSIXltUnk, unknown=POSIXltUnk), xPOSIXltTest)
+ checkIdentical(isUnknown(xPOSIXlt1Unk, unknown=POSIXltUnk), xPOSIXlt1Test)
+ checkIdentical(isUnknown(xPOSIXctUnk, unknown=POSIXctUnk), xPOSIXctTest)
+ checkIdentical(isUnknown(xPOSIXct1Unk, unknown=POSIXctUnk), xPOSIXct1Test)
+
+ ## --- lists and data.frames ---
+
+ ## with vector of single unknown values
+ checkIdentical(isUnknown(xListUnk, unknown=unkC), xListUnkTest)
+ checkIdentical(isUnknown(xDFUnk, unknown=unkC), xDFUnkTest)
+
+ ## with list of single unknown values
+ checkIdentical(isUnknown(xListUnk, unknown=unkL), xListUnkTest)
+ checkIdentical(isUnknown(xDFUnk, unknown=unkL), xDFUnkTest)
+
+ ## with named list of single unknown values
+ checkIdentical(isUnknown(xListNUnk, unknown=unkLN), xListNUnkTest)
+ checkIdentical(isUnknown(xDFUnk, unknown=unkLN), xDFUnkTest)
+
+ ## with named list of multiple unknown values - valid here
+ checkIdentical(isUnknown(xListMNUnkF, unknown=unkLMN), xListMNUnkFTest)
+ checkIdentical(isUnknown(xDFMUnkF, unknown=unkLMN), xDFMUnkFTest)
+
+ ## with single unknown value - recycling
+ checkIdentical(isUnknown(xListUnk1, unknown=unk1), xListUnk1Test)
+ checkIdentical(isUnknown(xDFUnk1, unknown=unk1), xDFUnk1Test)
+
+ ## with vector of two unknown values - recycling
+ checkIdentical(isUnknown(xListUnk2, unknown=unkC2), xListUnk2Test)
+ checkIdentical(isUnknown(xDFUnk2, unknown=unkC2), xDFUnk2Test)
+
+ ## with list of two unknown values - recycling
+ checkIdentical(isUnknown(xListUnk2, unknown=unkL2), xListUnk2Test)
+ checkIdentical(isUnknown(xDFUnk2, unknown=unkL2), xDFUnk2Test)
+
+ ## list(.default=)
+ checkIdentical(isUnknown(x=xListUnkD1, unknown=unkLND1), xListUnkD1Test)
+ ## list(.default=, someOther=) we do not know someOther, but should work
+ ## as x is not named
+ checkIdentical(isUnknown(x=xListUnkDSO2, unknown=unkLNDSO2), xListUnkDSO2Test)
+ ## list(.default=) in named list
+ checkIdentical(isUnknown(x=xListNUnkD1, unknown=unkLND1), xListNUnkD1Test)
+ ## list(.default=, someOther=) OK if someOther is in the named list
+ checkIdentical(isUnknown(x=xListNUnkD3, unknown=unkLND3), xListNUnkD3Test)
+ ## 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)
+}
+
+### }}}
+### {{{ --- unknownToNA ---
+
+test.unknownToNA <- function()
+{
+ ## --- base methods for vectors ---
+
+ ## base ...
+ checkIdentical(unknownToNA(xIntUnk, as.integer(intUnk)), xInt)
+ checkIdentical(unknownToNA(xIntUnk, intUnk), xInt) ## with numeric
+ checkIdentical(unknownToNA(xNumUnk, numUnk), xNum)
+ checkIdentical(unknownToNA(xNumUnk, as.integer(numUnk)), xNum)
+ checkIdentical(unknownToNA(xChaUnk, chaUnk), xCha)
+ checkIdentical(unknownToNA(xChaUnk, chaUnk), xCha)
+ checkIdentical(unknownToNA(xFacUnk, facUnk), xFac)
+
+ ## multiple values are allowed for vector methods in vector or list form
+ checkIdentical(unknownToNA(xIntUnk, unknown=unkC), xInt)
+ checkIdentical(unknownToNA(xIntUnk, unknown=unkL), xInt)
+
+ ## NA's in factors
+ checkIdentical(unknownToNA(xFacUnk1, unknown=facUnk1), xFac1)
+ facNA <- factor(c("0", 1, 2, 3, NA, "NA"))
+ facNATest <- factor(c("0", 1, 2, 3, NA, NA))
+ checkIdentical(unknownToNA(x=facNA, unknown="NA"), facNATest)
+
+ ## Date-time classes
+ checkIdentical(unknownToNA(xDateUnk, unknown=dateUnk), xDate)
+ checkIdentical(unknownToNA(xPOSIXctUnk, unknown=POSIXctUnk), xPOSIXct)
+
+ ## Per Brian Ripley on 2014-01-15:
+ ##
+ ## On platforms where POSIXlt has a gmtoff component, it does not need to be set. So
+ ##
+ ## > z$gmtoff
+ ## [1] 3600 NA
+ ## > xPOSIXltUnk$gmtoff
+ ## [1] 3600 3600
+ ##
+ ## (or sometimes 0, not NA).
+ ##
+ ## So although identical() correctly reports that they differ, this
+ ## is allowed for optional components.
+ ##
+ ## It would also be wrong to use identical() to compare isdst
+ ## components: isdst = -1 means unknown.
+ ##
+ tmp_unknownToNA <- unknownToNA(xPOSIXltUnk, unknown=POSIXltUnk)
+ tmp_xPOSIXlt <- xPOSIXlt
+
+ tmp_unknownToNA$gmtoff <- NULL # Remove $gmtoff to avoid comparison
+ tmp_xPOSIXlt$gmtoff <- NULL
+
+ tmp_unknownToNA$isdst <- NULL # Remove $isdst to avoid comparison
+ tmp_xPOSIXlt$isdst <- NULL
+
+ checkIdentical(tmp_unknownToNA, tmp_xPOSIXlt)
+
+
+ ## --- lists and data.frames ---
+
+ ## with vector of single unknown values
+ checkIdentical(unknownToNA(xListUnk, unknown=unkC), xList)
+ checkIdentical(unknownToNA(xDFUnk, unknown=unkC), xDF)
+
+ ## with list of single unknown values
+ checkIdentical(unknownToNA(xListUnk, unknown=unkL), xList)
+ checkIdentical(unknownToNA(xDFUnk, unknown=unkL), xDF)
+
+ ## with named list of single unknown values
+ checkIdentical(unknownToNA(xListNUnk, unknown=unkLN), xListN)
+ checkIdentical(unknownToNA(xDFUnk, unknown=unkLN), xDF)
+
+ ## with names list of multiple unknown values - must be an error
+ checkIdentical(unknownToNA(xListMNUnkF, unknown=unkLMN), xListMNF)
+ checkIdentical(unknownToNA(xDFMUnkF, unknown=unkLMN), xDFMF)
+
+ ## with single unknown value - recycling
+ checkIdentical(unknownToNA(xListUnk1, unknown=unk1), xList)
+ checkIdentical(unknownToNA(xDFUnk1, unknown=unk1), xDF)
+
+ ## with vector of two unknown values - recycling
+ checkIdentical(unknownToNA(xListUnk2, unknown=unkC2), xList)
+ checkIdentical(unknownToNA(xDFUnk2, unknown=unkC2), xDF)
+
+ ## with list of two unknown values - recycling
+ checkIdentical(unknownToNA(xListUnk2, unknown=unkL2), xList)
+ checkIdentical(unknownToNA(xDFUnk2, unknown=unkL2), xDF)
+
+ ## with named list of two unknown values but x is not named so named list
+ ## does not have any effect --> error as we do not know how to recycle
+ checkException(unknownToNA(xListUnk2a, unknown=unkLN2))
+
+ ## but we should get some results with named x
+ checkIdentical(unknownToNA(xListNUnk2, unknown=unkL2), xListN)
+ ## not also necesarilly with recycling of names lists, as it is
+ ## not clear how to properly recycle named lists (only names that match
+ ## can be really properly recycled)
+ checkException(unknownToNA(xListNUnk2, unknown=unkLN2))
+ checkIdentical(unknownToNA(xDFUnk2, unknown=unkL2), xDF)
+ checkException(unknownToNA(xDFUnk2, unknown=unkLN2))
+
+ ## list(.default=)
+ checkIdentical(unknownToNA(x=xListUnkD1, unknown=unkLND1), xListD1)
+ ## list(.default=, someOther=) we do not know someOther, but should work
+ ## as x is not named
+ checkIdentical(unknownToNA(x=xListUnkDSO2, unknown=unkLNDSO2), xList)
+ ## list(.default=) in named list
+ checkIdentical(unknownToNA(x=xListNUnkD1, unknown=unkLND1), xListND1)
+ ## list(.default=, someOther=) OK if someOther is in the named list
+ 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)
+}
+
+### }}}
+### {{{ --- NAToUnknown ---
+
+test.NAToUnknown <- function()
+{
+ ## --- base methods for vectors ---
+
+ ## base ...
+ checkIdentical(NAToUnknown(xInt, as.integer(intUnk)), xIntUnk)
+ checkIdentical(NAToUnknown(xInt, intUnk), xIntUnk) ## with numeric
+ checkIdentical(NAToUnknown(xNum, numUnk), xNumUnk)
+ checkIdentical(NAToUnknown(xNum, as.integer(numUnk)), xNumUnk)
+ checkIdentical(NAToUnknown(xCha, chaUnk), xChaUnk)
+ checkIdentical(NAToUnknown(xCha, chaUnk), xChaUnk)
+ checkIdentical(NAToUnknown(xFac, facUnk), xFacUnk)
+
+ ## only single values are allowed for vector methods
+ checkException(NAToUnknown(xInt, unknown=unkC))
+ checkException(NAToUnknown(xInt, unknown=unkL))
+
+ ## and they should not already be in x unless force=TRUE
+ checkException(NAToUnknown(xCha, unknown=chaUnk1))
+ checkIdentical(NAToUnknown(xCha, unknown=chaUnk1, force=TRUE), xChaUnk1)
+
+ checkException(NAToUnknown(xFac, unknown=facLev))
+ checkIdentical(NAToUnknown(xFac, unknown=facLev, force=TRUE), xFacUnkLev)
+
+ ## NA's in factors
+ checkIdentical(NAToUnknown(xFac, unknown=facUnk1, force=TRUE), xFacUnk1)
+ facNA <- factor(c("0", 1, 2, 3, NA, NA))
+ facNATest <- factor(c("0", 1, 2, 3, "NA", "NA"))
+ checkIdentical(NAToUnknown(x=facNA, unknown="NA"), facNATest)
+
+ ## Date-time classes
+ checkIdentical(NAToUnknown(xDate, unknown=dateUnk), xDateUnk)
+ checkIdentical(NAToUnknown(xPOSIXlt, unknown=POSIXltUnk), xPOSIXltUnk)
+ checkIdentical(NAToUnknown(xPOSIXct, unknown=POSIXctUnk), xPOSIXctUnk)
+
+ ## --- lists and data.frames ---
+
+ ## with vector of single unknown values
+ checkIdentical(NAToUnknown(xList, unknown=unkC), xListUnk)
+ checkIdentical(NAToUnknown(xDF, unknown=unkC), xDFUnk)
+
+ ## with list of single unknown values
+ checkIdentical(NAToUnknown(xList, unknown=unkL), xListUnk)
+ checkIdentical(NAToUnknown(xDF, unknown=unkL), xDFUnk)
+
+ ## with named list of single unknown values
+ checkIdentical(NAToUnknown(xListN, unknown=unkLN), xListNUnk)
+ checkIdentical(NAToUnknown(xDF, unknown=unkLN), xDFUnk)
+
+ ## with names list of multiple unknown values - must be an error
+ checkException(NAToUnknown(xListN, unknown=unkLMN))
+ checkException(NAToUnknown(xDF, unknown=unkLMN))
+
+ ## with single unknown value - recycling
+ checkIdentical(NAToUnknown(xList, unknown=unk1), xListUnk1)
+ checkIdentical(NAToUnknown(xDF, unknown=unk1), xDFUnk1)
+
+ ## with vector of two unknown values - recycling
+ checkIdentical(NAToUnknown(xList, unknown=unkC2), xListUnk2)
+ checkIdentical(NAToUnknown(xDF, unknown=unkC2), xDFUnk2)
+
+ ## with list of two unknown values - recycling
+ checkIdentical(NAToUnknown(xList, unknown=unkL2), xListUnk2)
+ checkIdentical(NAToUnknown(xDF, unknown=unkL2), xDFUnk2)
+
+ ## with named list of two unknown values but x is not named so named list
+ ## does not have any effect --> error as we do not know how to recycle
+ checkException(NAToUnknown(xList, unknown=unkLN2))
+
+ ## but we should get some results with named x
+ checkIdentical(NAToUnknown(xListN, unknown=unkL2), xListNUnk2)
+ ## not also necesarilly with recycling of names lists, as it is
+ ## not clear how to properly recycle named lists (only names that match
+ ## can be really properly recycled)
+ checkException(NAToUnknown(xListN, unknown=unkLN2))
+ checkIdentical(NAToUnknown(xDF, unknown=unkL2), xDFUnk2)
+ checkException(NAToUnknown(xDF, unknown=unkLN2))
+
+ ## list(.default=)
+ checkIdentical(NAToUnknown(x=xList, unknown=unkLND1), xListUnkD1)
+ ## list(.default=, someOther=) we do not know someOther, but should work
+ ## as x is not named
+ checkIdentical(NAToUnknown(x=xList, unknown=unkLNDSO2), xListUnkDSO2)
+ ## list(.default=) in named list
+ checkIdentical(NAToUnknown(x=xListN, unknown=unkLND1), xListNUnkD1)
+ ## list(.default=, someOther=) OK if someOther is in the named list
+ checkIdentical(NAToUnknown(x=xListN, unknown=unkLND3), xListNUnkD3)
+ ## 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)
+}
+
+### }}}
+### {{{ Dear Emacs
+### Local variables:
+### folded-file: t
+### End:
+### }}}
+
+###------------------------------------------------------------------------
+### runit.unknown.R ends here
Copied: trunk/gdata/inst/unitTests/runit.wideByFactor.R (from rev 1782, trunk/gdata/tests/runit.wideByFactor.R)
===================================================================
--- trunk/gdata/inst/unitTests/runit.wideByFactor.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.wideByFactor.R 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,55 @@
+### runit.wideByFactor.R
+###------------------------------------------------------------------------
+### What: Reshape by factor levels - unit tests
+### $Id$
+### Time-stamp: <2008-12-30 11:58:50 ggorjan>
+###------------------------------------------------------------------------
+
+### {{{ --- Test setup ---
+
+if(FALSE) {
+ library("RUnit")
+ library("gdata")
+}
+
+### }}}
+### {{{ --- wideByFactor ---
+
+test.wideByFactor <- function()
+{
+ n <- 10
+ f <- 2
+ tmp <- data.frame(y1=(1:n)/2,
+ y2=(n:1)*2,
+ f1=factor(rep(letters[1:f], n/2)),
+ f2=factor(c(rep(c("M"), n/2), rep(c("F"), n/2))),
+ c1=1:n,
+ c2=2*(1:n))
+
+ ## 'x' must be a data.frame
+ checkException(wideByFactor(x=1:10))
+ checkException(wideByFactor(x=matrix(1:10)))
+ ## 'factor' can be only of length one
+ checkException(wideByFactor(x=tmp, factor=c("f1", "f2")))
+ ## column defined in 'factor' must be a factor
+ checkException(wideByFactor(x=tmp, factor="c1"))
+
+ tmp2 <- wideByFactor(x=tmp, factor="f1", common=c("c1", "c2"), sort=FALSE)
+ checkEquals(tmp2[c("c1", "c2")], tmp[c("c1", "c2")])
+ checkEquals(names(tmp2), c("c1", "c2", "f1", "y1.a", "y2.a", "f2.a", "y1.b", "y2.b", "f2.b"))
+ checkEquals(tmp2$y1.a, c(0.5, NA, 1.5, NA, 2.5, NA, 3.5, NA, 4.5, NA))
+ checkEquals(tmp2$f2.a, factor(c("M", NA, "M", NA, "M", NA, "F", NA, "F", NA)))
+ tmp2 <- wideByFactor(x=tmp, factor="f1", common=c("c1", "c2"), sort=TRUE, keepFactor=FALSE)
+ checkEquals(tmp2$f2.a, factor(c("M", "M", "M", "F", "F", NA, NA, NA, NA, NA)))
+ checkEquals(names(tmp2), c("c1", "c2", "y1.a", "y2.a", "f2.a", "y1.b", "y2.b", "f2.b"))
+}
+
+### }}}
+### {{{ Dear Emacs
+## Local variables:
+## folded-file: t
+## End:
+### }}}
+
+###------------------------------------------------------------------------
+### runit.wideByFactor.R ends here
Copied: trunk/gdata/inst/unitTests/runit.write.fwf.R (from rev 1782, trunk/gdata/tests/runit.write.fwf.R)
===================================================================
--- trunk/gdata/inst/unitTests/runit.write.fwf.R (rev 0)
+++ trunk/gdata/inst/unitTests/runit.write.fwf.R 2014-04-05 02:23:45 UTC (rev 1784)
@@ -0,0 +1,137 @@
+### runit.write.fwf.R
+###------------------------------------------------------------------------
+### What: Unit tests for write.fwf
+### $Id$
+### Time-stamp: <2008-08-05 11:58:50 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)))
+
+ ## only single value is allowed in 'na'
+ checkException(write.fwf(data.frame(1:10, letters[1:10]), na=c("", " ")))
+
+ ## Example dataset
+ num <- round(c(733070.345678, 1214213.78765456, 553823.798765678,
+ 1085022.8876545678, 571063.88765456, 606718.3876545678,
+ 1053686.6, 971024.187656, 631193.398765456, 879431.1),
+ digits=3)
+
+ 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(4:9)),
+ fac1=factor(c(NA, letters[1:9], "hjh")),
+ fac2=factor(c(letters[6:15], NA)),
+ cha1=c(letters[17:26], NA),
+ cha2=c(NA, "longer", letters[25: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 ---
+ ## is tested with 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)
+
+ ## scientific notation
+ dd <- options("digits"); options(digits = 7)
+ testData2 <- data.frame(a=123, b=pi, c=1e8, d=1e222)
+ formatInfo <- write.fwf(x=testData2, formatInfo=TRUE)
+ checkEquals(formatInfo$width, c(3, 8, 5, 6))
+ checkEquals(formatInfo$digits, c(0, 6, 0, 0))
+ checkEquals(formatInfo$exp, c(0, 0, 2, 3))
+ options(dd) ## reset old options
+
+ ## 'na' can either decrease or increase the width
+ ## --> values of int1 have width 1 and using na="" should not increase
+ ## the width
+ formatInfo <- write.fwf(testData[, "int1", drop=FALSE], formatInfo=TRUE,
+ na="")
+ checkEquals(formatInfo$width, 1)
+ ## --> values of int1 have width 1 and using na="1234" should increase
+ ## the width to 4
+ formatInfo <- write.fwf(testData...
[truncated message content] |
|
From: <wa...@us...> - 2014-04-05 02:25:57
|
Revision: 1786
http://sourceforge.net/p/r-gregmisc/code/1786
Author: warnes
Date: 2014-04-05 02:25:54 +0000 (Sat, 05 Apr 2014)
Log Message:
-----------
Update NEWS for gdata 2.13.4
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/inst/NEWS
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2014-04-05 02:25:02 UTC (rev 1785)
+++ trunk/gdata/DESCRIPTION 2014-04-05 02:25:54 UTC (rev 1786)
@@ -4,11 +4,12 @@
Depends: R (>= 2.13.0)
SystemRequirements: perl
Imports: gtools
-Version: 2.13.2
-Date: 2013-06-28
+Version: 2.13.3
+Date: 2014-04-04
Author: Gregory R. Warnes, Ben Bolker, Gregor Gorjanc, Gabor
Grothendieck, Ales Korosec, Thomas Lumley, Don MacQueen, Arni
Magnusson, Jim Rogers, and others
Maintainer: Gregory R. Warnes <gr...@wa...>
License: GPL-2
NeedsCompilation: no
+Depends: RUnit
Modified: trunk/gdata/inst/NEWS
===================================================================
--- trunk/gdata/inst/NEWS 2014-04-05 02:25:02 UTC (rev 1785)
+++ trunk/gdata/inst/NEWS 2014-04-05 02:25:54 UTC (rev 1786)
@@ -1,3 +1,16 @@
+Changes in 2.13.3 (2014-04-04)
+------------------------------
+
+Bug Fixes
+
+- Unit tests were incorrectly checking for equality of optional POSIXlt
+ components. (Bug reported by Brian Ripley).
+
+Other Changes
+
+- Unit tests now follow R standard practice
+
+
Changes in 2.13.2 (2013-06-28)
------------------------------
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2014-04-05 12:53:41
|
Revision: 1787
http://sourceforge.net/p/r-gregmisc/code/1787
Author: warnes
Date: 2014-04-05 12:53:38 +0000 (Sat, 05 Apr 2014)
Log Message:
-----------
Complete changes so that the unit tests are run as part of R CMD check
Modified Paths:
--------------
trunk/gdata/DESCRIPTION
trunk/gdata/man/gdata-package.Rd
trunk/gdata/tests/runRUnitTests.R
Added Paths:
-----------
trunk/gdata/tests/unitTests/
Removed Paths:
-------------
trunk/gdata/inst/unitTests/
Modified: trunk/gdata/DESCRIPTION
===================================================================
--- trunk/gdata/DESCRIPTION 2014-04-05 02:25:54 UTC (rev 1786)
+++ trunk/gdata/DESCRIPTION 2014-04-05 12:53:38 UTC (rev 1787)
@@ -12,4 +12,4 @@
Maintainer: Gregory R. Warnes <gr...@wa...>
License: GPL-2
NeedsCompilation: no
-Depends: RUnit
+Recommends: RUnit
Modified: trunk/gdata/man/gdata-package.Rd
===================================================================
--- trunk/gdata/man/gdata-package.Rd 2014-04-05 02:25:54 UTC (rev 1786)
+++ trunk/gdata/man/gdata-package.Rd 2014-04-05 12:53:38 UTC (rev 1787)
@@ -32,13 +32,4 @@
}
-\section{Testing}{
-
-If you want to perform the validity/unit testing of the installed
-\pkg{ggmisc} package on your own computer, take a look at
-\code{\link{.runRUnitTestsGdata}} function - please note that
-you need the \pkg{RUnit} package for this to work.
-
-}
-
\keyword{package}
\ No newline at end of file
Modified: trunk/gdata/tests/runRUnitTests.R
===================================================================
--- trunk/gdata/tests/runRUnitTests.R 2014-04-05 02:25:54 UTC (rev 1786)
+++ trunk/gdata/tests/runRUnitTests.R 2014-04-05 12:53:38 UTC (rev 1787)
@@ -39,9 +39,10 @@
if(require("RUnit", quietly=TRUE))
{
- pkg <- c(read.dcf(file="../DESCRIPTION", fields="Package"))
- path <- normalizePath( file.path(getwd(), "..", "inst", "unitTests") )
+ pkg <- 'gdata'
+ path <- normalizePath("unitTests")
+
cat("\nRunning unit tests\n")
print(list(pkg=pkg, getwd=getwd(), pathToUnitTests=path))
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <wa...@us...> - 2014-04-05 13:57:14
|
Revision: 1788
http://sourceforge.net/p/r-gregmisc/code/1788
Author: warnes
Date: 2014-04-05 13:57:10 +0000 (Sat, 05 Apr 2014)
Log Message:
-----------
Change 'aggregate.table' from deprecated to defunct.
Modified Paths:
--------------
trunk/gdata/R/aggregate.table.R
Added Paths:
-----------
trunk/gdata/man/gdata-defunct.Rd
Removed Paths:
-------------
trunk/gdata/man/aggregate.table.Rd
Modified: trunk/gdata/R/aggregate.table.R
===================================================================
--- trunk/gdata/R/aggregate.table.R 2014-04-05 12:53:38 UTC (rev 1787)
+++ trunk/gdata/R/aggregate.table.R 2014-04-05 13:57:10 UTC (rev 1788)
@@ -2,32 +2,34 @@
aggregate.table <- function(x, by1, by2, FUN=mean, ...)
{
- warning("'aggregate.table' is deprecated and will be removed in a future version of the gdata package. ",
- "Please use 'tapply(X=",
- deparse(substitute(x)),
- ", INDEX=list(",
- deparse(substitute(by1)),
- ", ",
- deparse(substitute(by2)),
- "), FUN=",
- deparse(substitute(FUN)),
- if(length(list(...))>0)
- {
- l <- list(...)
- paste(", ",
- paste(names(l),"=",
- deparse(substitute(...)),
- sep="",
- collapse=", ")
- )
- },
- ")' instead.")
- tapply(X=x, INDEX=list(by1, by2), FUN=FUN, ...)
+ .Defunct(
+ new=paste(
+ "tapply(X=",
+ deparse(substitute(x)),
+ ", INDEX=list(",
+ deparse(substitute(by1)),
+ ", ",
+ deparse(substitute(by2)),
+ "), FUN=",
+ deparse(substitute(FUN)),
+ if(length(list(...))>0)
+ {
+ l <- list(...)
+ paste(", ",
+ paste(names(l),"=",
+ deparse(substitute(...)),
+ sep="",
+ collapse=", ")
+ )
+ },
+ ")", sep=""),
+ package="gdata"
+ )
}
## aggregate.table <- function(x, by1, by2, FUN=mean, ... )
## {
-##
+##
## tab <- matrix( nrow=nlevels(by1), ncol=nlevels(by2) )
## dimnames(tab) <- list(levels(by1),levels(by2))
##
Deleted: trunk/gdata/man/aggregate.table.Rd
===================================================================
--- trunk/gdata/man/aggregate.table.Rd 2014-04-05 12:53:38 UTC (rev 1787)
+++ trunk/gdata/man/aggregate.table.Rd 2014-04-05 13:57:10 UTC (rev 1788)
@@ -1,94 +0,0 @@
-% $Id$
-%
-% $Log$
-% Revision 1.7 2005/09/12 15:42:45 nj7w
-% Updated Greg's email
-%
-% Revision 1.6 2005/06/09 14:20:25 nj7w
-% Updating the version number, and various help files to synchronize splitting of gregmisc bundle in 4 individual components.
-%
-% Revision 1.1.1.1 2005/05/25 22:07:33 nj7w
-% Initial entry for individual package gdata
-%
-% Revision 1.5 2003/11/17 22:09:00 warnes
-% Fix syntax error.
-%
-% Revision 1.4 2003/06/07 17:58:37 warnes
-%
-% - Fixed error in examples. Had sqrt(var(x)/(n-1)) for the standard
-% error of the mean instead of sqrt(var(x)/n).
-%
-% Revision 1.3 2002/09/23 13:59:30 warnes
-% - Modified all files to include CVS Id and Log tags.
-%
-%
-
-\name{aggregate.table}
-\alias{aggregate.table}
-\title{Create 2-Way Table of Summary Statistics}
-\description{
- Splits the data into subsets based on two factors, computes a summary
- statistic on each subset, and arranges the results in a 2-way table.
-}
-\usage{
-aggregate.table(x, by1, by2, FUN=mean, ...)
-}
-%- maybe also `usage' for other objects documented here.
-\arguments{
- \item{x}{ data to be summarized }
- \item{by1}{ first grouping factor. }
- \item{by2}{ second grouping factor. }
- \item{FUN}{ a scalar function to compute the summary statistics which can
- be applied to all data subsets. Defaults to \code{mean}.}
- \item{\dots}{ Optional arguments for \code{FUN}. }
-}
-%\details{
-% ~~ If necessary, more details than the __description__ above ~~
-%}
-\value{
- Returns a matrix with one element for each combination of \code{by1}
- and \code{by2}.
-}
-\author{ Gregory R. Warnes \email{gr...@wa...}}
-
-\seealso{ \code{\link{aggregate}}, \code{\link{tapply}},
- \code{\link{interleave}} }
-\note{This function is DEPRECIATED. Please use \code{tapply}
- instead. See example for illustration.}
-\examples{
-# Useful example:
-#
-# Create a 2-way table of means, standard errors, and # obs
-set.seed(314159)
-g1 <- sample(letters[1:5], 1000, replace=TRUE)
-g2 <- sample(LETTERS[1:3], 1000, replace=TRUE )
-dat <- rnorm(1000)
-
-stderr <- function(x) sqrt( var(x,na.rm=TRUE) / nobs(x) )
-
-## Depreciated:
-means <- aggregate.table( dat, g1, g2, mean )
-## Instead use:
-means <- tapply( dat, list(g1, g2), mean )
-
-## Depreciated
-stderrs <- aggregate.table( dat, g1, g2, stderr )
-## Instead use:
-stderrs <- tapply( dat, list(g1, g2), stderr )
-
-## Depreciated
-ns <- aggregate.table( dat, g1, g2, nobs )
-## Instead use:
-ns <- tapply( dat, list(g1, g2), nobs )
-
-blanks <- matrix( " ", nrow=5, ncol=3)
-
-tab <- interleave( "Mean"=round(means,2),
- "Std Err"=round(stderrs,2),
- "N"=ns, " " = blanks, sep=" " )
-
-print(tab, quote=FALSE)
-}
-\keyword{iteration}
-\keyword{category}
-
Copied: trunk/gdata/man/gdata-defunct.Rd (from rev 1786, trunk/gdata/man/aggregate.table.Rd)
===================================================================
--- trunk/gdata/man/gdata-defunct.Rd (rev 0)
+++ trunk/gdata/man/gdata-defunct.Rd 2014-04-05 13:57:10 UTC (rev 1788)
@@ -0,0 +1,24 @@
+\name{gdata-defunct}
+\alias{aggregate.table}
+\title{Defunct Functions in Package 'gdata'}
+\description{
+ The functions or variables listed here are no longer part of 'gdata'.
+}
+\usage{
+aggregate.table(x, by1, by2, FUN=mean, ...)
+}
+%- maybe also `usage' for other objects documented here.
+\arguments{
+ \item{x}{ data to be summarized }
+ \item{by1}{ first grouping factor. }
+ \item{by2}{ second grouping factor. }
+ \item{FUN}{ a scalar function to compute the summary statistics which can
+ be applied to all data subsets. Defaults to \code{mean}.}
+ \item{\dots}{ Optional arguments for \code{FUN}. }
+}
+\details{
+ \code{aggregate.table(x, by1, by2, FUN=mean, ...)} should be replacede
+ by \code{tapply(X=x, INDEX=list(by1, by2), FUN=FUN, ...)}.
+}
+
+
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