[r-cran-zelig] 05/102: Import Upstream version 2.1-4
Andreas Tille
tille at debian.org
Sun Jan 8 16:58:08 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 0a190cb5ae3ba3fb15bb59092e5d018b7ef3b154
Author: Andreas Tille <tille at debian.org>
Date: Sun Jan 8 09:38:57 2017 +0100
Import Upstream version 2.1-4
---
DESCRIPTION | 8 +--
NAMESPACE | 13 +++--
R/MULTIPLE/cmsystemfit.R | 19 +++++++
R/MULTIPLE/model.matrix.multiple.R | 67 +++++++++++++++++++++++++
R/MULTIPLE/terms.multiple.R | 19 +++++++
R/MULTIPLE/zelig2w2sls.R | 15 ++++++
R/help.zelig.R | 100 ++++++++++++++++---------------------
R/misc.vglm.R | 2 +-
R/param.betareg.R | 11 ++++
R/param.lm.R | 2 +-
R/plot.zelig.blogit.R | 2 +-
R/plot.zelig.bprobit.R | 2 +-
R/print.summary.zelig.R | 18 +++----
R/qi.vglm.R | 8 +--
R/summarize.array.R | 37 ++++++--------
R/summarize.default.R | 36 +++----------
R/summarize.matrix.R | 36 ++++++-------
R/summary.glm.robust.R | 29 +++++++++++
R/summary.lm.robust.R | 21 ++++++++
R/summary.zelig.R | 29 ++++++-----
R/vcov.glm.robust.R | 4 ++
R/vcov.lm.robust.R | 4 ++
R/zelig.R | 26 +++++++++-
README | 16 ++++++
data/hoff.tab | 37 ++++++++++++++
demo/beta.R | 24 +++++++++
demo/blogit.R | 12 ++---
demo/bprobit.R | 12 ++---
demo/mlogit.R | 4 +-
demo/oprobit.R | 8 +--
demo/robust.R | 37 ++++++++++++++
demo/strata.R | 27 ++++++++++
man/dims.Rd | 5 +-
man/hoff.Rd | 27 ++++++++++
34 files changed, 535 insertions(+), 182 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index a6b3f6d..050394a 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,12 +1,12 @@
Package: Zelig
-Version: 2.0-13
-Date: 2005-03-11
+Version: 2.1-4
+Date: 2005-05-22
Title: Zelig: Everyone's Statistical Software
Author: Kosuke Imai <kimai at Princeton.Edu>,
Gary King <king at harvard.edu>,
Olivia Lau <olau at fas.harvard.edu>
Maintainer: Olivia Lau <olau at fas.harvard.edu>
-Depends: R (>= 1.9.0), MASS, boot
+Depends: R (>= 1.9.1), MASS, boot
Description: Zelig is an easy-to-use program that can estimate, and
help interpret the results of, an enormous range of
statistical models. It literally is ``everyone's statistical
@@ -22,4 +22,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: Fri Mar 11 11:04:06 2005; king
+Packaged: Sun May 22 13:46:26 2005; king
diff --git a/NAMESPACE b/NAMESPACE
index bd15706..e3707fe 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,7 +1,8 @@
import(MASS)
import(boot)
-export( help.zelig,
+export( dims,
+ help.zelig,
zelig,
help.zelig,
gsource,
@@ -14,9 +15,11 @@ export( help.zelig,
user.prompt
)
-
+S3method("$", vglm)
+S3method("$", summary.vglm)
+S3method("$<-", vglm)
+S3method("$<-", summary.vglm)
S3method(names, relogit)
-S3method(names, summary.vglm)
S3method(names, summary.zelig.relogit)
S3method(names, vglm)
S3method(names, zelig)
@@ -68,9 +71,13 @@ S3method(summary, setx.cond)
S3method(summary, setx)
S3method(summary, zelig.strata)
S3method(summary, zelig)
+S3method(summary, lm.robust)
+S3method(summary, glm.robust)
S3method(terms, vglm)
S3method(vcov, BetaReg)
S3method(vcov, lm)
S3method(vcov, relogit)
+S3method(vcov, lm.robust)
+S3method(vcov, glm.robust)
diff --git a/R/MULTIPLE/cmsystemfit.R b/R/MULTIPLE/cmsystemfit.R
new file mode 100644
index 0000000..09b5de3
--- /dev/null
+++ b/R/MULTIPLE/cmsystemfit.R
@@ -0,0 +1,19 @@
+cmsystemfit<-function(formu,omit=NULL,...){
+ tr<-terms.multiple(formu,omit)
+ ev<-attr(tr,"term.labels")
+ dv<-all.vars(attr(tr,"variables")[[2]],unique=FALSE)
+ om<-attr(tr,"omit")
+ syst<-res<-list()
+ for(i in 1:length(dv)){
+ syst[[i]]<- ev[om[i,]==0]
+ res[[i]]<-paste(dv[i],"~")
+ for(j in 1:(length(syst[[i]])-1)){
+ res[[i]]<-paste(res[[i]],syst[[i]][j])
+ res[[i]]<-paste(res[[i]],"+")
+ }
+ res[[i]]<-paste(res[[i]],syst[[i]][length(syst[[i]])])
+ res[[i]]<-as.formula(res[[i]])
+
+ }
+ return (res)
+}
diff --git a/R/MULTIPLE/model.matrix.multiple.R b/R/MULTIPLE/model.matrix.multiple.R
new file mode 100644
index 0000000..5752a5d
--- /dev/null
+++ b/R/MULTIPLE/model.matrix.multiple.R
@@ -0,0 +1,67 @@
+model.matrix.multiple <- function (object,data,eqn=NULL,...){
+
+ # print("model.matrix.multiple is called")
+ if(class(object)[[1]]=="formula"){
+ terms <-terms(object)
+ obj<-"formula"
+ }
+ else
+ {
+ obj<-"terms"
+ terms<-object
+ }
+ att<-attributes(terms)
+ expVar<-att$term.labels
+ nrExpVariables<- length(expVar)
+ nrEquations<-length(all.vars((att$variables)[[2]],unique=FALSE))
+
+ terms1<-terms
+ class(terms1)<-class(terms1)[class(terms1)!="multiple"]
+ multiple<-model.matrix.default(terms1,data)
+
+
+ attrList<-attributes(multiple)
+ if(obj=="formula"){
+ if (hasArg(omit))
+ omitLst=omit
+ else
+ omitLst=NULL
+ if(hasArg(constrain))
+ constrainLst=constrain
+ else
+ constrainLst=list()
+ omitconsLst<-omitconstrain(object,omitLst,constrainLst)
+ attrList<-c(attrList,omitconsLst)
+ } # end of "if obj="formula""
+ else
+ {
+ if ("omit" %in% names(attributes(object))){
+ attrList[["omit"]]<-attributes(object)$omit
+ omitAttr<-attributes(object)$omit
+ nrEquations<-dim(omitAttr)[[1]]
+ }
+
+ if ("constrain" %in% names(attributes(object)))
+ attrList[["constrain"]]<-attributes(object)$constrain
+ }
+ if (!is.null(eqn))
+ {
+
+ eqnattr<-multiple[,c(1:dim(multiple)[[2]])* c(1,as.numeric(!(attrList[["omit"]][eqn,])))]
+ attrname<-paste("eqn",eqn,sep="")
+ multiple<-eqnattr
+ }
+ else
+ {
+ for (i in 1:nrEquations){
+ eqntmp<-paste("eqn",i,sep="")
+ attrtmp<-c(1:dim(multiple)[[2]])* c(1,as.numeric(!(attrList[["omit"]][i,])))
+ attrtmp1<-attrtmp[attrtmp !=0]
+ attr(multiple,eqntmp)<-attrtmp1
+ }
+ }
+
+ multiple
+
+}
+
diff --git a/R/MULTIPLE/terms.multiple.R b/R/MULTIPLE/terms.multiple.R
new file mode 100644
index 0000000..9f719a4
--- /dev/null
+++ b/R/MULTIPLE/terms.multiple.R
@@ -0,0 +1,19 @@
+terms.multiple <- function (object,omit=NULL, constrain=NULL){
+
+ if (any(class(object)=="multiple")){
+ terms<-object$terms
+ class(terms)<-c(class(terms),"multiple")
+ return (terms)
+ }
+
+ terms<-terms.formula(object)
+
+ attrList<-attributes(terms)
+ tmp<-omitconstrain(object,omit,constrain)
+ attrList[["omit"]]<-tmp[["omit"]]
+ attrList[["constrain"]]<-tmp[["constrain"]]
+ attributes(terms)<-attrList
+ class(terms)<-c(class(terms),"multiple")
+ terms
+}
+
diff --git a/R/MULTIPLE/zelig2w2sls.R b/R/MULTIPLE/zelig2w2sls.R
new file mode 100644
index 0000000..438f507
--- /dev/null
+++ b/R/MULTIPLE/zelig2w2sls.R
@@ -0,0 +1,15 @@
+zelig2w2sls <- function(formula, model, data, M,
+ omit = NULL, ...) {
+ check <- library()
+ if(any(check$results[,"Package"] == "systemfit"))
+ require(systemfit)
+ else
+ stop("Please install systemfit using \n install.packages(\"systemfit\")")
+ mf <- match.call(expand.dots = TRUE)
+ mf[[1]] <- as.name("callsystemfit")
+ tmp <- cmsystemfit(formula, omit)
+ mf$eqns <- tmp
+ mf$method<-"3SLS"
+ mf$model<- mf$M<-NULL
+ as.call(mf)
+}
diff --git a/R/help.zelig.R b/R/help.zelig.R
index 06bbc34..a89f690 100644
--- a/R/help.zelig.R
+++ b/R/help.zelig.R
@@ -1,65 +1,53 @@
-help.zelig <- function(object) {
- # Elements of this function use functions from the Hmisc library for
- # R by Frank E Harrell Jr, distributed under the GNU GPL v.2.
- under.unix <- !(version$os=='Microsoft Windows' ||
- version$os=='Win32' || version$os=='mingw32')
- sys <- function (command, text = NULL) {
- cmd <- if (length(text))
- paste(command, text)
- else command
- if (under.unix)
- system(cmd)
- else shell(cmd, wait = TRUE)
+help.zelig <- function (...) {
+ zipped <- FALSE
+ loc <- NULL
+ name <- c(as.character(substitute(list(...))[-1]), list)[[1]]
+ if (length(name) == 0)
+ loc <- "http://gking.harvard.edu/zelig"
+ paths <- .find.package("Zelig")
+ if (length(paths) > 1)
+ warning(paste("Zelig installed in", length(paths), "locations. Using\n ", paths[1]))
+ path <- paths[1]
+ path <- file.path(path, "data")
+ if (tools::file_test("-f", file.path(path, "Rdata.zip"))) {
+ zipped <- TRUE
+ if (tools::file_test("-f", fp <- file.path(path, "filelist")))
+ files <- file.path(path, scan(fp, what = "", quiet = TRUE))
+ else
+ stop(gettextf("file 'filelist' is missing for directory '%s'",
+ path), domain = NA)
}
- browser <- .Options$help.browser
- if(!length(browser)) browser <- .Options$browser
- if(!length(browser)) browser <- getOption("browser")
- url <- NULL
- if (missing(object))
- url <- c("http://gking.harvard.edu/zelig/docs/")
- else if (is.character(object)) {
- z <- .libPaths()
- n <- urls <- array()
- for (i in 1:length(z))
- n[i] <- file.path(z[i], "Zelig", fsep = .Platform$file.sep)
- check <- file.exists(n)
- if (sum(check) > 1) {
- Zdir <- n[check][1]
- warning(paste("library Zelig found in two locations. Using",
-Zdir))
+ else
+ files <- list.files(path, full = TRUE)
+ files <- files[which(regexpr("url", files) > 0)]
+ if (length(files) == 0)
+ loc <- "http://gking.harvard.edu/zelig"
+ else {
+ zfile <- array()
+ for (f in 1:length(files)) {
+ if (zipped)
+ zfile[f] <- zip.file.extract(files[f], "Rdata.zip")
+ else
+ zfile <- files
}
- else
- Zdir <- n[which(check)]
- Zdata <- file.path(Zdir, "data", fsep = .Platform$file.sep)
- files <- list.files(Zdata, pattern = "url")
- for (i in 1:length(files))
- urls[i] <- file.path(Zdata, files[i], fsep = .Platform$file.sep)
- data.path <- read.table(urls[1], header = FALSE)
- if (length(urls) > 1) {
- for (i in 2:length(urls)) {
- tmp <- read.table(urls[i], header = FALSE)
- data.path <- rbind(data.path, tmp)
- }
+ tab <- read.table(zfile[1], header = FALSE, as.is = TRUE)
+ if (length(zfile) > 1) {
+ for (i in 2:length(zfile))
+ tab <- rbind(tab, read.table(zfile[i], header = FALSE, as.is = TRUE))
}
- url <- data.path[which(as.character(data.path[,1]) == object), 2]
+ loc <- tab[which(as.character(tab[, 1]) == name), 2]
}
- else
- stop("Please enclose the requested topic \n in quotes and try again.")
- if (is.null(url)) {
+ if (is.null(loc)) {
cat("Warning: Requested topic not found in Zelig help. \n If you are sure the topic exists, please check \n the full documentation at http://gking.harvard.edu/zelig. \n Now searching R-help.\n\n")
- topic <- as.name(object)
+ topic <- as.name(name)
do.call("help", list(topic, htmlhelp = TRUE))
}
else {
- if (under.unix) {
- sys(paste(browser, as.character(url), '&'))
- invisible()
- }
- if (!under.unix) {
- browseURL(as.character(url), browser = browser)
- invisible("")
- }
+ browseURL(loc)
+ invisible(name)
+ }
+ if (zipped) {
+ for (i in 1:length(zfile))
+ on.exit(unlink(zfile[i]))
}
-}
-
-
+}
diff --git a/R/misc.vglm.R b/R/misc.vglm.R
index 6d5f3ab..c89a701 100644
--- a/R/misc.vglm.R
+++ b/R/misc.vglm.R
@@ -10,7 +10,7 @@
slot(a, b)
}
-"$<-.vglm"<-"$<-summary.vglm"<-function(a, b, value){
+"$<-.vglm"<-"$<-.summary.vglm"<-function(a, b, value){
if(is.na(pmatch(b, slotNames(a)))){
tmp<-class(a)
class(a)<-NULL
diff --git a/R/param.betareg.R b/R/param.betareg.R
new file mode 100644
index 0000000..a71dbda
--- /dev/null
+++ b/R/param.betareg.R
@@ -0,0 +1,11 @@
+param.glm <- function(object, num = NULL, bootstrap = FALSE) {
+ if (!bootstrap) {
+ coef <- mvrnorm(num, mu=coef(object), Sigma=vcov(object))
+ res <- cbind(coef, phi)
+ }
+ else {
+ coef <- coef(object)
+ res <- c(coef, phi)
+ }
+ res
+}
diff --git a/R/param.lm.R b/R/param.lm.R
index 4df93f2..d35b785 100644
--- a/R/param.lm.R
+++ b/R/param.lm.R
@@ -1,5 +1,5 @@
param.lm <-function(object, num, bootstrap = FALSE) {
- if (num < 1) num <- 1
+# if (num < 1) num <- 1
if (!bootstrap) {
coef <- mvrnorm(num, mu=coef(object), Sigma=vcov.lm(object))
df <- object$df.residual
diff --git a/R/plot.zelig.blogit.R b/R/plot.zelig.blogit.R
index 2fed8cd..693d669 100644
--- a/R/plot.zelig.blogit.R
+++ b/R/plot.zelig.blogit.R
@@ -12,7 +12,7 @@ plot.zelig.blogit <- function(x, xlab = "", user.par = FALSE, alt.col = "red", .
par(mfrow = c(k, 1))
for (i in 1:k) {
qi <- as.matrix(x$qi[[i]])
- if (is.character(qi[1])) {
+ if (names(x$qi)[i] == "pr") {
total <- sum(as.integer(qi))
y00 <- 100 * sum(as.integer(qi[,1]))/total
y01 <- 100 * sum(as.integer(qi[,2]))/total
diff --git a/R/plot.zelig.bprobit.R b/R/plot.zelig.bprobit.R
index 728828e..70b7ae0 100644
--- a/R/plot.zelig.bprobit.R
+++ b/R/plot.zelig.bprobit.R
@@ -12,7 +12,7 @@ plot.zelig.bprobit <- function(x, xlab = "", user.par = FALSE, alt.col = "red",
par(mfrow = c(k, 1))
for (i in 1:k) {
qi <- as.matrix(x$qi[[i]])
- if (is.character(qi[1])) {
+ if (names(x$qi)[i] == "pr") {
total <- sum(as.integer(qi))
y00 <- 100 * sum(as.integer(qi[,1]))/total
y01 <- 100 * sum(as.integer(qi[,2]))/total
diff --git a/R/print.summary.zelig.R b/R/print.summary.zelig.R
index 7efee16..b081acb 100644
--- a/R/print.summary.zelig.R
+++ b/R/print.summary.zelig.R
@@ -1,6 +1,6 @@
print.summary.zelig <- function(x, digits=getOption("digits"),
print.x=FALSE, ...){
- cat("\n Model:", x$zelig, "\n")
+ cat("\n Model:", x$model, "\n")
if (!is.null(x$num))
cat(" Number of simulations:", x$num, "\n")
if (!is.null(x$x)) {
@@ -30,14 +30,14 @@ print.summary.zelig <- function(x, digits=getOption("digits"),
for (i in 1:length(x$qi.name)){
indx <- pmatch(names(x$qi.name[i]), names(x$qi.stats))
tmp <- x$qi.stats[[indx]]
- if (names(x$qi.name)[indx] == "pr" && colnames(tmp)[1] != "mean")
- lab <- paste(x$qi.name[[i]], "(percentage of simulations)", sep = " ")
- else
+# if (names(x$qi.name)[indx] == "pr" && colnames(tmp)[1] != "mean")
+# lab <- paste(x$qi.name[[i]], "(percentage of simulations)", sep = " ")
+# else
lab <- x$qi.name[[i]]
cat("\n", lab, "\n", sep = "")
if (length(dim(tmp)) == 3) {
for (j in 1:dim(tmp)[3]){
- cat("\n Observation", dimnames(tmp)[[3]][j], "\n")
+ cat("\n Observation", rownames(x$x)[j], "\n")
if (is.null(rownames(tmp[,,j])))
rownames(tmp[,,j]) <- 1:nrow(tmp[,,j])
if (!is.null(names(tmp[,,j])))
@@ -46,11 +46,11 @@ print.summary.zelig <- function(x, digits=getOption("digits"),
}
}
else {
- if (is.null(rownames(tmp)))
+ if (is.matrix(tmp) & is.null(rownames(tmp)))
rownames(tmp) <- 1:nrow(tmp)
- if (!is.null(names(tmp)))
- names(tmp) <- NULL
- print.matrix(tmp, digits=digits, ...)
+# if (!is.null(names(tmp)))
+# names(tmp) <- NULL
+ print(tmp, digits=digits, ...)
}
}
}
diff --git a/R/qi.vglm.R b/R/qi.vglm.R
index 6eacacd..f9297ba 100644
--- a/R/qi.vglm.R
+++ b/R/qi.vglm.R
@@ -83,10 +83,10 @@ qi.vglm <- function (object, simpar, x, x1=NULL, y = NULL) {
for (i in 1:2)
index[,i] <- rbinom(length(mpr[,i]), 1, mpr[,i])
pr <- matrix(NA, nrow(simpar), 4)
- pr[,1] <- as.character(as.integer(index[,1] == 0 & index[,2] == 0))
- pr[,2] <- as.character(as.integer(index[,1] == 0 & index[,2] == 1))
- pr[,3] <- as.character(as.integer(index[,1] == 1 & index[,2] == 0))
- pr[,4] <- as.character(as.integer(index[,1] == 1 & index[,2] == 1))
+ pr[,1] <- as.integer(index[,1] == 0 & index[,2] == 0)
+ pr[,2] <- as.integer(index[,1] == 0 & index[,2] == 1)
+ pr[,3] <- as.integer(index[,1] == 1 & index[,2] == 0)
+ pr[,4] <- as.integer(index[,1] == 1 & index[,2] == 1)
colnames(pr) <- c("(Y1=0, Y2=0)", "(Y1=0, Y2=1)", "(Y1=1, Y2=0)",
"(Y1=1, Y2=1)")
}
diff --git a/R/summarize.array.R b/R/summarize.array.R
index c7e363d..1149f4a 100644
--- a/R/summarize.array.R
+++ b/R/summarize.array.R
@@ -1,31 +1,24 @@
-summarize.array <- function(x, cip, stats, model, object, subset = NULL) {
- if (is.function(subset)){ # subset = all; all is class "function"
- tmp <- summarize.default(x[,,1], cip, stats, model)
- tmp <- array(NA, dim=c(nrow(tmp), ncol(tmp), dim(x)[3]),
- dimnames=list(dimnames(x)[[2]], dimnames(tmp)[[2]],
- rownames(object$x)))
- for (j in 1:dim(x)[3])
- tmp[,,j] <- summarize.default(x[,,j], cip, stats, model)
- res <- tmp
+summarize.array <- function(x, rows = NULL, cip, stats, subset = NULL) {
+ if (is.function(subset)) { # subset = all; all is class "function"
+ res <- apply(x, c(2,3), summarize.default, stats = stats, cip = cip)
+ dimnames(res)[[3]] <- rows
}
- if(is.null(subset)){# subset = NULL; summarizes all obs at once.
- tmp <-NULL
+ if (is.null(subset)){# subset = NULL; summarizes all obs at once
+ tmp <- NULL
for (j in 1:dim(x)[3])
tmp <- rbind(tmp, x[,,j])
- res <- summarize.default(tmp, cip, stats, model)
+ res <- apply(tmp, 2, summarize.default,
+ stats = stats, cip = cip)
}
if (is.numeric(subset)) { # subset=integer, summarizes identified obs
if (length(subset) > 1) {
- tmp <- summarize.default(x[,,1], cip, stats, model)
- tmp <- array(NA, dim=c(ncol(x), ncol(tmp), length(subset)),
- dimnames=list(dimnames(x)[[2]],
- dimnames(tmp)[[2]], as.character(subset)))
- for (l in 1:length(subset))
- tmp[,,l] <- summarize.default(x[,,subset[l]], cip, stats, model)
- res <- tmp
+ res <- apply(x[, , subset], c(2,3), summarize.default,
+ stats = stats, cip = cip)
+ dimnames(res)[[3]] <- rows
}
- else
- res <- summarize.default(x[,,subset], cip, stats, model)
+ else
+ res <- apply(x[, , subset], 2, summarize.default,
+ stats = stats, cip = cip)
}
- return(res)
+ res
}
diff --git a/R/summarize.default.R b/R/summarize.default.R
index ab5cd78..15c1a84 100644
--- a/R/summarize.default.R
+++ b/R/summarize.default.R
@@ -1,32 +1,12 @@
-summarize.default <- function(x, cip, stats, model, object, subset = NULL) {
-
+summarize.default <- function(x, rows = NULL, cip, stats, subset = NULL) {
res <- NULL
- if (!is.matrix(x))
- x <- as.matrix(x)
if (is.numeric(x)) {
- if (!is.null(stats))
- for (i in 1:length(stats))
- res <- cbind(res, apply(x, 2, stats[i]))
- res <- cbind(res, apply(x, 2, quantile, prob=cip[1]))
- res <- cbind(res, apply(x, 2, quantile, prob=cip[2]))
- colnames(res) <- c(stats, paste(cip[1]*100, "%", sep=""),
- paste(cip[2]*100, "%", sep=""))
+ for (i in 1:length(stats))
+ res <- c(res, do.call(stats[i], list(x)))
+ res <- c(res, quantile(x, cip))
+ names(res) <- c(stats, paste(cip*100, "%", sep = ""))
}
- else {
- res <- t(apply(if(is.matrix(x)) x else as.matrix(x), 2, table))
- if (length(unique(x))==1) {
- colnames(res) <- unique(x)
- if(model=="relogit")
- if(colnames(res)==1) {
- res <- cbind(0, res)
- colnames(res)[1] <-0
- }
- else {
- res <- cbind(res, 0)
- colnames(res)[2] <-1
- }
- }
- res <- res/nrow(x) * 100
- }
- return(res)
+ else if (is.character(x))
+ res <- table(x) / length(x)
+ res
}
diff --git a/R/summarize.matrix.R b/R/summarize.matrix.R
index 747ddb2..03cfb08 100644
--- a/R/summarize.matrix.R
+++ b/R/summarize.matrix.R
@@ -1,20 +1,22 @@
-summarize.matrix <- function(x, cip, stats, model, object, subset = NULL) {
- res <- NULL
- if (dim(x)[2]==1)
- res <- summarize.default(x, cip, stats, model)
- else {
- if (is.function(subset))
- res <- summarize.default(x, cip, stats, model)
- if (is.null(subset)) {
- tmp <- matrix(c(x), ncol=1)
- tmp <- summarize.default(tmp, cip, stats, model)
- res <- as.matrix(tmp)
- names(res) <- colnames(tmp)
- }
- if (is.numeric(subset)) {
- res <- summarize.default(as.matrix(x[,subset]), cip, stats, model)
- rownames(res) <- subset
+summarize.matrix <- function(x, rows, cip, stats, subset = NULL) {
+ if (is.function(subset)) {
+ res <- apply(x, 2, summarize.default, stats = stats, cip = cip)
+ colnames(res) <- rows
+ }
+ if (is.null(subset)) {
+ if (length(rows) == 1)
+ res <- apply(x, 2, summarize.default, stats = stats, cip = cip)
+ else {
+ tmp <- NULL
+ for (i in 1:dim(x)[2])
+ tmp <- c(tmp, x[,i])
+ res <- summarize.default(tmp, stats = stats, cip = cip)
}
}
- return(res)
+ if (is.numeric(subset)) {
+ res <- apply(as.matrix(x[,subset]), 2, summarize.default,
+ cip = cip, stats = stats)
+ colnames(res) <- rows
+ }
+ res
}
diff --git a/R/summary.glm.robust.R b/R/summary.glm.robust.R
new file mode 100644
index 0000000..5a1ba39
--- /dev/null
+++ b/R/summary.glm.robust.R
@@ -0,0 +1,29 @@
+summary.glm.robust <- function(object, ...) {
+ class(object) <- "glm"
+ res <- summary.glm(object, ...)
+ if (is.null(object$robust))
+ res$cov.unscaled <- covmat.unscaled <- vcovHAC(object)
+ else {
+ fn <- object$robust$method
+ object$robust$method <- NULL
+ arg <- object$list
+ arg$x <- object
+ res$cov.unscaled <- covmat.unscaled <- eval(do.call(fn, arg))
+ }
+ res$cov.scaled <- covmat <- covmat.unscaled*res$dispersion
+ if (!is.null(res$correlation)) {
+ dd <- sqrt(diag(res$cov.unscaled))
+ res$correlation <- res$cov.unscaled/outer(dd, dd)
+ dimnames(res$correlation) <- dimnames(res$cov.unscaled)
+ }
+
+ res$coefficients[,2] <- s.err <- sqrt(diag(covmat))
+ res$coefficients[,3] <- tvalue <- coefficients(object)/s.err
+ if (length(dimnames(res$coefficients)[[2]])>3) {
+ if (dimnames(res$coefficients)[[2]][3]=="z value")
+ res$coefficients[,4] <- 2 * pnorm(-abs(tvalue))
+ else
+ res$coefficients[,4] <- 2 * pt(-abs(tvalue), object$df.residual)
+ }
+ return(res)
+}
diff --git a/R/summary.lm.robust.R b/R/summary.lm.robust.R
new file mode 100644
index 0000000..40126a5
--- /dev/null
+++ b/R/summary.lm.robust.R
@@ -0,0 +1,21 @@
+summary.lm.robust <- function(object, ...) {
+ class(object) <- "lm"
+ res <- summary.lm(object, ...)
+ if (is.null(object$robust))
+ res$cov.unscaled <- R <- vcovHC(object)/(res$sigma^2)
+ else {
+ fn <- object$robust$method
+ object$robust$method <- NULL
+ arg <- object$list
+ arg$x <- object
+ res$cov.unscaled <- R <- eval(do.call(fn, arg))/(res$sigma^2)
+ }
+ res$coefficients[,2] <- se <- sqrt(diag(R))*res$sigma
+ if (!is.null(res$correlation)) {
+ res$correlation <- (R * res$sigma^2)/outer(se, se)
+ dimnames(res$correlation) <- dimnames(res$cov.unscaled)
+ }
+ res$coefficients[,3] <- tval <- coefficients(object)/se
+ res$coefficients[,4] <- 2*pt(abs(tval), res$df[2], lower.tail = FALSE)
+ return(res)
+}
diff --git a/R/summary.zelig.R b/R/summary.zelig.R
index 4f28841..3a6d6bd 100644
--- a/R/summary.zelig.R
+++ b/R/summary.zelig.R
@@ -1,8 +1,7 @@
summary.zelig<-function(object, subset = NULL, CI=95,
- stats=c("mean", "sd", "min", "max"), ...){
+ stats=c("mean", "sd"), ...){
cip <- c((100-CI)/200, 1-(100-CI)/200)
- model <- object$zelig.call$model
- qi.stats<-list()
+ qi.stats <- list()
X <- object$x
X1 <- object$x1
if (any(class(X)=="setx.MI") & any(class(X)=="cond")) {
@@ -23,21 +22,27 @@ summary.zelig<-function(object, subset = NULL, CI=95,
colnames(X1) <- "(Intercept)"
}
}
- for (i in 1:length(object$qi)) {
- qi.stats[[i]] <- summarize(object$qi[[i]], cip, stats, model,
- object, subset)
- if (is.null(subset) & dim(object$qi[[i]])[2]!=1)
- object$qi.name[i] <- paste("Pooled", object$qi.name[[i]])
- }
if (is.numeric(subset)) {
X <- X[subset,]
if (!is.null(X1))
X1 <- X1[subset,]
}
+ rows <- rownames(X)
+ for (i in 1:length(object$qi)) {
+ qi.stats[[i]] <- summarize(object$qi[[i]], rows = rows,
+ stats = stats, cip = cip,
+ subset = subset)
+ if (is.matrix(qi.stats[[i]]))
+ qi.stats[[i]] <- t(qi.stats[[i]])
+ if (is.table(qi.stats[[i]]))
+ qi.stats[[i]] <- t(as.matrix(qi.stats[[i]]))
+ if (is.null(subset) && nrow(X) > 1)
+ object$qi.name[i] <- paste("Pooled", object$qi.name[[i]])
+ }
names(qi.stats) <- names(object$qi)
- res <- list(zelig=model, num=object$call$num, x=X, x1=X1,
- qi.stats=qi.stats, qi.name=object$qi.name)
- class(res)<-"summary.zelig"
+ res <- list(model=object$zelig$model, num=object$call$num, x=X,
+ x1=X1, qi.stats=qi.stats, qi.name=object$qi.name)
+ class(res) <- "summary.zelig"
return(res)
}
diff --git a/R/vcov.glm.robust.R b/R/vcov.glm.robust.R
new file mode 100644
index 0000000..53ccfbc
--- /dev/null
+++ b/R/vcov.glm.robust.R
@@ -0,0 +1,4 @@
+vcov.glm.robust <- function(object, ...) {
+ so <- summary.glm.robust(object, corr=FALSE, ...)
+ so$dispersion * so$cov.unscaled
+}
diff --git a/R/vcov.lm.robust.R b/R/vcov.lm.robust.R
new file mode 100644
index 0000000..b127be1
--- /dev/null
+++ b/R/vcov.lm.robust.R
@@ -0,0 +1,4 @@
+vcov.lm.robust <- function(object, ...) {
+ so <- summary.lm.robust(object, corr=FALSE, ...)
+ so$cov.unscaled * so$sigma^2
+}
diff --git a/R/zelig.R b/R/zelig.R
index e471db2..3f211c2 100644
--- a/R/zelig.R
+++ b/R/zelig.R
@@ -1,8 +1,9 @@
-zelig <- function(formula, model, data, by = NULL, ...) {
+zelig <- function(formula, model, data, by = NULL, robust = FALSE, ...) {
fn <- paste("zelig2", model, sep = "")
if (!exists(fn))
stop(model, "not supported. Type help.zelig(\"models\") to list supported models.")
mf <- match.call(expand.dots = TRUE)
+ mf$robust <- NULL
if (missing(by))
by <- NULL
N <- M <- 1
@@ -47,6 +48,29 @@ zelig <- function(formula, model, data, by = NULL, ...) {
res$call <- match.call()
res$data <- res$call$data
res$zelig <- model
+ if (is.list(robust)) {
+ if (any(c("lm", "glm") %in% class(res)[1])) {
+ require(sandwich)
+ ctmp <- class(res)
+ class(res) <- c(paste(ctmp[1], ".robust", sep=""), ctmp)
+ if (!any(robust$method %in% c("vcovHC", "vcovHAC", "kernHAC")))
+ stop("such a robust option is not supported")
+ else if ((robust$method == "vcovHC") & ("lm" != class(res)[1]))
+ stop("vcovHC is supported only for ols")
+ res$robust <- robust
+ }
+ else
+ stop("robust option is not supported for this model.")
+ }
+ else if (robust) {
+ if (any(c("lm", "glm") %in% class(res)[1])) {
+ require(sandwich)
+ ctmp <- class(res)
+ class(res) <- c(paste(ctmp[1], ".robust", sep=""), ctmp)
+ }
+ else
+ stop("robust option is not supported for this model.")
+ }
if (M > 1)
obj[[j]] <- res
else
diff --git a/README b/README
index 9fe82d9..985803e 100644
--- a/README
+++ b/README
@@ -1,3 +1,19 @@
+2.1-4 (May 22, 2005): Stable release for R 1.9.1-2.1.0. Revised
+ help.zelig() to deal with CRAN build of Windows version. Added
+ recode of slots to lists in NAMESPACE. Revised install.R script
+ to deal with changes to install.packages(). (reported by Dan
+ Powers and Ying Lu)
+
+2.1-3 (May 9, 2005): Stable release for R 1.9.1-2.1.0. Revised
+ param.lm() function to work with bootstrap simulation. (reported by
+ Jens Hainmueller)
+
+2.1-2 (April 14, 2005): Stable release for R 1.9.1-2.1. Revised
+ summary.zelig().
+
+2.1-1 (April 7, 2005): Stable release for R 1.9.1-2.1. Fixed bugs in
+ NAMESPACE and summary.vglm().
+
2.0-13 (March 11, 2005): Stable release for R 1.9.1-2.0.1. Fixed bugs in
NAMESPACE and rocplot.Rd.
diff --git a/data/hoff.tab b/data/hoff.tab
new file mode 100644
index 0000000..3c85344
--- /dev/null
+++ b/data/hoff.tab
@@ -0,0 +1,37 @@
+year L2SocSec Just503D Just503R RGovDumy
+1948 1.83 0 2.44 0
+1949 3.44 0 2.44 0
+1950 3.05 0 2.44 0
+1951 3.57 0 2.44 0
+1952 4.73 5.41 3.5 1
+1953 6.47 5.41 3.5 1
+1954 7.75 5.41 3.5 1
+1955 8.7 5.41 3.5 1
+1956 9.97 3.04 1.03 1
+1957 10.57 3.04 1.03 1
+1958 12.58 3.04 1.03 1
+1959 12.76 3.04 1.03 1
+1960 13.45 2.01 0.84 0
+1961 14.18 2.01 0.84 0
+1962 14.02 2.01 0.84 0
+1963 14.77 2.01 0.84 0
+1964 15.38 0.82 0.28 0
+1965 13.92 0.82 0.28 0
+1966 13.29 0.82 0.28 0
+1967 14.86 0.82 0.28 0
+1968 15.47 0.62 0.2 1
+1969 17.07 0.62 0.2 1
+1970 17.41 0.62 0.2 1
+1971 19.98 0.62 0.2 1
+1972 20.74 1.8 0.18 1
+1973 19.46 1.8 0.18 1
+1974 19.88 1.8 0.18 1
+1975 20.79 1.8 0.18 1
+1976 20.46 0.67 0.62 0
+1977 20.67 0.67 0.62 0
+1978 20.06 0.67 0.62 0
+1979 20.58 0.67 0.62 0
+1980 20.91 3.14 2.28 1
+1981 21.12 3.14 2.28 1
+1982 20.92 3.14 2.28 1
+1983 19.93 3.14 2.28 1
diff --git a/demo/beta.R b/demo/beta.R
new file mode 100644
index 0000000..712bc23
--- /dev/null
+++ b/demo/beta.R
@@ -0,0 +1,24 @@
+data(house)
+
+z.out <- zelig(dpct86 ~ dpct84 + dwin86 + incum86, data = house, model = "beta")
+
+user.prompt()
+
+summary(z.out)
+
+user.prompt()
+
+x0 <- setx(z.out, incum86 = 0)
+x1 <- setx(z.out, incum86 = 1)
+
+user.prompt()
+
+s.out <- sim(z.out, x = x0, x1 = x1)
+
+user.prompt()
+
+summary(s.out)
+
+user.prompt()
+
+plot(s.out)
diff --git a/demo/blogit.R b/demo/blogit.R
index a12100d..dce4635 100644
--- a/demo/blogit.R
+++ b/demo/blogit.R
@@ -14,7 +14,7 @@ data(sanction)
z.out1 <- zelig(cbind(import, export) ~ coop + cost + target,
model = "blogit", data = sanction)
user.prompt()
-summary(z.out1)
+print(summary(z.out1))
user.prompt()
# Generate baseline values for the explanatory variables (with cost set
# to 1, net gain to sender) and alternative values (with cost set to 4,
@@ -25,7 +25,7 @@ x.high <- setx(z.out1, cost = 4)
user.prompt()
s.out1 <- sim(z.out1, x = x.low, x1 = x.high)
user.prompt()
-summary(s.out1)
+print(summary(s.out1))
# Plot the s.out
user.prompt()
@@ -42,7 +42,7 @@ z.out2 <- zelig(cbind(import, export) ~ coop + cost + target,
omit = list("1" = "cost", "2" = c("coop", "target")),
model = "blogit", data = sanction)
user.prompt()
-summary(z.out2)
+print(summary(z.out2))
user.prompt()
# Set the explanatory variables to their default values:
x.out2 <- setx(z.out2)
@@ -51,7 +51,7 @@ x.out2 <- setx(z.out2)
user.prompt()
s.out2 <- sim(z.out2, x = x.out2)
user.prompt()
-summary(s.out2)
+print(summary(s.out2))
# Plotting marginal densities:
user.prompt()
@@ -69,7 +69,7 @@ z.out3 <- zelig(cbind(import, export) ~ coop + cost + target,
"2" = c("coop", "cost", "target")),
model = "blogit", data = sanction)
user.prompt()
-summary(z.out3)
+print(summary(z.out3))
# Note that this model only returns one parameter estimate for each of
# coop, cost, and target. Contrast this to Example 1 which returns two
@@ -83,7 +83,7 @@ x.out3 <- setx(z.out3, cost = 1:4)
user.prompt()
s.out3 <- sim(z.out3, x = x.out3)
user.prompt()
-summary(s.out3)
+print(summary(s.out3))
diff --git a/demo/bprobit.R b/demo/bprobit.R
index f86c828..c5ee1c7 100644
--- a/demo/bprobit.R
+++ b/demo/bprobit.R
@@ -13,7 +13,7 @@ user.prompt()
z.out1 <- zelig(cbind(import, export) ~ coop + cost + target,
model = "bprobit", data = sanction)
user.prompt()
-summary(z.out1)
+print(summary(z.out1))
# Generate baseline values for the explanatory variables (with cost set
# to 1, net gain to sender) and alternative values (with cost set to 4,
@@ -26,7 +26,7 @@ x.high <- setx(z.out1, cost = 4)
user.prompt()
s.out1 <- sim(z.out1, x = x.low, x1 = x.high)
user.prompt()
-summary(s.out1)
+print(summary(s.out1))
# Plot the s.out
user.prompt()
@@ -44,7 +44,7 @@ z.out2 <- zelig(cbind(import, export) ~ coop + cost + target,
omit = list("1"="coop", "2"="cost", "3" = "target"),
model = "bprobit", data = sanction)
user.prompt()
-summary(z.out2)
+print(summary(z.out2))
# Set the explanatory variables to their default values:
user.prompt()
@@ -54,7 +54,7 @@ Xval2 <- setx(z.out2)
user.prompt()
s.out2 <- sim(z.out2, x = Xval2)
user.prompt()
-summary(s.out2)
+print(summary(s.out2))
# Plotting marginal densities:
user.prompt()
@@ -72,7 +72,7 @@ z.out3 <- zelig(cbind(import, export) ~ coop + cost + target,
"2"=c("coop", "cost", "target")),
model = "bprobit", data = sanction)
user.prompt()
-summary(z.out3)
+print(summary(z.out3))
# Note that this model only returns one parameter estimate for each of
# coop, cost, and target. Contrast this to Example 1 which returns two
@@ -86,7 +86,7 @@ x.out3 <- setx(z.out3, cost = 1:4)
user.prompt()
s.out3 <- sim(z.out3, x = x.out3)
user.prompt()
-summary(s.out3)
+print(summary(s.out3))
diff --git a/demo/mlogit.R b/demo/mlogit.R
index a22c620..91df41b 100644
--- a/demo/mlogit.R
+++ b/demo/mlogit.R
@@ -3,7 +3,7 @@ user.prompt()
z.out <- zelig(vote88 ~ pristr + othcok + othsocok, model = "mlogit",
data = mexico)
user.prompt()
-summary(z.out)
+print(summary(z.out))
user.prompt()
x.weak <- setx(z.out, pristr = 1)
@@ -12,7 +12,7 @@ x.strong <- setx(z.out, pristr = 3)
user.prompt()
s.out <- sim(z.out, x = x.strong, x1 = x.weak)
user.prompt()
-summary(s.out)
+print(summary(s.out))
user.prompt()
ev.weak <- s.out$qi$ev + s.out$qi$fd
diff --git a/demo/oprobit.R b/demo/oprobit.R
index 6d43f65..4dad7f1 100644
--- a/demo/oprobit.R
+++ b/demo/oprobit.R
@@ -8,7 +8,7 @@ user.prompt()
z.out1 <- zelig(as.factor(cost) ~ mil + coop, model = "oprobit",
data = sanction)
user.prompt()
-summary(z.out1)
+print(summary(z.out1))
# Set the explanatory variables to their means, with 'mil' set
# to 0 (no military action in addition to sanctions) in the baseline
@@ -23,7 +23,7 @@ x.high <- setx(z.out1, mil = 1)
user.prompt()
s.out1 <- sim(z.out1, x = x.low, x1 = x.high)
user.prompt()
-summary(s.out1)
+print(summary(s.out1))
##### Example 2: Creating An Ordered Dependent Variable #####
@@ -38,7 +38,7 @@ sanction$ncost <- factor(sanction$ncost, ordered = TRUE,
user.prompt()
z.out2 <- zelig(ncost ~ mil + coop, model = "oprobit", data = sanction)
user.prompt()
-summary(z.out2)
+print(summary(z.out2))
# Set the explanatory variables to their observed values:
user.prompt()
@@ -48,7 +48,7 @@ x.out2 <- setx(z.out2, fn = NULL)
user.prompt()
s.out2 <- sim(z.out2, x = x.out2)
user.prompt()
-summary(s.out2)
+print(summary(s.out2))
diff --git a/demo/robust.R b/demo/robust.R
new file mode 100644
index 0000000..78d8288
--- /dev/null
+++ b/demo/robust.R
@@ -0,0 +1,37 @@
+#####
+##### robust estimation of covariance matrix
+#####
+
+##### Example 1: linear least squares regression with
+##### heteroskedasticity consistent standard errors (default)
+# Attach sample data and variable names:
+data(macro)
+
+# Fit the model with robust standard error
+user.prompt()
+z.out1 <- zelig(unem ~ gdp + capmob + trade, model = "ls", data = macro, robust = TRUE)
+user.prompt()
+print(summary(z.out1))
+
+# usual procedure applies
+user.prompt()
+x <- setx(z.out1)
+user.prompt()
+s.out1 <- sim(z.out1, x = x)
+user.prompt()
+print(summary(s.out1))
+user.prompt()
+plot(s.out1)
+
+##### Example 2: linear least squares regression with
+##### heteroskedasticity and autocorrelation consistent standard errors
+
+# Attach sample data and variable names:
+data(hoff)
+# Fit the model with robust standard error
+user.prompt()
+z.out1 <- zelig(L2SocSec ~ Just503D + Just503R + Just503D:RGovDumy +
+ Just503R:I(1-RGovDumy), model = "ls", data = hoff,
+ robust = list(method="vcovHAC", order.by=hoff$year, adjust=TRUE))
+user.prompt()
+print(summary(z.out1))
diff --git a/demo/strata.R b/demo/strata.R
new file mode 100644
index 0000000..2b95562
--- /dev/null
+++ b/demo/strata.R
@@ -0,0 +1,27 @@
+
+data(turnout)
+z.out1 <- zelig(vote ~ educate + age + income, model = "logit", data = turnout, by = "race")
+user.prompt()
+## Viewing the regression output:
+summary(z.out1)
+
+## Using setx to generate baseline and alternative values for the
+## explanatory variables.
+user.prompt()
+x.out1 <- setx(z.out1, age = 65)
+
+## Simulating quantities of interest (predicted probabilites, risk
+## ratios, and risk differences):
+user.prompt()
+s.out1 <- sim(z.out1, x = x.out1)
+user.prompt()
+## Summarizing the simulated quantities of interest:
+summary(s.out1)
+user.prompt()
+
+## Conditional prediction:
+x.out2 <- setx(z.out1, fn = NULL, cond = TRUE)
+s.out2 <- sim(z.out1, x = x.out2)
+user.prompt()
+summary(s.out2)
+
diff --git a/man/dims.Rd b/man/dims.Rd
index 5a68f2e..9c20e00 100644
--- a/man/dims.Rd
+++ b/man/dims.Rd
@@ -5,19 +5,16 @@
\title{Return Dimensions of Vectors, Arrays, and Data Frames}
\description{
- Retrieve or set the dimensions of a vector, array, or data frame.
+ Retrieve the dimensions of a vector, array, or data frame.
}
\usage{
dims(x)
-dims(x) <- value
}
\arguments{
\item{x}{An R object. For example, a vector, matrix, array, or data
frame.}
- \item{value}{For the default method, either \code{NULL} or a numeric
-vector coerced to integer (by truncation).}
}
\value{
diff --git a/man/hoff.Rd b/man/hoff.Rd
new file mode 100644
index 0000000..5791625
--- /dev/null
+++ b/man/hoff.Rd
@@ -0,0 +1,27 @@
+\name{hoff}
+
+\alias{hoff}
+
+\title{Social Security Expenditure Data}
+
+\description{
+ This data set contains annual social security expenditure (as percent
+ of budget lagged by two years), the
+ relative frequency of mentions social justice received in the party's
+ platform in each year, and whether the president is Republican or
+ Democrat.
+}
+
+\usage{data(hoff)}
+
+\format{A table containing 5 variables ("year", "L2SocSec", "Just503D", "Just503R", "RGovDumy") and 36 observations.}
+
+\source{ICPSR (replication dataset s1109)}
+
+\references{
+ Gary King and Michael Laver. ``On Party Platforms, Mandates, and
+ Government Spending,'' \emph{American Political Science Review},
+ Vol. 87, No. 3 (September, 1993): pp. 744-750.
+}
+
+\keyword{datasets}
--
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