## Performs Chi-sqared test to determine if genDist is a random draw from postDist "compareDS" <- function (postDist, genDist) { chi2 <- mahalanobis(genDist$parameterSet$value,postDist$parameterSet$value, postDist$parameterSet$covariance) list(chi2=chi2,df=length(genDist$parameterSet$value)) } ## Performs Chi-sqared test to determine if genDist is a random draw from postDist "compareHD" <- function (postDist, genDist) { alphas <- scaleTable(numericPart(postDist$parameterTable)) p <- scaleTable(numericPart(genDist$parameterTable)) if (is.null(nrow(p)) || nrow(p)==1) { p <- p*sum(alphas)/sum(p) df <- length(alphas) -1 } else { Nadj <- apply(alphas,1,sum)/apply(p,1,sum) p <- sweep(p,1,Nadj,"*") df <- nrow(alphas)*(ncol(alphas) -1) } chi2 <- 2*sum(ifelse(alphas<0.000001,0,p*log(p/alphas))) df <- df-sum(alphas<0.000001) list(chi2=chi2,df=df) } ## Compares two AMDs "compareAMD" <- function(postAMD,testAMD,level=.05,chatty=TRUE) { chi2 <- 0 df <- 0 for (imod in 1:length(postAMD$studentModels)) { mPost <- postAMD$studentModels[[imod]] mTest <- testAMD$studentModels[[imod]] if (chatty) { cat("Student Model ",mPost$id,":\n") } ## Two models could have different fill-ins depending on compilation order. wDist <- sapply(mPost$distributions,function (d) d$type!="Fillin Distribution") pDists <- mPost$distributions[wDist] wDist <- sapply(mTest$distributions,function (d) d$type!="Fillin Distribution") tDists <- mTest$distributions[wDist] for (idist in 1:length(pDists)) { dPost <- pDists[[idist]] dTest <- tDists[[idist]] if (chatty) { cat("Variable ",dPost$cons, ": \n") } if (dPost$type == "Fixed Distribution") { cat(" Fixed distribution, Skipping \n") } else { if (dPost$type == "HyperDirichlet Distribution") { result <- compareHD(dPost,dTest) } else { result <- compareDS(dPost,dTest) } if (chatty) { cat(" ", ifelse(result$chi2>qchisq(1-level,result$df),"***"," "), " chi2 = ",result$chi2, ", df = ",result$df,"\n") } chi2 <- chi2+ result$chi2 df <- df + result$df } } } for (imod in 1:length(postAMD$linkModels)) { mPost <- postAMD$linkModels[[imod]] mTest <- testAMD$linkModels[[imod]] if (chatty) { cat("\n Link Model ",mPost$id,":\n") } ## Two models could have different fill-ins depending on compilation order. wDist <- sapply(mPost$distributions,function (d) d$type!="Fillin Distribution") pDists <- mPost$distributions[wDist] wDist <- sapply(mTest$distributions,function (d) d$type!="Fillin Distribution") tDists <- mTest$distributions[wDist] for (idist in 1:length(pDists)) { dPost <- pDists[[idist]] dTest <- tDists[[idist]] if (chatty) { cat("Variable ",dPost$cons, ": \n") } if (dPost$type == "Fixed Distribution") { cat(" Fixed distribution, Skipping \n") } else { if (dPost$type == "HyperDirichlet Distribution") { result <- compareHD(dPost,dTest) } else { result <- compareDS(dPost,dTest) } if (chatty) { cat(" ", ifelse(result$chi2>qchisq(1-level,result$df),"***"," "), " chi2 = ",result$chi2, ", df = ",result$df,"\n") } chi2 <- chi2+ result$chi2 df <- df + result$df } } } list(chi2=chi2,df=df) } "compareEMtoLM" <- function(AMD,ADF,level=.05,chatty=TRUE) { lmids <- getECDMetaID(sapply(ADF$linkModels,function(x) x$id)) chi2 <- 0 df <- 0 for (iemod in 1:length(AMD$evidenceModels)) { mPrior <- AMD$evidenceModels[[iemod]] emid <- mPrior$id for (ilmod in grep(emid,lmids)) { mTest <- ADF$linkModels[[ilmod]] if (chatty) { cat("\n Evidence model", mPrior$id,"\n") cat(" Link Model ",mTest$id,":\n") } ## Two models could have different fill-ins depending on compilation order. wDist <- sapply(mPrior$distributions,function (d) d$type!="Fillin Distribution") pDists <- mPrior$distributions[wDist] wDist <- sapply(mTest$distributions,function (d) d$type!="Fillin Distribution") tDists <- mTest$distributions[wDist] for (idist in 1:length(pDists)) { dPost <- pDists[[idist]] dTest <- tDists[[idist]] if (chatty) { cat("Variable ",dPost$cons, ": \n") } if (dPost$type == "Fixed Distribution") { cat(" Fixed distribution, Skipping \n") } else { if (dPost$type == "HyperDirichlet Distribution") { result <- compareHD(dPost,dTest) } else { result <- compareDS(dPost,dTest) } if (chatty) { cat(" ", ifelse(result$chi2>qchisq(1-level,result$df),"***"," "), " chi2 = ",result$chi2, ", df = ",result$df,"\n") } chi2 <- chi2+ result$chi2 df <- df + result$df } } } } list(chi2=chi2,df=df) }