[R-gregmisc-users] SF.net SVN: r-gregmisc:[1782] trunk/gdata
Brought to you by:
warnes
Menu
▾
▴
[R-gregmisc-users] SF.net SVN: r-gregmisc:[1782] trunk/gdata
|
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] |
