[Rsiena-commits] r133 - in pkg: RSiena RSiena/man RSienaTest RSienaTest/R RSienaTest/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jan 25 00:35:15 CET 2011
Author: steglich
Date: 2011-01-25 00:35:15 +0100 (Tue, 25 Jan 2011)
New Revision: 133
Modified:
pkg/RSiena/DESCRIPTION
pkg/RSiena/changeLog
pkg/RSiena/man/RSiena-package.Rd
pkg/RSienaTest/DESCRIPTION
pkg/RSienaTest/R/phase2.r
pkg/RSienaTest/R/siena08.r
pkg/RSienaTest/changeLog
pkg/RSienaTest/man/RSiena-package.Rd
pkg/RSienaTest/man/print.sienaMeta.Rd
pkg/RSienaTest/man/siena08.Rd
Log:
Modified: pkg/RSiena/DESCRIPTION
===================================================================
--- pkg/RSiena/DESCRIPTION 2011-01-19 16:03:34 UTC (rev 132)
+++ pkg/RSiena/DESCRIPTION 2011-01-24 23:35:15 UTC (rev 133)
@@ -1,8 +1,8 @@
Package: RSiena
Type: Package
Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.0.12.132
-Date: 2011-01-16
+Version: 1.0.12.133
+Date: 2011-01-25
Author: Various
Depends: R (>= 2.9.0), xtable
Imports: Matrix
Modified: pkg/RSiena/changeLog
===================================================================
--- pkg/RSiena/changeLog 2011-01-19 16:03:34 UTC (rev 132)
+++ pkg/RSiena/changeLog 2011-01-24 23:35:15 UTC (rev 133)
@@ -1,3 +1,13 @@
+2011-01-25 R-forge revision 133
+ * changes to RSienaTest only
+ * R/phase2.r: comment out two test lines causing a crash of the ML
+ estimation when model specifications get so large that subphases
+ exceed 1000 iterations.
+ * R/siena08.r: debugging and adding of functionalities to the meta-
+ analysis.
+ * man/siena08.Rd: explain new features in help function
+ * man/print.sienaMeta.Rd: explain new features in help function
+
2011-01-17 R-forge revision 132
* Changing revision 131 to conform with coding standards
2011-01-17 R-forge revision 131
Modified: pkg/RSiena/man/RSiena-package.Rd
===================================================================
--- pkg/RSiena/man/RSiena-package.Rd 2011-01-19 16:03:34 UTC (rev 132)
+++ pkg/RSiena/man/RSiena-package.Rd 2011-01-24 23:35:15 UTC (rev 133)
@@ -30,8 +30,8 @@
\tabular{ll}{
Package: \tab RSiena\cr
Type: \tab Package\cr
-Version: \tab 1.0.12.132\cr
-Date: \tab 2011-01-19\cr
+Version: \tab 1.0.12.133\cr
+Date: \tab 2011-01-25\cr
License: \tab GPL-2 \cr
LazyLoad: \tab yes\cr
}
Modified: pkg/RSienaTest/DESCRIPTION
===================================================================
--- pkg/RSienaTest/DESCRIPTION 2011-01-19 16:03:34 UTC (rev 132)
+++ pkg/RSienaTest/DESCRIPTION 2011-01-24 23:35:15 UTC (rev 133)
@@ -1,8 +1,8 @@
Package: RSienaTest
Type: Package
Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.0.12.132
-Date: 2011-01-16
+Version: 1.0.12.133
+Date: 2011-01-25
Author: Various
Depends: R (>= 2.9.0), xtable
Imports: Matrix
Modified: pkg/RSienaTest/R/phase2.r
===================================================================
--- pkg/RSienaTest/R/phase2.r 2011-01-19 16:03:34 UTC (rev 132)
+++ pkg/RSienaTest/R/phase2.r 2011-01-24 23:35:15 UTC (rev 133)
@@ -285,7 +285,7 @@
}
if (x$maxlike)
{
- z$phase2fras[subphase, ,z$nit] <- fra
+ # z$phase2fras[subphase, ,z$nit] <- fra
# z$rejectprops[subphase, , z$nit] <- zz$rejectprop
}
if (z$nit %% 2 == 1)
@@ -464,7 +464,7 @@
}
if (x$maxlike)
{
- z$phase2fras[subphase, ,z$nit] <- fra
+ # z$phase2fras[subphase, ,z$nit] <- fra
## z$rejectprops[subphase, , z$nit] <- zz$rejectprop
}
if (z$nit %% 2 == 1)
Modified: pkg/RSienaTest/R/siena08.r
===================================================================
--- pkg/RSienaTest/R/siena08.r 2011-01-19 16:03:34 UTC (rev 132)
+++ pkg/RSienaTest/R/siena08.r 2011-01-24 23:35:15 UTC (rev 133)
@@ -1,5 +1,5 @@
#/******************************************************************************
-# * SIENA: Simulation Investigation for Empirical Network Analysis
+# * SIENA: Simulation Investigation for Empirical bwork Analysis
# *
# * Web: http://www.stats.ox.ac.uk/~snidjers/siena
# *
@@ -90,6 +90,14 @@
x1 <- x[!is.na(x$theta) & !is.na(x$se) & x$se < bound,]
if (any(x1$theta != 0))
{
+ if (sum((x1$se < bound)) >= 3)
+ {
+ check.correl <- cor.test(x1$theta,x1$se)
+ }
+ else
+ {
+ check.correl <- data.frame(estimate=NA,p.value=NA)
+ }
regfit <- iwlsm(theta ~ 1, psi=psi.iwlsm, data=x1,
ses=x1$se^2)
regfit$terms <- NA
@@ -105,7 +113,9 @@
cjminus <- -2 * sum(pnorm(x1$theta / x1$se, log=TRUE))
cjplusp <- 1 - pchisq(cjplus, 2 * nrow(x1))
cjminusp <- 1 - pchisq(cjminus, 2 * nrow(x1))
- ret1 <- list(regfit=regfit, regsummary=regsummary,
+ ret1 <- list(cor.est=check.correl$estimate,
+ cor.pval=check.correl$p.value,
+ regfit=regfit, regsummary=regsummary,
Tsq=Tsq, pTsq=1 - pchisq(Tsq, nrow(x1) - 1),
tratio=tratio,
ptratio=2 * pnorm(abs(tratio), lower.tail=FALSE),
@@ -145,7 +155,7 @@
meta$thetadf <- mydf
class(meta) <- "sienaMeta"
meta$projname <- projname
- meta$bound <- 5
+ meta$bound <- bound
## count the score tests
meta$scores <- by(mydf, mydf$effects, function(x)
any(!is.na(x$scoretests)))
@@ -208,16 +218,34 @@
Report(c(" ", y$n1, " datasets used.\n\n"), sep="", outf)
if (y$n1 > 0)
{
- Report(c("\nTest that all parameters are 0 : \n"), outf)
+ Report("Test that estimates and standard errors are uncorrelated", outf)
+ if (is.na(y$cor.est))
+ {
+ Report("\ncannot be performed.\n\n", outf)
+ }
+ else
+ {
+ Report(c(": \nPearson correlation =", format(round(y$cor.est, 4), width=9),
+ ", two-sided ",reportp(y$cor.pval,3), "\n\n"), sep="", outf)
+ }
+ Report(c("Test that all parameters are 0 : \n"), outf)
Report(c("chi-squared =", format(round(y$Tsq, 4), width=9),
", d.f. = ", y$n1, ", ",
reportp(y$pTsq, 3), "\n\n"), sep="", outf)
Report(c("Estimated mean parameter",
- format(round(y[[2]]$coefficients[1, 1], 4), width=9),
- " (s.e.", format(round(y[[2]]$coefficients[1, 2], 4),
- width=9), "), two-sided ",
- reportp(2 * pt(-abs(y[[2]]$coefficients[1, 3]),
- y$n1 - 1), 3), "\n\n"), sep="", outf)
+ format(round(y$regsummary$coefficients[1, 1], 4), width=9),
+ " (s.e.", format(round(y$regsummary$coefficients[1, 2], 4),
+ width=9), "), two-sided ",
+ reportp(2 * pt(-abs(y$regsummary$coefficients[1, 3]),
+ y$n1 - 1), 3), "\n"), sep="", outf)
+ Report("based on IWLS modification of Snijders & Baerveldt (2003). \n\n", outf)
+ Report(c("Residual standard error",
+ format(round(y$regsummary$stddev, 4), width=9)), outf)
+ Report("\nTest that variance of parameter is 0 :\n",outf)
+ Report(c("Chi-squared = ", format(round(y$Qstat, 4), width=9),
+ " (d.f. = ", y$n1-1, "), ", reportp(y$pttilde, 3),
+ "\n"), sep="", outf)
+ Report("based on IWLS modification of Snijders & Baerveldt (2003). \n\n", outf)
Report("Fisher's combination of one-sided tests\n", outf)
Report("----------------------------------------\n", outf)
Report("Combination of right one-sided p-values:\n", outf)
@@ -228,7 +256,7 @@
Report(c("Chi-squared = ", format(round(y$cjminus, 4), width=9),
" (d.f. = ", 2 * y$n1, "), ", reportp(y$cjminusp, 3),
"\n"), sep="", outf)
- }
+ }
else
{
Report(c("There were no data sets satisfying the bounds for",
@@ -296,13 +324,13 @@
plot.sienaMeta <- function(x, ...)
{
library(lattice)
- tmp <- xyplot(se ~ theta|effects, data=x$thetadf, xlab="estimates",
- ylab="standard errors", layout=c(4,4),
+ tmp <- xyplot(theta ~ se|effects, data=x$thetadf, ylab="estimates",
+ xlab="standard errors", layout=c(4,4),
panel=function(x, y)
{
panel.xyplot(x, y)
- panel.abline(0, 2)
- panel.abline(0, -2)
+ panel.abline(0, qnorm(0.025))
+ panel.abline(0, qnorm(0.975))
}, scales="free")
tmp[!sapply(tmp$y.limits, function(x)all(is.na(x)))]
}
@@ -397,7 +425,7 @@
}
Report(c("================================= SIENA08 ",
"================================================\n",
- "Multilevel use of Siena algorithms according to",
+ "Multilevel use of Siena algorithms according to ",
"Snijders & Baerveldt (2003) with extension\n",
"=================================================",
"=========================================\n\n"), sep="", outf)
@@ -501,25 +529,43 @@
{
if (extra)
{
- Report(c("Snijders-Baerveldt (2003) method of combining",
+ Report(c("IWLS modification of Snijders-Baerveldt (2003) method of combining",
"estimates"), outf)
- Report(c("\n---------------------------------------",
- "----------------\n"), sep="", outf)
+ Report(c("\n--------------------------------------------",
+ "---------------------------------\n"), sep="", outf)
Report(c("This method assumes that true parameters and",
" standard errors are uncorrelated.\n",
- "This can be checked from the plots.\n"), sep="",
+ "This can be checked by the plot method and the test below.\n\n"), sep="",
outf)
}
- Report(c("\nTest that all parameters are 0 : \n"), outf)
+ Report("Test that estimates and standard errors are uncorrelated", outf)
+ if (is.na(y$cor.est))
+ {
+ Report("\ncannot be performed.\n\n", outf)
+ }
+ else
+ {
+ Report(c(": \nPearson correlation =", format(round(y$cor.est, 4), width=9),
+ ", two-sided ",reportp(y$cor.pval,3), "\n\n"), sep="", outf)
+ }
+ Report(c("Test that all parameters are 0 : \n"), outf)
Report(c("chi-squared =", format(round(y$Tsq, 4), width=9),
", d.f. = ", y$n1, ", ",
reportp(y$pTsq, 3), "\n\n"), sep="", outf)
Report(c("Estimated mean parameter",
- format(round(y[[2]]$coefficients[1, 1], 4), width=9),
- " (s.e.", format(round(y[[2]]$coefficients[1, 2], 4),
+ format(round(y$regsummary$coefficients[1, 1], 4), width=9),
+ " (s.e.", format(round(y$regsummary$coefficients[1, 2], 4),
width=9), "), two-sided ",
- reportp(pt(y[[2]]$coefficients[1, 3],
- y$n1 - 1), 3), "\n\n"), sep="", outf)
+ reportp(pt(y$regsummary$coefficients[1, 3],
+ y$n1 - 1), 3), "\n"), sep="", outf)
+ Report("based on IWLS modification of Snijders & Baerveldt (2003). \n\n", outf)
+ Report(c("Residual standard error",
+ format(round(y$regsummary$stddev, 4), width=9)), outf)
+ Report("\nTest that variance of parameter is 0 :\n",outf)
+ Report(c("Chi-squared = ", format(round(y$Qstat, 4), width=9),
+ " (d.f. = ", y$n1-1, "), ", reportp(y$pttilde, 3),
+ "\n"), sep="", outf)
+ Report("based on IWLS modification of Snijders & Baerveldt (2003). \n\n", outf)
Report("Fisher's combination of one-sided tests\n", outf)
Report("----------------------------------------\n", outf)
Report("Combination of right one-sided p-values:\n", outf)
Modified: pkg/RSienaTest/changeLog
===================================================================
--- pkg/RSienaTest/changeLog 2011-01-19 16:03:34 UTC (rev 132)
+++ pkg/RSienaTest/changeLog 2011-01-24 23:35:15 UTC (rev 133)
@@ -1,3 +1,13 @@
+2011-01-25 R-forge revision 133
+ * changes to RSienaTest only
+ * R/phase2.r: comment out two test lines causing a crash of the ML
+ estimation when model specifications get so large that subphases
+ exceed 1000 iterations.
+ * R/siena08.r: debugging and adding of functionalities to the meta-
+ analysis.
+ * man/siena08.Rd: explain new features in help function
+ * man/print.sienaMeta.Rd: explain new features in help function
+
2011-01-17 R-forge revision 132
* Changing revision 131 to conform with coding standards
2011-01-17 R-forge revision 131
Modified: pkg/RSienaTest/man/RSiena-package.Rd
===================================================================
--- pkg/RSienaTest/man/RSiena-package.Rd 2011-01-19 16:03:34 UTC (rev 132)
+++ pkg/RSienaTest/man/RSiena-package.Rd 2011-01-24 23:35:15 UTC (rev 133)
@@ -30,8 +30,8 @@
\tabular{ll}{
Package: \tab RSiena\cr
Type: \tab Package\cr
-Version: \tab 1.0.12.132\cr
-Date: \tab 2011-01-19\cr
+Version: \tab 1.0.12.133\cr
+Date: \tab 2011-01-25\cr
License: \tab GPL-2 \cr
LazyLoad: \tab yes\cr
}
Modified: pkg/RSienaTest/man/print.sienaMeta.Rd
===================================================================
--- pkg/RSienaTest/man/print.sienaMeta.Rd 2011-01-19 16:03:34 UTC (rev 132)
+++ pkg/RSienaTest/man/print.sienaMeta.Rd 2011-01-24 23:35:15 UTC (rev 133)
@@ -8,7 +8,7 @@
\usage{
\method{print}{sienaMeta}(x, file=FALSE, ...)
-\method{summary}{sienaMeta}(object, file=FALSE, extra=TRUE, ...)
+\method{summary}{sienaMeta}(x, file=FALSE, extra=TRUE, ...)
\method{print}{summary.sienaMeta}(x, file=FALSE, extra=TRUE, ...)
@@ -19,7 +19,6 @@
\code{sienaMeta} objects.
}
\arguments{
- \item{object}{An object of class \code{sienaMeta}}
\item{x}{An object of class \code{sienaMeta}, or
\code{summary.sienaMeta} as appropriate}
\item{file}{Boolean: if TRUE, sends output to file named
@@ -42,7 +41,8 @@
argument to \code{siena08}.
The function \code{plot.sienaMeta} plots estimates against standard
- errors for each effect, with lines added at \verb{x=\pm 2}.
+ errors for each effect, with reference lines added at the two-sided
+ significance threshold 0.05.
}
\references{
T. A. B. Snijders and Chris Baerveldt.
Modified: pkg/RSienaTest/man/siena08.Rd
===================================================================
--- pkg/RSienaTest/man/siena08.Rd 2011-01-19 16:03:34 UTC (rev 132)
+++ pkg/RSienaTest/man/siena08.Rd 2011-01-24 23:35:15 UTC (rev 133)
@@ -30,8 +30,10 @@
\code{summary} and \code{plot} methods for this class.
An object of class \code{sienaMeta} is a list containing at least the
- following. (Items \code{regfit} to
+ following. (Items \code{cor.est} to
\code{ns} appear once for each effect.)
+ \item{cor.est}{Pearson correlation coefficient between estimates ans their standard errors.}
+ \item{cor.pval}{p-value for above}
\item{regfit}{Part of the result of the fit of \code{\link{iwlsm}}.}
\item{regsummary}{The summary of the fit, which includes the
coefficient table.}
@@ -39,7 +41,7 @@
\item{pTsq}{p-value for above}
\item{tratio}{test statistics that mean effect is 0}
\item{ptratio}{p-value for above}
- \item{Qstat}{Test statisitc for variance of effects is zero}
+ \item{Qstat}{Test statistic for variance of effects is zero}
\item{pttilde}{p-value for above}
\item{cjplus}{Test statistic for at least one theta strictly greater than 0}
\item{cjminus}{Test statistic for at least one theta strictly less than 0}
More information about the Rsiena-commits
mailing list