[Rsiena-commits] r171 - in pkg: RSiena RSiena/R RSiena/inst/doc RSiena/man RSienaTest RSienaTest/R RSienaTest/doc RSienaTest/inst/doc RSienaTest/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Sep 7 18:10:08 CEST 2011
Author: ripleyrm
Date: 2011-09-07 18:10:08 +0200 (Wed, 07 Sep 2011)
New Revision: 171
Modified:
pkg/RSiena/DESCRIPTION
pkg/RSiena/R/globals.r
pkg/RSiena/R/print07Report.r
pkg/RSiena/R/printDataReport.r
pkg/RSiena/R/printInitialDescription.r
pkg/RSiena/R/robmon.r
pkg/RSiena/R/siena07gui.r
pkg/RSiena/R/siena08.r
pkg/RSiena/R/sienaprint.r
pkg/RSiena/changeLog
pkg/RSiena/inst/doc/RSiena_Manual.pdf
pkg/RSiena/man/siena08.Rd
pkg/RSiena/man/simstats0c.Rd
pkg/RSienaTest/DESCRIPTION
pkg/RSienaTest/R/globals.r
pkg/RSienaTest/R/initializeFRAN.r
pkg/RSienaTest/R/printInitialDescription.r
pkg/RSienaTest/R/siena08.r
pkg/RSienaTest/changeLog
pkg/RSienaTest/doc/RSiena_Manual.tex
pkg/RSienaTest/inst/doc/RSiena_Manual.pdf
pkg/RSienaTest/man/RSiena-package.Rd
pkg/RSienaTest/man/siena08.Rd
Log:
siena08 bugs, other minor changes.
Modified: pkg/RSiena/DESCRIPTION
===================================================================
--- pkg/RSiena/DESCRIPTION 2011-08-22 10:35:09 UTC (rev 170)
+++ pkg/RSiena/DESCRIPTION 2011-09-07 16:10:08 UTC (rev 171)
@@ -1,8 +1,8 @@
Package: RSiena
Type: Package
Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.0.12.170
-Date: 2011-08-22
+Version: 1.0.12.171
+Date: 2011-09-07
Author: Various
Depends: R (>= 2.10.0)
Imports: Matrix
Modified: pkg/RSiena/R/globals.r
===================================================================
--- pkg/RSiena/R/globals.r 2011-08-22 10:35:09 UTC (rev 170)
+++ pkg/RSiena/R/globals.r 2011-09-07 16:10:08 UTC (rev 171)
@@ -33,6 +33,7 @@
type <- match.arg(type)
beverbose <<- verbose
besilent <<- silent
+ noReportFile <<- FALSE
if (type =='w')
{
x$outf <<- file(paste(projname, ".out", sep=""), open="w")
@@ -166,14 +167,16 @@
##@PrtOutMat Reporting
PrtOutMat<- function(mat, dest)
{
+ testing <- Sys.getenv("RSIENATESTING")
+ testing <- testing != ""
if (missing(dest))
{
- Report(format(t(mat), scientific=FALSE),
+ Report(format(t(mat), scientific=testing),
sep=c(rep.int(" ", ncol(mat) - 1), "\n"))
}
else
{
- Report(format(t(mat), scientific=FALSE),
+ Report(format(t(mat), scientific=testing),
sep=c(rep.int(" ", ncol(mat) - 1), "\n"),
hdest=deparse(substitute(dest)))
Report("\n", hdest=deparse(substitute(dest)))
Modified: pkg/RSiena/R/print07Report.r
===================================================================
--- pkg/RSiena/R/print07Report.r 2011-08-22 10:35:09 UTC (rev 170)
+++ pkg/RSiena/R/print07Report.r 2011-09-07 16:10:08 UTC (rev 171)
@@ -162,8 +162,8 @@
Report(c("covariance/correlation matrix of X can be found using\n",
"summary(ans) within R,",
" or by using the 'verbose' option in Siena07.\n "), sep = "", outf)
- Report(c('Derivative matrix of expected statistics X by',
- 'parameters:\n\n '), lf)
+ Report(c("Derivative matrix of expected statistics X by",
+ "parameters:\n\n"), lf)
PrtOutMat(z$dfrac, lf)
Report('Covariance matrix of X (correlations below the diagonal):\n',
lf)
Modified: pkg/RSiena/R/printDataReport.r
===================================================================
--- pkg/RSiena/R/printDataReport.r 2011-08-22 10:35:09 UTC (rev 170)
+++ pkg/RSiena/R/printDataReport.r 2011-09-07 16:10:08 UTC (rev 171)
@@ -11,6 +11,13 @@
##@DataReport siena07 Print report
DataReport <- function(z, x, f)
{
+ if (z$maxlike)
+ {
+ Report(c(z$nrunMH,
+ "MCMC steps per RM step (multiplication factor =",
+ x$mult), outf)
+ Report(")\n", outf)
+ }
## f could be a group, but has attributes like a group even if not!
oneMode <- attr(f, "types") == "oneMode"
bipartite <- attr(f, "types") == "bipartite"
@@ -88,7 +95,7 @@
width = 4), '.\n'),sep='', outf)
}
}
- else
+ else if (!z$maxlike)
{
Report("unconditional moment estimation.\n", outf)
@@ -107,6 +114,10 @@
}
Report('is 1.0.\n', outf)
}
+ else
+ {
+ Report("Maximum likelihood estimation\n", outf)
+ }
if (z$FinDiff.method)
{
Report(c('Standard errors are estimated with the finite difference',
Modified: pkg/RSiena/R/printInitialDescription.r
===================================================================
--- pkg/RSiena/R/printInitialDescription.r 2011-08-22 10:35:09 UTC (rev 170)
+++ pkg/RSiena/R/printInitialDescription.r 2011-09-07 16:10:08 UTC (rev 171)
@@ -72,7 +72,7 @@
{
nties <- nties / 2
}
- periodFromStart <- data[[group]]$observations
+ periodFromStart <- periodFromStart + data[[group]]$observations
}
## now do the format
tmp <- rbind(format(round(density, 3), nsmall=3, width=7),
Modified: pkg/RSiena/R/robmon.r
===================================================================
--- pkg/RSiena/R/robmon.r 2011-08-22 10:35:09 UTC (rev 170)
+++ pkg/RSiena/R/robmon.r 2011-09-07 16:10:08 UTC (rev 171)
@@ -18,7 +18,7 @@
z$FinDiff.method<- x$FinDiff.method
z$n <- 0
z$OK <- TRUE
- z$error<- FALSE
+ z$error <- FALSE
z$restarted <- FALSE
z$DerivativeProblem <- FALSE
z$ForceFinDifPhase1 <- FALSE
@@ -28,6 +28,10 @@
z$gain <- x$firstg
z$haveDfra <- FALSE
z$maxlike <- x$maxlike
+ if (z$maxlike && !is.batch())
+ {
+ tkconfigure(z$tkvars$phaselabel, text="MCMC Burnin")
+ }
#######################################################
##do initial setup call of FRAN
#######################################################
@@ -36,6 +40,10 @@
x$FRAN <- getFromNamespace(x$FRANname, pos=grep("RSiena", search())[1])
}
z <- x$FRAN(z, x, INIT=TRUE, initC=FALSE, ...)
+ if (z$maxlike && !is.batch())
+ {
+ tkconfigure(z$tkvars$phaselabel, text="Phase")
+ }
##
##if conditional, FRAN changes z$theta etc
#######################################################
@@ -52,7 +60,8 @@
cl <- makeCluster(clusterString, type = "SOCK",
outfile = "cluster.out")
clusterCall(cl, library, pkgname, character.only = TRUE)
- clusterSetupRNG(cl, seed = as.integer(runif(6, max=.Machine$integer.max)))
+ clusterSetupRNG(cl, seed = as.integer(runif(6,
+ max=.Machine$integer.max)))
clusterCall(cl, storeinFRANstore, FRANstore())
if (initC)
{
@@ -66,7 +75,10 @@
}
z$newFixed <- rep(FALSE, z$pp)
z$AllNowFixed <- FALSE
- z$dinv <- matrix(NA, nrow = z$pp, ncol = z$pp)
+ if (!z$haveDfra)
+ {
+ z$dinv <- matrix(NA, nrow = z$pp, ncol = z$pp)
+ }
z$scale <- rep(0.1, z$pp)
Report('\n', outf)
Report('\nStochastic approximation algorithm.\n', cf)
@@ -79,13 +91,15 @@
}
Report(c('Initial value for gain parameter = ', format(z$gain),
'.\nStart of the algorithm.\n'), cf, sep='')
- Report('Target function values are \n', cf)
- ftargets <- format(z$targets, width = 10, nsmall = 4)
- fnum<- format(1 : z$pp, width = 3)
+ Report('Observed function values are \n', cf)
+ targets <- if (!z$maxlike) z$targets else z$maxlikeTargets
+ ftargets <- format(targets, width = 10, nsmall = 4)
+ fnum <- format(1 : z$pp, width = 3)
Report(c(paste(fnum, '. ', ftargets, sep = '')), cf, fill=80)
z$epsilon<- pmin(0.1,z$scale)
- z$epsilon[z$posj]<- 0.1 * z$theta[z$posj]
- z$theta0<- z$theta ## store starting value without any conditioning variables
+ z$epsilon[z$posj] <- 0.1 * z$theta[z$posj]
+ z$theta0 <- z$theta
+ ## store starting value without any conditioning variables
z$anyposj <- any(z$posj)
z$resist <- rep(1, z$pp)
z$n1 <- 7 + 3 * z$pp
Modified: pkg/RSiena/R/siena07gui.r
===================================================================
--- pkg/RSiena/R/siena07gui.r 2011-08-22 10:35:09 UTC (rev 170)
+++ pkg/RSiena/R/siena07gui.r 2011-09-07 16:10:08 UTC (rev 171)
@@ -95,7 +95,8 @@
# cat('here\n')
list(tt=tt, pb=progressbar, earlyEndPhase2=button2, current=text1,
quasi=text2, deviations=text3, phase=phase, subphase=subphase,
- iteration=iteration, subphaselabel=subphaselabel)
+ iteration=iteration, subphaselabel=subphaselabel,
+ phaselabel=phaselabel)
}
Modified: pkg/RSiena/R/siena08.r
===================================================================
--- pkg/RSiena/R/siena08.r 2011-08-22 10:35:09 UTC (rev 170)
+++ pkg/RSiena/R/siena08.r 2011-09-07 16:10:08 UTC (rev 171)
@@ -9,7 +9,7 @@
# * collection of Siena fits.
# *****************************************************************************/
##@siena08 siena08
-siena08 <- function(..., projname="sienaMeta", bound=5, alpha=0.05)
+siena08 <- function(..., projname="sienaMeta", bound=5, alpha=0.05, maxit=20)
{
dots <- as.list(substitute(list(...)))[-1] ##first entry is the word 'list'
if (length(dots) == 0)
@@ -62,9 +62,9 @@
projname=rep(projnames[i], n),
theta=x$theta,
effects=
- paste(format(x$effects$type,
+ paste(format(x$requestedEffects$type,
width=5),
- x$effects$effectName,
+ x$requestedEffects$effectName,
sep=": "),
tconv=x$tconv,
version=rep(x$version, n),
@@ -102,7 +102,7 @@
method="no correlation test")
}
regfit <- iwlsm(theta ~ 1, psi=psi.iwlsm, data=x1,
- ses=x1$se^2)
+ ses=x1$se^2, maxit=maxit)
regfit$terms <- NA
regfit$model <- NULL
regfit$psi <- NULL
Modified: pkg/RSiena/R/sienaprint.r
===================================================================
--- pkg/RSiena/R/sienaprint.r 2011-08-22 10:35:09 UTC (rev 170)
+++ pkg/RSiena/R/sienaprint.r 2011-09-07 16:10:08 UTC (rev 171)
@@ -12,211 +12,236 @@
##@print.siena Methods
print.siena <- function(x, ...)
{
- if (!inherits(x, "siena"))
+ if (!inherits(x, "siena"))
+ {
stop("not a legitimate Siena data object")
- cat('Dependent variables: ', paste(names(x$depvars), collapse=", "), "\n")
- cat('Number of waves:', x$observations, "\n")
- if (!is.null(x$nodesets))
- {
- tmp <- cbind(c('Nodesets',
- paste(names(x$nodesets), collapse=", ")),
- c('Number of nodes', sapply(x$nodesets, length)))
- print(tmp)
- }
- if (length(x$cCovars) > 0)
- {
- cat('Constant covariates: ', paste(names(x$cCovars), collapse=", "), "\n")
- }
- if (length(x$vCovars) > 0)
- {
- cat('Changing covariates: ',
- paste(names(x$vCovars), collapse = ", "), "\n")
- }
- if (length(x$dycCovars) > 0)
- {
- cat('Constant dyadic covariates: ',
- paste(names(x$dycCovars), collapse=", "), "\n")
- }
- if (length(x$dyvCovars) > 0)
- {
- cat('Changing dyadic covariates: ',
- paste(names(x$dyvCovars), collapse=", "), "\n")
- }
- attrs <- attributes(x)
- highers <- attrs[["higher"]]
- disjoints <- attrs[["disjoint"]]
- atleastones <- attrs[["atLeastOne"]]
- if (any(highers))
- {
- cat("Higher: ", names(highers)[highers], "\n")
- }
- if (any(disjoints))
- {
- cat("Disjoint: ", names(disjoints)[disjoints], "\n")
- }
- if (any(atleastones))
- {
- cat("atLeatOne: ", names(atleastones)[atleastones], "\n")
- }
- invisible(x)
+ }
+ cat('Dependent variables: ', paste(names(x$depvars), collapse=", "), "\n")
+ cat('Number of waves:', x$observations, "\n")
+ if (!is.null(x$nodesets))
+ {
+ tmp <- cbind(c('Nodesets',
+ paste(names(x$nodesets), collapse=", ")),
+ c('Number of nodes', sapply(x$nodesets, length)))
+ print(tmp)
+ }
+ if (length(x$cCovars) > 0)
+ {
+ cat('Constant covariates: ', paste(names(x$cCovars), collapse=", "), "\n")
+ }
+ if (length(x$vCovars) > 0)
+ {
+ cat('Changing covariates: ',
+ paste(names(x$vCovars), collapse = ", "), "\n")
+ }
+ if (length(x$dycCovars) > 0)
+ {
+ cat('Constant dyadic covariates: ',
+ paste(names(x$dycCovars), collapse=", "), "\n")
+ }
+ if (length(x$dyvCovars) > 0)
+ {
+ cat('Changing dyadic covariates: ',
+ paste(names(x$dyvCovars), collapse=", "), "\n")
+ }
+ attrs <- attributes(x)
+ highers <- attrs[["higher"]]
+ disjoints <- attrs[["disjoint"]]
+ atleastones <- attrs[["atLeastOne"]]
+ if (any(highers))
+ {
+ cat("Higher: ", names(highers)[highers], "\n")
+ }
+ if (any(disjoints))
+ {
+ cat("Disjoint: ", names(disjoints)[disjoints], "\n")
+ }
+ if (any(atleastones))
+ {
+ cat("atLeatOne: ", names(atleastones)[atleastones], "\n")
+ }
+ invisible(x)
}
##@print.sienaGroup Methods
print.sienaGroup <- function(x, ...)
{
- if (!inherits(x, "sienaGroup"))
+ if (!inherits(x, "sienaGroup"))
+ {
stop("not a legitimate Siena group data object")
- att <- attributes(x)
- cat('Dependent variables: \n')
- cat(paste(att$netnames, ":", att$types),'\n')
- cat('Total number of periods:', att$observations)
- cat("\nmore to be added!\n")
- invisible(x)
+ }
+ att <- attributes(x)
+ cat('Dependent variables: \n')
+ cat(paste(att$netnames, ":", att$types),'\n')
+ cat('Total number of periods:', att$observations)
+ cat("\nmore to be added!\n")
+ invisible(x)
}
##@print.sienafit Methods
print.sienaFit <- function(x, tstat=TRUE, ...)
{
- if (!inherits(x, "sienaFit"))
+ if (!inherits(x, "sienaFit"))
+ {
stop("not a legitimate Siena model fit")
- if (!x$OK)
- {
- cat("Error end of estimation algorithm\n")
- }
- else if (x$termination == "UserInterrupt")
- {
- cat("User interrupted run, object possibly incomplete\n")
- }
- else
- {
- cat(c("Estimates, standard errors and t-statistics for",
- "convergence\n\n"))
- tmp <- sienaFitThetaTable(x, tstat=tstat)
- mydf <- tmp$mydf
- mymat <- as.matrix(mydf)
- mymat[, 'value'] <- format(round(mydf$value, digits=4))
- mymat[, 'se'] <- format(round(mydf$se, digits=4))
- mymat[, 'tstat'] <- format(round(mydf$tstat, digits=4))
- mymat[is.na(mydf$tstat), 'tstat'] <- ' '
- mymat[, 'type'] <- format(mymat[, 'type'])
- mymat[, 'text'] <- format(mymat[, 'text'])
- mymat[mydf$row < 1, 'row'] <-
- format(mydf[mydf$row < 1, 'row'])
- mymat[mydf[,'row'] >= 1, 'row'] <-
- paste(format(mydf[mydf$row >= 1, 'row']), '.', sep='')
- mymat <- rbind(c(rep("", 4), "Estimate", "", "Standard", "",
- "t statistic"),
- c(rep("", 6), " Error", "", ""), mymat)
- mymat <- apply(mymat, 2, format)
- tmp1 <- apply(mymat, 1, function(x) paste(x, collapse=" "))
- addtorow <- tmp$addtorow
- for (i in 1:length(tmp1))
- {
- if (length(addtorow$command) > 0)
- {
- for (j in 1:length(addtorow$command))
- {
- ii <- match(i-1, addtorow$pos[[j]])
- if (!is.na(ii))
- if (i == 2 | addtorow$command[j] == 'Network Dynamics')
- cat( addtorow$command[j], '\n')
- else
- cat('\n', addtorow$command[j], '\n', sep='')
- }
- }
- cat(tmp1[i], '\n')
- }
+ }
+ if (!x$OK)
+ {
+ cat("Error end of estimation algorithm\n")
+ }
+ else if (x$termination == "UserInterrupt")
+ {
+ cat("User interrupted run, object possibly incomplete\n")
+ }
+ else
+ {
+ cat("Estimates, standard errors and convergence t-ratios\n\n")
+ tmp <- sienaFitThetaTable(x, tstat=tstat)
+ mydf <- tmp$mydf
+ mymat <- as.matrix(mydf)
+ mymat[, 'value'] <- format(round(mydf$value, digits=4))
+ mymat[, 'se'] <- format(round(mydf$se, digits=4))
+ mymat[, 'tstat'] <- paste(" ", format(round(mydf$tstat, digits=4)))
+ mymat[is.na(mydf$tstat), 'tstat'] <- ' '
+ mymat[, 'type'] <- format(mymat[, 'type'])
+ mymat[, 'text'] <- format(mymat[, 'text'])
+ mymat[mydf$row < 1, 'row'] <-
+ format(mydf[mydf$row < 1, 'row'])
+ mymat[mydf[,'row'] >= 1, 'row'] <-
+ paste(format(mydf[mydf$row >= 1, 'row']), '.', sep='')
+ mymat <- rbind(c(rep("", 4), "Estimate", "", "Standard", "",
+ "Convergence"),
+ c(rep("", 6), " Error", "", " t-ratio"), mymat)
+ mymat <- apply(mymat, 2, format)
+ tmp1 <- apply(mymat, 1, function(x) paste(x, collapse=" "))
+ addtorow <- tmp$addtorow
+ for (i in 1:length(tmp1))
+ {
+ if (length(addtorow$command) > 0)
+ {
+ for (j in 1:length(addtorow$command))
+ {
+ ii <- match(i-1, addtorow$pos[[j]])
+ if (!is.na(ii))
+ if (i == 2 | addtorow$command[j] == 'Network Dynamics')
+ cat( addtorow$command[j], '\n')
+ else
+ cat('\n', addtorow$command[j], '\n', sep='')
+ }
+ }
+ cat(tmp1[i], '\n')
+ }
- cat("\nTotal of", x$n, "iteration steps.\n\n")
- if (x$termination == "UserInterrupt")
- cat(" \n*** Warning ***",
- "Estimation terminated early at user request.\n")
- }
- invisible(x)
+ cat("\nTotal of", x$n, "iteration steps.\n\n")
+ if (x$termination == "UserInterrupt")
+ cat(" \n*** Warning ***",
+ "Estimation terminated early at user request.\n")
+ }
+ invisible(x)
}
##@summary.sienaFit Methods
summary.sienaFit <- function(object, ...)
{
if (!inherits(object, "sienaFit"))
+ {
stop("not a legitimate Siena model fit")
+ }
class(object) <- c("summary.sienaFit", class(object))
object
}
##@print.summary.sienaFit Methods
print.summary.sienaFit <- function(x, ...)
{
- if (!inherits(x, "summary.sienaFit"))
+ if (!inherits(x, "summary.sienaFit"))
+ {
stop("not a legitimate summary of a Siena model fit")
- print.sienaFit(x)
- if (sum(x$test) > 0) ## we have some score tests
- {
- testn <- sum(x$test)
- if (x$maxlike)
- {
- cat("Score test <c>\n\n")
- }
- else
- {
- cat("Generalised score test <c>\n\n")
- }
- cat("Testing the goodness-of-fit of the model restricted by\n")
- j <- 0
- for (k in 1:x$pp)
- if (x$test[k])
- {
- j <- j+1
- cat(c(" (",j,") ",
- format(paste(x$requestedEffects$type[k], ": ",
- x$requestedEffects$effectName[k],
- sep=""),
- width=50), " = ",
- sprintf("%8.4f", x$theta[k]),"\n"),
- sep = "")
- }
- cat("_________________________________________________\n")
- cat(" ")
- cat(" \n")
- if (testn > 1)
- cat('Joint test:\n-----------\n')
- cat(c(' c = ',sprintf("%8.4f", x$testresOverall),
- ' d.f. = ',j,' p-value '), sep='')
- pvalue <- 1 - pchisq(x$testresOverall, j)
+ }
+ print.sienaFit(x)
+ if (sum(x$test) > 0) ## we have some score tests
+ {
+ testn <- sum(x$test)
+ if (x$maxlike)
+ {
+ cat("Score test <c>\n\n")
+ }
+ else
+ {
+ cat("Generalised score test <c>\n\n")
+ }
+ cat("Testing the goodness-of-fit of the model restricted by\n")
+ j <- 0
+ for (k in 1:x$pp)
+ {
+ if (x$test[k])
+ {
+ j <- j + 1
+ cat(c(" (", j, ") ",
+ format(paste(x$requestedEffects$type[k], ": ",
+ x$requestedEffects$effectName[k],
+ sep=""),
+ width=50), " = ",
+ sprintf("%8.4f", x$theta[k]),"\n"),
+ sep = "")
+ }
+ }
+ cat("_________________________________________________\n")
+ cat(" ")
+ cat(" \n")
+ if (testn > 1)
+ {
+ cat('Joint test:\n-----------\n')
+ }
+ cat(c(' c = ',sprintf("%8.4f", x$testresOverall),
+ ' d.f. = ',j,' p-value '), sep='')
+ pvalue <- 1 - pchisq(x$testresOverall, j)
if (pvalue < 0.0001)
+ {
cat('< 0.0001\n')
+ }
else
+ {
cat(c('= ', sprintf("%8.4f\n", pvalue)), sep = '')
+ }
if (testn==1)
+ {
cat(c('\n one-sided (normal variate): ',
- sprintf("%8.4f",x$testresulto[1])), sep = '')
+ sprintf("%8.4f", x$testresulto[1])), sep = '')
+ }
if (testn> 1)
{
cat('\n\n')
for (k in 1:j)
{
- cat(c('(',k,') tested separately:\n'),sep='')
+ cat(c('(', k, ') tested separately:\n'), sep='')
cat('-----------------------\n')
cat(' - two-sided:\n')
cat(c(' c = ', sprintf("%8.4f", x$testresult[k]),
' d.f. = 1 p-value '), sep = '')
pvalue<- 1-pchisq(x$testresult[k],1)
if (pvalue < 0.0001)
+ {
cat('< 0.0001\n')
+ }
else
+ {
cat(c('= ', sprintf("%8.4f", pvalue), '\n'), sep = '')
+ }
cat(c(' - one-sided (normal variate): ',
- sprintf("%8.4f", x$testresulto[k])), sep = '')
- if (k<j)
+ sprintf("%8.4f", x$testresulto[k])), sep = '')
+ if (k < j)
+ {
cat('\n\n')
+ }
}
}
cat(' \n_________________________________________________\n\n')
cat('One-step estimates: \n\n')
for (i in 1 : x$pp)
{
- onestepest<- x$oneStep[i]+x$theta[i]
- cat(c(format(paste(x$requestedEffects$type[i],': ',
- x$requestedEffects$effectName[i], sep = ''),
- width=50),
+ onestepest <- x$oneStep[i] + x$theta[i]
+ cat(c(format(paste(x$requestedEffects$type[i], ': ',
+ x$requestedEffects$effectName[i], sep = ''),
+ width=50),
sprintf("%8.4f", onestepest), '\n'), sep = "")
}
cat('\n')
@@ -225,7 +250,7 @@
{
cat("Covariance matrix of estimates (correlations below diagonal)\n\n")
covcor <- x$covtheta
- correl <- x$covtheta/sqrt(diag(x$covtheta))[row(x$covtheta)]/
+ correl <- x$covtheta / sqrt(diag(x$covtheta))[row(x$covtheta)] /
sqrt(diag(x$covtheta))[col(x$covtheta)]
covcor[lower.tri(covcor)] <- correl[lower.tri(correl)]
printMatrix(format(round(t(covcor),digits=3),width=12))
@@ -233,7 +258,8 @@
printMatrix(format(round(x$dfra,digits=3),width=12))
cat("\nCovariance matrix of X (correlations below diagonal):\n\n")
covcor <- x$msf
- correl <- x$msf/sqrt(diag(x$msf))[row(x$msf)]/sqrt(diag(x$msf))[col(x$msf)]
+ correl <- x$msf / sqrt(diag(x$msf))[row(x$msf)] /
+ sqrt(diag(x$msf))[col(x$msf)]
covcor[lower.tri(covcor)] <- correl[lower.tri(correl)]
printMatrix(format(round(t(covcor),digits=3),width=12))
}
@@ -270,10 +296,16 @@
{
cat(" Conditional simulation:")
if (x$condname != '')
- cat('conditioned on', x$condname,'\n')
+ {
+ cat('conditioned on', x$condname, '\n')
+ }
else
+ {
if (x$condvarno > 0)
+ {
cat('conditioned on First variable')
+ }
+ }
}
cat(" Model Type:", ModelTypeStrings[x$modelType], "\n")
invisible(x)
@@ -442,12 +474,12 @@
}
else ##html
{
- # use <- addtorow$command != 'Network Dynamics'
+ ## use <- addtorow$command != 'Network Dynamics'
addtorow$command <- paste("<TR> <TD colspan=9 align=left>",
addtorow$command,
"</TD> </TR> <TR> </TR> \n")
- # use[1] <- FALSE
- # addtorow$command[use] <- paste('\\\\ ', addtorow$command[use])
+ ## use[1] <- FALSE
+ ## addtorow$command[use] <- paste('\\\\ ', addtorow$command[use])
}
}
else
@@ -459,7 +491,8 @@
mydf[mydf[,'row'] >= 1, 'row'] <- paste(format(mydf[mydf$row >= 1,
'row']), '.', sep='')
tmp <- list(xtable::xtable(mydf, caption=caption, label=label, align=align,
- digits=digits, display=display), add.to.row=addtorow,
+ digits=digits, display=display),
+ add.to.row=addtorow,
include.colnames=FALSE, include.rownames=FALSE, ...)
class(tmp) <- c("xtable.sienaFit", "xtable")
tmp
Modified: pkg/RSiena/changeLog
===================================================================
--- pkg/RSiena/changeLog 2011-08-22 10:35:09 UTC (rev 170)
+++ pkg/RSiena/changeLog 2011-09-07 16:10:08 UTC (rev 171)
@@ -1,3 +1,21 @@
+2011-09-07 R-forge revision 171
+
+ * R/globals.r, R/siena08.r, man/siena08.Rd: fix bugs in siena08 which was
+ using out of date effects object which included unselected underlying
+ effects from interactions, and report would not print if it had
+ previously been displayed. New parameter to control maximum numnber of
+ iterations.
+ * R/printInitialDescription.r: fix bug in description of more than two
+ groups.
+ * R/initializeFRAN.r: (RSienaTest only) add some validation to
+ updateTheta.
+ * R/globals.r: (To Rsiena also now) allow format of printed matrices to
+ be controlled by an environment variable. Designed for use in testing as
+ there are rounding incompatibilities between platforms.
+ * man/simstats0c.Rd: (RSiena only) updated page.
+ * R/sienaprint.r, R/printDataReport.r, R/print07report.r, R/robmon.r,
+ R/siena07Gui.r: (RSiena only) as for revision 168 in RSienatest.
+
2011-08-22 R-forge revision 170
* doc/RSiena_manual.tex: changes mainly for non-directed models
Modified: pkg/RSiena/inst/doc/RSiena_Manual.pdf
===================================================================
--- pkg/RSiena/inst/doc/RSiena_Manual.pdf 2011-08-22 10:35:09 UTC (rev 170)
+++ pkg/RSiena/inst/doc/RSiena_Manual.pdf 2011-09-07 16:10:08 UTC (rev 171)
@@ -49,15 +49,19 @@
endstream
endobj
439 0 obj <<
-/Length 1161
+/Length 1168
/Filter /FlateDecode
>>
stream
-xÚµVKsÛ6¾ëWð͘ ‚ ÙžœÄIÓ©ÝÔROIK¨ùPù°«þúî "ÚòdÜ™ŽfD<v?ì.¾Ý‹¶‹>ÎØw¾o—³7 x I³<ãÑò.LQ&y¤£2Zn¢/äZ×s¡È Ëyœ0AîšvþÇògÐÌO59WTÁóZ· kjí%‹¸¤‰TcUP%²ÀhÂy ú ÀÃ9׿¹µûÒ Šsš¢‚ ¬ZÎsAšÊË^Ò·Ôk/jûçÆ´×ã)Í”œ*~žƒ‚ J Ö9•ÏY[½iüì—f?AÂüóÍvN‹4õ¶Œæ
-mÏ©JSø{m Žµ= ª¹óß_ÿ†m~˜Ç2IÉ{³×m_™ûSÁŒ,zÝÛ9'Ý<æ°Ç‰]w?ú›á+ãÊ”¯ñ®)K³5ÎK.2/ *™ò6]Û¡ ðB\xÁ8G•gD¸ZÎ8 ÀÕˆg)U 8žÊBEëjö×,q›þß-ŒÒaá͇ŠGï›Ùoð{Š=ŠÆ#r|ít+h¡„rÌ€ 92KRGçͪë[½îÏ â æ*8À9<§<‹OW7—þFóᄃ( 9û•¥ìÈî (/¨ ¹…†®ª©!®R‘Oõƒéz»=.e$s‘“Öï_U{ÛÚµK ˜ÞÇ’G”ðb÷~ã²Ö塳Ýs;Zˆ;¹× YwœöÓuSí‡Þ„c÷mû<¹ iñTö(ÛVcúäŠô;ÝûÑZ·5šg¤úqßøA‡O½+°€nW£Û¨rç×+È&pl 6HæÒ³E0ÀSTóà"Q#NÈî—ŒŸ¥ó„ËkŒd "ÙÞà "M‰^¯!ßl½õÓ¾ _<O¤’lµ®ìzî›6nÀëQz³ñ룦ôs°È‘²j\ø—2j·Ñ³µÛ³è‹;ê´ ëöRǶWbB3þ‹\¼Þ°Ò§@H«×ƒeÌyOî'P̹ K& \”ûê’>.ÿÇXdç]ˆ¥àD×›×ú‚– oìÿ3›³sfCS©"Ë
-g_Ç[ TÚ5
-׈%KÈùR•°zòÙ><©(9Íø±¢¸˜ ò¸ƒ´ Öï|ÙH Ë¥ÓÕ%¦dR°%~²rÉbüªCi6gLË¡äűŠ¾X’s8-¹Ò€ÕU —h*óÏj|Ú¶v5¸ÜÅŽv^ÜÏ!žz¬êƒÝ¾ìÀ`ZÌpáÐõ¦:c7D £)Üà$·ÏmWT&r4 _$RÂ…ây2™\ Î}í–d¥;g8 }÷H‚°`t[Z_ÏÃýç#€|áþ4É¿ ä${!È€œ\ø‚9äµÃh ¸¶uxd‰”AŸ-¦Á™Ü ࢯ@ÙÇÖö½©¿=$Ý ô –L]„ùjäH]k×'aõ§Áv ‰F²œ\#g3²Ó&<Pþ3À»Ì:ÐÀÑvkÚ JÄÓªõn×"/4š™$ð*3Û2äÅ´
-`L9£+ü »,${ )TxØNË5<´þÓö
+xÚµVKsÛ6¾ëWðΘ ‚$ØžœÄIÓ©ÝÔROIK¨ùPIÊ®úë» €ŠhË“qg:šñØý°»øv,ÚD,ú8cßù¾]ÌÞ|àE$$-TÁ£Å]$XN™äQž3*£Å:úB®u‹œìu')ä®íâ??ƒ¦:Õä<§9,1¯u;·¦Ñ^P²ˆKšÊ\ `’—4E`4å<ˆï‡-ÀÃ9׿¹µ»Ê JÍPA€‚V-b%H[{ÙKú–zíycÿ\›®÷z<£E.§ŠŸcPÐûÊ‚uNåsgVV¯[?û¥ÝÅ H˜¾ÙÎi™eÞö’Q•£íŠæYæo삱vÀÁÁCµwþûëß²õq"ÓŒ¼7;Ý
+µiPp8,È|Ѓ9éã„à 'vÕÿè·nö_ÏMµöïÚª2ã¼ÄÀg*/Kš¥¥·invƒ©ñŒ¥w§óŠÅ…ÇŒ>G€g´¸ZÌ8 ÀñˆÍ0ü–LE«zö×,u›þß-ŒÒaá͇šGïÛÙoð{Š=Š&#rríøä+i™‹Üѱ ®(䙤˜ê|»\öC§WÃYã@œ $<O ÎáŠrØ6ÿtuséïW§ DùÈà¯,cG®O at yIð!ÈÍm½¯àâÚB+sò©y0ý`7Ç¥R&Št~ÿªÞÙή\:ÁôÆ8Î<¢„»÷—®½íŸÛ)ÀÐRœØɽȺ㴟®Úz· L8v×µ‰Ï
+¡Í
+ Œ#vîQ6ÆdR9¶zð£•î:kT¤Ýã¾ñƒ é
+žzW`Ý®G·Qåί×[àØgÚ•ç8Š`€§¨æÁE¢Ú8!?@¸o —![+ç .„<l0’*D²»‡D–½ZAöÙfã§C¾xžÈ$Y ]ÛÕ(<´]Ò‚×
+¢ fí×GLåç`‘# e%T¼ð/eÔm¢gk· gÑwÔiq:ÖíeŽm¯Ä„$fü ¹x½aeOV¯+˜ó29w?ÎõD2Ià¢ÜWWôi,pù?Æ¢8ïB"'ºY¿Ö´äxcÿŸÙœ3ÚYžåd±µáìñëx‹ƒZ»âÚ²d)9_ªRVB‡>Û•'EÑ‚ +Š‹™ [H `ýÖ—z^6½Q]aJ¦¥ kPòà'K—,ÆO :Tf}Æ4
+@•Ç*úbIVpZr¥Û¬« .ÑTæ+ žÕú´íìrïrwÚyq C<õ&X5»}ÙÁ´˜á¡ÇúÜnˆ@A3¸ÁI(nŸÛžS™ÊÑt|ŸH ŠçÉtr}8÷µ[’¥îá0ôÝ#
+6‚Ñ]e}=÷¯F ùÂý .hª¾ ä´x!È€œ^ø‚9äµÃh ¸¶Mxr‰ŒAŸ-§Íer/€‹¾e ;; ¦ùö¬tƒÐX:uæË‘c u]Ÿ„ÕŸö¶I4’)rœ-ÈV›ð\ûÎ /!ë@G»é‚f(O«Ö»m‡¼ÐhfšÂÍlªÓ*€1化¬ôïaì²ì ¤ä!Ór
+hH×
endstream
endobj
429 0 obj <<
@@ -229,33 +233,25 @@
/Type /ObjStm
/N 100
/First 899
-/Length 2808
+/Length 2805
/Filter /FlateDecode
>>
stream
-xÚÅ[ÛŽÇ}çWô£
-$Í®ª®êîÀ0 kbÀ
-Ëœz vGÒÚkRØåÊßçÔ°)Y—]ŽìûaÑ3äðÌéšêªS]³9IH!§„0ÔP9d¢@$9ú¨jÃhsÆØ
-™~…ÏY‚hZeÎA`¸à8Rñ‡cMÁ€‘£ÿ·ªÀÊ¡)¾ ”r
-Ä|$’*«,¸µ²_k¬à+|MÕÙe°¬ãÏK –pß~ YD}&ŠOÌo…ë¸dçR×J«¬-HbüÊ|æDæg Ĺdó‰ùŒ 3+à’MƒÔâ_4ù$¸aüÀg›l•
-&ñ9g§«
-€Eü ×Õâ4‘ ä ¤~ Ay¼Ø‚ºIr)AÕü“ÔZ]åÒ‚VqŒ´`Óú1[cÌ)W &Ír0?Ð`末«TœB°Ñòµ†Ë¯2 oaV-…"Å(%·*‡bêJiêÄCinI> ܯ’»¾Æ£Åä²Á•ÖÀ”j¡4ãš
-CiÂcOÀPø^£ì94®~ ¡¹[i2¸†ùA Í ¯ðÍV³›…Öª”à ‰à N“ãI¨»lr?Vr§ÒŒûÁÌ”ÌáÝ‘háÈÜåÌà=„+qï#wpÅL° jY)¸Ö ˆ°/
-óç†É¹+ ³Vÿ÷à“+Љ™ý÷`1?Â=Øg©ì nð-<k Üã‹/ÂúIXÿ}÷ý.¬ †Ï®‡³ýÅnÉ>_~¹ú 7ºsqy~±}ñ—p±½Þo./q 6Ûópör8ûÙOö/‡ðjsöóæÅðù툥#–ð¯íùp¨íùjsÞÃðü9~ð˜›go‘" ±"…G¯7¿¼º þvq6û«›íÙf?œ‡ÝÍþ¯çË«a¸zóêÕ *¯ã½ê½ðõÅõ>잇Ç@ñ[^cêá›+°öO ½ Înüã; î î‡/7ÛÃu8ÛýòjsBû]6W—Àú/¬àèwà<8à<ß
-χ«a{6ŒW¯ÖßÿïÕÖßÂä«õƒÝv?l÷×
-õ»Õú»ázws…‹Ç 5~ôÏáübs÷:ü˜‚/`ŒÅ^3ÅÚž®€ô=bGG¸·Ýî€øã8ñÉ8#÷Q#üépžû¨}´q|ºÂœñß<û ö>ׯ~ñH}ø!¾^{µ;{2ìq»õ· û÷˜Øƒ·¿=Ìvä´Z?¹y¶ Ï¿¾Øþ¼Zßßùƒg•ž®ÿ±þjý ' ûÔí€þ(%EÏ%Ôj¬Q9Y¬XHL)V©¸î^xÿ œ]ì‡ød{ñ“»j:øÛ,dà"{ú8’¹ö'‘‹žÞÑåS¸èŒ\L£ç©7\j‰ÌÓÉ<º—Ê|ty#W ˆ¡F±Á6Þ NÇJ¬ùWtj‹ÅäÏ¢ÃT£! épåèyçèPÚÌȧÖèI·ÓøŒ‹±ßNç¡/ŽC€Zÿðïÿ@=Ä„Ì^”£‹—íÍååÓ[¯m‡káA šäk #VT »Ê‡XŠ(¤,ýÄEhÎÇrAw<êÊÖOü'åMýux}<†×vkxý~x½?¸¾ŸJZù •4ý©D{jPëcécO!z ìªø0ö”c=åXO9ÖSu<ëxÖñ¬ãYÇ+ ¯t¼ÒñJÇ+ ¯t¼ÒñJÇ+ ¯t¼ÚñjÇ« ¯v¼ÚñjÇ« ¯v¼ÚñjÇk ¯u¼ÖñÚÏ5ï;©ôS×
-'ǵ⮠©j5EsF6ô'bp[n _+o¤×ïY± g‘
-£§CB@ µ(I?Êj¿fd`//eL@†ŒœR¾Ó< )˜9†xHÕ«€!†µÓx«†yN‹ ¹(â&g¯²K–ÒZ>ÍeN»°F,EHG(“ÆQ¼ìiÅt+“wÈÌjšN§ä(¸R°Z¼¬ÃÓ¢[2̇|0Á.Iœcõ:²@MR™HG槣)fT¡‚ "Õ· vËTóäùùH…À é˜Ã¹Á‹¦zÎO‡-ú– L+áq Ö—M5-°Ð)Gõêþ£H—
-ž9•Ó }×%K9HÆ\!´•y‰'ÙFXéÈʈþQ‡¥¥¾uDªh"ŸùW:TH4ߣSÅÒRWQóTûÈü¾Ù…|éJ‘!á —¢Ö ¾“à¢9È/§ê»¹(&Mø4]€ ¸zá*9šotªD+všËë; ŠgÈ\á›oC¤¦Ó\Ê\P36:Œóâ›Öì%ì»Ô¸ !4”œQ7z×Õ5M0K›]}
-Ÿ aÃBA*Â
-Ëí˜ç§€¤m¨Æ÷áI;K»S Ëü,¸Æ‚GCŠ8Ç8—æùàN DˆL()‚—"êæ
-ZÅÓÀ)×È d 1ó pí[`…Ô3À„ˆ6 ðað@ÉŠ" ŠD¼^jé,P11*Xo1ìD#?ò$púQ-Á¥€ ‚œ÷ õ’Ài. $fÖ“‹p…B€y|ë°L0Ë« EdLe Zh—F¬²@Zfßh »ÉQߎå~³ fY -3jûæ?ìÁ6¾exšËi™QÛc!ú§11A*d>Íe´<&Ahn¶„•ìA¹¡•Ó\æÏËT ³Ý ýÍ“cµHå€×„¬â ÄÒ¸O¹€bí”EtðO
-YàÎZPÄBk“¡P³)ñ_gNGGÛ@!øÞ¯z«)› c„&Øf~ Ex<Þ e¢8vë¥F„ßO¤â„fo äZ„ïè:üúâc×JPÉßÒu_bHŸØ[ø
-ýÍ ô4ÿÞþA;ì«ëá›ñeŽÃxÜ'ïß'í£õ±ô±ö±ÿžR © : u<êxÔñ¨ãQÇ£ŽÇ ; w<îxÜñ¸ãqÇãŽ×;âÚ[7Ú[ïÚ[ïÚ[ïÚ[ïÚ[îÚ[îÚ[î* ¯7¥T:^îx¹ãõö“öÎÓÓy—gAäd<šãò,ÏT:½&æ¯- Ê*ô‡S€))!¯Ø JåÍ>)Þg þV‚{¤yë2O0ËòÌ<»xÅW¶°j ¡ ‰î4—2ù¾–¿Ý§ðx3d:9MeyfÙ3wµ3<fAü墧¹, ÏLÀ% Ìâ/AZF’ãÓTêìùߨD}"þ€pŽ‚]L'åÿº€ 1Tèê¯KJ7Ž
-ÙòŽuô. ^¢i&àa‡² ¡œbÖ ^ÓàR)ú{“ ¹HHÅŠÒ=· z„Òd¬Eó÷cêQFQ·kž¢açoöz¨xˆÚØû÷:î6Ù²~‰¾ |¶Ø¸]=¾™1–“9À–hh²Äj¾Ï•ÇŠ *` ›°ŒlU5˜dßõ“}»x‚mXÒX2+ª.,Ÿì¯é¦X“æ²D»e|‰GÏmþfv«±äÓTò(‹ A…Qùk䨌KÕI ³Ä6i†PH^à#½ 'í’ÚÌ[µ¿—.2¾Ð ÛdëÌßVÍÐ äÿŽ€uÍÞCŸd"<{üÍœµ:¤y7…3ßËü½¿Å·0$Å
-žS º“ÅÛ]ÞëñZ!x® ø/…åd–®K„]ñçÿè.
-zSªD:½k¼ˆ’KcrÎ(×
-Šs/O„'Øeþå#¹F¯×U‰ï©K™]êÌo% m#ÕE8*X¦1KæÓ;êu‘V$ƒÿo•*·Qˆ£Hµ .ó¦zü?.‹
+xÚÅ[ÛŽ ·}Ÿ¯à£
+$ V«H†]lXàDÐÃx·%µžvgåïsª‡#Y²v§ewÛ ²§»O ‹uaqs’BN%¡©¡rÈDHÐr õVÕ†Ö猶.2'¼…ßY‚hZeÎA`¸à8Rñ‡¾¦`ÀÈ‚Ößç*°²phŠû"RC'×@œÁGr ©²Ê‚O+û³È
+ná6Ug—Á²Ž¯—@-á»
+ü0²*ˆúH¿˜
+ÏqÉÎ¥®•VY[ÄxË|æ
+" ã3â\²ùÀ|D†‘pɦAjñ[ M>H+.ïøh“²A$>æìtµ° ¢ˆwð\-Þ‘ ‰¼“ƒ’zGƒòø°u‘äR‚ªù/5¨µºÊ¥â)hÁ¢õb´ÆS®Lšwr0ïh0sÎÕ‚U*N!Ø(ùZCäWÓ[Ø窥P¤x‡BQr©r(¦Þ‘PJS' Jsi4èKòáà{•\pS‹Áeƒ*)¤!ÕAiÆ3‚Ò„iOÀPè^£ì Wïhh®Vš ªaÞ)¡àºÙjv±µÐZµ•4!”ÃiRbÌ„ºÊ&×c%W*Íø ÄLÉ Þ9zæ*gÞƒöžDÚG®àŠ‘`Ô²Rp!¬a_æó†Á¹+ £V¿‹op‚ÈèÄÌÞÃ7XÌ{øû(•]Ã
+º…¹F¯à_|ÖOÂúï»ïwaý0|v=œí/vÛHöyøòËÕgøÐý›‹Ëó‹í‹¿„‹íõ~sy‰~ØlÏÃÙËáì•_ì_áõæìÕæÅðù툥#–ð¯íùp¨íùjsÞ»axþ /|ææÇwH‘ŽX‘£7›Ÿ__;‚8›ýÕÍöl³ ÎÃîfÿ×óáÅÕ0Ü
+½yýz •7ñÞõ^øúâz vÏÃc ø'¯1ôðÍXû¯Þ g7þó P÷P÷×›í‹á:œí~~½¹¡ý. ›«Ë `ýRpô;p p „ï†çÃÕ°=ƧWëïÿ÷zëo!òÕúÁn» ¶ûk˜€ƒúÝjýÝp½»¹Âãúçp~±¹¿{ž¦à X#c±×L±¶g+ }ÛÑîm·; >
+'~
+ç¡åÞÊ¡…> ®soµ·6¶ÏV€3þá› ‚üƒõ«ŸÝR ^Äíõ·W»³'à Ÿ[ûð±ßÇÀ ¼{÷0Ú‘ÓjýäæÇýxýõÅöÕj}ç3Ž*=[ÿcýÕú.@ö™Ë |*%E÷%Ôj¬î’ÅŠ…Ä”"l ž»>œ³‹ýŸl/~rUM}›… \dw G2" ×þ$2bÑýÂ[2Z£|
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rsiena -r 171
More information about the Rsiena-commits
mailing list