### Helper function to suppress output (form https://stat.ethz.ch/pipermail/r-help/2008-January/151471.html)
suppressFunctionOutput <- function(expr){
this_will_die <- capture.output({expr})
}
### Return node names for use in function
helper_node_names <- function(){
c("xyz", "abc", "123", "hij", "a1b2c3")
}
### Generate fixed data -- need 5 columns to match objects below
generate_fixed_data_frame <- function(){
x <- runif(5)
y <- exp(1)^(1:5)
z <- sqrt(y)
a <- x+1:5
b <- log(0.5)^(1:5)
data.frame(x, y, z, a, b)
}
generate_fixed_discrete_data_frame <- function(){
x <- c(0,1,0,1,0)
y <- c(1,0,1,0,1)
z <- c(0,1,2,1,0)
a <- c(1,1,1,0,0)
b <- c(0,0,1,1,1)
data.frame(x, y, z, a, b)
}
generate_continuous_sparsebnData <- function(){
suppressMessages(sparsebnData(generate_fixed_data_frame(), type = "c"))
}
generate_discrete_sparsebnData <- function(){
suppressMessages(sparsebnData(generate_fixed_discrete_data_frame(), type = "d"))
}
### Generate fixed data
generate_na_data_frame <- function(){
dat <- generate_fixed_data_frame()
dat[2,2] <- NA
dat
}
### Generate fixed objects for empty graphs
generate_empty_edgeList <- function(){
edgeList(list(integer(0)))
}
generate_empty_sparse <- function(){
sparse(list(rows = integer(0), cols = integer(0), vals = numeric(0), dim = c(1, 1), start = 1))
}
generate_empty_SparseBlockMatrixR <- function(){
li <- list(rows = list(), vals = list(), blocks = list(), sigmas = c(), start = 1)
SparseBlockMatrixR(li)
}
generate_empty_sparsebnFit <- function(){
li <- list(edges = generate_empty_edgeList(), nodes = "test", lambda = 1, nedge = 0, pp = 1, nn = 10, time = 1)
sparsebnFit(li)
}
generate_empty_sparsebnPath <- function(){
sbf <- generate_empty_sparsebnFit()
sparsebnPath(list(sbf, sbf, sbf, sbf))
}
generate_empty_matrix <- function(){
m <- matrix(0, nrow = 1, ncol = 1)
m
}
generate_empty_Matrix <- function(){
Matrix::Matrix(generate_empty_matrix())
}
generate_empty_adjacency_matrix <- function(){
m <- matrix(0, nrow = 1, ncol = 1)
m
}
generate_empty_adjacency_Matrix <- function(){
Matrix::Matrix(generate_empty_adjacency_matrix())
}
### Generate fixed objects for the following toy DAG
#
# 0 . . . .
# 1 0 . . .
# 0 0 0 . .
# 5 4 0 . .
# 0 3 0 0 .
#
generate_fixed_edgeList <- function(){
nnode <- 5
li <- vector("list", length = nnode)
li[[1]] <- c(2L,4L)
li[[2]] <- c(4L,5L)
li[[3]] <- integer(0)
li[[4]] <- integer(0)
li[[5]] <- integer(0)
edgeL <- edgeList(li)
edgeL
}
generate_fixed_sparse <- function(){
rows <- c(2, 4, 4, 5)
cols <- c(1, 1, 2, 2)
vals <- c(1, 5, 4, 3)
sparse(list(rows = as.integer(rows), cols = as.integer(cols), vals = vals, dim = c(5, 5), start = 1))
}
generate_fixed_graphNEL <- function(){
V <- helper_node_names()
edL <- vector("list", length=5)
names(edL) <- V
edL[[1]] <- list(edges=c(), weights=runif(1)) # Edge list is
edL[[2]] <- list(edges=c(V[1]), weights=runif(1)) # to-from, not
edL[[3]] <- list(edges=c(), weights=runif(1)) # from-to!
edL[[4]] <- list(edges=c(V[1], V[2]), weights=runif(2)) #
edL[[5]] <- list(edges=c(V[2]), weights=runif(1)) #
graph::graphNEL(nodes=V, edgeL=edL, edgemode="directed")
}
generate_fixed_SparseBlockMatrixR <- function(){
nnode <- 5
li <- list(rows = vector("list", length = nnode),
vals = vector("list", length = nnode),
blocks = vector("list", length = nnode),
sigmas = numeric(nnode),
start = 1)
### Parents / rows
li$rows[[1]] <- c(2L,4L)
li$rows[[2]] <- c(4L,5L)
li$rows[[3]] <- integer(0)
li$rows[[4]] <- integer(0)
li$rows[[5]] <- integer(0)
### Values
li$vals[[1]] <- c(1,5)
li$vals[[2]] <- c(4,3)
li$vals[[3]] <- integer(0)
li$vals[[4]] <- integer(0)
li$vals[[5]] <- integer(0)
### Blocks -- LEAVE EMPTY
### Sigmas
li$sigmas <- rep(1,5)
SparseBlockMatrixR(li)
}
generate_fixed_sparsebnFit <- function(edges = generate_fixed_edgeList()){
# sbm <- generate_fixed_SparseBlockMatrixR()
# edges <- generate_fixed_edgeList()
# sbf <- sparsebnFit(list(edges = edges, nodes = LETTERS[1:num.nodes(edges)], lambda = 1.54, nedge = num.edges(edges), pp = num.nodes(edges), nn = 10, time = 1))
sbf <- sparsebnFit(list(edges = edges,
nodes = helper_node_names()[1:num.nodes(edges)],
lambda = 1.54,
nedge = num.edges(edges),
pp = num.nodes(edges),
nn = 10,
time = 1))
sbf
}
generate_fixed_sparsebnPath <- function(sbf = generate_fixed_sparsebnFit()){
# sbf <- generate_fixed_sparsebnFit()
sbp <- sparsebnPath(list(sbf, sbf, sbf, sbf))
sbp
}
generate_fixed_matrix <- function(){
### Not the same as adjacency matrix!
m <- rbind(c(0, 0, 0, 0, 0),
c(1, 0, 0, 0, 0),
c(0, 0, 0, 0, 0),
c(5, 4, 0, 0, 0),
c(0, 3, 0, 0, 0))
m
# Matrix::Matrix(m)
}
generate_fixed_Matrix <- function(){
Matrix::Matrix(generate_fixed_matrix())
}
generate_fixed_adjacency_matrix <- function(){
### CCDr output is unweighted adjacency matrix by default
m <- rbind(c(0, 0, 0, 0, 0),
c(1, 0, 0, 0, 0),
c(0, 0, 0, 0, 0),
c(1, 1, 0, 0, 0),
c(0, 1, 0, 0, 0))
m
}
generate_fixed_adjacency_Matrix <- function(){
Matrix::Matrix(generate_fixed_adjacency_matrix())
}
generate_nontrivial_sparsebnPath <- function(){
sbf1 <- sbf2 <- sbf3 <- sbf4 <- generate_fixed_sparsebnFit()
sbf1$edges[[1]] <- sbf1$edges[[2]] <- integer(0)
sbf1$lambda <- 2.1
sbf1$nedge <- 0
sbf3$edges[[3]] <- c(4)
sbf3$lambda <- 0.97
sbf3$nedge <- sbf3$nedge + 1
sbf4$edges[[4]] <- c(1,3,5)
sbf4$lambda <- 0.57
sbf4$nedge <- sbf4$nedge + 3
sbp <- sparsebnPath(list(sbf1, sbf2, sbf3, sbf4))
sbp
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.