[r-cran-zelig] 10/102: Import Upstream version 2.2-2
Andreas Tille
tille at debian.org
Sun Jan 8 16:58:09 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-zelig.
commit 6866516a4ee164be641782b32891030d86e84ae2
Author: Andreas Tille <tille at debian.org>
Date: Sun Jan 8 09:38:59 2017 +0100
Import Upstream version 2.2-2
---
DESCRIPTION | 6 +-
R/MCMC/param.MCMCZelig.R | 14 +++
R/MCMC/print.summary.MCMCZelig.R | 12 +++
R/MCMC/qi.MCMCZelig.R | 173 ++++++++++++++++++++++++++++++++
R/MCMC/summary.MCMCZelig.R | 19 ++++
R/MCMC/zelig2MCMC.R | 212 +++++++++++++++++++++++++++++++++++++++
R/MCMC/zelig3MCMC.R | 83 +++++++++++++++
R/setx.default.R | 4 +
README | 3 +
9 files changed, 523 insertions(+), 3 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 9919bbf..69260ec 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: Zelig
-Version: 2.2-1
-Date: 2005-7-11
+Version: 2.2-2
+Date: 2005-7-13
Title: Zelig: Everyone's Statistical Software
Author: Kosuke Imai <kimai at Princeton.Edu>,
Gary King <king at harvard.edu>,
@@ -23,4 +23,4 @@ Description: Zelig is an easy-to-use program that can estimate, and
translates them into quantities of direct interest.
License: GPL version 2 or newer
URL: http://gking.harvard.edu/zelig
-Packaged: Mon Jul 11 12:39:01 2005; olau
+Packaged: Wed Jul 13 16:09:18 2005; olau
diff --git a/R/MCMC/param.MCMCZelig.R b/R/MCMC/param.MCMCZelig.R
new file mode 100644
index 0000000..007ee15
--- /dev/null
+++ b/R/MCMC/param.MCMCZelig.R
@@ -0,0 +1,14 @@
+param.MCMCZelig <- function(object, num = NULL, bootstrap = FALSE) {
+ if (bootstrap)
+ stop("For the class of MCMC models, no need to use Bootstrap method.")
+ else
+ res <- object$coefficients
+
+
+ res
+
+}
+
+
+
+
diff --git a/R/MCMC/print.summary.MCMCZelig.R b/R/MCMC/print.summary.MCMCZelig.R
new file mode 100644
index 0000000..d9f634d
--- /dev/null
+++ b/R/MCMC/print.summary.MCMCZelig.R
@@ -0,0 +1,12 @@
+print.summary.MCMCZelig <- function(object, digits=max(3, getOption("digits") - 3), ...) {
+ cat("\nCall: ")
+ print(object$call)
+ cat("\n", "Iterations = ", object$start, ":", object$end, "\n", sep = "")
+ cat("Thinning interval =", object$thin, "\n")
+ cat("Number of chains =", object$nchain, "\n")
+ cat("Sample size per chain =", (object$end -
+ object$start)/object$thin + 1, "\n")
+ cat("\n", "Mean, standard deviation, and quantiles for marginal posterior distributions.", "\n")
+ print.matrix(round(object$summary, digits=digits))
+ cat("\n")
+}
diff --git a/R/MCMC/qi.MCMCZelig.R b/R/MCMC/qi.MCMCZelig.R
new file mode 100644
index 0000000..5ef9608
--- /dev/null
+++ b/R/MCMC/qi.MCMCZelig.R
@@ -0,0 +1,173 @@
+qi.MCMCZelig <- function(object, simpar=NULL, x, x1 = NULL, y = NULL, ...) {
+
+ model <- object$zelig
+ qi <- list()
+ check <- FALSE
+ if (model %in% c("MCMClogit", "MCMCprobit"))
+ check <- TRUE
+
+ if (model %in% c("MCMClogit","MCMCprobit", "MCMCregress", "MCMCpoisson")) {
+
+ if (model == "MCMClogit") {
+ coef <- object$coefficients
+ eta <- coef %*% t(x)
+ pr <- ev <- matrix(NA, nrow = nrow(eta), ncol = ncol(eta))
+ dimnames(pr) <- dimnames(ev) <- dimnames(eta)
+ ev <- 1/(1+exp(-eta))
+ for (i in 1:ncol(ev))
+ pr[,i] <- as.character(rbinom(length(ev[,i]), 1, ev[,i]))
+ qi$ev <- ev
+ qi$pr <- pr
+ qi.name <- list(ev = "Expected Values: E(Y|X)", pr="Predicted
+ Values: Y|X")
+ }
+ else if (model == "MCMCprobit") {
+ coef <- object$coefficients
+ eta <- coef %*% t(x)
+ pr <- ev <- matrix(NA, nrow = nrow(eta), ncol = ncol(eta))
+ dimnames(pr) <- dimnames(ev) <- dimnames(eta)
+ ev <- pnorm(eta)
+ for (i in 1:ncol(ev))
+ pr[,i] <- as.character(rbinom(length(ev[,i]), 1, ev[,i]))
+ qi$ev <- ev
+ qi$pr <- pr
+ qi.name <- list(ev = "Expected Values: E(Y|X)", pr="Predicted
+ Values: Y|X")
+ }
+ else if (model =="MCMCregress") {
+ coef <- object$coefficients[,1:(ncol(object$coefficients)-1)]
+ eta <- coef %*% t(x)
+ pr <- ev <- matrix(NA, nrow = nrow(eta), ncol = ncol(eta))
+ dimnames(pr) <- dimnames(ev) <- dimnames(eta)
+ ev <- eta
+ qi$ev <- ev
+ qi.name <- list(ev = "Expected Values: E(Y|X)")
+ }
+ else if (model == "MCMCpoisson") {
+ coef <- object$coefficients
+ eta <- coef %*% t(x)
+ pr <- ev <- matrix(NA, nrow = nrow(eta), ncol = ncol(eta))
+ dimnames(pr) <- dimnames(ev) <- dimnames(eta)
+ ev <- exp(eta)
+ for (i in 1:ncol(ev))
+ pr[,i] <- rpois(length(ev[,i]), ev[,i])
+ qi$ev <- ev
+ qi$pr <- pr
+ qi.name <- list(ev = "Expected Values: E(Y|X)", pr="Predicted
+ Values: Y|X")
+
+ }
+
+
+
+ if (!is.null(x1)) {
+ eta1 <- coef %*% t(x1)
+ if (model == "MCMClogit") {
+ ev1 <- 1/(1+exp(-eta1))
+ rr <-ev1/ev
+ fd <-ev1-ev
+
+ qi$fd <- fd
+ qi$rr <- rr
+
+ qi.name$fd <- "First Differences in Expected Values: E(Y|X1)-E(Y|X)"
+
+ qi.name$rr <- "Risk Ratios: P(Y=1|X1)/P(Y=1|X)"
+ }
+ else if (model == "MCMCprobit") {
+ ev1 <- pnorm(eta1)
+ rr <-ev1/ev
+ fd <-ev1-ev
+
+ qi$fd <- fd
+ qi$rr <- rr
+
+ qi.name$fd <- "First Differences in Expected Values: E(Y|X1)-E(Y|X)"
+
+ qi.name$rr <- "Risk Ratios: P(Y=1|X1)/P(Y=1|X)"
+ }
+ else if (model == "MCMCregress") {
+ ev1 <- eta1
+ fd <-ev1-ev
+
+ qi$fd <- fd
+
+ qi.name$fd <- "First Differences in Expected Values: E(Y|X1)-E(Y|X)"
+ }
+ else if (model == "MCMCpoisson") {
+ ev1 <- exp(eta1)
+ fd <-ev1-ev
+
+ qi$fd <- fd
+
+ qi.name$fd <- "First Differences in Expected Values: E(Y|X1)-E(Y|X)"
+
+ }
+ }
+
+ if (!is.null(y)) {
+ yvar <- matrix(rep(y, nrow(simpar)), nrow = nrow(simpar), byrow = TRUE)
+ tmp.ev <- yvar - qi$ev
+ if (check)
+ tmp.pr <- yvar - as.integer(qi$pr)
+ else
+ tmp.pr <- yvar - qi$pr
+ qi$ate.ev <- matrix(apply(tmp.ev, 1, mean), nrow = nrow(simpar))
+ qi.name$ate.ev <- "Average Treatment Effect: Y - EV"
+ if (model %in% c("MCMClogit", "MCMCprobit", "MCMCpoisson"))
+ {
+ qi$ate.pr <- matrix(apply(tmp.pr, 1, mean), nrow = nrow(simpar))
+ qi.name$ate.pr <- "Average Treatment Effect: Y - PR"
+ }
+ }
+
+ list(qi=qi, qi.name=qi.name)
+}
+
+ else if (model == "MCMChierEI") {
+ if (!any(class(x)=="cond")) stop("set 'cond=TRUE' in setx.\n")
+ else
+ {
+ coef <- object$coefficients
+ n <- nrow(x)
+ if (is.null(object$N))
+ N<-rep(1,n)
+ else N <- eval(object$N)
+ ev <- array(NA, c(nrow = nrow(coef), 2,2, n))
+ pr <- array(NA, c(nrow = nrow(coef), 2,2, n))
+ nlen<-length(coef[,1])
+ for (j in 1:2) {
+ ev[,j,1,] <- t(apply(coef[,((1:n)+(j-1)*n)],
+ 1,"*", x[,j])*N)
+ ev[,j,2,] <- t(apply((1-coef[,((1:n)+(j-1)*n)]), 1,"*",
+ x[,j])*N)
+ for (i in 1:n)
+ {
+ size<-round(x[i,j]*N[i])
+ pr[,j,1,i] <-rbinom(prob=coef[,(i+(j-1)*n)], n=nlen, size=size)
+
+ pr[,j,2,i] <- x[i,j]*N[i]-pr[,j,1,i]
+ }
+
+ }
+
+ dimnames(ev)[[4]] <- dimnames(pr)[[4]] <- rownames(x)
+ dimnames(ev)[[2]] <- dimnames(pr)[[2]] <- colnames(x)
+ dimnames(ev)[[3]] <- dimnames(pr)[[3]] <- colnames(model.response(object$model))
+ class(ev) <- class(pr) <- c("ei", "array")
+ qi$ev <- ev
+ qi$pr <- pr
+ qi.name <- list(ev = "Expected In sample predictions at aggregate
+ level", pr = "In sample predictions at aggregate level")
+
+ }
+
+ list(qi=qi, qi.name=qi.name)
+ }
+}
+
+
+
+
+
+
diff --git a/R/MCMC/summary.MCMCZelig.R b/R/MCMC/summary.MCMCZelig.R
new file mode 100644
index 0000000..c297013
--- /dev/null
+++ b/R/MCMC/summary.MCMCZelig.R
@@ -0,0 +1,19 @@
+
+summary.MCMCZelig <- function(object, quantiles = c(0.025, 0.5, 0.975), ...) {
+ require(coda)
+ out <- list()
+ out$summary <- cbind(summary(object$coefficients)$statistics[,1:2],
+ summary(object$coefficients,
+ quantiles=quantiles)$quantiles)
+
+ colnames(out$summary) <- c("Mean", "SD", paste(quantiles*100, "%",sep=""))
+ stuff <- attributes(object$coefficients)
+ out$call <- object$call
+ out$start <- stuff$mcpar[1]
+ out$end <- stuff$mcpar[2]
+ out$thin <- stuff$mcpar[3]
+ out$nchain <- 1
+ class(out) <- "summary.MCMCZelig"
+ out
+}
+
diff --git a/R/MCMC/zelig2MCMC.R b/R/MCMC/zelig2MCMC.R
new file mode 100644
index 0000000..91ef2a4
--- /dev/null
+++ b/R/MCMC/zelig2MCMC.R
@@ -0,0 +1,212 @@
+zelig2MCMChierEI <- function(formula, model, data, M, ...) {
+ require(MCMCpack)
+ mf <- match.call(expand.dots = TRUE)
+
+ if (is.null(mf$verbose) || !mf$verbose) mf$verbose <- 0
+ else
+ {
+ if (is.null(mf$mcmc)) mcmc <- 50000
+ else mcmc <- mf$mcmc
+ if (is.null(mf$burnin)) burnin <- 5000
+ else burnin <- mf$burnin
+ mf$verbose <- round((mcmc+burnin)/10)
+ }
+
+ mf$model <- mf$M <- NULL
+ temp <- mcmcei(formula=formula, data=data, covar=covar)
+
+ if ((any(temp<0)) || ((any(temp<1) && !any(temp==0) ) && any(temp>1)))
+ stop("data need to be either counts or proportions.\n")
+ if (is.null(mf$N))
+ {
+ if (all(temp>=0)) #N is not needed
+ {
+ mf$r0 <- temp$r0
+ mf$r1 <- temp$r1
+ mf$c0 <- temp$c0
+ mf$c1 <- temp$c1
+ }
+ else stop("Needs total counts for inputs as porportion.\n")
+ }
+ else if (((length(mf$N)!= nrow(data)) && (length(mf$N)!=1)) || (any(mf$N<1)))
+ stop("N needs to have same length as the observations and be postive numbers\n.")
+ else if ((all(temp<1)) && (all(mf$N>1)))
+ {
+ mf$r0 <- round(temp$r0*mf$N)
+ mf$r1 <- mf$N-mf$r0
+ mf$c0 <- round(temp$c0*mf$N)
+ mf$c1 <- mf$N-mf$c0
+
+ }
+
+ mf[[1]] <- MCMCpack::MCMChierEI
+ as.call(mf)
+}
+
+
+zelig2MCMClogit <- function(formula, model, data, M, ...) {
+ require(MCMCpack)
+ mf <- match.call(expand.dots = TRUE)
+
+ if (is.null(mf$verbose) || !mf$verbose) mf$verbose <- 0
+ else
+ {
+ if (is.null(mf$mcmc)) mcmc <- 10000
+ else mcmc <- mf$mcmc
+ if (is.null(mf$burnin)) burnin <- 1000
+ else burnin <- mf$burnin
+ mf$verbose <- round((mcmc+burnin)/10)
+ }
+
+ mf$model <- mf$M <- NULL
+
+ mf[[1]] <- MCMCpack::MCMClogit
+ as.call(mf)
+}
+
+zelig2MCMCprobit <- function(formula, model, data, M, ...) {
+ require(MCMCpack)
+ mf <- match.call(expand.dots = TRUE)
+
+ if (is.null(mf$verbose) || !mf$verbose) mf$verbose <- 0
+ else
+ {
+ if (is.null(mf$mcmc)) mcmc <- 10000
+ else mcmc <- mf$mcmc
+ if (is.null(mf$burnin)) burnin <- 1000
+ else burnin <- mf$burnin
+ mf$verbose <- round((mcmc+burnin)/10)
+ }
+
+ mf$model <- mf$M <- NULL
+
+ mf[[1]] <- MCMCpack::MCMCprobit
+ as.call(mf)
+}
+
+zelig2MCMCregress <- function(formula, model, data, M, ...) {
+ require(MCMCpack)
+ mf <- match.call(expand.dots = TRUE)
+ mf$model <- mf$M <- NULL
+ if (is.null(mf$verbose) || !mf$verbose) mf$verbose <- 0
+ else
+ {
+ if (is.null(mf$mcmc)) mcmc <- 10000
+ else mcmc <- mf$mcmc
+ if (is.null(mf$burnin)) burnin <- 1000
+ else burnin <- mf$burnin
+ mf$verbose <- round((mcmc+burnin)/10)
+ }
+
+ mf[[1]] <- MCMCpack::MCMCregress
+ as.call(mf)
+}
+
+zelig2MCMCpoisson <- function(formula, model, data, M, ...) {
+ require(MCMCpack)
+ mf <- match.call(expand.dots = TRUE)
+ mf$model <- mf$M <- NULL
+ if (is.null(mf$verbose) || !mf$verbose) mf$verbose <- 0
+ else
+ {
+ if (is.null(mf$mcmc)) mcmc <- 10000
+ else mcmc <- mf$mcmc
+ if (is.null(mf$burnin)) burnin <- 1000
+ else burnin <- mf$burnin
+ mf$verbose <- round((mcmc+burnin)/10)
+ }
+ mf[[1]] <- MCMCpack::MCMCpoisson
+ as.call(mf)
+}
+
+zelig2MCMCoprobit <- function(formula, model, data, M, ...) {
+ require(MCMCpack)
+ mf <- match.call(expand.dots = TRUE)
+ mf$model <- mf$M <- NULL
+ if (is.null(mf$verbose) || !mf$verbose) mf$verbose <- 0
+ else mf$verbose <- 500
+ mf[[1]] <- MCMCpack::MCMCoprobit
+ as.call(mf)
+}
+
+
+
+
+zelig2MCMCmnl <- function(formula, model, data, M, ...) {
+ require(MCMCpack)
+ mf <- match.call(expand.dots = TRUE)
+ mf$model <- mf$M <- NULL
+ if (is.null(mf$verbose) || !mf$verbose) mf$verbose <- 0
+ else mf$verbose <- 500
+ mf[[1]] <- MCMCpack::MCMCmnl
+ as.call(mf)
+}
+
+
+
+
+zelig2MCMCtobit <- function(formula, model, data, M, ...) {
+ require(MCMCpack)
+ mf <- match.call(expand.dots = TRUE)
+ if (is.null(mf$verbose) || !mf$verbose) mf$verbose <- 0
+ else mf$verbose <- 500
+ mf$model <- mf$M <- NULL
+ mf[[1]] <- MCMCpack::MCMCtobit
+ as.call(mf)
+}
+
+zelig2MCMCdynamicEI <- function(formula, model, data, M, ...) {
+ require(MCMCpack)
+ mf <- match.call(expand.dots = TRUE)
+ if (is.null(mf$verbose) || !mf$verbose) mf$verbose <- 0
+ else mf$verbose <- 500
+ mf$model <- mf$M <- NULL
+ temp <- mcmcei(formula=formula, data=data, covar=covar)
+ mf$r0 <- temp$r0
+ mf$r1 <- temp$r1
+ mf$c0 <- temp$c0
+ mf$c1 <- temp$c1
+ # mf$formula <- mf$data <- NULL
+ mf[[1]] <- MCMCpack::MCMCdynamicEI
+ as.call(mf)
+}
+
+
+
+
+zelig2MCMCfactanal <- function(formula, model, data, M, ...) {
+ require(MCMCpack)
+ mf <- match.call(expand.dots = TRUE)
+ if (is.null(mf$verbose) || !mf$verbose) mf$verbose <- 0
+ else mf$verbose <- 500
+ mf$model <- mf$M <- NULL
+ mf$x <- as.matrix(model.frame(formula, data=data, na.action=NULL))
+ mf[[1]] <- MCMCpack::MCMCfactanal
+ as.call(mf)
+}
+
+zelig2MCMCordfactanal <- function(formula, model, data, M, ...) {
+ require(MCMCpack)
+ mf <- match.call(expand.dots = TRUE)
+ if (is.null(mf$verbose) || !mf$verbose) mf$verbose <- 0
+ else mf$verbose <- 500
+ mf$model <- mf$M <- NULL
+ mf$x <- as.matrix(model.frame(formula, data=data, na.action=NULL))
+ mf[[1]] <- MCMCpack::MCMCordfactanal
+ as.call(mf)
+}
+
+zelig2MCMCmixfactanal <- function(formula, model, data, M, ...) {
+ require(MCMCpack)
+ mf <- match.call(expand.dots = TRUE)
+ if (is.null(mf$verbose) || !mf$verbose) mf$verbose <- 0
+ else mf$verbose <- 500
+ mf$model <- mf$M <- NULL
+ var <- model.response(model.frame(formula, data=data,
+ na.action=NULL))
+ varnames <- colnames(var)
+ mf$x <- as.formula(paste("~", paste(varnames, collapse="+")))
+ mf[[1]] <- MCMCpack::MCMCmixfactanal
+ as.call(mf)
+}
+
diff --git a/R/MCMC/zelig3MCMC.R b/R/MCMC/zelig3MCMC.R
new file mode 100644
index 0000000..13d4dce
--- /dev/null
+++ b/R/MCMC/zelig3MCMC.R
@@ -0,0 +1,83 @@
+ zelig3MCMCdynamicEI <- zelig3MCMChierEI <- function(res, fcall=NULL, zcall=NULL) {
+
+ out <- list()
+ out$coefficients <- res
+ out$formula <- zcall$formula
+ out$data <- zcall$data
+
+ if (!is.null(zcall$N))
+ out$N <- zcall$N
+
+ out$model <- model.frame(formula=eval(out$formula),
+ data=eval(out$data))
+ out$terms <- attr(out$model, "terms")
+ attr(out$terms,"intercept") <- 0
+ class(out) <- "MCMCZelig"
+
+ out
+}
+
+zelig3MCMClogit <- zelig3MCMCoprobit <- zelig3MCMCpoisson <-
+ zelig3MCMCmnl <- zelig3MCMCregress <-
+ zelig3MCMCtobit <- function(res, fcall=NULL, zcall=NULL) {
+
+ out <- list()
+ out$coefficients <- res
+ out$formula <- zcall$formula
+ out$data <- zcall$data
+
+ out$model <- model.frame(formula=eval(out$formula),
+ data=eval(out$data))
+ out$terms <- attr(out$model, "terms")
+ class(out) <- "MCMCZelig"
+
+ out
+}
+
+zelig3MCMCprobit <- function(res, fcall=NULL, zcall=NULL) {
+
+ out <- list()
+ if (is.null(zcall$bayes.resid))
+ zcall$bayes.resid <- FALSE
+
+ if (zcall$bayes.resid==FALSE)
+ out$coefficients <- res
+ else
+ {
+ p<-dim(model.matrix(eval(zcall$formula), eval(zcall$data)))[2]
+ out$coefficients <- res[,1:p]
+ out$bayes.residuals <- res[, -(1:p)]
+ }
+
+ out$formula <- zcall$formula
+ out$data <- zcall$data
+
+ out$model <- model.frame(formula=eval(out$formula),data=eval(out$data))
+ out$terms <- attr(out$model, "terms")
+ class(out) <- "MCMCZelig"
+
+ out
+
+ }
+
+
+
+ zelig3MCMCfactanal <- zelig3MCMCordfactanal <- zelig3MCMCmixfactanal <- function(res, fcall=NULL, zcall=NULL) {
+
+ out <- list()
+ out$coefficients <- res
+ out$formula <- zcall$formula
+ out$data <- zcall$data
+
+ out$model <- model.frame(formula=eval(out$formula),
+ data=eval(out$data))
+ out$terms <- attr(out$model, "terms")
+ attr(out$terms,"intercept") <- 0
+ class(out) <- "MCMCZelig"
+
+ out
+}
+
+
+
+
diff --git a/R/setx.default.R b/R/setx.default.R
index 28694b6..ab09ddb 100644
--- a/R/setx.default.R
+++ b/R/setx.default.R
@@ -149,6 +149,10 @@ setx.default <- function(object, fn = list(numeric = mean, ordered =
}
data <- data[1:maxl,]
}
+ if (!is.data.frame(data)) {
+ data <- data.frame(data)
+ names(data) <- vars
+ }
if (cond) {
X <- model.frame(tt, odta)
if (!is.null(counter)) {
diff --git a/README b/README
index 6a9ef87..e974adc 100644
--- a/README
+++ b/README
@@ -1,3 +1,6 @@
+2.2-2 (July 13, 2005): Stable release for R 2.0.0-2.1.1. Fixed bug in
+ setx(). (reported by Ying Lu)
+
2.2-1 (July 11, 2005): Stable release for R 2.0.0-2.1.0. Revised
ordinal probit to use MASS library. Added robust standard errors
for the following regression models: exponential, gamma, logit,
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/r-cran-zelig.git
More information about the debian-science-commits
mailing list