inst/unitTests/attrData_test.R

In graph: graph: A package to handle graph data structures

basicProps <- list(weight=1, color="blue", friends=c("bob", "alice"))


testCreation <- function() {
    aset <- new("attrData", defaults=basicProps)
    checkEquals(TRUE, is(aset, "attrData"))
}


testDefaultAttributesGetting <- function() {
    aset <- new("attrData", defaults=basicProps)

    ## Get the entire list
    checkEquals(basicProps, attrDefaults(aset))

    ## Get a single attribute
    checkEquals(basicProps$weight, attrDefaults(aset, attr="weight"))
    checkEquals(basicProps$friends, attrDefaults(aset, attr="friends"))

    ## It is an error to ask for an undefined attr
    checkException(attrDefaults(aset, attr="NOSUCHATTRIBUTE"), silent=TRUE)
    ## You can only ask for one attr at a time
    checkException(attrDefaults(aset, attr=c("weight", "friends")), silent=TRUE)
}


testDefaultAttributesSetting <- function() {
    aset <- new("attrData", defaults=basicProps)

    ## Edit default value, type changes are allowed
    attrDefaults(aset, attr="weight") <- 100
    checkEquals(100, attrDefaults(aset, attr="weight"))

    ## Add a new attribute
    attrDefaults(aset, attr="size") <- c(1, 2)
    checkEquals(c(1, 2), attrDefaults(aset, attr="size"))
        
    ## This is sort of dangerous, but for now, we'll allow it.
    ## I would prefer the attributes to be write-once and there
    ## forever.  Or at least a special interface to remove unwanted...
    newProps <- list(dir="home", size=100)
    attrDefaults(aset) <- newProps
    checkEquals(newProps, attrDefaults(aset))
}


testItemGettingAndSettingSimple <- function() {
    aset <- new("attrData", defaults=basicProps)

    ## access to defaults
    checkEquals(1, attrDataItem(aset, x="k1", attr="weight")[[1]])
    expect <- as.list(rep(1, 3))
    names(expect) <- letters[1:3]
    checkEquals(expect, attrDataItem(aset, x=letters[1:3], attr="weight"))

    ## mixed custom/defaults
    attrDataItem(aset, x="k1", attr="weight") <- 900
    checkEquals(900, attrDataItem(aset, x="k1", attr="weight")[[1]])

    ## Retrieve entire attribute list 
    expect <- basicProps
    expect[["weight"]] <- 900
    checkEquals(expect, attrDataItem(aset, x=c("k1", "newone"))[[1]])
    checkEquals(basicProps, attrDataItem(aset, x=c("k1", "newone"))[[2]])

    ## error on unknown attrs
    checkException(attrDataItem(aset, "k1", "UNKNOWN"), silent=TRUE)
    checkException(attrDataItem(aset, "k1", "UNKNOWN") <- "BAD", silent=TRUE)
}


testItemGettingAndSettingVectorized <- function() {
    aset <- new("attrData", defaults=basicProps)
    keys <- c("k1", "k2", "k3")
    
    ## Set multiple with same value 1
    attrDataItem(aset, x=keys, attr="weight") <- 222
    expectPerElem <- basicProps
    expectPerElem[["weight"]] <- 222
    for(k in keys)
      checkEquals(expectPerElem, attrDataItem(aset, k)[[1]])

    ## Set multiple with same value 2
    complexVal <- list(a=as.list(1:3), b="ccc", c=1:5)
    attrDataItem(aset, x=keys, attr="weight") <- list(complexVal)
    expectPerElem <- basicProps
    expectPerElem[["weight"]] <- complexVal
    checkEquals(expectPerElem, attrDataItem(aset, "k1")[[1]])
    checkEquals(expectPerElem, attrDataItem(aset, "k2")[[1]])
    checkEquals(expectPerElem, attrDataItem(aset, "k3")[[1]])

    ## Set multiple with same value 3
    complexVal <- list(a=as.list(1:3), b="ccc", c=1:5, d="extra")
    attrDataItem(aset, x=keys, attr="weight") <- list(complexVal)
    expectPerElem <- basicProps
    expectPerElem[["weight"]] <- complexVal
    for(k in keys)
      checkEquals(expectPerElem, attrDataItem(aset, k)[[1]])

    ## Set multiple with distinct values 1
    wVect <- c(10, 20, 30)
    attrDataItem(aset, x=keys, attr="weight") <- wVect
    for (i in 1:length(wVect))
      checkEquals(wVect[i], attrDataItem(aset, keys[i], "weight")[[1]])

    ## Set multiple with distinct values 2
    wVect <- list(list(a=1), list(a=2), list(a=3))
    attrDataItem(aset, x=keys, attr="weight") <- wVect
    for (i in 1:length(wVect))
      checkEquals(wVect[[i]], attrDataItem(aset, keys[i], "weight")[[1]])
}


testItemRemovalSimple <- function() {
    aset <- new("attrData", defaults=basicProps)

    attrDataItem(aset, x="k1", attr="weight") <- 900
    checkEquals(900, attrDataItem(aset, x="k1", attr="weight")[[1]])

    removeAttrDataItem(aset, x="k1") <- NULL
    checkEquals(1, attrDataItem(aset, x="k1", attr="weight")[[1]])
}


testNames <- function() {
    aset <- new("attrData", defaults=basicProps)

    attrDataItem(aset, x=letters, attr="weight") <- 1:26
    checkEquals(letters, names(aset))

    names(aset) <- LETTERS
    checkEquals(LETTERS, names(aset))

    ## must have right length
    checkException(names(aset) <- letters[1:4], silent=TRUE)
    ## can't have NA
    bad <- letters
    bad[11] <- NA
    checkException(names(aset) <- bad, silent=TRUE)
    ## can't have duplicates
    bad[11] <- "b"
    checkException(names(aset) <- bad, silent=TRUE)
}