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

[<gg...@us...>]

Revision: 991
          http://svn.sourceforge.net/r-gregmisc/?rev=991&view=rev
Author:   ggorjan
Date:     2006-10-29 07:47:33 -0800 (Sun, 29 Oct 2006)

Log Message:
-----------
sort is generic now; mapply keeps names in R 2.4.0; some codetools suggestions fixed

Modified Paths:
--------------
    trunk/gdata/R/drop.levels.R
    trunk/gdata/R/mapLevels.R
    trunk/gdata/inst/unitTests/runit.mapLevels.R
    trunk/gdata/man/mapLevels.Rd
    trunk/gdata/tests/doRUnit.R

Modified: trunk/gdata/R/drop.levels.R
===================================================================
--- trunk/gdata/R/drop.levels.R	2006-10-29 15:34:19 UTC (rev 990)
+++ trunk/gdata/R/drop.levels.R	2006-10-29 15:47:33 UTC (rev 991)
@@ -1,6 +1,6 @@
 
 drop.levels  <- function(x, reorder=TRUE, ...)
-  UseMethod("drop.levels")
+  UseMethod("drop.levels", x=x)
 
 drop.levels.default <- function(x, reorder=TRUE, ...)
   x

Modified: trunk/gdata/R/mapLevels.R
===================================================================
--- trunk/gdata/R/mapLevels.R	2006-10-29 15:34:19 UTC (rev 990)
+++ trunk/gdata/R/mapLevels.R	2006-10-29 15:47:33 UTC (rev 991)
@@ -2,7 +2,7 @@
 ###------------------------------------------------------------------------
 ### What: Mapping levels
 ### $Id: mapLevels.R,v 1.1 2006/03/29 13:47:15 ggorjan Exp ggorjan $
-### Time-stamp: <2006-09-10 03:54:56 ggorjan>
+### Time-stamp: <2006-10-29 16:45:20 ggorjan>
 ###------------------------------------------------------------------------
 
 ### {{{ mapLevels
@@ -12,7 +12,7 @@
 mapLevels <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
                       combine=FALSE, ...)
 {
-  UseMethod("mapLevels")
+  UseMethod("mapLevels", x=x)
 }
 
 mapLevels.default <- function(x, codes=TRUE, sort=TRUE, drop=FALSE,
@@ -88,10 +88,10 @@
 .unlistLevelsMap <- function(x, ind=FALSE)
 {
   y <- unlist(x, use.names=FALSE)
-  length <- sapply(x, FUN=length)
-  names(y) <- rep(names(x), times=length)
+  len <- sapply(x, FUN=length)
+  names(y) <- rep(names(x), times=len)
   if(ind) {
-    return(list(y, rep(1:length(x), times=length), length))
+    return(list(y, rep(1:length(x), times=len), len))
   } else {
     return(y)
   }
@@ -214,6 +214,7 @@
 {
   x <- list(...)
   class(x) <- "listLevelsMap"
+  ## we use recursive=TRUE here because ... is a lists of lists
   c(x, sort=sort, recursive=TRUE)
 }
 
@@ -231,7 +232,7 @@
     x <- unlist(x, recursive=FALSE)
     ## how to merge components with the same name?
     class(x) <- "levelsMap"
-    if(sort) x <- sort.levelsMap(x)
+    if(sort) x <- sort(x)
     x <- unique(x)
   }
   x
@@ -330,13 +331,7 @@
                    dQuote("listLevelsMap"), dQuote("levelsMap")))
     }
   }
-  ## FIXME: mapply drops names
-  if(!is.null(names(x))) {
-    isNamed <- TRUE
-    namesX <- names(x)
-  }
   x <- mapply(FUN="mapLevels<-", x=x, value=value, SIMPLIFY=FALSE)
-  if(isNamed) names(x) <- namesX
   x
 }
 

Modified: trunk/gdata/inst/unitTests/runit.mapLevels.R
===================================================================
--- trunk/gdata/inst/unitTests/runit.mapLevels.R	2006-10-29 15:34:19 UTC (rev 990)
+++ trunk/gdata/inst/unitTests/runit.mapLevels.R	2006-10-29 15:47:33 UTC (rev 991)
@@ -2,16 +2,280 @@
 ###------------------------------------------------------------------------
 ### What: Unit tests for mapLevels et al.
 ### $Id$
-### Time-stamp: <2006-08-31 02:24:20 ggorjan>
+### Time-stamp: <2006-10-29 16:41:41 ggorjan>
 ###------------------------------------------------------------------------
 
-### {{{ --- Test setup ---

if(FALSE) {
  library("RUnit")
  library("gdata")
}

### }}}
-### {{{ mapLevels, is.*, as.*, [.*

test.mapLevels <- function()
{
  ## Integer and numeric
  checkException(mapLevels(1:3)) # wrong class(x)
  checkException(mapLevels(1.5)) # wrong class(x)

  ## Factor
  f <- factor(c("B", "C", "A"))
  fMapInt <- list(A=as.integer(1), B=as.integer(2), C=as.integer(3))
  fMapInt1 <- list(B=as.integer(1), C=as.integer(2))
  fMapCha <- list(A="A", B="B", C="C")
  fMapInt <- as.levelsMap(fMapInt)
  fMapInt1 <- as.levelsMap(fMapInt1)
  fMapCha <- as.levelsMap(fMapCha)
  fMapCha1 <- fMapCha[c(1, 3)] # this will test also [.levelsMap
  checkIdentical(mapLevels(f), fMapInt)
  checkTrue(is.levelsMap(mapLevels(f))) # test for is.levelsMap
  checkTrue(is.levelsMap(fMapInt))      # test for as.levelsMap
  checkTrue(!gdata:::.isCharacterMap(fMapInt))
  checkIdentical(mapLevels(f, sort=FALSE), fMapInt) # sort is not used for factors
  checkIdentical(mapLevels(f[1:2], drop=TRUE), fMapInt1)
  checkIdentical(mapLevels(f, codes=FALSE), fMapCha)
  checkIdentical(mapLevels(f[c(2, 3)], drop=TRUE, codes=FALSE), fMapCha1)

  ## Character
  cha <- c("Z", "M", "A")
  chaMapInt <- list(A=as.integer(1), M=as.integer(2), Z=as.integer(3))
  chaMapIntO <- list(Z=as.integer(1), M=as.integer(2), A=as.integer(3))
  chaMapInt1 <- list(M=as.integer(1), Z=as.integer(2))
  chaMapCha <- list(A="A", M="M", Z="Z")
  chaMapInt <- as.levelsMap(chaMapInt)
  chaMapIntO <- as.levelsMap(chaMapIntO)
  chaMapInt1 <- as.levelsMap(chaMapInt1)
  chaMapCha <- as.levelsMap(chaMapCha)
  checkIdentical(mapLevels(cha), chaMapInt)
  checkIdentical(mapLevels(cha, sort=FALSE), chaMapIntO) # sort works for characters
  checkIdentical(mapLevels(cha[1:2], drop=TRUE), chaMapInt1)
  checkIdentical(mapLevels(cha, codes=FALSE), chaMapCha)

  ## List
  l <- list(f=f, cha=cha)
  l1 <- list(cha=cha, f=f)
  l2 <- list(cha=cha, f=f, i=1:10)
  lMapInt <- list(f=fMapInt, cha=chaMapInt)
  lMapCha <- list(f=fMapCha, cha=chaMapCha)
  lMapInt <- as.listLevelsMap(lMapInt)
  lMapCha <- as.listLevelsMap(lMapCha)
  lMapChaC <- as.list(sort(unique(c(cha, as.character(f)))))
  lMapChaCO <- as.list(unique(c(cha, as.character(f))))
  names(lMapChaC) <- unlist(lMapChaC)
  names(lMapChaCO) <- unlist(lMapChaCO)
  lMapChaC <- as.levelsMap(lMapChaC)
  lMapChaCO <- as.levelsMap(lMapChaCO)
  checkIdentical(mapLevels(l), lMapInt)
  checkTrue(is.listLevelsMap(mapLevels(l))) # test for is.listLevelsMap
  checkTrue(is.listLevelsMap(lMapInt))      # test for as.listLevelsMap
  checkIdentical(mapLevels(l, codes=FALSE), lMapCha)
  checkException(mapLevels(l, combine=TRUE)) # can not combine integer maps
  checkIdentical(mapLevels(l, codes=FALSE, combine=TRUE), lMapChaC)
  checkIdentical(mapLevels(l1, codes=FALSE, combine=TRUE), lMapChaC)
  checkIdentical(mapLevels(l1, codes=FALSE, combine=TRUE, sort=FALSE), lMapChaCO)
  checkException(mapLevels(l2)) # only char and factor

  ## Data.frame
  df <- data.frame(f1=factor(c("G", "Abc", "Abc", "D", "F")),
                   f2=factor(c("Abc", "Abc", "B", "D", "K")),
                         cha=c("jkl", "A", "D", "K", "L"),
                   int=1:5)
  dfMapInt <- list(f1=mapLevels(df$f1), f2=mapLevels(df$f2), cha=mapLevels(df$cha))
  dfMapInt <- as.listLevelsMap(dfMapInt)
  dfMapInt1 <- dfMapInt[c(1, 3)] # this will test also [.listLevelsMap
  checkException(mapLevels(df)) # wrong class of int
  checkIdentical(mapLevels(df[, 1:3]), dfMapInt)
  checkIdentical(mapLevels(df[, c(1, 3)]), dfMapInt1)
}

### }}}
-### {{{ .check*

test.checkLevelsMap <- function(x)
{
  ## --- levelsMap ---

  ## not a list
  checkException(gdata:::.checkLevelsMap(x="A", method="raw"))
  ## list without names
  checkException(gdata:::.checkLevelsMap(x=list("A"), method="raw"))
  fMapInt <- list(A=as.integer(1), B=as.integer(2), C=as.integer(3))
  ## x should be levelsMap
  checkException(gdata:::.checkLevelsMap(x=fMapInt, method="class"))

  ## --- listLevelsMap ---

  map <- list(as.levelsMap(fMapInt), as.levelsMap(fMapInt))
  map1 <- list(fMapInt, fMapInt)
  class(map1) <- "listLevelsMap"
  ## x should be a listLevelsMap
  checkException(gdata:::.checkListLevelsMap(x=map, method="class"))
  ## x should be also a list of levelsMaps
  checkException(gdata:::.checkListLevelsMap(x=map1, method="class"))
  ## the rest is done with levelsMap tests
}

### }}}
-### {{{ c.*

test.cLevelsMap <- function()
{
  f1 <- factor(letters[c(2, 1)])
  f2 <- factor(letters[c(3, 1, 2)])
  mapCha1 <- mapLevels(f1, codes=FALSE) # get maps
  mapCha2 <- mapLevels(f2, codes=FALSE)
  mapCha1S <- mapLevels(as.character(f1), codes=FALSE, sort=FALSE)
  mapCha2S <- mapLevels(as.character(f2), codes=FALSE, sort=FALSE)
  mapChaTest <- list(a="a", b="b")
  mapChaTest1 <- list(a="a", b="b", c="c")
  mapChaTest2 <- list(c="c", a="a", b="b")
  class(mapChaTest) <- class(mapChaTest1) <- class(mapChaTest2) <- "levelsMap"
  mapChaTest3 <- list(mapChaTest, mapChaTest1, mapChaTest, mapChaTest1)
  class(mapChaTest3)  <- "listLevelsMap"
  checkIdentical(c(mapCha1), mapChaTest)
  checkIdentical(c(mapCha2, mapCha1), mapChaTest1)
  checkIdentical(c(mapCha2S, mapCha1S, sort=FALSE), mapChaTest2)

  l <- list(f1, f2)
  mapCha <- mapLevels(l, codes=FALSE)
  checkIdentical(c(mapCha, mapCha), mapChaTest3)
  checkIdentical(c(mapCha, recursive=TRUE), mapChaTest1)

  checkException(c(mapLevels(f1))) # can not combine integer “levelsMaps”

  ## Example with maps of different length of components
  map1 <- list(A=c("a", "e", "i", "o", "u"), B="b", C="c", C="m",
               D=c("d", "e"), F="f")
  map2 <- list(A=c("a", "z", "w", "y", "x"), F="f", G=c("g", "h", "j"),
               i="i", k=c("k", "l"), B="B")
  map0Test <- list(A=c("a", "e", "i", "o", "u"), B="b", C="c", C="m",
                   D=c("d", "e"), F="f",
                   A=c("z", "w", "y", "x"), G=c("g", "h", "j"),
                   i="i", k=c("k", "l"), B="B")
  map0Test <- as.levelsMap(map0Test)
  mapTest <- sort.levelsMap(map0Test)
  map1 <- as.levelsMap(map1)
  map2 <- as.levelsMap(map2)
  map <- c(map1, map2)
  map0 <- c(map1, map2, sort=FALSE)
  checkIdentical(map, mapTest)
  checkIdentical(map0, map0Test)
}

### }}}
-### {{{ unique

test.uniqueLevelsMap <- function()
{
  map <- list(A=c(1, 2, 1, 3), B=4, C=1, C=5, D=c(6, 8), E=7, B=4,
              D=c(6, 8))
  map1 <- map
  map1[[1]] <- map[[1]][c(1, 2, 4)]
  map1[[7]] <- NULL # remove B=4
  map1[[7]] <- NULL # remove D=c(6, 8)
  ## unique (used in as.levelsMap), will remove duplicates (A=1)
  checkIdentical(as.levelsMap(map1), as.levelsMap(map))
}

### }}}
-### {{{ mapLevels<-

"test.mapLevels<-" <- function()
{
  ## Some errors
  checkException("mapLevels<-"(1.1, value=2))  # wrong class(x)
  checkException("mapLevels<-"(complex(1.1), value=2)) # wrong class(x)

  f <- factor(c("A", "B", "C"))
  fMapInt <- mapLevels(f)
  ## can not apply integer "levelsMap" to "character"
  checkException("mapLevels<-"(as.character(f), value=fMapInt))

  fMapCha <- mapLevels(f, codes=FALSE)
  ## can not apply character levelsMap to "integer"
  checkException("mapLevels<-"(as.integer(f), value=chaMapCha))

  fMapFuzz <- fMapInt
  fMapFuzz[[1]] <- "A"
  ## all components of 'value' must be of the same class
  checkException("mapLevels<-"(as.character(f), value=fMapFuzz))
  checkException("mapLevels<-"(as.integer(f), value=fMapFuzz))

  ## x integer, value integer levelsMap
  f <- factor(letters[c(10, 15, 1, 2)])
  fMapInt <- mapLevels(f)
  fInt <- as.integer(f)
  mapLevels(fInt) <- fMapInt
  checkIdentical(fInt, f)

  ## x factor, value integer levelsMap
  fInt <- factor(as.integer(f))
  mapLevels(fInt) <- fMapInt
  checkIdentical(fInt, f)

  ## above is essentially the same as levels<-.factor
  fInt1 <- factor(as.integer(f))
  levels(fInt1) <- fMapInt
  checkIdentical(fInt1, f)

  ## x character, value character levelsMap
  cha <- c("B", "A", "C")
  chaMapCha <- as.levelsMap(list(A1="A", B2="B", C3="C"))
  mapLevels(cha) <- chaMapCha
  chaTest <- factor(c("B2", "A1", "C3"))
  checkIdentical(cha, chaTest)
  ## and a bit more for components of length > 1
  cha <- c("G", "I", "B", "A", "C", "D", "Z")
  chaMapCha <- as.levelsMap(list(A1=c("A", "G", "I"), B2="B", C3=c("C", "D")))
  mapLevels(cha) <- chaMapCha
  chaTest <- factor(c("A1", "A1", "B2", "A1", "C3", "C3", NA))
  checkIdentical(cha, chaTest)

  ## x factor, value character levelsMap
  f <- factor(c("G", "I", "B", "A", "C", "D", "Z"))
  fMapCha <- as.levelsMap(list(A1=c("A", "G", "I"), B2="B", C3=c("C", "D")))
  mapLevels(f) <- fMapCha
  fTest <- factor(c("A1", "A1", "B2", "A1", "C3", "C3", NA))
  checkIdentical(f, fTest)

  ## Two factors and character map
  f1 <- factor(letters[1:10])
  f2 <- factor(letters[5:14])
  checkIdentical(as.integer(f1), as.integer(f2)) # the same integer codes
  mapCha1 <- mapLevels(f1, codes=FALSE) # get maps
  mapCha2 <- mapLevels(f2, codes=FALSE)
  mapCha <- c(mapCha1, mapCha2)         # combine maps
  ## apply map
  mapLevels(f1) <- mapCha # the same as levels(f1) <- mapCha
  mapLevels(f2) <- mapCha # the same as levels(f2) <- mapCha
  checkIdentical(as.integer(f1), 1:10) # \ internal codes are now
  checkIdentical(as.integer(f2), 5:14) # / "consistent" among factors

  ## The same with list
  l <- list(f1=f1, f2=f2)
  mapCha <- mapLevels(l, codes=FALSE, combine=TRUE)
  mapLevels(l) <- mapCha
  checkIdentical(as.integer(l$f1), 1:10) # \ internal codes are now
  checkIdentical(as.integer(l$f2), 5:14) # / "consistent" among factors

  ## and data.frame
  df <- data.frame(f1=f1, f2=f2)
  mapCha <- mapLevels(df, codes=FALSE, combine=TRUE)
  mapLevels(df) <- mapCha
  checkIdentical(as.integer(df$f1), 1:10) # \ internal codes are now
  checkIdentical(as.integer(df$f2), 5:14) # / "consistent" among factors

}

### }}}
-### {{{ Dear Emacs
## Local variables:
## folded-file: t
## End:
### }}}
+### {{{ --- Test setup ---
 
+if(FALSE) {
+  library("RUnit")
+  library("gdata")
+}
+
+### }}}
+### {{{ mapLevels, is.*, as.*, [.*
+
+test.mapLevels <- function()
+{
+  ## Integer and numeric
+  checkException(mapLevels(1:3)) # wrong class(x)
+  checkException(mapLevels(1.5)) # wrong class(x)
+
+  ## Factor
+  f <- factor(c("B", "C", "A"))
+  fMapInt <- list(A=as.integer(1), B=as.integer(2), C=as.integer(3))
+  fMapInt1 <- list(B=as.integer(1), C=as.integer(2))
+  fMapCha <- list(A="A", B="B", C="C")
+  fMapInt <- as.levelsMap(fMapInt)
+  fMapInt1 <- as.levelsMap(fMapInt1)
+  fMapCha <- as.levelsMap(fMapCha)
+  fMapCha1 <- fMapCha[c(1, 3)] # this will test also [.levelsMap
+  checkIdentical(mapLevels(f), fMapInt)
+  checkTrue(is.levelsMap(mapLevels(f))) # test for is.levelsMap
+  checkTrue(is.levelsMap(fMapInt))      # test for as.levelsMap
+  checkTrue(!gdata:::.isCharacterMap(fMapInt))
+  checkIdentical(mapLevels(f, sort=FALSE), fMapInt) # sort is not used for factors
+  checkIdentical(mapLevels(f[1:2], drop=TRUE), fMapInt1)
+  checkIdentical(mapLevels(f, codes=FALSE), fMapCha)
+  checkIdentical(mapLevels(f[c(2, 3)], drop=TRUE, codes=FALSE), fMapCha1)
+
+  ## Character
+  cha <- c("Z", "M", "A")
+  chaMapInt <- list(A=as.integer(1), M=as.integer(2), Z=as.integer(3))
+  chaMapIntO <- list(Z=as.integer(1), M=as.integer(2), A=as.integer(3))
+  chaMapInt1 <- list(M=as.integer(1), Z=as.integer(2))
+  chaMapCha <- list(A="A", M="M", Z="Z")
+  chaMapInt <- as.levelsMap(chaMapInt)
+  chaMapIntO <- as.levelsMap(chaMapIntO)
+  chaMapInt1 <- as.levelsMap(chaMapInt1)
+  chaMapCha <- as.levelsMap(chaMapCha)
+  checkIdentical(mapLevels(cha), chaMapInt)
+  checkIdentical(mapLevels(cha, sort=FALSE), chaMapIntO) # sort works for characters
+  checkIdentical(mapLevels(cha[1:2], drop=TRUE), chaMapInt1)
+  checkIdentical(mapLevels(cha, codes=FALSE), chaMapCha)
+
+  ## List
+  l <- list(f=f, cha=cha)
+  l1 <- list(cha=cha, f=f)
+  l2 <- list(cha=cha, f=f, i=1:10)
+  lMapInt <- list(f=fMapInt, cha=chaMapInt)
+  lMapCha <- list(f=fMapCha, cha=chaMapCha)
+  lMapInt <- as.listLevelsMap(lMapInt)
+  lMapCha <- as.listLevelsMap(lMapCha)
+  lMapChaC <- as.list(sort(unique(c(cha, as.character(f)))))
+  lMapChaCO <- as.list(unique(c(cha, as.character(f))))
+  names(lMapChaC) <- unlist(lMapChaC)
+  names(lMapChaCO) <- unlist(lMapChaCO)
+  lMapChaC <- as.levelsMap(lMapChaC)
+  lMapChaCO <- as.levelsMap(lMapChaCO)
+  checkIdentical(mapLevels(l), lMapInt)
+  checkTrue(is.listLevelsMap(mapLevels(l))) # test for is.listLevelsMap
+  checkTrue(is.listLevelsMap(lMapInt))      # test for as.listLevelsMap
+  checkIdentical(mapLevels(l, codes=FALSE), lMapCha)
+  checkException(mapLevels(l, combine=TRUE)) # can not combine integer maps
+  checkIdentical(mapLevels(l, codes=FALSE, combine=TRUE), lMapChaC)
+  checkIdentical(mapLevels(l1, codes=FALSE, combine=TRUE), lMapChaC)
+  checkIdentical(mapLevels(l1, codes=FALSE, combine=TRUE, sort=FALSE), lMapChaCO)
+  checkException(mapLevels(l2)) # only char and factor
+
+  ## Data.frame
+  df <- data.frame(f1=factor(c("G", "Abc", "Abc", "D", "F")),
+                   f2=factor(c("Abc", "Abc", "B", "D", "K")),
+                         cha=c("jkl", "A", "D", "K", "L"),
+                   int=1:5)
+  dfMapInt <- list(f1=mapLevels(df$f1), f2=mapLevels(df$f2), cha=mapLevels(df$cha))
+  dfMapInt <- as.listLevelsMap(dfMapInt)
+  dfMapInt1 <- dfMapInt[c(1, 3)] # this will test also [.listLevelsMap
+  checkException(mapLevels(df)) # wrong class of int
+  checkIdentical(mapLevels(df[, 1:3]), dfMapInt)
+  checkIdentical(mapLevels(df[, c(1, 3)]), dfMapInt1)
+}
+
+### }}}
+### {{{ .check*
+
+test.checkLevelsMap <- function(x)
+{
+  ## --- levelsMap ---
+
+  ## not a list
+  checkException(gdata:::.checkLevelsMap(x="A", method="raw"))
+  ## list without names
+  checkException(gdata:::.checkLevelsMap(x=list("A"), method="raw"))
+  fMapInt <- list(A=as.integer(1), B=as.integer(2), C=as.integer(3))
+  ## x should be levelsMap
+  checkException(gdata:::.checkLevelsMap(x=fMapInt, method="class"))
+
+  ## --- listLevelsMap ---
+
+  map <- list(as.levelsMap(fMapInt), as.levelsMap(fMapInt))
+  map1 <- list(fMapInt, fMapInt)
+  class(map1) <- "listLevelsMap"
+  ## x should be a listLevelsMap
+  checkException(gdata:::.checkListLevelsMap(x=map, method="class"))
+  ## x should be also a list of levelsMaps
+  checkException(gdata:::.checkListLevelsMap(x=map1, method="class"))
+  ## the rest is done with levelsMap tests
+}
+
+### }}}
+### {{{ c.*
+
+test.cLevelsMap <- function()
+{
+  f1 <- factor(letters[c(2, 1)])
+  f2 <- factor(letters[c(3, 1, 2)])
+  mapCha1 <- mapLevels(f1, codes=FALSE) # get maps
+  mapCha2 <- mapLevels(f2, codes=FALSE)
+  mapCha1S <- mapLevels(as.character(f1), codes=FALSE, sort=FALSE)
+  mapCha2S <- mapLevels(as.character(f2), codes=FALSE, sort=FALSE)
+  mapChaTest <- list(a="a", b="b")
+  mapChaTest1 <- list(a="a", b="b", c="c")
+  mapChaTest2 <- list(c="c", a="a", b="b")
+  class(mapChaTest) <- class(mapChaTest1) <- class(mapChaTest2) <- "levelsMap"
+  mapChaTest3 <- list(mapChaTest, mapChaTest1, mapChaTest, mapChaTest1)
+  class(mapChaTest3)  <- "listLevelsMap"
+  checkIdentical(c(mapCha1), mapChaTest)
+  checkIdentical(c(mapCha2, mapCha1), mapChaTest1)
+  checkIdentical(c(mapCha2S, mapCha1S, sort=FALSE), mapChaTest2)
+
+  l <- list(f1, f2)
+  mapCha <- mapLevels(l, codes=FALSE)
+  checkIdentical(c(mapCha, mapCha), mapChaTest3)
+  checkIdentical(c(mapCha, recursive=TRUE), mapChaTest1)
+
+  checkException(c(mapLevels(f1))) # can not combine integer “levelsMaps”
+
+  ## Example with maps of different length of components
+  map1 <- list(A=c("a", "e", "i", "o", "u"), B="b", C="c", C="m",
+               D=c("d", "e"), F="f")
+  map2 <- list(A=c("a", "z", "w", "y", "x"), F="f", G=c("g", "h", "j"),
+               i="i", k=c("k", "l"), B="B")
+  map0Test <- list(A=c("a", "e", "i", "o", "u"), B="b", C="c", C="m",
+                   D=c("d", "e"), F="f",
+                   A=c("z", "w", "y", "x"), G=c("g", "h", "j"),
+                   i="i", k=c("k", "l"), B="B")
+  map0Test <- as.levelsMap(map0Test)
+  mapTest <- sort(map0Test)
+  map1 <- as.levelsMap(map1)
+  map2 <- as.levelsMap(map2)
+  map <- c(map1, map2)
+  map0 <- c(map1, map2, sort=FALSE)
+  checkIdentical(map, mapTest)
+  checkIdentical(map0, map0Test)
+}
+
+### }}}
+### {{{ unique
+
+test.uniqueLevelsMap <- function()
+{
+  map <- list(A=c(1, 2, 1, 3), B=4, C=1, C=5, D=c(6, 8), E=7, B=4,
+              D=c(6, 8))
+  map1 <- map
+  map1[[1]] <- map[[1]][c(1, 2, 4)]
+  map1[[7]] <- NULL # remove B=4
+  map1[[7]] <- NULL # remove D=c(6, 8)
+  ## unique (used in as.levelsMap), will remove duplicates (A=1)
+  checkIdentical(as.levelsMap(map1), as.levelsMap(map))
+}
+
+### }}}
+### {{{ mapLevels<-
+
+"test.mapLevels<-" <- function()
+{
+  ## Some errors
+  checkException("mapLevels<-"(1.1, value=2))  # wrong class(x)
+  checkException("mapLevels<-"(complex(1.1), value=2)) # wrong class(x)
+
+  f <- factor(c("A", "B", "C"))
+  fMapInt <- mapLevels(f)
+  ## can not apply integer "levelsMap" to "character"
+  checkException("mapLevels<-"(as.character(f), value=fMapInt))
+
+  fMapCha <- mapLevels(f, codes=FALSE)
+  ## can not apply character levelsMap to "integer"
+  checkException("mapLevels<-"(as.integer(f), value=chaMapCha))
+
+  fMapFuzz <- fMapInt
+  fMapFuzz[[1]] <- "A"
+  ## all components of 'value' must be of the same class
+  checkException("mapLevels<-"(as.character(f), value=fMapFuzz))
+  checkException("mapLevels<-"(as.integer(f), value=fMapFuzz))
+
+  ## x integer, value integer levelsMap
+  f <- factor(letters[c(10, 15, 1, 2)])
+  fMapInt <- mapLevels(f)
+  fInt <- as.integer(f)
+  mapLevels(fInt) <- fMapInt
+  checkIdentical(fInt, f)
+
+  ## x factor, value integer levelsMap
+  fInt <- factor(as.integer(f))
+  mapLevels(fInt) <- fMapInt
+  checkIdentical(fInt, f)
+
+  ## above is essentially the same as levels<-.factor
+  fInt1 <- factor(as.integer(f))
+  levels(fInt1) <- fMapInt
+  checkIdentical(fInt1, f)
+
+  ## x character, value character levelsMap
+  cha <- c("B", "A", "C")
+  chaMapCha <- as.levelsMap(list(A1="A", B2="B", C3="C"))
+  mapLevels(cha) <- chaMapCha
+  chaTest <- factor(c("B2", "A1", "C3"))
+  checkIdentical(cha, chaTest)
+  ## and a bit more for components of length > 1
+  cha <- c("G", "I", "B", "A", "C", "D", "Z")
+  chaMapCha <- as.levelsMap(list(A1=c("A", "G", "I"), B2="B", C3=c("C", "D")))
+  mapLevels(cha) <- chaMapCha
+  chaTest <- factor(c("A1", "A1", "B2", "A1", "C3", "C3", NA))
+  checkIdentical(cha, chaTest)
+
+  ## x factor, value character levelsMap
+  f <- factor(c("G", "I", "B", "A", "C", "D", "Z"))
+  fMapCha <- as.levelsMap(list(A1=c("A", "G", "I"), B2="B", C3=c("C", "D")))
+  mapLevels(f) <- fMapCha
+  fTest <- factor(c("A1", "A1", "B2", "A1", "C3", "C3", NA))
+  checkIdentical(f, fTest)
+
+  ## Two factors and character map
+  f1 <- factor(letters[1:10])
+  f2 <- factor(letters[5:14])
+  checkIdentical(as.integer(f1), as.integer(f2)) # the same integer codes
+  mapCha1 <- mapLevels(f1, codes=FALSE) # get maps
+  mapCha2 <- mapLevels(f2, codes=FALSE)
+  mapCha <- c(mapCha1, mapCha2)         # combine maps
+  ## apply map
+  mapLevels(f1) <- mapCha # the same as levels(f1) <- mapCha
+  mapLevels(f2) <- mapCha # the same as levels(f2) <- mapCha
+  checkIdentical(as.integer(f1), 1:10) # \ internal codes are now
+  checkIdentical(as.integer(f2), 5:14) # / "consistent" among factors
+
+  ## The same with list
+  l <- list(f1=f1, f2=f2)
+  mapCha <- mapLevels(l, codes=FALSE, combine=TRUE)
+  mapLevels(l) <- mapCha
+  checkIdentical(as.integer(l$f1), 1:10) # \ internal codes are now
+  checkIdentical(as.integer(l$f2), 5:14) # / "consistent" among factors
+
+  ## and data.frame
+  df <- data.frame(f1=f1, f2=f2)
+  mapCha <- mapLevels(df, codes=FALSE, combine=TRUE)
+  mapLevels(df) <- mapCha
+  checkIdentical(as.integer(df$f1), 1:10) # \ internal codes are now
+  checkIdentical(as.integer(df$f2), 5:14) # / "consistent" among factors
+
+}
+
+### }}}
+### {{{ Dear Emacs
+## Local variables:
+## folded-file: t
+## End:
+### }}}
+
 ###------------------------------------------------------------------------
 ### runit.mapLevels.R ends here

Modified: trunk/gdata/man/mapLevels.Rd
===================================================================
--- trunk/gdata/man/mapLevels.Rd	2006-10-29 15:34:19 UTC (rev 990)
+++ trunk/gdata/man/mapLevels.Rd	2006-10-29 15:47:33 UTC (rev 991)
@@ -2,7 +2,7 @@
 %--------------------------------------------------------------------------
 % What: Mapping levels
 % $Id: mapLevels.Rd,v 1.1 2006/03/29 13:47:10 ggorjan Exp ggorjan $
-% Time-stamp: <2006-08-31 02:43:29 ggorjan>
+% Time-stamp: <2006-10-15 18:36:28 ggorjan>
 %--------------------------------------------------------------------------
 
 \name{mapLevels}
@@ -144,7 +144,7 @@
 applied to \dQuote{character} or \dQuote{factor}. Methods for
 \dQuote{list} and \dQuote{data.frame} can work only on mentioned atomic
 components/columns and can accept either \dQuote{levelsMap} or
-\dQuote{levelsMap}. Recycling occours, if length of \code{value} is not
+\dQuote{listLevelsMap}. Recycling occours, if length of \code{value} is not
 the same as number of components/columns of a \dQuote{list/data.frame}.
 }
 

Modified: trunk/gdata/tests/doRUnit.R
===================================================================
--- trunk/gdata/tests/doRUnit.R	2006-10-29 15:34:19 UTC (rev 990)
+++ trunk/gdata/tests/doRUnit.R	2006-10-29 15:47:33 UTC (rev 991)
@@ -2,7 +2,7 @@
 ###------------------------------------------------------------------------
 ### What: Run RUnit tests
 ### $Id$
-### Time-stamp: <2006-09-18 13:14:34 ggorjan>
+### Time-stamp: <2006-10-29 16:37:40 ggorjan>
 ###------------------------------------------------------------------------
 
 if(require("RUnit", quietly=TRUE)) {
@@ -26,8 +26,7 @@
   ## --- Testing ---
 
   ## Define tests
-  testSuite <- defineTestSuite(name=paste(pkg, "unit testing"),
-                                           dirs=path)
+  testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), dirs=path)
   ## Run
   tests <- runTestSuite(testSuite)
 


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