tests/RUnit/RUnit_tests_00b_sWsAparser.R

In osofr/tmlenet: Targeted Maximum Likelihood Estimation for Network Data

`%+%` <- function(a, b) paste0(a, b)

#***************************************************************************************
# Testing new parser DefineSummariesClass:
#***************************************************************************************
data(df_netKmax6) # load observed data
head(df_netKmax6)
data(NetInd_mat_Kmax6)  # load the network ID matrix
netind_cl <- simcausal:::NetIndClass$new(nobs = nrow(df_netKmax6), Kmax = 6)
netind_cl$NetInd <- NetInd_mat_Kmax6
head(netind_cl$nF)

# --------------------------------------------------------------------------------------
# test 1 (simple vars, expressions unnamed):
# --------------------------------------------------------------------------------------
# as expressions:
sW <- def_sW(W1, W2, W3)

mat1 <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl)
sW$sVar.names.map
head(mat1)
checkTrue(all.equal(mat1[["W1"]], df_netKmax6[["W1"]]))
checkTrue(all.equal(mat1[["W2"]], df_netKmax6[["W2"]]))
checkTrue(all.equal(mat1[["W3"]], df_netKmax6[["W3"]]))
checkTrue(all.equal(mat1[["nF"]], netind_cl$nF))

# old parser (deprecated):
# mat1b <- sW$get.mat.sVar(data.df = df_netKmax6, netind_cl = netind_cl)
# head(mat1b)
# checkTrue(all.equal(mat1, mat1b)) # passed

sW <- def_sW(W1[[0]],W2,W3)

mat2 <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl)
sW$sVar.names.map
head(mat2)
checkTrue(all.equal(mat1, mat2))

# old parser (deprecated):
# mat2b <- sW$get.mat.sVar(data.df = df_netKmax6, netind_cl = netind_cl)
# head(mat2b)
# checkTrue(all.equal(mat2, mat2b)) # passed

# as character strings:
sW <- def_sW("W1", "W2", "W3")

mat2 <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl)
head(mat2)
sW$sVar.names.map
checkTrue(all.equal(mat1, mat2))

# old parser (deprecated):
# mat2b <- sW$get.mat.sVar(data.df = df_netKmax6, netind_cl = netind_cl)
# checkTrue(all.equal(mat2, mat2b)) # passed

sW <- def_sW("W1[[0]]", "W2", "W3")

mat2 <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl)
sW$sVar.names.map
head(mat2)
checkTrue(all.equal(mat1, mat2))

# old parser (deprecated):
# mat2b <- sW$get.mat.sVar(data.df = df_netKmax6, netind_cl = netind_cl)
# sW$sVar.names.map
# head(mat2b)
# (all.equal(mat2, mat2b)) # passed


# --------------------------------------------------------------------------------------
# test 2 (matrix result for named expression):
# --------------------------------------------------------------------------------------
sW <- def_sW(netW2 = W2[[0:Kmax]], W3 = W3[[0]])

mat1 <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl)
(map1 <- sW$sVar.names.map)
head(mat1)

checkTrue(all.equal(names(map1)[1], "netW2"))
checkTrue(all.equal(mat1[["W2"]], df_netKmax6[["W2"]]))

# old parser (deprecated):
# mat2 <- sW$get.mat.sVar(data.df = df_netKmax6, netind_cl = netind_cl, addnFnode = "nF")
# (map2 <- sW$sVar.names.map)
# head(mat2)
# colnames(mat2)

# --------------------------------------------------------------------------------------
# test 3 (matrix result with unnamed expression):
# --------------------------------------------------------------------------------------
sW <- def_sW(W2[[0:Kmax]], W3 = W3[[0]])

mat1 <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl)
(map1 <- sW$sVar.names.map)
head(mat1)

# checkTrue(all.equal(colnames(head(mat1)), as.vector(unlist(map1))))
checkTrue(all.equal(names(map1)[1], "W2"))
checkTrue(all.equal(mat1[["W2"]], df_netKmax6[["W2"]]))

# --------------------------------------------------------------------------------------
# test 4 (vector result, complex expression with one parent):
# --------------------------------------------------------------------------------------
# named expression:
sW <- def_sW(sum.netW3 = sum(W3[[1:Kmax]]), replaceNAw0 = TRUE)

mat1a <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl)
(map1a <- sW$sVar.names.map)
head(mat1a)
checkTrue(all.equal(names(map1a)[1], "sum.netW3"))

# the same unnamed expression:
sW <- def_sW(sum(W3[[1:Kmax]]), replaceNAw0 = TRUE)

mat1b <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl)
(map1b <- sW$sVar.names.map)
head(mat1b)
checkTrue(all.equal(names(map1b)[1], "W3"))
checkTrue(all.equal(mat1a[["sum.netW3"]], mat1b[["W3"]]))

# --------------------------------------------------------------------------------------
# test 5 (vector result, complex expression with more than one parent):
# --------------------------------------------------------------------------------------
# named expression:
sW <- def_sW(sum.netW2W3 = sum(W3[[1:Kmax]]*W2[[1:Kmax]]), replaceNAw0 = TRUE)

mat1a <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl)
(map1a <- sW$sVar.names.map)
head(mat1a)
checkTrue(all.equal(names(map1a)[1], "sum.netW2W3"))
# checkTrue(all.equal(colnames(mat1a)[1], names(map1a)[1]))

# the same unnamed expression (should throw an exception):
sW <- def_sW(sum(W3[[1:Kmax]]*W2[[1:Kmax]]), replaceNAw0 = TRUE)

checkException(mat1b <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl))

# --------------------------------------------------------------------------------------
# test 6 (matrix result, complex expression with more than one parent):
# --------------------------------------------------------------------------------------
# when more than one parent is present, new naming convention for resulting column names:
# sVar.name%+%c(1:ncol)
sW <- def_sW(sum.netW2W3 = W3[[1:Kmax]]*W2[[1:Kmax]])

mat1a <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl)
(map1a <- sW$sVar.names.map)
head(mat1a)
checkTrue(all.equal(map1a$sum.netW2W3, "sum.netW2W3."%+%c(1:6)))

# the same as unnamed expression (should throw an exception):
sW <- def_sW(W3[[1:Kmax]]*W2[[1:Kmax]])
checkException(mat1b <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl))

# --------------------------------------------------------------------------------------
# test 7 (removing duplicate summary measure names):
# --------------------------------------------------------------------------------------
sW <- def_sW(netW1 = W1[[1:Kmax]], W1, W2, W3) + def_sW(netW1 = W2[[1:Kmax]])
mat1 <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl)
sW$sVar.names.map
head(mat1)

# check that only one summary measure names netW1 exists:
checkTrue(sum(names(sW$sVar.names.map)%in%"netW1")==1L)
# check that columns from the first summary measure (W1_netF1, ..., W1_netF6) were removed:
# checkTrue(!"W1_netF1"%in%colnames(mat1))
# checkTrue(!"W1_netF2"%in%colnames(mat1))
# checkTrue(!"W1_netF3"%in%colnames(mat1))
# checkTrue(!"W1_netF4"%in%colnames(mat1))
# checkTrue(!"W1_netF5"%in%colnames(mat1))
# checkTrue(!"W1_netF6"%in%colnames(mat1))

# --------------------------------------------------------------------------------------
# test 8 (removing duplicate column names from evaluation matrix):
# --------------------------------------------------------------------------------------
sW <- def_sW(netW1 = W1[[1:Kmax]], W1, W2, W3) + def_sW(netW2 = W1[[1:Kmax]])
mat1 <- sW$eval.nodeforms(data.df = df_netKmax6, netind_cl = netind_cl)
sW$sVar.names.map
head(mat1)

# check that only one summary measure names netW1 exists:
checkTrue(sum(colnames(mat1) %in% "W1_netF1")==1L)
checkTrue(sum(colnames(mat1) %in% "W1_netF2")==1L)
checkTrue(sum(colnames(mat1) %in% "W1_netF3")==1L)
checkTrue(sum(colnames(mat1) %in% "W1_netF4")==1L)
checkTrue(sum(colnames(mat1) %in% "W1_netF5")==1L)
checkTrue(sum(colnames(mat1) %in% "W1_netF6")==1L)