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