### This is a series of classes for parsing and evaluating ### AMD and GM objects # setClassUnion("array or NULL",c("array","NULL")) # setClassUnion("matrix or NULL",c("matrix","NULL")) # setClass("parameterVector", # representation("numeric", # identifier="character", # covariance="matrix or NULL" # )) # setMethod("show","parameterVector", function (object) # { # cat("Parameters for \"",object@identifier,"\"\n") # show(object[1:length(object)]) # }) # setClassUnion("parmeterVector or NULL",c("parameterVector","NULL")) # setClass("distribution", # representation(conditions="character", # consequences="character", # type = "character", # table="array or NULL", # parameterSet = "parameterVector or NULL", # parameterTable = "array or NULL")) # setClass("varDescription", # representation(name="character",nodeName="character", # role="character",levels="character")) ## S4 class stuff is not working, try again with S3 classes. ## Creates a new parameter vector object "parameterVector" <- function(params, identifier=character(0), covariance=NULL) { obj <- list(value=params, identifier=identifier, covariance=covariance) class(obj) <- "parameterVector" obj } "show.parameterVector" <- function (object) { cat("Parameters for \"",object$identifier,"\"\n") show(object$value) } buildParameterVector <- function(model,varname, alpha,betas,dincs=numeric(0), alphaVar,betaVar,dincVar=numeric(0)) { pnames <- c("Task Difficulty", paste("Relative Importance(",names(betas),")",sep="")) if (length(dincs)>0) { pnames <- c(pnames, paste("Level Difficulty Increment(", varname,",",names(dincs),")",sep="")) } pvalue <- c(alpha,betas,dincs) names(pvalue) <- pnames pcov <- matrix(0,nrow=length(pnames),ncol=length(pnames), dimnames=list(pnames,pnames)) diag(pcov) <- c(alphaVar,betaVar,dincVar) parameterVector(pvalue,paste(model,varname,sep="."),pcov) } pv.beta <- function (pv) { pv$value[1] } pv.alphas <- function (pv) { pn <- names(pv$value) ind <- grep("Relative Importance",pn) alpha <- pv$value[ind] names(alpha) <-sub("Relative Importance\\((.*)\\)","\\1",pn[ind]) alpha } pv.dinc <- function (pv) { pn <- names(pv$value) ind <- grep("Level Difficulty Increment",pn) dinc <- pv$value[ind] names(dinc) <-sub("Level Difficulty Increment\\((.*),(.*)\\)","\\2",pn[ind]) dinc } ## Constructor for Distribution "distribution" <- function (conditions=character(0), consequences=character(0), type = character(0), table = NULL, parameterSet=NULL, parameterTable = NULL) { obj <- list(conditions=conditions, consequences=consequences, type=type, table=table, parameterSet=parameterSet, parameterTable = parameterTable) class(obj) <- "distribution" obj } ## Constructor for var description object "varDescription" <- function (name=character(0),nodeName=character(0), role=character(0),levels=character(0), isOrdered=TRUE) { obj <- list (name=name, nodeName=nodeName, role=role, levels=levels, isOrdered=isOrdered) class(obj) <- "varDescription" obj } "toString.varDescription" <- function (x,...) { paste(""); } "print.varDescription" <- function (x,...) { print(paste(""),...); } ### Contructor for a gmModel class "gmModel" <- function(id,taskID=character(0), type=length(taskID)>0?"EM/LM":"SM", variables=list(0),distributions=list(0)) { if (length(variables) > 1) { vnames <- sapply(variables,function(v) v$name) variables <- variables[order(vnames)] } if (length(distributions) > 1) { dnames <- sapply(distributions, function(d) d$consequences[1]) distributions <- distributions[order(dnames)] } obj <- list(id=id,taskID=taskID,type=type,variables=variables, distributions=distributions) class(obj) <- "gmModel" obj } "toString.gmModel" <- function (x,...) { paste("<",x$type,": ",x$id,">"); } "print.gmModel" <- function (x,...) { print(paste("<",x$type,": ",x$id,">"),...); } ## Parsing stuff #library(XML) ##pt <- xmlTreeParse("A46helios.1_AccessS9EM.gm.xml") ##ptr <- xmlRoot(pt) ##xmlSize(ptr) ##xmlApply(ptr,xmlName) ##dists <- xmlElementsByTagName(ptr,"Distribution") ##vars <- xmlElementsByTagName(ptr,"DiscreteVariable") "getEMObservables" <- function (em) { which <- sapply(em$variables, function(v) v$role == "Observable") em$variables[which] } ### This function creates a varDescription from the xml ### DiscreteVariable element. "parseVar" <- function (xNode) { ## TODO Do I need to reverse these two lines to get the defaults right? nodeName <- xmlGetAttr(xNode,"varName") name <- xmlGetAttr(xNode,"externalName",default=nodeName) role <- xmlGetAttr(xNode,"role") snames <- sapply(xmlElementsByTagName(xNode,"State"),xmlValue) isOrdered <- xmlGetAttr(xNode,"isOrdered",default=TRUE,converter=as.logical) ## Get rid of confusing labels names(snames) <- NULL varDescription(name,nodeName,role,snames,isOrdered) } ### This function creates a distribution from the xml Distribution ### element. "parseDist" <- function (xNode) { result <- distribution() result$type <- xmlGetAttr(xNode,"type") cond <- xmlElementsByTagName(xNode,"Conditions") condNames <- xmlSApply(cond[[1]],function(n) xmlGetAttr(n,"varName")) ## This traps a problem where the cons name list is ## empty and returns a value of list() result$conditions <- as.character(condNames) names(result$conditions) <- NULL cons <- xmlElementsByTagName(xNode,"Consequences") consNames <- xmlSApply(cons[[1]],function(n) xmlGetAttr(n,"varName")) result$consequences <- as.character(consNames) names(result$consequences) <- NULL result$table <- NULL table <- xmlElementsByTagName(xNode,"DistributionTable") if (length(table) > 0) { result$table <- parseTable(table[[1]]) } result$parameterSet <- NULL ps <- xmlElementsByTagName(xNode,"ParameterSet") if (length(ps) > 0) { result$parameterSet <- parseParameterSet(ps[[1]]) result$parameterSet$identifier <- result$consequences } result$parameterTable <- NULL table <- xmlElementsByTagName(xNode,"ParameterTable") if (length(table) > 0) { result$parameterTable <- parseTable(table[[1]]) } result } ###################################################################### ### Tables ### This function parses a table from a or ### element. "parseTable" <- function(xNode) { rows <- xmlElementsByTagName(xNode,"TableRow") col.names <- parseTableHeader(rows[[1]]) numbers <- t(sapply(rows,function(row) { sapply(xmlElementsByTagName(row,"TableCell"),xmlValue) })) numbers <- matrix(as.numeric(numbers),nrow=nrow(numbers)) if (length(rows) == 1) { result <- data.frame(numbers,row.names=NULL) } else { labels <- sapply(rows,function(row) { trh <- xmlElementsByTagName(row,"TableRowHeader")[[1]] sapply(xmlElementsByTagName(trh,"TableHeaderCell"),xmlGetAttr,"state") }) if (is.null(nrow(labels))) { ## Correction for 1 column case labels <- matrix(labels,nrow=nrow(numbers)) } else { labels <- t(labels) } result <- data.frame(labels,numbers,row.names=NULL) } names(result) <- col.names result } ### Gets the header information from a row of a table. "parseTableHeader" <- function(rowNode) { trh <- xmlElementsByTagName(rowNode,"TableRowHeader") if (length(trh) >0) { thc <- xmlElementsByTagName(trh[[1]],"TableHeaderCell") parents <- sapply(thc,xmlGetAttr,"varName") } else { parents <- character(0) } cells <- xmlElementsByTagName(rowNode,"TableCell") states <- sapply(cells,xmlGetAttr,"state") c(parents,states) } ###################################################################### ### Parameter Sets ### This function creates a parameterVector from the xml ParameterSet ### element. "parseParameterSet" <- function (xNode) { data <- numeric() names <- character() cov <- NULL for (child in xmlChildren(xNode)) { if (xmlName(child) == "CovMatrix") { cov <- child } else { names <- c(names,getParameterName(child)) data <- c(data,as.numeric(xmlValue(child))) } } names(data) <- names result <- parameterVector(data,covariance=NULL) if (!identical(cov,NULL)) { result$covariance <- parseCov(cov) } result } ###################################### #### Parameter Name stuff. ### Extracts the stylized name of a parameter from ### A parameter name reference. "getParameterName" <- function (xNode) { UseMethod("getParameterName") } ### Will coerce this into a new class based on the ### name of the XML tag, then recall. "getParameterName.XMLNode" <- function (xNode) { cl <- class(xNode) if (length(cl)>5) { stop("Can't find getParameterName method for class ",cl) } class(xNode) <- c(xmlName(xNode),cl) getParameterName(xNode) } "getParameterName.ParameterValue" <- function (xNode) { xmlGetAttr(xNode,"parameterName") } "getParameterName.VarParameterValue" <- function (xNode) { name <- xmlGetAttr(xNode,"parameterName") var <- xmlGetAttr(xNode,"varName") paste(name,"(",var,")",sep="") } "getParameterName.StateParameterValue" <- function (xNode) { name <- xmlGetAttr(xNode,"parameterName") var <- xmlGetAttr(xNode,"varName") state <- xmlGetAttr(xNode,"state") paste(name,"(",var,",",state,")",sep="") } "getParameterName.ParName" <- function (xNode) { xmlValue(xNode) } "getParameterName.VarParName" <- function (xNode) { name <- xmlValue(xNode) var <- xmlGetAttr(xNode,"varName") paste(name,"(",var,")",sep="") } "getParameterName.StateParName" <- function (xNode) { name <- xmlValue(xNode) var <- xmlGetAttr(xNode,"varName") state <- xmlGetAttr(xNode,"state") paste(name,"(",var,",",state,")",sep="") } ###################################### #### Covariance Matrix Processing ### Parses the covariance Matrix "parseCov" <- function (xNode) { UseMethod("parseCov") } ### Will coerce this into a new class based on the ### type attribute "parseCov.XMLNode" <- function (xNode) { if (xmlName(xNode) != "CovMatrix") { stop("Method only works for elements.") } cl <- class(xNode) if (length(cl)>5) { stop("Can't find parseCov method for class ",cl) } class(xNode) <- c(xmlGetAttr(xNode,"type"),cl) parseCov(xNode) } "parseCov.DIAGONAL" <- function (xNode) { data <- numeric() names <- character() cov <- NULL for (child in xmlChildren(xNode)) { if (xmlName(child) == "CovMatrixRow") { data <- c(data,as.numeric(xmlValue(child))) } else { names <- c(names,getParameterName(child)) } } if (length(data) != length(names)) { stop("Bad covariance matrix.") } result <- matrix(0,length(data),length(data),dimnames=list(names,names)) diag(result) <- data result } "parseCov.TRIANGULAR" <- function (xNode) { data <- numeric() names <- character() cov <- NULL for (child in xmlChildren(xNode)) { if (xmlName(child) == "CovMatrixRow") { data <- rbind(data,as.numeric(unlist(strsplit(xmlValue(child)," ")))) } else { names <- c(names,getParameterName(child)) } } if (nrow(data) != length(names)) { stop("Bad covariance matrix.") } if (ncol(data) != length(names)) { stop("Bad covariance matrix.") } result <- matrix(data,nrow(data),nrow(data),dimnames=list(names,names)) ## TODO This really doesn't take the case that the matrix is really ## triangluar into account. I may get into trouble some day. For ## now all of my test cases are diagonal anyway. result } ############################################ #### Actual AMD Parsing tricks ## Parses a gm.xml file and returns a gmModel object. "parseGmModel" <- function(filename,type) { pt <- xmlTreeParse(filename) ptr <- xmlRoot(pt) ## Parse IDs and guess type if not supplied. id <- NULL taskId <- character(0) smidtags <- xmlElementsByTagName(ptr,"StudentModelID") linkidtags <- xmlElementsByTagName(ptr,"LinkID") taskidtags <- xmlElementsByTagName(ptr,"TaskID") if (length(smidtags) > 0) { id <- xmlValue(smidtags[[1]]) if (missing(type)) type <- "SM" } if (length(linkidtags) > 0) { id <- xmlValue(linkidtags[[1]]) if (missing(type)) type <- "EM/LM" } if (length(taskidtags) > 0) { taskId <- xmlValue(taskidtags[[1]]) } ## Variables and Distributions vars <- lapply(xmlElementsByTagName(ptr,"DiscreteVariable"),parseVar) names(vars) <- sapply(vars, function(v) v$name) dists <- lapply(xmlElementsByTagName(ptr,"Distribution"),parseDist) names(dists) <- sapply(dists, function(d) d$consequences[1]) gmModel(id,taskId,type,vars,dists) } ## Reads the "gm.xml" file associated with a given ,, or node. "getGmModelFromNode" <- function (modelXML, chatty=FALSE) { type <- NULL name <- xmlName(modelXML) if (name=="StudentModel") type <- "SM" if (name=="EvidenceModel") type <- "EM" if (name=="LinkModel") type <- "LM" entity <- xmlGetAttr(modelXML,"entityref") if (chatty) { cat("Reading model: ",entity,"\n") } filename <- paste(entity,"gm.xml",sep=".") parseGmModel(filename,type) } ## Fetches a list of all parameter sets for a model, given ## StudentModel, EvidenceModel or LinkModel xml tag. "getParameterSetsForModel" <- function (modelXML,chatty=FALSE) { name <- xmlGetAttr(modelXML,"name") entity <- xmlGetAttr(modelXML,"entityref") if (chatty) { cat("Reading model: ",entity,"\n") } filename <- paste(entity,"gm.xml",sep=".") getParameterSetsFromGMFile(filename,name) } "getParameterSetsFromGMFile" <- function (filename,name=filename) { pt <- xmlTreeParse(filename) ptr <- xmlRoot(pt) dists <- xmlElementsByTagName(ptr,"Distribution") ## Apparently this needs to be sapply rather than lapply too result <- lapply(dists, function (xNode) { dist <- parseDist(xNode) ps <- dist$parameterSet if (!identical(ps,NULL)) { ps$identifier <-paste(name,ps$identifier,sep=".") } ps }) result <- result[!sapply(result,is.null)] names <- sapply(result,function(x) x$identifier) names(result) <- names result } ################################################################### ### AMD object "amd" <- function (studentModels,evidenceModels,linkModels, statistics=list(), missingCodes=list(), filename=NULL) { if (!is.null(studentModels)) { smname <- sapply(studentModels, function(x) getECDIDModel(x$id)) names(studentModels) <- smname studentModels <- studentModels[order(smname)] } if (!is.null(evidenceModels)) { emname <- sapply(evidenceModels, function(x) getECDIDModel(x$id)) names(evidenceModels) <- emname evidenceModels <- evidenceModels[order(emname)] } if (!is.null(linkModels)) { lmid <- sapply(linkModels,function(x) x$id) lmnames <- sapply(lmid,getECDIDtask) names(linkModels) <- lmnames linkModels <- linkModels[order(lmid)] } if (!is.null(statistics)) { statnames <- sapply(statistics, function(x) x$name) names(statistics) <- statnames statistics <- statistics[order(statnames)] } if (!is.null(missingCodes)) { codetype <- sapply(missingCodes, function(x) x$type) names(missingCodes) <- codetype missingCodes <- missingCodes[order(codetype)] } result <- list(studentModels = studentModels, evidenceModels = evidenceModels, linkModels = linkModels, statistics = statistics, missingCodes = missingCodes, filename = filename) class(result) <- "amd" result } ## This gets all of the parameters for an Assessment Model Description ## File and puts them into one big group. "getEMParametersForAMD" <- function (filename, chatty=FALSE) { curdir <- getwd() amdt <- xmlTreeParse(filename) setwd(dirname(filename)) out <- try({ amd <- xmlRoot(amdt) lms <- sapply(xmlElementsByTagName(amd,"EvidenceModelSet"), function (el) xmlElementsByTagName(el,"EvidenceModel")) ## for some reason need lapply rather than sapply here. result <- lapply(lms,getParameterSetsForModel,chatty) }) ## finally setwd(curdir) out } ## This gets all of the parameters for an Assessment Model Description ## File and puts them into one big group. "getLMParametersForAMD" <- function (filename, chatty=FALSE) { curdir <- getwd() amdt <- xmlTreeParse(filename) setwd(dirname(filename)) out <- try({ amd <- xmlRoot(amdt) lms <- sapply(xmlElementsByTagName(amd,"LinkModelSet"), function (el) xmlElementsByTagName(el,"LinkModel")) ## for some reason need lapply rather than sapply here. result <- lapply(lms,getParameterSetsForModel,chatty) }) ## finally setwd(curdir) out } ## This gets all of the parameters for an Assessment Model Description ## File and puts them into three lists, one for StudentModels, one for EvidenceModels ## and one for LinkModels "parseAMD" <- function (filename, chatty=FALSE) { curdir <- getwd() amdt <- xmlTreeParse(filename) setwd(dirname(filename)) result <- try({ amd <- xmlRoot(amdt) miss <- lapply(xmlElementsByTagName(amd, "MissingCode"), parseMissingCode) sms <- xmlElementsByTagName(amd,"StudentModel"); ## for some reason need lapply rather than sapply here. studentModels <- lapply(sms,getGmModelFromNode,chatty) ems <- sapply(xmlElementsByTagName(amd,"EvidenceModelSet"), function (el) xmlElementsByTagName(el,"EvidenceModel")) ## for some reason need lapply rather than sapply here. evidenceModels <- lapply(ems,getGmModelFromNode,chatty) lms <- sapply(xmlElementsByTagName(amd,"LinkModelSet"), function (el) xmlElementsByTagName(el,"LinkModel")) ## for some reason need lapply rather than sapply here. linkModels <- lapply(lms,getGmModelFromNode,chatty) statistics <- lapply(xmlElementsByTagName(amd, "Statistic"), parseStatistic) names(statistics) <- sapply(statistics, function(s) s$name) amd(studentModels, evidenceModels, linkModels, statistics, miss, filename) }) ## finally setwd(curdir) result } "printAMDParameterValues" <- function (amdObj) { for (model in amdObj$studentModels) { cat("Student Model: ",model$id,"\n") for (dist in model$distributions) { cat("Distribution for ",dist$consequences,"\n") if (dist$type == "HyperDirichlet Distribution") { print(dist$table) } else { print(dist$parameterSet$value) } } cat("\n") } for (model in amdObj$evidenceModels) { cat("Evidence Model: ",model$id,"\n") for (dist in model$distributions) { cat("Distribution for ",dist$consequences,"\n") if (dist$type == "HyperDirichlet Distribution") { print(dist$table) } else { print(dist$parameterSet$value) } } cat("\n") } for (model in amdObj$linkModels) { cat("Evidence Model: ",model$id,"\n") for (dist in model$distributions) { cat("Distribution for ",dist$consequences,"\n") if (dist$type == "HyperDirichlet Distribution") { print(dist$table) } else { print(dist$parameterSet$value) } } cat("\n") } } ############################################################### ### QMatrix check ## This builds a Q Matrix from the output of getEMParametersForAMD "buildQMatrix" <- function (plist) { ## First flatten the parameter list allemp1 <- unlist(plist, r=FALSE) #flatten allpnames <- unique(unlist(lapply(allemp1,function(p) names(p$value)))) slopenames <- allpnames[grep("Relative Importance",allpnames)] contextname <- slopenames[grep("Context",slopenames)] if (length(contextname)>0) { slopenames <- slopenames[-grep("Context",slopenames)] col.names <- c("Task Difficulty",sort(slopenames),contextname) } else { col.names <- c("Task Difficulty",sort(slopenames)) } ## Build the core Q-Matrix as a matrix. Q <- matrix(NA,nrow=length(allemp1),ncol=length(col.names), dimnames=list(names(allemp1),col.names)) ## Various pieces of metadata task <- character(0) EM <- character(0) observable <- character(0) ## Difficulty increment parameters ln <- allpnames[grep("Level Difficulty Increment",allpnames)] if (length(ln) >0) { lnr <- regexpr(",.*)",ln) dnames <- sort(unique(substr(ln,lnr+1,lnr+attr(lnr,"match.length")-2))) dpats <- paste("Level.*,",dnames,")",sep="") dnames <- paste("Dinc",dnames,sep=".") QInc <- matrix(NA,nrow=length(allemp1),ncol=length(dnames), dimnames=list(names(allemp1),dnames)) } else { ## No polytomous items dnames <- character(0) dpats <- character(0) QInc <- NULL } for (pname in names(allemp1)) { ## Parse Names ## Need to be careful here as Portal substitutes __ for spaces. split <- parsePname(pname) task <- c(task,split$task) EM <- c(EM,split$EM) observable <- c(observable,split$observable) ## Parse data pset <- allemp1[[pname]]$value Q[pname,] <- pset[match(col.names,names(pset))] ## Put the rest into other column if (length(dnames) > 0) { for (i in 1:length(dnames)) { ## If multiple matches, punt if (length(grep(dpats[i],names(pset)))!=1) { QInc[pname,dnames[i]] <- NA } else { QInc[pname,dnames[i]] <- pset[grep(dpats[i],names(pset))] } } } } if (is.null(QInc)) { result <- data.frame(EM=I(EM),task=I(task),observable=I(observable),Q) } else { result <- data.frame(EM=I(EM),task=I(task),observable=I(observable),Q,QInc) } ## original names are too long row.names(result) <- 1:nrow(result) ## Shorten column names names(result) <- sub("Relative\\.Importance\\.","",names(result)) names(result) <- sub("\\.$","",names(result)) class(result) <- c("QMatrix", class(result)) result } ##Splits up a Pname into its component parts. "parsePname" <- function(pname) { task <- "??" EM <- "??" observable <- "??" if (substring(pname, 1,23) == "LinkModelSet.LinkModel.") { pname <- substring(pname,24) sp1 <- regexpr("\\.[0-9]*_",pname) sp1 <- sp1 + attr(sp1,"match.length") task <- substring(pname,1,sp1-2) rest <- substring(pname,sp1) split2 <- unlist(strsplit(rest,"\\.{1}",perl=TRUE)) EM <- split2[1] observable <- split2[length(split2)] } else if (substring(pname, 1,31) == "EvidenceModelSet.EvidenceModel.") { pname <- substring(pname,32) split2 <- unlist(strsplit(pname,"\\.{1}",perl=TRUE)) EM <- split2[1] observable <- split2[length(split2)] } else { stop("Not an evidence or link model.") } list(task=task,EM=EM,observable=observable) } ## This builds a variance matrix for the Q Matrix from the output of getEMParametersForAMD "buildVMatrix" <- function (plist) { ## First flatten the parameter list allemp1 <- unlist(plist, r=FALSE) #flatten ## Build the core Q-Matrix as a matrix. V <- t(sapply(allemp1,function(p) diag(p$cov))) ## Various pieces of metadata task <- character(0) EM <- character(0) observable <- character(0) for (pname in names(allemp1)) { ## Parse Names ## Need to be careful here as Portal substitutes __ for spaces. split <- parsePname(pname) task <- c(task,split$task) EM <- c(EM,split$EM) observable <- c(observable,split$observable) } result <- data.frame(EM=I(EM),task=I(task),observable=I(observable),V) ## original names are too long row.names(result) <- 1:nrow(result) ## Shorten column names names(result) <- sub("Relative\\.Importance\\.","",names(result)) names(result) <- sub("Level\\.Difficulty\\.Increment\\.","Dinc.",names(result)) names(result) <- sub("\\.$","",names(result)) class(result) <- c("QMatrix", class(result)) result } ##################################################### ## Statistics "Statistic" <- function (name, class, model, reportingVars = character(0), reportOnUpdate = TRUE, scale=1, offset=0) { stat <- list(name = name, class = class, model = model, reportingVars = reportingVars, reportOnUpdate = reportOnUpdate, scale = scale, offset = offset) class(stat) <- "Statistic" stat } "print.Statistic" <- function (x, ...) { print(paste(""), ...) } "toString.Statistic" <- function (x, ...) { paste("") } "addStatsForVars" <- function (amd, stats) { smname <- names(amd$studentModels)[1] sm <- amd$studentModels[[1]] for (statname in names(stats)) { amd$statistics <- append(amd$statistics, buildStatsForVars(names(sm$variables), statname, stats[statname], smname)) } amd } "buildStatsForVars" <- function (varnames, statName, statClass, modelName, scale=1, offset=0) { result <- lapply(varnames, function(v) Statistic(paste(statName, "(", v, ")", sep = ""), statClass, modelName, v, scale, offset)) names(result) <- sapply(result, function(r) r$name) result } "parseStatistic" <- function (statNode) { name <- xmlGetAttr(statNode, "name") class <- xmlGetAttr(statNode, "class") reportOnUpdate <- xmlGetAttr(statNode, "reportOnUpdate", TRUE, function(x) x == "Yes") if (is.null(statNode[["UseStudentModel"]])) { model <- character(0) } else { model <- xmlGetAttr(statNode[["UseStudentModel"]], "model") } rve <- xmlElementsByTagName(statNode, "UseReportingVar") if (length(rve) == 0) { reportingVars <- character(0) } else { reportingVars <- sapply(rve, function(v) xmlGetAttr(v, "name")) names(reportingVars) <- NULL } if (is.null(statNode[["ScaleStatistic"]])) { scale <- 1 offset <- 0 } else { scale <- xmlGetAttr(statNode[["ScaleStatistic"]],"scaleFactor",1, as.numeric) offset <- xmlGetAttr(statNode[["ScaleStatistic"]],"offset",0, as.numeric) } Statistic(name, class, model, reportingVars, reportOnUpdate, scale, offset) }