ZeligEI/0000755000176200001440000000000013116100673011540 5ustar liggesusersZeligEI/inst/0000755000176200001440000000000013076464766012542 5ustar liggesusersZeligEI/inst/JSON/0000755000176200001440000000000013076464766013313 5ustar liggesusersZeligEI/inst/JSON/zelig5eimodels.json0000644000176200001440000000347713104644616017124 0ustar liggesusers{ "zelig5eimodels": { "eirxc": { "name": ["eirxc"], "description": ["Multinomial Dirichlet model for Ecological Inference in RxC tables"], "outcome": { "modelingType": [""] }, "explanatory": { "modelingType": ["continuous", "discrete", "nominal", "ordinal", "binary"] }, "vignette.url": ["http://docs.zeligproject.org/articles/zeligei_eirxc.html"], "wrapper": ["eirxc"], "tree": ["Zelig-eirxc", "Zelig-ei"] }, "eidynamic": { "name": ["eidynamic"], "description": ["Quinn's Dynamic Ecological Inference Model"], "outcome": { "modelingType": [""] }, "explanatory": { "modelingType": ["continuous", "discrete", "nominal", "ordinal", "binary"] }, "vignette.url": ["http://docs.zeligproject.org/articles/zeligei_eidynamic.html"], "wrapper": ["eidynamic"], "tree": ["Zelig-eidynamic", "Zelig-ei"] }, "eihier": { "name": ["eihier"], "description": ["Wakefield's Hierarchical Ecological Inference Model"], "outcome": { "modelingType": [""] }, "explanatory": { "modelingType": ["continuous", "discrete", "nominal", "ordinal", "binary"] }, "vignette.url": ["http://docs.zeligproject.org/articles/zeligei_eihier.html"], "wrapper": ["eihier"], "tree": ["Zelig-eihier", "Zelig-ei"] }, "eiml": { "name": ["eiml"], "description": ["Ecological Inference Model by Maximum Likelihood"], "outcome": { "modelingType": [""] }, "explanatory": { "modelingType": ["continuous", "discrete", "nominal", "ordinal", "binary"] }, "vignette.url": ["http://docs.zeligproject.org/articles/zeligei_eiml.html"], "wrapper": ["eiml"], "tree": ["Zelig-eiml", "Zelig-ei"] } } }ZeligEI/tests/0000755000176200001440000000000013116014064012700 5ustar liggesusersZeligEI/tests/testthat.R0000755000176200001440000000011113076464766014706 0ustar liggesuserslibrary(testthat) library(ZeligEI) set.seed("123") test_check("ZeligEI")ZeligEI/tests/testthat/0000755000176200001440000000000013116100673014542 5ustar liggesusersZeligEI/tests/testthat/test-zelig-core.R0000644000176200001440000000121513115314714017703 0ustar liggesusers# FAIL TEST setx and sim should fail with ZeligEI ------------------------------ test_that('FAIL TEST setx and sim should fail with ZeligEI', { library("eiPack", quietly = TRUE) data(senc) z.out <- zeirxc$new() z.out$zelig(cbind(dem, rep, non) ~ cbind(black, white, natam), N = "total", data = senc) expect_error(z.out$setx(), 'Function is not relevant for ZeligEI objects.') expect_error(setx(z.out), 'Function is not relevant for ZeligEI objects.') expect_error(z.out$sim(), 'Function is not relevant for ZeligEI objects.') expect_error(sim(z.out), 'Function is not relevant for ZeligEI objects.') }) ZeligEI/tests/testthat/test-eihier.R0000755000176200001440000000230413104610302017101 0ustar liggesusersset.seed(123) rnormtrunc <- function(n,mean,sd){ b <- rep(0,n) flag<-rep(TRUE,n) while(any(flag)){ b[flag] <- rnorm(n=sum(flag), mean=mean, sd=sd) flag<- (b<0) | (b>1) } return(b) } n <- 50 total <- rep(200,n) mu.b <- 0.5 mu.w <- 0.5 bb <- rnormtrunc(n, mean=mu.b, sd=0.2) bw <- rnormtrunc(n, mean=mu.w, sd=0.2) x <- round(runif(n) * total) notx <- total - x z11 <- round(bb*x) z21 <- round(bw*notx) y <- z11 + z21 noty <- total - y x.frac <- x/total y.frac <- y/total notx.frac <- notx/total noty.frac <- noty/total mydata <- data.frame(bb,bw,z11,z21,x,notx,x.frac,notx.frac,y,noty,y.frac,noty.frac,total) # Different possible formula representations: z.out <- zeihier$new() z.out$zelig(y.frac~x.frac, N=total, data=mydata) expect_that(length(z.out$getcoef()), equals(5200000)) z2.out <- zeihier$new() z2.out$zelig(y.frac~x.frac, N="total", data=mydata) expect_that(length(z2.out$getcoef()), equals(5200000)) z3.out <- zeihier$new() z3.out$zelig( cbind(y.frac,noty.frac)~cbind(x.frac,notx.frac), N="total", data=mydata) expect_that(length(z3.out$getcoef()), equals(5200000)) z4.out <- zeihier$new() z4.out$zelig(y~x, N="total", data=mydata) expect_that(length(z4.out$getcoef()), equals(5200000)) ZeligEI/tests/testthat/test-eiml.R0000755000176200001440000000274213104610302016570 0ustar liggesusersset.seed(123) rnormtrunc <- function(n,mean,sd){ b <- rep(0,n) flag<-rep(TRUE,n) while(any(flag)){ b[flag] <- rnorm(n=sum(flag), mean=mean, sd=sd) flag<- (b<0) | (b>1) } return(b) } n <- 50 total <- rep(200,n) mu.b <- 0.5 mu.w <- 0.5 bb <- rnormtrunc(n, mean=mu.b, sd=0.2) bw <- rnormtrunc(n, mean=mu.w, sd=0.2) x <- round(runif(n) * total) notx <- total - x z11 <- round(bb*x) z21 <- round(bw*notx) y <- z11 + z21 noty <- total - y x.frac <- x/total y.frac <- y/total notx.frac <- notx/total noty.frac <- noty/total mydata <- data.frame(bb,bw,z11,z21,x,notx,x.frac,notx.frac,y,noty,y.frac,noty.frac,total) # Different possible formula representations: z.out <- zeiml$new() z.out$zelig(y.frac~x.frac, N=total, data=mydata) expect_that(length(z.out$getcoef()[[1]]), equals(25)) expect_that(round(z.out$getcoef()[[1]]$phi), equals(c(0,0,-2,-2,0,0,0))) z2.out <- zeiml$new() z2.out$zelig(y.frac~x.frac, N="total", data=mydata) expect_that(length(z2.out$getcoef()[[1]]), equals(25)) expect_that(round(z2.out$getcoef()[[1]]$phi), equals(c(0,0,-2,-2,0,0,0))) z3.out <- zeiml$new() z3.out$zelig( cbind(y.frac,noty.frac)~cbind(x.frac,notx.frac), N="total", data=mydata) expect_that(length(z3.out$getcoef()[[1]]), equals(25)) expect_that(round(z3.out$getcoef()[[1]]$phi), equals(c(0,0,-2,-2,0,0,0))) z4.out <- zeiml$new() z4.out$zelig(y~x, N="total", data=mydata) expect_that(length(z4.out$getcoef()[[1]]), equals(25)) expect_that(round(z4.out$getcoef()[[1]]$phi), equals(c(0,0,-2,-2,0,0,0))) ZeligEI/tests/testthat/test-eirxc.R0000755000176200001440000000144513104610302016753 0ustar liggesusersset.seed(123) rnormtrunc <- function(n,mean,sd){ b <- rep(0,n) flag<-rep(TRUE,n) while(any(flag)){ b[flag] <- rnorm(n=sum(flag), mean=mean, sd=sd) flag<- (b<0) | (b>1) } return(b) } n <- 50 total <- rep(200,n) mu.b <- 0.5 mu.w <- 0.5 mu.a <- 0.2 bb <- rnormtrunc(n, mean=mu.b, sd=0.2) bw <- rnormtrunc(n, mean=mu.w, sd=0.2) ba <- rnormtrunc(n, mean=mu.a, sd=0.2) x1 <- round(runif(n) * total) x2 <- round( (total - x1)*runif(n)) x3 <- total - x1 - x2 z11 <- round(bb*x1) z21 <- round(bw*x2) z31 <- round(ba*x3) y <- z11 + z21 + z31 noty <- total - y mydata <- data.frame(x1,x2,x3,y,noty,total) # Different possible formula representations: z.out <- zeirxc$new() z.out$zelig( cbind(y,noty)~cbind(x1,x2,x3), N="total", data=mydata) expect_that(length(z.out$getcoef()[[1]]), equals(3)) ZeligEI/NAMESPACE0000644000176200001440000000055313104610472012762 0ustar liggesusersimport(methods, Formula, Zelig, jsonlite, dplyr, eiPack, ei, MCMCpack) importFrom("MASS", "mvrnorm") importFrom("stats", "runif", "as.formula") importFrom("methods", "setRefClass") importFrom("methods", "new") exportPattern("^[[:alpha:]]+") exportClasses( "Zelig-ei", "Zelig-eirxc", "Zelig-eiml", "Zelig-eidynamic", "Zelig-eihier" ) ZeligEI/NEWS.md0000644000176200001440000000034413115315453012642 0ustar liggesusers# ZeligEI 0.1-2 * Informative fail message given when a ZeligEI object is passed to `setx` and `sim`. # ZeligEI 0.1-1 * Establish compatibility with Zelig 5.1-0. * Added a `NEWS.md` file to track changes to the package. ZeligEI/R/0000755000176200001440000000000013116014064011737 5ustar liggesusersZeligEI/R/model-dynamic-ei.R0000644000176200001440000000574613104644616015224 0ustar liggesusers#' Quinn's Dynamic Ecological Inference Model #' #' Vignette: \url{http://docs.zeligproject.org/articles/zeligei_eidynamic.html} #' @import methods #' @export Zelig-eidynamic #' @exportClass Zelig-eidynamic #' #' @include model-ei.R zeidynamic <- setRefClass("Zelig-eidynamic", contains = "Zelig-ei") zeidynamic$methods( initialize = function() { callSuper() .self$name <- "eidynamic" .self$description <- "Quinn's Dynamic Ecological Inference Model" .self$fn <- quote(MCMCpack::MCMCdynamicEI) .self$packageauthors <- "Andrew D. Martin, Kevin M. Quinn, Jong Hee Park" .self$wrapper <- "eidynamic" .self$vignette.url <- "http://docs.zeligproject.org/articles/zeligei_eidynamic.html" ref1<-bibentry( bibtype="InCollection", title = "Ecological Inference in the Presence of Temporal Dependence.", booktitle = "Ecological Inference: New Methodological Strategies", author = person("Kevin", "Quinn"), year = 2004, publisher = "Cambridge University Press", organization = "Cambridge University Press", address = "New York", editor = c(person("Gary", "King"), person("Ori", "Rosen"), person("Martin", "Tanner")) ) .self$refs<-c(.self$refs,ref1) } ) zeidynamic$methods( zelig = function(formula, data, N=NULL, ..., weights = NULL, by = NULL, bootstrap = FALSE, na.action="na.omit") { na.action <- checkZeligEIna.action(na.action) if(!identical(bootstrap,FALSE)){ stop("Error: The bootstrap is not available for Markov chain Monte Carlo (MCMC) models.") } if(!is.null(weights)){ stop("Error: This model is dynamic over time and currently Zelig does not have a weighting approach to work in this model. Check if you intended to use the W argument to adjust the temporal dependence among elements in the Quinn model.") } if(!is.null(by)){ stop("Error: The `by' argument is not implemented for Quinn's Dynamic EI model. Try the eiml model if this is required, or subset the data and run multiple models.") } cnvt <- convertEIformula(formula=formula, N=N, data=data, na.action=na.action) .self$zelig.call <- match.call(expand.dots = TRUE) .self$model.call <- match.call(expand.dots = TRUE) .self$model.call$r0 <- cnvt$r0 .self$model.call$r1 <- cnvt$r1 .self$model.call$c0 <- cnvt$c0 .self$model.call$c1 <- cnvt$c1 .self$model.call$N <- NULL .self$model.call$formula <- NULL .self$model.call$data <- NULL .self$model.call$na.action <- NULL # Note, formula and data pass through the Zelig internals, but are ignored by the wrapped model callSuper(formula = formula, data = data, ..., weights = NULL, by = NULL, bootstrap = FALSE) } ) zeidynamic$methods( param = function(z.out) { return(z.out) } ) zeidynamic$methods( getcoef = function() { "Get estimated model coefficients" return(.self$zelig.out$z.out[[1]]) } ) ZeligEI/R/model-ml-ei.R0000644000176200001440000000602413104644616014176 0ustar liggesusers#' Ecological Inference Model by Maximum Likelihood #' #' Vignette: \url{http://docs.zeligproject.org/articles/zeligei_eiml.html} #' @import methods #' @export Zelig-eiml #' @exportClass Zelig-eiml #' #' @include model-ei.R zeiml <- setRefClass("Zelig-eiml", contains = "Zelig-ei") zeiml$methods( initialize = function() { callSuper() .self$name <- "eiml" .self$description <- "Ecological Inference Model by Maximum Likelihood" .self$fn <- quote(ei::ei) .self$packageauthors <- "Gary King, Molly Roberts" .self$wrapper <- "eiml" .self$vignette.url <- "http://docs.zeligproject.org/articles/zeligei_eiml.html" ref1<-bibentry( bibtype="Book", title = "A Solution to the Ecological Inference Problem: Reconstructing Individual Behavior from Aggregate Data", author = person("Gary", "King"), year = 1997, publisher = "Princeton University Press", organization = "Princeton University Press", address = "Princeton" ) .self$refs<-c(.self$refs, ref1) } ) zeiml$methods( zelig = function(formula, data, N = NULL, ..., weights = NULL, by = NULL, bootstrap = FALSE, na.action="na.omit") { na.action <- checkZeligEIna.action(na.action) #if(is.null(N)){ # stop("The argument N needs to be set to the name of the variable giving the total for each unit, or a vector of counts.") #} cnvt <- convertEIformula2(formula=formula, data=data, N=N, na.action=na.action) localformula <- cnvt$formula localdata <- cnvt$data .self$zelig.call <- match.call(expand.dots = TRUE) .self$model.call <- match.call(expand.dots = TRUE) .self$model.call$formula <- localformula .self$model.call$N <- NULL .self$model.call$na.action <- NULL .self$model.call$total <- cnvt$totalName # Check if N needs to be replaced in this model, or everything can rely on .self$model.call$total callSuper(formula = localformula, data = localdata, N=N, ..., weights = weights, by = by, bootstrap = bootstrap) } ) zeiml$methods( param = function(z.out, method=NULL) { # method arguments allows bootstrap. However, the same object should be returned regardless. sim <- ei::ei.sim(z.out) return(sim) } ) zeiml$methods( qi = function(simparam, mm) { if(.self$bootstrap){ ev <- ei::eiread(simparam, "maggs") }else{ ev <- ei::eiread(simparam, "aggs") } return(list(ev = ev)) } ) # Overwrite diagnostic test that are inherited from model-ei zeiml$methods( geweke.diag = function() { stop("The eiml model is not estimated by Markov chain Monte Carlo, so this test for MCMC convergence is not needed.") } ) zeiml$methods( heidel.diag = function() { stop("The eiml model is not estimated by Markov chain Monte Carlo, so this test for MCMC convergence is not needed.") } ) zeiml$methods( raftery.diag = function() { stop("The eiml model is not estimated by Markov chain Monte Carlo, so this test for MCMC convergence is not needed.") } ) ZeligEI/R/create-json.R0000644000176200001440000000167413076464766014333 0ustar liggesusers#' @include model-ei.R #' @include model-hier-ei.R #' @include model-ml-ei.R #' @include model-dynamic-ei.R #' @include model-rxc-ei.R #library(jsonlite) createJSONzeligei <- function(){ z5eirxc <- zeirxc$new() z5eirxc$toJSON() z5eidynamic <- zeidynamic$new() z5eidynamic$toJSON() z5eihier <- zeihier$new() z5eihier$toJSON() z5eiml <- zeiml$new() z5eiml$toJSON() zeligeimodels <- list(zelig5eimodels = list("eirxc" = z5eirxc$ljson, "eidynamic" = z5eidynamic$ljson, "eihier" = z5eihier$ljson, "eiml" = z5eiml$ljson)) cat(toJSON(zeligeimodels, pretty = TRUE), file = file.path("zelig5eimodels.json")) file.rename(from = file.path("zelig5eimodels.json"), to = file.path("inst", "JSON", "zelig5eimodels.json")) file.remove(file.path("zelig5eimodels.json")) return(TRUE) }ZeligEI/R/model-ei.R0000644000176200001440000003302413114355740013566 0ustar liggesusers#' Ecological Inference object for inheritance across models in ZeligEI #' #' @import methods #' @export Zelig-ei #' @exportClass Zelig-ei zei <- setRefClass("Zelig-ei", contains = "Zelig") zei$methods( initialize = function() { callSuper() .self$authors <- "James Honaker" .self$year <- 2016 .self$category <- "ei" .self$acceptweights <- FALSE } ) zei$methods( zelig = function(formula, data, N, ..., weights = NULL, by = NULL, bootstrap = FALSE) { # .self$zelig.call <- match.call(expand.dots = TRUE) # .self$model.call <- match.call(expand.dots = TRUE) # Check for zeros # Check for NA's callSuper(formula = formula, data = data, N=N, ..., weights = weights, by = by, bootstrap = bootstrap) } ) zei$methods( param = function(z.out, method="mvn") { if(identical(method,"mvn")){ return(mvrnorm(.self$num, coef(z.out), vcov(z.out))) } else if(identical(method,"point")){ return(t(as.matrix(coef(z.out)))) } else { stop("param called with method argument of undefined type.") } } ) #' Checking function for argument to na.action #' @keywords internal checkZeligEIna.action = function(na.action){ # Allow the user to accidentally pass the na.omit or na.fail functions, instead of a text string if(identical(na.action,stats::na.omit)){ na.action<-"na.omit" } if(identical(na.action,stats::na.fail)){ na.action<-"na.fail" } if(!(na.action %in% c("na.omit","na.fail"))){ stop("Error: Zelig's na.action argument should be a text string of 'na.omit' or 'na.fail' ") } return(na.action) } #' Conversion utility to allow different possible formula notations, and deal with zeroes and missing values, for EI models in eiml, eirxc #' @keywords internal convertEIformula2 = function(formula, data, N, na.action, rxc=FALSE){ newdata <- data newformula <- formula formula <- as.formula(formula) rterms <- length(formula[[2]]) cterms <- length(formula[[3]]) if(rterms>1){ rdata <- data[ as.character(formula[[2]][2:rterms] ) ] rtotal <- apply(rdata,1,sum) }else{ rtotal <- data[ as.character(formula[[2]] ) ] } if(cterms>1){ cdata <- data[ as.character(formula[[3]][2:cterms] ) ] ctotal <- apply(cdata,1,sum) }else{ ctotal <- data[ as.character(formula[[3]] ) ] } ## Determine whether N is valid, and format appropriately if(!is.null(N)){ if(is.character(N)){ Nvalid <- N %in% names(data) if(Nvalid){ Nvalues <- data[[ as.character(N) ]] totalName <- as.character(N) } }else if(is.numeric(N)){ Nvalid <- length(N) == nrow(data) if(Nvalid){ newdata$ZeligN <- N Nvalues <- N totalName <- "ZeligN" } else { stop("The argument N needs to match in length the number of observations in the dataset.") } } }else{ if((rterms==1) | (cterms==1)){ stop("The argument 'N' has not been specified, however the formula does not define all terms. Either set the 'N' argument, or redefine formula using 'cbind' notation, or both.") } if(! all(rtotal == ctotal)){ stop("Some of the row observations do not sum to the same total as the column observations. Please correct the data or the formula, or set the N argument.") } if (all (rtotal==1)){ stop("Row and column observations appear to be fractions, but no N argument has been set. Please correct the data or the formula, or set the N argument.") } Nvalues <- rtotal newdata$ZeligN <- rtotal totalName <- "ZeligN" } ## Examine and check appropriateness of formula check <- formula[[1]]=="~" ## Need more checks on formula structure for these models if(!rxc){ ## Rewrite formula passed to model, if written in cbind fashion if((rterms>1) | (cterms>1)){ newformula <- as.formula(paste(as.character(formula[[2]][2]) , "~" , as.character(formula[[3]][2]))) } ## Rewrite values in dataset passed to model, if counts instead of fractions if(any(rtotal > 1)){ newdata[ as.character(newformula[[2]] ) ] <- newdata[ as.character(newformula[[2]] ) ]/Nvalues } if(any(ctotal > 1)){ newdata[ as.character(newformula[[3]] ) ] <- newdata[ as.character(newformula[[3]] ) ]/Nvalues } } if(!check){ stop("Formula and/or N argument provided for EI model does not appear to match any of the accepted templates.") } ## Deal with tables with zero counts and missing values flag.missing <- is.na(rtotal) | is.na(ctotal) | is.na(Nvalues) if(any(flag.missing)){ if (na.action=="na.omit"){ warnings("There are observations in the EI model with missing values. These observations have been removed.") Nvalues <- Nvalues[!flag.missing] newdata <- newdata[!flag.missing,] rtotal <- rtotal[!flag.missing] ctotal <- ctotal[!flag.missing] } else { stop("Error: There are observations in the EI model with zero as the total count for the observation. \nRemove these observations from data, or change Zelig's 'na.action' argument.") } } flag.zero <- Nvalues<1 if(any(flag.zero)){ warnings("There are observations in the EI model with zero as the total count for the observation. Check data. These observations have been removed.") Nvalues<-Nvalues[!flag.zero] newdata <- newdata[!flag.zero] rtotal <- rtotal[!flag.zero] ctotal <- ctotal[!flag.zero] } if(any(Nvalues < rtotal) | any(Nvalues < ctotal)){ stop("The N argument provided for table totals is lower than some row or column counts. Please examine the data and correct.") } return(list(formula=newformula, data=newdata, N=Nvalues, totalName=totalName)) } #' Conversion utility to allow different possible formula notations, and deal with zeroes and missing values, for EI models in eiheir, eidynamic #' @keywords internal convertEIformula = function(formula, N, data, na.action){ formula <- as.formula(formula) ## Determine whether N is valid, and format appropriately if(!is.null(N)){ if(is.character(N)){ Nvalid <- N %in% names(data) if(Nvalid){ Nvalues <- data[[ as.character(N) ]] } else { stop("The argument 'N' appears to be intended to be a variable name, but does not match any name in the dataset ") } }else if(is.numeric(N)){ Nvalid <- length(N) == nrow(data) if(Nvalid){ Nvalues <- N } else { stop("The argument 'N' needs to match in length the number of observations in the dataset.") } } }else{ rterms <- length(formula[[2]]) cterms <- length(formula[[3]]) if((rterms==1) | (cterms==1)){ stop("The argument 'N' has not been specified, however the formula does not define all terms. Either set the 'N' argument, or redefine formula using 'cbind' notation, or both.") } rdata <- data[ as.character(formula[[2]][2:rterms] ) ] rtotal <- apply(rdata,1,sum) cdata <- data[ as.character(formula[[3]][2:cterms] ) ] ctotal <- apply(cdata,1,sum) Nvalid <- all(rtotal == ctotal) if(Nvalid){ Nvalues <- rtotal } else { stop("Some of the row observations do not sum to the same total as the column observations. Please correct the data or the formula, or set the 'N' argument.") } } ## Examine and check appropriateness of formula check <- formula[[1]]=="~" if(length(formula[[2]]) == 1){ check <- check & (length(formula[[3]]) == 1) & Nvalid # Need same length covariate list, and must have useable N argument if(check){ r0 <- data[[ as.character(formula[[2]]) ]] c0 <- data[[ as.character(formula[[3]]) ]] if( !identical(floor(r0),r0) ){ r0 <- round(r0 * Nvalues) c0 <- round(c0 * Nvalues) } r1 <- Nvalues - r0 c1 <- Nvalues - c0 } } else if (length(formula[[2]]) == 3){ check <- check & (length(formula[[3]]) == 3) # Need same length covariate list check <- check & formula[[2]][1] == "cbind()" if(check){ r0 <- data[[ as.character(formula[[2]][2]) ]] r1 <- data[[ as.character(formula[[2]][3]) ]] c0 <- data[[ as.character(formula[[3]][2]) ]] c1 <- data[[ as.character(formula[[3]][3]) ]] } if( !identical(floor(r0),r0) ){ # Make a better check here. Deal with case of 0-100 instead of fraction. Check if fractions sum to 1. check <- check & Nvalid # If variables expressed as proportions, must have useable N argument if(check){ r0 <- round(r0 * Nvalues) r1 <- Nvalues - r0 c0 <- round(c0 * Nvalues) c1 <- Nvalues - c0 } } } else { check <- FALSE } if(!check){ stop("Formula and/or N argument provided for EI model does not appear to match any of the accepted templates.") } ## Deal with tables with zero counts and missing values flag.zero <- Nvalues<1 if(any(flag.zero)){ warnings("There are observations in the EI model with zero as the total count for the observation. Check data. These observations have been removed.") r0<-r0[!flag.zero] r1<-r1[!flag.zero] c0<-c0[!flag.zero] c1<-c1[!flag.zero] Nvalues<-Nvalues[!flag.zero] } flag.missing <- is.na(r0) | is.na(r1) | is.na(c0) | is.na(c1) | is.na(Nvalues) if(any(flag.missing)){ if (na.action=="na.omit"){ warnings("There are observations in the EI model with missing values. These observations have been removed.") r0<-r0[!flag.missing] r1<-r1[!flag.missing] c0<-c0[!flag.missing] c1<-c1[!flag.missing] Nvalues<-Nvalues[!flag.missing] } else { stop("Error: There are observations in the EI model with zero as the total count for the observation. \nRemove these observations from data, or change Zelig's 'na.action' argument.") } } return(list(r0=r0,r1=r1,c0=c0,c1=c1,N=Nvalues)) } # This works for eiheir, eidynamic, eiml and needs overwriting for eirxc zei$methods( getcoef = function() { "Get estimated model coefficients" return(.self$zelig.out$z.out) } ) # This works for eihier, eidynamic and eirxc (with overwritten $getcoef method). Model eiml is not MCMC. zei$methods( geweke.diag = function() { mycoef<-.self$getcoef() if(is.list(mycoef[[1]])){ # eirxc is list of lists diag <- lapply(mycoef, function(x)lapply(x, coda::geweke.diag) ) }else{ # eidynamic and eihier pack all parameters into one list diag <- lapply(mycoef, coda::geweke.diag) } # Collapse if only one list element for prettier printing if(length(diag)==1){ diag<-diag[[1]] } if(!citation("coda") %in% .self$refs){ .self$refs<-c(.self$refs,citation("coda")) } ref1<-bibentry( bibtype="InCollection", title = "Evaluating the accuracy of sampling-based approaches to calculating posterior moments.", booktitle = "Bayesian Statistics 4", author = person("John", "Geweke"), year = 1992, publisher = "Clarendon Press", address = "Oxford, UK", editor = c(person("JM", "Bernado"), person("JO", "Berger"), person("AP", "Dawid"), person("AFM", "Smith")) ) .self$refs<-c(.self$refs,ref1) return(diag) } ) zei$methods( heidel.diag = function() { mycoef<-.self$getcoef() if(is.list(mycoef[[1]])){ # eirxc is list of lists diag <- lapply(mycoef, function(x)lapply(x, coda::heidel.diag) ) }else{ # eidynamic and eihier pack all parameters into one list diag <- lapply(mycoef, coda::heidel.diag) } # Collapse if only one list element for prettier printing if(length(diag)==1){ diag<-diag[[1]] } if(!citation("coda") %in% .self$refs){ .self$refs<-c(.self$refs,citation("coda")) } ref1<-bibentry( bibtype="Article", title = "Simulation run length control in the presence of an initial transient.", author = c(person("P", "Heidelberger"), person("PD", "Welch")), journal = "Operations Research", volume = 31, year = 1983, pages = "1109--44") .self$refs<-c(.self$refs,ref1) return(diag) } ) zei$methods( raftery.diag = function() { mycoef<-.self$getcoef() if(is.list(mycoef[[1]])){ # eirxc is list of lists diag <- lapply(mycoef, function(x)lapply(x, coda::raftery.diag) ) }else{ # eidynamic and eihier pack all parameters into one list diag <- lapply(mycoef, coda::raftery.diag) } # Collapse if only one list element for prettier printing if(length(diag)==1){ diag<-diag[[1]] } if(!citation("coda") %in% .self$refs){ .self$refs<-c(.self$refs,citation("coda")) } ref1<-bibentry( bibtype="Article", title = "One long run with diagnostics: Implementation strategies for Markov chain Monte Carlo.", author = c(person("Adrian E", "Raftery"), person("Steven M", "Lewis")), journal = "Statistical Science", volume = 31, year = 1992, pages = "1109--44") ref2<-bibentry( bibtype="InCollection", title = "The number of iterations, convergence diagnostics and generic Metropolis algorithms.", booktitle = "Practical Markov Chain Monte Carlo", author = c(person("Adrian E", "Raftery"), person("Steven M", "Lewis")), year = 1995, publisher = "Chapman and Hall", address = "London, UK", editor = c(person("WR", "Gilks"), person("DJ", "Spiegelhalter"), person("S", "Richardson")) ) .self$refs<-c(.self$refs,ref1,ref2) return(diag) } ) ZeligEI/R/model-hier-ei.R0000644000176200001440000000524113104644616014515 0ustar liggesusers#' Wakefield's Hierarchical Ecological Inference Model #' #' Vignette: \url{http://docs.zeligproject.org/articles/zeligei_eihier.html} #' @import methods #' @export Zelig-eihier #' @exportClass Zelig-eihier #' #' @include model-ei.R zeihier <- setRefClass("Zelig-eihier", contains = "Zelig-ei") zeihier$methods( initialize = function() { callSuper() .self$name <- "eihier" .self$description <- "Wakefield's Hierarchical Ecological Inference Model" .self$fn <- quote(MCMCpack::MCMChierEI) .self$packageauthors <- "Andrew D. Martin, Kevin M. Quinn, Jong Hee Park" .self$wrapper <- "eihier" .self$vignette.url <- "http://docs.zeligproject.org/articles/zeligei_eihier.html" ref1<-bibentry( bibtype="Article", title = "Ecological Inference for 2 x 2 Tables.", author = person("Jonathan C.", "Wakefield"), journal = "Journal of the Royal Statistical Society, Series A.", volume = 167, number = 3, year = 2004, pages = "385--445") .self$refs<-c(.self$refs,ref1) } ) zeihier$methods( zelig = function(formula, data, N=NULL, ..., weights = NULL, by = NULL, bootstrap = FALSE, na.action="na.omit") { na.action <- checkZeligEIna.action(na.action) if(!identical(bootstrap,FALSE)){ stop("Error: The bootstrap is not available for Markov chain Monte Carlo (MCMC) models.") } if(!is.null(weights)){ stop("Error: Weights are not implemented for the Wakefield Hierarchical EI model. Try the eiml model if weights are required.") } if(!is.null(by)){ stop("Error: The `by' argument is not implemented for the Wakefield Hierarchical EI model. Try the eiml model if this is required, or subset the data and run multiple models.") } cnvt <- convertEIformula(formula=formula, N=N, data=data, na.action=na.action) .self$zelig.call <- match.call(expand.dots = TRUE) .self$model.call <- match.call(expand.dots = TRUE) .self$model.call$r0 <- cnvt$r0 .self$model.call$r1 <- cnvt$r1 .self$model.call$c0 <- cnvt$c0 .self$model.call$c1 <- cnvt$c1 .self$model.call$N <- NULL .self$model.call$formula <- NULL .self$model.call$data <- NULL .self$model.call$na.action <- NULL # Note, formula and data pass through the Zelig internals, but are ignored by the wrapped model callSuper(formula = formula, data = data, ..., weights = NULL, by = NULL, bootstrap = FALSE) } ) zeihier$methods( param = function(z.out) { return(z.out) } ) zeihier$methods( getcoef = function() { "Get estimated model coefficients" return(.self$zelig.out$z.out[[1]]) } ) ZeligEI/R/model-rxc-ei.R0000644000176200001440000000445113104644616014364 0ustar liggesusers#' Multinomial Dirichlet model for Ecological Inference in RxC tables #' #' Vignette: \url{http://docs.zeligproject.org/articles/zeligei_eirxc.html} #' @import methods #' @export Zelig-eirxc #' @exportClass Zelig-eirxc #' #' @include model-ei.R zeirxc <- setRefClass("Zelig-eirxc", contains = "Zelig-ei") zeirxc$methods( initialize = function() { callSuper() .self$name <- "eirxc" .self$description <- "Multinomial Dirichlet model for Ecological Inference in RxC tables" .self$fn <- quote(eiPack::ei.MD.bayes) .self$packageauthors <- "Michael Kellerman, Olivia Lau" .self$wrapper <- "eirxc" .self$vignette.url <- "http://docs.zeligproject.org/articles/zeligei_eirxc.html" ref1<-bibentry( bibtype="Article", title = "Bayesian and Frequentist Inference for Ecological Inference: The R x C case.", author = c( person("Ori", "Rosen"), person("Wenxin", "Jiang"), person("Gary", "King"), person("Martin A.", "Tanner") ), journal = "Statistica Neerlandia", volume = 167, year = 2001, pages = "134--156") .self$refs<-c(.self$refs,ref1) } ) zeirxc$methods( zelig = function(formula, data, N = NULL, ..., weights = NULL, by = NULL, bootstrap = FALSE, na.action="na.omit") { na.action <- checkZeligEIna.action(na.action) if(!identical(bootstrap,FALSE)){ stop("Error: The bootstrap is not available for Markov chain Monte Carlo (MCMC) models.") } cnvt <- convertEIformula2(formula=formula, data=data, N=N, na.action=na.action, rxc=TRUE) localformula <- cnvt$formula localdata <- cnvt$data .self$zelig.call <- match.call(expand.dots = TRUE) .self$model.call <- match.call(expand.dots = TRUE) .self$model.call$N <- NULL .self$model.call$na.action <- NULL .self$model.call$total <- cnvt$totalName callSuper(formula = localformula, data = localdata, N=NULL, ..., weights = weights, by = by, bootstrap = bootstrap) } ) zeirxc$methods( getcoef = function() { "Get estimated model coefficients" coeflist <- list() for(i in 1:length(.self$zelig.out$z.out)){ coeflist[[i]]<-.self$zelig.out$z.out[[i]]$draw } return(coeflist) } ) ZeligEI/MD50000644000176200001440000000247413116100673012057 0ustar liggesusersdcb55470e61c613e3dfebd1f78f772b1 *DESCRIPTION 1172e69eab003d8a41100f2f7cf43102 *NAMESPACE 43b8260fdd8d88f9db7b1098abd2f683 *NEWS.md 75d81a4ec6175a37a8d750e50593724f *R/create-json.R d6841930c5478ec7c6dea6b06728864d *R/model-dynamic-ei.R 40759751d94d99f780d5bf96c15a178f *R/model-ei.R fd9624f33b66baac967e46ead71cf35b *R/model-hier-ei.R bfb4a5b4983cc9b17d2dc469a3ba1edf *R/model-ml-ei.R 270382e17e41e92b7d70e33af6d24295 *R/model-rxc-ei.R 035a864dbd3a71bc4c5cd83edfb86707 *inst/JSON/zelig5eimodels.json ffcad19b5a1d71994bfcd6d2382e0a25 *man/Zelig-ei-class.Rd 5fe75b990365f0a94a5e31abcd780880 *man/Zelig-eidynamic-class.Rd 8c97c6630edf4b268b665e14d25344ed *man/Zelig-eihier-class.Rd b76c81f4a38823bcad9fc960c8e84068 *man/Zelig-eiml-class.Rd b80c7ce1443d4563a5f2ffdcd8194843 *man/Zelig-eirxc-class.Rd 5956a81965a285858d184ee71536d67e *man/checkZeligEIna.action.Rd 209bc581c1fbe1012c03c35070218cc1 *man/convertEIformula.Rd f0b7952ede77d5db6979aafe39313d7f *man/convertEIformula2.Rd 60e8fbe239c9a85d9bd99cc2f08f300d *man/createJSONzeligei.Rd 4e30c2a266af9bef92b72ab6a3c1dfa3 *tests/testthat.R 1de5266a10930f985005efad0023c268 *tests/testthat/test-eihier.R 590bed3a4fe43285d99d46dfb3957cd6 *tests/testthat/test-eiml.R ef9c24058d6e645c14dd03da659089b2 *tests/testthat/test-eirxc.R ec15fa9cbe90c6ee3a343ec73ff3046b *tests/testthat/test-zelig-core.R ZeligEI/DESCRIPTION0000644000176200001440000000171613116100673013253 0ustar liggesusersPackage: ZeligEI License: GPL (>= 3) Title: Zelig Ecological Inference Models Authors@R: c( person("Christopher", "Gandrud", email = "zelig.zee@gmail.com", role = c("cre")), person("James", "Honaker", role = "aut") ) Description: Add-on package for Zelig 5. Enables the use of a variety of ecological inference models. URL: https://cran.r-project.org/package=ZeligEI BugReports: https://github.com/IQSS/ZeligEI/issues Version: 0.1-2 Date: 2017-06-05 Depends: eiPack Imports: dplyr, ei, Formula, jsonlite, MASS, MCMCpack, methods, Zelig (>= 5.1-0), Suggests: knitr, testthat Collate: 'create-json.R' 'model-ei.R' 'model-rxc-ei.R' 'model-dynamic-ei.R' 'model-ml-ei.R' 'model-hier-ei.R' RoxygenNote: 6.0.1 NeedsCompilation: no Packaged: 2017-06-07 15:13:56 UTC; cgandrud Author: Christopher Gandrud [cre], James Honaker [aut] Maintainer: Christopher Gandrud Repository: CRAN Date/Publication: 2017-06-07 22:44:11 UTC ZeligEI/man/0000755000176200001440000000000013104610302012303 5ustar liggesusersZeligEI/man/checkZeligEIna.action.Rd0000644000176200001440000000050213104610302016650 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-ei.R \name{checkZeligEIna.action} \alias{checkZeligEIna.action} \title{Checking function for argument to na.action} \usage{ checkZeligEIna.action(na.action) } \description{ Checking function for argument to na.action } \keyword{internal} ZeligEI/man/Zelig-ei-class.Rd0000644000176200001440000000107713104610302015347 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-ei.R \docType{class} \name{Zelig-ei-class} \alias{Zelig-ei-class} \alias{zei} \title{Ecological Inference object for inheritance across models in ZeligEI} \description{ Ecological Inference object for inheritance across models in ZeligEI } \section{Methods}{ \describe{ \item{\code{getcoef()}}{Get estimated model coefficients} \item{\code{zelig(formula, data, model = NULL, ..., weights = NULL, by, bootstrap = FALSE)}}{The zelig function estimates a variety of statistical models} }} ZeligEI/man/Zelig-eirxc-class.Rd0000644000176200001440000000066013104644616016100 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-rxc-ei.R \docType{class} \name{Zelig-eirxc-class} \alias{Zelig-eirxc-class} \alias{zeirxc} \title{Multinomial Dirichlet model for Ecological Inference in RxC tables} \description{ Vignette: \url{http://docs.zeligproject.org/articles/zeligei_eirxc.html} } \section{Methods}{ \describe{ \item{\code{getcoef()}}{Get estimated model coefficients} }} ZeligEI/man/Zelig-eidynamic-class.Rd0000644000176200001440000000065413104644616016733 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-dynamic-ei.R \docType{class} \name{Zelig-eidynamic-class} \alias{Zelig-eidynamic-class} \alias{zeidynamic} \title{Quinn's Dynamic Ecological Inference Model} \description{ Vignette: \url{http://docs.zeligproject.org/articles/zeligei_eidynamic.html} } \section{Methods}{ \describe{ \item{\code{getcoef()}}{Get estimated model coefficients} }} ZeligEI/man/Zelig-eiml-class.Rd0000644000176200001440000000047513104644616015720 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-ml-ei.R \docType{class} \name{Zelig-eiml-class} \alias{Zelig-eiml-class} \alias{zeiml} \title{Ecological Inference Model by Maximum Likelihood} \description{ Vignette: \url{http://docs.zeligproject.org/articles/zeligei_eiml.html} } ZeligEI/man/convertEIformula2.Rd0000644000176200001440000000101513104610302016135 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-ei.R \name{convertEIformula2} \alias{convertEIformula2} \title{Conversion utility to allow different possible formula notations, and deal with zeroes and missing values, for EI models in eiml, eirxc} \usage{ convertEIformula2(formula, data, N, na.action, rxc = FALSE) } \description{ Conversion utility to allow different possible formula notations, and deal with zeroes and missing values, for EI models in eiml, eirxc } \keyword{internal} ZeligEI/man/createJSONzeligei.Rd0000644000176200001440000000065713076464766016145 0ustar liggesusers\name{createJSONzeligei} \alias{createJSONzeligei} \title{Utility function for constructing JSON file that encodes the hierarchy of available statistical models in ZeligEI} \usage{ createJSONzeligei() } \value{ Returns TRUE on successful completion of json file } \description{ Utility function for construction a JSON file that encodes the hierarchy of available statistical models. } \author{ Christine Choirat, Vito D'Orazio }ZeligEI/man/Zelig-eihier-class.Rd0000644000176200001440000000064613104644616016237 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-hier-ei.R \docType{class} \name{Zelig-eihier-class} \alias{Zelig-eihier-class} \alias{zeihier} \title{Wakefield's Hierarchical Ecological Inference Model} \description{ Vignette: \url{http://docs.zeligproject.org/articles/zeligei_eihier.html} } \section{Methods}{ \describe{ \item{\code{getcoef()}}{Get estimated model coefficients} }} ZeligEI/man/convertEIformula.Rd0000644000176200001440000000101113104610302016047 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-ei.R \name{convertEIformula} \alias{convertEIformula} \title{Conversion utility to allow different possible formula notations, and deal with zeroes and missing values, for EI models in eiheir, eidynamic} \usage{ convertEIformula(formula, N, data, na.action) } \description{ Conversion utility to allow different possible formula notations, and deal with zeroes and missing values, for EI models in eiheir, eidynamic } \keyword{internal}