[Rsiena-commits] r301 - in pkg: RSiena RSiena/R RSiena/data RSiena/man RSiena/src RSiena/src/model/effects RSiena/src/model/effects/generic RSienaTest RSienaTest/R RSienaTest/data RSienaTest/doc RSienaTest/man RSienaTest/src RSienaTest/src/data RSienaTest/src/model/effects RSienaTest/src/model/effects/generic
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Oct 10 17:15:00 CEST 2016
Author: tomsnijders
Date: 2016-10-10 17:14:59 +0200 (Mon, 10 Oct 2016)
New Revision: 301
Added:
pkg/RSiena/src/model/effects/SameCovariateFourCyclesEffect.cpp
pkg/RSiena/src/model/effects/SameCovariateFourCyclesEffect.h
pkg/RSiena/src/model/effects/generic/CovariateDegreeFunction.cpp
pkg/RSiena/src/model/effects/generic/CovariateDegreeFunction.h
pkg/RSiena/src/model/effects/generic/DifferentCovariateInStarFunction.cpp
pkg/RSiena/src/model/effects/generic/DifferentCovariateInStarFunction.h
pkg/RSiena/src/model/effects/generic/DifferentCovariateOutStarFunction.cpp
pkg/RSiena/src/model/effects/generic/DifferentCovariateOutStarFunction.h
pkg/RSienaTest/src/model/effects/SameCovariateFourCyclesEffect.cpp
pkg/RSienaTest/src/model/effects/SameCovariateFourCyclesEffect.h
pkg/RSienaTest/src/model/effects/generic/CovariateDegreeFunction.cpp
pkg/RSienaTest/src/model/effects/generic/CovariateDegreeFunction.h
pkg/RSienaTest/src/model/effects/generic/DifferentCovariateInStarFunction.cpp
pkg/RSienaTest/src/model/effects/generic/DifferentCovariateInStarFunction.h
pkg/RSienaTest/src/model/effects/generic/DifferentCovariateOutStarFunction.cpp
pkg/RSienaTest/src/model/effects/generic/DifferentCovariateOutStarFunction.h
Modified:
pkg/RSiena/ChangeLog
pkg/RSiena/DESCRIPTION
pkg/RSiena/R/effects.r
pkg/RSiena/R/printInitialDescription.r
pkg/RSiena/R/sienaRI.r
pkg/RSiena/R/sienaeffects.r
pkg/RSiena/R/sienaprint.r
pkg/RSiena/data/allEffects.csv
pkg/RSiena/man/RSiena-package.Rd
pkg/RSiena/man/siena07.Rd
pkg/RSiena/man/sienaGOF-auxiliary.Rd
pkg/RSiena/man/sienaRI.Rd
pkg/RSiena/src/model/effects/AllEffects.h
pkg/RSiena/src/model/effects/CovariateEgoSquaredEffect.cpp
pkg/RSiena/src/model/effects/CovariateEgoSquaredEffect.h
pkg/RSiena/src/model/effects/EffectFactory.cpp
pkg/RSiena/src/model/effects/FourCyclesEffect.cpp
pkg/RSiena/src/model/effects/FourCyclesEffect.h
pkg/RSiena/src/siena07setup.cpp
pkg/RSiena/src/sources.list
pkg/RSienaTest/ChangeLog
pkg/RSienaTest/DESCRIPTION
pkg/RSienaTest/R/effects.r
pkg/RSienaTest/R/printInitialDescription.r
pkg/RSienaTest/R/sienaRI.r
pkg/RSienaTest/R/sienaeffects.r
pkg/RSienaTest/R/sienaprint.r
pkg/RSienaTest/data/allEffects.csv
pkg/RSienaTest/doc/RSiena.bib
pkg/RSienaTest/doc/RSiena_Manual.pdf
pkg/RSienaTest/doc/RSiena_Manual.tex
pkg/RSienaTest/man/RSiena-package.Rd
pkg/RSienaTest/man/siena07.Rd
pkg/RSienaTest/man/sienaGOF-auxiliary.Rd
pkg/RSienaTest/man/sienaRI.Rd
pkg/RSienaTest/src/data/NetworkLongitudinalData.h
pkg/RSienaTest/src/model/effects/AllEffects.h
pkg/RSienaTest/src/model/effects/CovariateEgoSquaredEffect.cpp
pkg/RSienaTest/src/model/effects/CovariateEgoSquaredEffect.h
pkg/RSienaTest/src/model/effects/EffectFactory.cpp
pkg/RSienaTest/src/model/effects/FourCyclesEffect.cpp
pkg/RSienaTest/src/model/effects/FourCyclesEffect.h
pkg/RSienaTest/src/siena07setup.cpp
pkg/RSienaTest/src/sources.list
Log:
New version 301: various new effects, changes to sienaRI, some smaller changes.
Modified: pkg/RSiena/ChangeLog
===================================================================
--- pkg/RSiena/ChangeLog 2016-09-12 18:06:53 UTC (rev 300)
+++ pkg/RSiena/ChangeLog 2016-10-10 15:14:59 UTC (rev 301)
@@ -1,3 +1,37 @@
+2016-10-09 R-Forge Revision 301
+Changes in RSiena and RSienaTest:
+ * Warning if includeEffects is used with parameter initialValue - corrected.
+ * New effect: sameXCycle4, homCovNetNet, contrastCovNetNet, covNetNetIn,
+ homCovNetNetIn, contrastCovNetNetIn,
+ inPopIntnX, inActIntnX, outPopIntnX, outActIntnX
+ * Changed type of lcounters and counters in FourCyclesEffect to long int,
+ permitting the 4-cycles effects for larger and denser networks.
+ * Dropped cl.XWX effect from two-mode - one-mode coevolution
+ (did not belong).
+ * egoSqX is an ego effect (CovariateEgoSquared.cpp and .h).
+ * Added cycle4 for one-mode networks.
+ * Added outAct, outInAss for symmetric networks.
+ * SienaRI: Structural zeros and ones are excluded from the calculations;
+ added option getChangeStatistics;
+ row names given to matrices that have rows corresponding to effects;
+ adapted so that it runs for models with only 1 parameter;
+ adapted so that for a bipartite dependent variable it does not crash.
+ * Warning if includeEffects is used with parameter 'parameter'.
+ * Small additions to print.sienaAlgorithm.
+ * Clearer output for MaxDegree in print.sienaFit.
+ * Indication '^(1/2)' for outInAss for 2-mode networks changed to '^(1/#)',
+ where # is the effect parameter (allEffects.csv).
+Changes RSienaTest:
+ * simulatedOffset changed from int to double (NetworkLongitudinalData)
+
+2016-09-12 R-Forge Revision 300
+Changes RSienaTest:
+ * doc/RSienaDeveloper.tex: Build system documentation.
+
+2016-08-30 R-Forge Revision 299
+Changes RSienaTest:
+ * network/Simmelian: Cleaned dependencies.
+
2016-08-28 R-Forge Revision 297
Changes in RSiena:
* buildsystem: added Makefile and src/sources.list
@@ -4,12 +38,13 @@
2016-08-17 R-Forge Revision 296
Changes in RSiena and RSienaTest:
- * Warning if includeEffects is used with parameter initialValue.
+ * Warning if includeEffects is used with parameter initialValue - did not work.
* Warning if includeInteraction is used for more interactions
than available given parameters nintn and behNintn.
* Deleted session parameter from print01Report.
* Corrected cycle4 effect for parameter=2 (sqrt version).
* Additional auxiliary function CliqueCensus in help page sienaGOF-auxiliary.
+ * Error corrected in DyadicCovariateAvAltEffect.cpp.
2016-07-23 R-Forge Revision 295
Changes in RSienaTest (Felix Schoenenberger):
Modified: pkg/RSiena/DESCRIPTION
===================================================================
--- pkg/RSiena/DESCRIPTION 2016-09-12 18:06:53 UTC (rev 300)
+++ pkg/RSiena/DESCRIPTION 2016-10-10 15:14:59 UTC (rev 301)
@@ -1,8 +1,8 @@
Package: RSiena
Type: Package
Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.1-297
-Date: 2016-08-17
+Version: 1.1-301
+Date: 2016-10-09
Author: Ruth Ripley, Krists Boitmanis, Tom A.B. Snijders, Felix Schoenenberger
Depends: R (>= 2.15.0), utils
Imports: Matrix, tcltk, lattice, parallel, MASS, methods
Modified: pkg/RSiena/R/effects.r
===================================================================
--- pkg/RSiena/R/effects.r 2016-09-12 18:06:53 UTC (rev 300)
+++ pkg/RSiena/R/effects.r 2016-10-10 15:14:59 UTC (rev 301)
@@ -965,7 +965,8 @@
covObjEffects <-
covObjEffects[covObjEffects$shortName %in%
c("egoX", "egoSqX", "altInDist2", "totInDist2",
- "simEgoInDist2", "sameXInPop", "diffXInPop"), ]
+ "simEgoInDist2", "sameXInPop", "diffXInPop",
+ "sameXCycle4"), ]
covRateEffects <- createEffects("covarBipartiteRate", covarname,
name=varname,
groupName=groupName, group=group,
Modified: pkg/RSiena/R/printInitialDescription.r
===================================================================
--- pkg/RSiena/R/printInitialDescription.r 2016-09-12 18:06:53 UTC (rev 300)
+++ pkg/RSiena/R/printInitialDescription.r 2016-10-10 15:14:59 UTC (rev 301)
@@ -210,7 +210,7 @@
(matchange[3, per] + matchange[4, per]) )
{
Report(c("\nThis means that in period ", per,
- ", proportionately less 1-ties stayed 1,\n",
+ ", proportionately fewer 1-ties stayed 1,\n",
" than 0-ties became 1. A great reversal",
" of the network pattern!\n",
"For some model specifications this may",
Modified: pkg/RSiena/R/sienaRI.r
===================================================================
--- pkg/RSiena/R/sienaRI.r 2016-09-12 18:06:53 UTC (rev 300)
+++ pkg/RSiena/R/sienaRI.r 2016-10-10 15:14:59 UTC (rev 301)
@@ -10,7 +10,8 @@
# *****************************************************************************/
##@sienaRI
-sienaRI <- function(data, ans=NULL, theta=NULL, algorithm=NULL, effects=NULL)
+sienaRI <- function(data, ans=NULL, theta=NULL, algorithm=NULL, effects=NULL,
+ getChangeStats=FALSE)
{
if (!inherits(data, "siena"))
{
@@ -31,13 +32,17 @@
if (sum(ans$effects$include==TRUE &
(ans$effects$type =="endow"|ans$effects$type =="creation")) > 0)
{
- stop("sienaRI does not yet work for models that contain endowment or creation effects")
+stop("sienaRI does not yet work for models containing endowment or creation effects")
}
contributions <- getChangeContributions(algorithm = ans$x, data = data,
effects = ans$effects)
+# contributions[[1]] is periods by effects by actors by actors
RI <- expectedRelativeImportance(conts = contributions,
- effects = ans$effects, theta =ans$theta)
- }else{
+ effects = ans$effects, theta =ans$theta, thedata=data,
+ getChangeStatistics=getChangeStats)
+ }
+ else
+ {
if (!inherits(algorithm, "sienaAlgorithm"))
{
stop(paste("algorithm is not a legitimate Siena algorithm specification", sep=""))
@@ -50,7 +55,7 @@
if(sum(effects$include==TRUE &
(effects$type =="endow"|effects$type =="creation")) > 0)
{
- stop("sienaRI does not yet work for models containinf endowment or creation effects")
+ stop("sienaRI does not yet work for models containing endowment or creation effects")
}
effs <- effects
if (!is.numeric(theta))
@@ -67,19 +72,19 @@
"theta is treated as if containing rate parameters"))
paras <- theta
## all necessary information available
- ## call getChangeContributions
contributions <- getChangeContributions(algorithm = algo,
data = data, effects = effs)
RI <- expectedRelativeImportance(conts = contributions,
- effects = effs, theta = paras)
+ effects = effs, theta = paras, thedata=data,
+ getChangeStatistics=getChangeStats)
}else{
paras <- theta
## all necessary information available
- ## call getChangeContributions
contributions <- getChangeContributions(algorithm = algo,
data = data, effects = effs)
RI <- expectedRelativeImportance(conts = contributions,
- effects = effs, theta = paras)
+ effects = effs, theta = paras, thedata=data,
+ getChangeStatistics=getChangeStats)
}
}
RI
@@ -88,6 +93,7 @@
##@getChangeContributions. Use as RSiena:::getChangeContributions
getChangeContributions <- function(algorithm, data, effects)
{
+ ## Gets the simulated statistics.
## The following initializations data, effects, and model
## for calling "getTargets" in "siena07.setup.h"
## is more or less copied from "getTargets" in "getTargets.r".
@@ -111,6 +117,8 @@
ans <- reg.finalizer(pData, clearData, onexit = FALSE)
ans<- .Call('OneMode', PACKAGE=pkgname,
pData, list(f$nets))
+ ans <- .Call("Bipartite", PACKAGE=pkgname, # added 1.1-299
+ pData, list(f$bipartites))
ans<- .Call('Behavior', PACKAGE=pkgname, pData,
list(f$behavs))
ans<-.Call('ConstantCovariates', PACKAGE=pkgname,
@@ -144,11 +152,12 @@
ans <- .Call("getTargets", PACKAGE=pkgname, pData, pModel, myeffects,
parallelrun=TRUE, returnActorStatistics=FALSE,
returnStaticChangeContributions=TRUE)
+# See getTargets in siena07setup.cpp; also see rTargets in StatisticsSimulation.cpp
ans
}
-expectedRelativeImportance <- function(conts, effects, theta,
- effectNames = NULL)
+expectedRelativeImportance <- function(conts, effects, theta, thedata=NULL,
+ getChangeStatistics=FALSE, effectNames = NULL)
{
waves <- length(conts[[1]])
effects <- effects[effects$include == TRUE,]
@@ -184,37 +193,82 @@
depNumber <- depNumber + 1
currentDepEffs <- effects$name == currentDepName
effNumber <- sum(currentDepEffs)
+ depNetwork <- thedata$depvars[[depNumber]]
+ # impute for wave 1
+ if (networkTypes[eff] == "oneMode")
+ {
+ depNetwork[,,1][is.na(depNetwork[,,1])] <- 0
+ }
+ else
+ {
+ depNetwork[,,1][is.na(depNetwork[,,1])] <- attr(depNetwork, 'modes')[1]
+ }
+ # impute for next waves;
+ # this may be undesirable for structurals immediately followed by NA...
+ for (m in 2:dim(depNetwork)[3]){depNetwork[,,m][is.na(depNetwork[,,m])] <-
+ depNetwork[,,m-1][is.na(depNetwork[,,m])]}
+ # Make sure the diagonals are not treated as structurals
+ if (networkTypes[eff] == "oneMode")
+ {
+ for (m in 1:dim(depNetwork)[3]){diag(depNetwork[,,m]) <- 0}
+ }
+ structurals <- (depNetwork >= 10)
+ if (networkTypes[eff] == "oneMode"){
+ if (attr(depNetwork, 'symmetric')){
+ cat('\nNote that for symmetric networks, effect sizes are for modelType 2 (forcing).\n')}}
-# RIs <- data.frame(row.names = effectIds[currentDepEffs])
-# RIs <- cbind(RIs, matrix(0, nrow=effNumber, ncol = actors))
- entropies <- vector(mode="numeric", length = actors)
-
# currentDepObjEffsNames <- paste(effects$shortName[currentDepEffs],
# effects$type[currentDepEffs],effects$interaction1[currentDepEffs],sep=".")
# otherObjEffsNames <- paste(effects$shortName[!currentDepEffs],
# effects$type[!currentDepEffs],effects$interaction1[!currentDepEffs],sep=".")
+ entropies <- vector(mode="numeric", length = actors)
expectedRI <- list()
expectedI <- list()
RIActors <- list()
IActors <- list()
absoluteSumActors <- list()
- entropyActors <-list()
+ RHActors <-list()
+ changeStats <-list()
+ sigma <- list()
for(w in 1:waves)
{
currentDepEffectContributions <- conts[[1]][[w]][currentDepEffs]
+# conts[[1]] is periods by effects by actors by actors
currentDepEffectContributions <-
sapply(lapply(currentDepEffectContributions, unlist),
matrix, nrow=actors, ncol=choices, byrow=TRUE,
simplify="array")
+ cdec <- apply(currentDepEffectContributions, c(2,1), as.matrix)
+# cdec is effects by actors (alters) by actors (egos)
+ if (dim(currentDepEffectContributions)[3] <= 1) # only one effect
+ {
+ cdec <- array(cdec, dim=c(1,dim(cdec)))
+ }
+ rownames(cdec) <- effectNa[currentDepEffs]
+ if (getChangeStatistics)
+ {
+ changeStats[[w]] <- cdec
+ }
+ # replace structural 0s and 1s by NA,
+ # so they are omitted from calculation of RI, R_H, sigma
+ if (networkTypes[eff] == "oneMode")
+ {
+ # structuralsw <- structurals[,,w]
+ for (ff in 1:dim(cdec)[1]){cdec[ff,,][t(structurals[,,w])] <- NA}
+ }
+ distributions <- apply(cdec, 3,
+ calculateDistributions, theta[which(currentDepEffs)])
distributions <-
- apply(apply(currentDepEffectContributions, c(2,1), as.matrix),
- 3, calculateDistributions, theta[which(currentDepEffs)])
- distributions <-
lapply(apply(distributions, 2, list),
function(x){matrix(x[[1]], nrow=effNumber+1,
ncol=choices, byrow=F)})
+# distributions is a list, length = number of actors
+# distributions[[i]] is for actor i, a matrix of dim (effects + 1) * (actors as alters)
+# giving the probability of toggling the tie variable to the alters;
+# the first row is for the unchanged parameter vector theta,
+# each of the following has put one element of theta to 0.
entropy_vector <- unlist(lapply(distributions,
function(x){entropy(x[1,])}))
@@ -225,16 +279,18 @@
x[2:dim(x)[1],])})
RIs_matrix <-(matrix(unlist(RIs_list),nrow=effNumber,
ncol=actors, byrow=F))
-
-# RIs <- RIs_matrix
entropies <- entropy_vector
# divide by column sums:
- RIActors[[w]] <- apply(RIs_matrix, 2, function(x){x/sum(x)})
- absoluteSumActors[[w]] <- colSums(RIs_matrix)
- entropyActors[[w]] <- entropies
- expectedRI[[w]] <- rowSums(RIActors[[w]] )/dim(RIActors[[w]])[2]
+ RIActors[[w]] <- t(t(RIs_matrix)/rowSums(t(RIs_matrix), na.rm=TRUE))
+ rownames(RIActors[[w]]) <- effectNa[currentDepEffs]
+ absoluteSumActors[[w]] <- colSums(RIs_matrix, na.rm=TRUE)
+ RHActors[[w]] <- entropies
+ expectedRI[[w]] <- rowMeans(RIActors[[w]], na.rm=TRUE)
IActors[[w]] <- RIs_matrix
- expectedI[[w]] <- rowMeans(RIs_matrix)
+ rownames(IActors[[w]]) <- effectNa[currentDepEffs]
+ expectedI[[w]] <- rowMeans(RIs_matrix, na.rm=TRUE)
+ sigma[[w]] <- apply(cdec, c(1,3), sd, na.rm=TRUE)
+ rownames(sigma[[w]]) <- effectNa[currentDepEffs]
}
RItmp <- NULL
RItmp$dependentVariable <- currentDepName
@@ -243,7 +299,8 @@
RItmp$expectedI <- expectedI
RItmp$IActors <- IActors
RItmp$absoluteSumActors <- absoluteSumActors
- RItmp$entropyActors <- entropyActors
+ RItmp$RHActors <- RHActors
+ RItmp$sigma <- sigma
if(!is.null(effectNames))
{
RItmp$effectNames <- effectNames[currentDepEffs]
@@ -252,6 +309,9 @@
paste(effectTypes[currentDepEffs], " ",
effects$effectName[currentDepEffs], sep="")
}
+ if (getChangeStatistics){
+ RItmp$changeStatistics <- changeStats
+ }
class(RItmp) <- "sienaRI"
if(depNumber == 1){
RI <- RItmp
@@ -276,42 +336,60 @@
calculateDistributions <- function(effectContributions = NULL, theta = NULL)
{
- effects <- dim(effectContributions)[1]
- choices <- dim(effectContributions)[2]
- effectContributions[effectContributions=="NaN"]<-0
- distributions <- array(dim = c(effects+1,choices))
- distributions[1,] <-
- exp(colSums(theta*effectContributions))/
- sum(exp(colSums(theta*effectContributions)))
- for(eff in 1:effects)
+ neffects <- dim(effectContributions)[1]
+ nchoices <- dim(effectContributions)[2]
+ distributions <- array(NA, dim = c(neffects+1,nchoices))
+ the.choices <- !is.na(colSums(effectContributions))
+ if (sum(the.choices) >= 2)
{
- t <- theta
- t[eff] <- 0
- distributions[eff+1,] <-
- exp(colSums(t*effectContributions))/
- sum(exp(colSums(t*effectContributions)))
+ distributions[1,the.choices] <-
+ exp(colSums(theta*effectContributions[,the.choices,drop=FALSE], na.rm=TRUE))/
+ sum(exp(colSums(theta*effectContributions[,the.choices,drop=FALSE], na.rm=TRUE)))
+ for(eff in 1:neffects)
+ {
+ th <- theta
+ th[eff] <- 0
+ distributions[eff+1,the.choices] <-
+ exp(colSums(th*effectContributions[,the.choices,drop=FALSE], na.rm=TRUE))/
+ sum(exp(colSums(th*effectContributions[,the.choices,drop=FALSE], na.rm=TRUE)))
+ }
}
distributions
}
entropy <- function(distribution = NULL)
{
- entropy <- -1*(distribution %*% log(distribution)/log(length(distribution)))
+ if (sum(!is.na((distribution))) <= 1) # only constant choice
+ {
+ certainty <- NA
+ }
+ else
+ {
+ entropy <- -1*(sum(distribution * log(distribution), na.rm=TRUE)/
+ log(sum(!is.na((distribution)))))
certainty <- 1-entropy
+ }
certainty
}
KLD <- function(referenz = NULL, distributions = NULL)
{
+ if (sum(!is.na((referenz))) <= 1) # only constant choice
+ {
+ kld <- rep(NA, dim(distributions)[1])
+ }
+ else
+ {
if(is.vector(distributions))
{
- kld <- (referenz %*%
- (log(referenz)-log(distributions)))/log(length(referenz))
+ kld <- sum(referenz * (log(referenz)-log(distributions)),
+ na.rm=TRUE)/log(sum(!is.na((referenz))))
}
else
{
- kld <- colSums(referenz *
- (log(referenz)-t(log(distributions))))/log(length(referenz))
+ kld <- colSums(referenz * (log(referenz)-t(log(distributions))),
+ na.rm=TRUE)/log(sum(!is.na((referenz))))
+ }
}
kld
}
@@ -321,24 +399,31 @@
## and each row of distributions (which is a matrix with n columns)
L1D <- function(referenz = NULL, distributions = NULL)
{
+ if (sum(!is.na((referenz))) <= 1) # only constant choice
+ {
+ l1d <- rep(NA, dim(distributions)[1])
+ }
+ else
+ {
if(is.vector(distributions))
{
- l1d <- sum(abs(referenz-distributions))
+ l1d <- sum(abs(referenz-distributions), na.rm=TRUE)
}
else
{
- l1d <- colSums(abs(referenz-t(distributions)))
+ l1d <- colSums(abs(referenz-t(distributions)), na.rm=TRUE)
+ }
}
l1d
}
##@print.sienaRI Methods
-print.sienaRI <- function(x, ...){
+print.sienaRI <- function(x, printSigma = FALSE, ...){
if (!inherits(x, "sienaRI"))
{
if (inherits(x[[1]], "sienaRI"))
{
- cat("The components of this object ")
+ cat("This object is a list, the components of which\n")
cat("are Siena relative importance of effects objects.\n")
cat("Apply the print function to the separate components.\n")
}
@@ -353,7 +438,13 @@
line2 <- paste(format(1:effs,width=3), '. ',
format(x$effectNames, width = 56),sep="")
line3 <- line2
- line4 <- format(" Entropy", width = 61)
+ line4 <- format(" R_H ('degree of certainty')", width = 61)
+ line5 <- line2
+ if (printSigma)
+ {
+ sigmas <- matrix(sapply(x$sigma,rowMeans,na.rm=TRUE), effs, waves)
+ # construction with matrix because of the possibility effs=1
+ }
for(w in 1:length(colNames))
{
line1 <- paste(line1, format(colNames[w], width=8)," ", sep = "")
@@ -361,8 +452,14 @@
width=8, nsmall=4)," ",sep="")
line3 <- paste(line3, format(round(x$expectedI[[w]], 4),
width=8, nsmall=4)," ",sep="")
- line4 <- paste(line4, format(round(mean(x$entropyActors[[w]]), 4),
+ line4 <- paste(line4,
+ format(round(mean(x$RHActors[[w]], na.rm=TRUE), 4),
width=8, nsmall=4)," ",sep="")
+ if (printSigma)
+ {
+ line5 <- paste(line5,
+ format(round(sigmas[,w], 4), width=8, nsmall=4)," ",sep="")
+ }
}
line2 <- paste(line2, rep('\n',effs), sep="")
line3 <- paste(line3, rep('\n',effs), sep="")
@@ -371,6 +468,12 @@
cat("\n Expected importance of effects for this dependent variable:\n\n")
cat(as.matrix(line3),'\n\n', sep='')
cat(as.matrix(line4),'\n', sep='')
+ if (printSigma)
+ {
+ cat("\n sigma (within-ego standard deviation of change statistics):\n\n")
+ line5 <- paste(line5, rep('\n',effs), sep="")
+ cat('\n',as.matrix(line5),'\n', sep='')
+ }
invisible(x)
}
Modified: pkg/RSiena/R/sienaeffects.r
===================================================================
--- pkg/RSiena/R/sienaeffects.r 2016-09-12 18:06:53 UTC (rev 300)
+++ pkg/RSiena/R/sienaeffects.r 2016-10-10 15:14:59 UTC (rev 301)
@@ -67,9 +67,12 @@
}
if (hasArg('initialValue'))
{
- cat
-("Warning: argument 'initialValue' has no effect in includeEffects; use setEffect.\n")
+ cat("Warning: argument 'initialValue' has no effect in includeEffects; use setEffect.\n")
}
+ if (hasArg('parameter'))
+ {
+ cat("Warning: argument 'parameter' has no effect in includeEffects; use setEffect.\n")
+ }
myeff
}
##@includeInteraction DataCreate
Modified: pkg/RSiena/R/sienaprint.r
===================================================================
--- pkg/RSiena/R/sienaprint.r 2016-09-12 18:06:53 UTC (rev 300)
+++ pkg/RSiena/R/sienaprint.r 2016-10-10 15:14:59 UTC (rev 301)
@@ -341,8 +341,10 @@
if (any(x$x$MaxDegree > 0)) {
- cat(' Restrictions on degree in simulations: maximum degrees (0 = no restriction)')
- cat('\n',x$x$MaxDegree,'\n\n')
+ cat('\nDegrees constrained to maximum values:\n')
+ for (i in 1:length(x$x$MaxDegree)){
+ cat(names(x$x$MaxDegree)[i],':',x$x$MaxDegree[i],'\n')}
+ cat('\n')
}
if (any(x$x$UniversalOffset > 0)) {
cat(' Offsets for universal and meeting settings (if any): \n')
@@ -539,6 +541,7 @@
cat(' Project name:', x$projname, '\n')
cat(' Use standard initial values:', x$useStdInits, '\n')
cat(' Random seed:', objectOrNull(x$randomSeed),'\n')
+ cat(' Number of subphases in phase 2:', x$nsub, '\n')
if (x$simOnly)
{
cat(' Simulation only', '\n')
@@ -548,6 +551,7 @@
cat(' Starting value of gain parameter:', x$firstg, '\n')
cat(' Reduction factor for gain parameter:', objectOrNull(x$reduceg), '\n')
cat(' Diagonalization parameter:', x$diagonalize, '\n')
+ cat(' Double averaging after subphase:', x$doubleAveraging, '\n')
}
cat(' Dolby noise reduction:', x$dolby, '\n')
if (any(x$MaxDegree > 0))
Modified: pkg/RSiena/data/allEffects.csv
===================================================================
--- pkg/RSiena/data/allEffects.csv 2016-09-12 18:06:53 UTC (rev 300)
+++ pkg/RSiena/data/allEffects.csv 2016-10-10 15:14:59 UTC (rev 301)
@@ -176,6 +176,7 @@
covarBipartiteObjective,xxxxxx ego-in-alter dist 2 similarity,xxxxxx ego-in-alter dist 2 similarity,simEgoInDist2,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,dyadic,FALSE
covarBipartiteObjective,ind. pop. from same xxxxxx,indegree pop. from same values on xxxxxx,sameXInPop,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
covarBipartiteObjective,ind. pop. from dif. xxxxxx,indegree pop. from dif. values on xxxxxx,diffXInPop,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
+covarBipartiteObjective,4-cycles (#) same xxxxxx,sum 4-cycles^1/# same xxxxxx,sameXCycle4,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,FALSE
covarBipartiteObjective,outd. act. to hom. xxxxxx,sum sqr. outd. to hom. values on xxxxxx,homXOutAct,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
covarBipartiteObjective,outd. act. weight alt. xxxxxx,sum sqr. outd. weight alt. xxxxxx,altXOutAct,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
covarNonSymmetricObjective,xxxxxx alter,Sum indegrees x xxxxxx,altX,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
@@ -230,7 +231,7 @@
bipartiteObjective,anti in-near-isolates,Number of indegrees at least 2,antiInIso2,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,ego,FALSE
bipartiteObjective,indegree at least 2,Number of indegrees at least 2,in2Plus,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,ego,FALSE
bipartiteObjective,indegree at least 3,Number of indegrees at least 3,in3Plus,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,ego,FALSE
-bipartiteObjective,out-in degree^(1/2) assortativity,Sum of out-in degree^(1/2) products,outInAss,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,,FALSE
+bipartiteObjective,out-in degree^(1/#) assortativity,Sum of out-in degree^(1/#) products,outInAss,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,,FALSE
nonSymmetricObjective,outdegree (density),Number of ties,density,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,TRUE
nonSymmetricObjective,reciprocity,Number of reciprocated ties,recip,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,TRUE
nonSymmetricObjective,transitive triplets,Number of transitive triplets,transTrip,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,TRUE
@@ -279,6 +280,7 @@
nonSymmetricObjective,out-in degree^(1/#) assortativity,Sum of out-in degree^(1/#) products,outInAss,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,,FALSE
nonSymmetricObjective,in-out degree^(1/#) assortativity,Sum of in-out degree^(1/#) products,inOutAss,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,dyadic,FALSE
nonSymmetricObjective,in-in degree^(1/#) assortativity,Sum of in-in degree^(1/#) products,inInAss,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,,FALSE
+nonSymmetricObjective,4-cycles (#),(Number 4-cycles)^1/#),cycle4,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,FALSE
nonSymmetricObjective,in-struct equivalence,In-struct equivalence,inStructEq,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
nonSymmetricObjective,in-Jaccard similarity,In-Jaccard similarity,Jin,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
nonSymmetricObjective,out-Jaccard similarity,Out-Jaccard similarity,Jout,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
@@ -290,10 +292,12 @@
symmetricObjective,number of actor pairs at dist 2,Number of dists equal to 2,nbrDist2,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
symmetricObjective,number pairs at doubly achieved dist 2,Number of doubly achieved dists 2,nbrDist2twice,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
symmetricObjective,GWESP (#),Numb. edgew. shrd prtns.(#),gwesp,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,69,objective,NA,NA,0,0,0,0,dyadic,FALSE
-symmetricObjective,4-cycles,(Number 4-cycles)^1/#),cycle4ND,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,FALSE
+symmetricObjective,4-cycles (#),(Number 4-cycles)^1/#),cycle4ND,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,FALSE
symmetricObjective,degree of alter,Sum of squared degrees,inPop,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
symmetricObjective,sqrt degree of alter,Sum of degrees x sqrt(degree),inPopSqrt,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
+symmetricObjective,degree of ego,Sum of squared degrees,outAct,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
symmetricObjective,degree^(1.5),Sum of degrees^(1.5),outActSqrt,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
+symmetricObjective,out-in degree^(1/#) assortativity,Sum of out-in degree^(1/#) products,outInAss,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,,FALSE
symmetricObjective,outdegree-trunc(#),Sum of outdegrees trunc(#),outTrunc,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,FALSE
symmetricObjective,outdegree-trunc(#),Sum of outdegrees trunc(#),outTrunc2,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,5,objective,NA,NA,0,0,0,0,,FALSE
symmetricObjective,1/(degree + #),Sum 1/(degrees + #),outInv,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,FALSE
@@ -356,13 +360,11 @@
bipartiteNonSymmetricObjective,indegree^(1/#) xxxxxx activity,sum outd. x ind.^(1/#) xxxxxx,inActIntn,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,ego,FALSE
bipartiteNonSymmetricObjective,outdegree^(1/#) xxxxxx activity,sum outd. x degree^(1/#) xxxxxx,outActIntn,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,dyadic,FALSE
bipartiteNonSymmetricObjective,xxxxxx to agreement,"mixed triplets XWW, W = xxxxxx",to,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
-bipartiteNonSymmetricObjective,XWX closure of xxxxxx,"mixed triplets X->W=>X, W = xxxxxx",cl.XWX,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
bipartiteNonSymmetricObjective,mixed incoming from xxxxxx,"mixed WXX triplets, W = xxxxxx",mixedInWX,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
bipartiteNonSymmetricObjective,shared xxxxxx (#) to agreement,"mixed 4cycles WWXX, W = xxxxxx",sharedTo,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,FALSE
bipartiteSymmetricObjective,indegree^(1/#) xxxxxx activity,sum outd. x ind.^(1/#) xxxxxx,inActIntn,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,ego,FALSE
bipartiteSymmetricObjective,degree^(1/#) xxxxxx activity,sum outd. x degre.^(1/#) xxxxxx,outActIntn,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,dyadic,FALSE
bipartiteSymmetricObjective,xxxxxx to agreement,"mixed triplets XWW, W = xxxxxx",to,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
-bipartiteSymmetricObjective,XWX closure of xxxxxx,"mixed triplets X->W=>X, W = xxxxxx",cl.XWX,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
bipartiteSymmetricObjective,shared xxxxxx (#) to agreement,"mixed 4cycles WWXX, W = xxxxxx",sharedTo,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,FALSE
bipartiteSymmetricObjective,mixed incoming from xxxxxx,"mixed WXX triplets, W = xxxxxx",mixedInWX,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,FALSE
nonSymmetricBipartiteObjective,deg.^(1/#) xxxxxx popularity,sum deg. x degree^(1/#) xxxxxx,outPopIntn,TRUE,xxxxxx,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,dyadic,FALSE
@@ -382,11 +384,22 @@
covarNetNetObjective,shared inc. xxxxxx jump. yyyyyy,"inc. m.tr. WWX, W = xxxxxx, jump yyyyyy",jumpSharedIn,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
covarNetNetObjective,mixed xxxxxx closure jumping yyyyyy,"m.tr. W->X=>X, W = xxxxxx, jump yyyyyy",jumpWXClosure,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
covarNetNetObjective,mixed xxxxxx closure homog. yyyyyy,"m.tr. W->X=>X, W = xxxxxx, homog. yyyyyy",homWXClosure,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
+covarNetNetObjective,from xxxxxx agr. x hom. yyyyyy,"m.tr. WWX, W = xxxxxx, hom. yyyyyy",homCovNetNet,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
+covarNetNetObjective,from xxxxxx agr. contrasting yyyyyy,"m.tr. XWW, W = xxxxxx, contrast yyyyyy",contrastCovNetNet,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
+covarNetNetObjective,from xxxxxx agr. all diff. yyyyyy,"m.tr. XWW, W = xxxxxx, all diff. yyyyyy",allDifCovNetNet,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
+covarNetNetObjective,shared incoming xxxxxx x hom. yyyyyy,"m.tr. WWX, W = xxxxxx, hom. yyyyyy",homCovNetNetIn,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
+covarNetNetObjective,shared incoming xxxxxx contrasting yyyyyy,"m.tr. WWX, W = xxxxxx, contrast yyyyyy",contrastCovNetNetIn,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
+covarNetNetObjective,shared incoming xxxxxx all diff. yyyyyy,"m.tr. WWX, W = xxxxxx, all diff. yyyyyy",allDifCovNetNetIn,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
covarNetNetObjective,xxxxxx ego-alter dist 2 yyyyyy sim.ty,xxxxxx ego-alter dist 2 yyyyyy sim.ty,simEgoDist2W,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,dyadic,FALSE
covarNetNetObjective,yyyyyy in-alter at dist 2 on xxxxxx (#),yyyyyy in-alter at dist 2 on xxxxxx,altInDist2W,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
covarNetNetObjective,yyyyyy tot in-alt. at dist 2 on xxxxxx (#),yyyyyy tot in-alter at dist 2 on xxxxxx (#),totInDist2W,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
+covarNetNetObjective,(ind. xxxxxx wghted yyyyyy)^(1/#) activity,"sum outd. x (ind. xxxxxx wghted yyyyyy)^(1/#)",inActIntnX,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,dyadic,FALSE
covarABNetNetObjective,from xxxxxx agr. x same yyyyyy,"m.tr. XWW, W = xxxxxx, same yyyyyy",covNetNet,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
+covarABNetNetObjective,shared incoming xxxxxx x same yyyyyy,"m.tr. WWX, W = xxxxxx, same yyyyyy",covNetNetIn,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,dyadic,FALSE
+covarANetNetObjective,(ind. xxxxxx wghted yyyyyy)^(1/#) popularity,"sum ind. x (ind. xxxxxx wghted yyyyyy)^(1/#)",inPopIntnX,TRUE,xxxxxx,yyyyyy,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,dyadic,FALSE
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rsiena -r 301
More information about the Rsiena-commits
mailing list