tests/unitTests/runit.mapLevels.R

In gdata: Various R Programming Tools for Data Manipulation

## Test setup
if(FALSE) {
  library("RUnit")
  library("gdata")
}

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)
}

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
}

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)
}

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))
}

"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
}