### Functions and routines for building graphical models. buildHyperDirichletDist <- function (depVarName, parameterTable) { parents <- getTableParents(parameterTable) distribution(cond=parents, cons=depVarName, type="HyperDirichlet Distribution", table = normalizeTable(parameterTable), parameterTable = parameterTable) } buildGMfromTables <- function(id, tables, type="SM", scaleFactor=1, addVars=NULL, varRoles=ifelse(type=="SM","SM","Observable"), taskID=character(0)) { if (length(scaleFactor==1)) { scaleFactor <- rep(scaleFactor,length(tables)) names(scaleFactor) <- names(tables) } scaleFactor <- as.list(scaleFactor) if (length(varRoles==1)) { varRoles <- rep(varRoles,length(tables)) names(varRoles) <- names(tables) } vars <- lapply(names(tables), function (var) { ## as.vector is necessary here to strip off the name, which can cause problems later. varDescription(var,var,role=as.vector(varRoles[var]), levels = getTableStates(tables[[var]])) }) names(vars) <- names(tables) if (!is.null(addVars)) { vars <- append(vars,addVars) } dists <- lapply(names(tables), function (var) { buildHyperDirichletDist(var,rescaleTable(tables[[var]], scaleFactor[[var]])) }) names(dists) <- names(tables) gmModel(id, taskID, type=type, var=vars, dist=dists) } buildSMfromVar <- function(id, pvecs, covariance, means = 0, scaleFactor=1, start=names(pvecs)[1]) { struct <- structMatrix(covariance) pl <- buildParentList(struct,start) rt <- buildRegressions(covariance,means,pl) tabs <- buildRegressionTables(rt,pvecs,means,sqrt(diag(covariance))) buildGMfromTables(id,tabs,type="SM",scaleFactor=scaleFactor) } buildVarsFromPvecs <- function (pvecs, role="SM") { if (length(role) == 1) { role <- rep(role, length(pvecs)) names(role) <- names(pvecs) } result <- lapply(names(pvecs), function (var) { varDescription(var,var, role=role[var], levels = names(pvecs[[var]])) }) names(result) <- names(pvecs) result }