[Rsiena-commits] r296 - in pkg: RSiena RSiena/R RSiena/man RSiena/src/data RSiena/src/model/effects RSienaTest RSienaTest/R RSienaTest/doc RSienaTest/man RSienaTest/src/data RSienaTest/src/model/effects

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Aug 18 09:45:44 CEST 2016


Author: tomsnijders
Date: 2016-08-18 09:45:44 +0200 (Thu, 18 Aug 2016)
New Revision: 296

Modified:
   pkg/RSiena/ChangeLog
   pkg/RSiena/DESCRIPTION
   pkg/RSiena/NAMESPACE
   pkg/RSiena/R/print01Report.r
   pkg/RSiena/R/sienaModelCreate.r
   pkg/RSiena/R/sienaeffects.r
   pkg/RSiena/man/RSiena-package.Rd
   pkg/RSiena/man/getEffects.Rd
   pkg/RSiena/man/includeEffects.Rd
   pkg/RSiena/man/sienaFit.Rd
   pkg/RSiena/man/sienaGOF-auxiliary.Rd
   pkg/RSiena/src/data/BehaviorLongitudinalData.h
   pkg/RSiena/src/model/effects/DyadicCovariateAvAltEffect.cpp
   pkg/RSiena/src/model/effects/FourCyclesEffect.cpp
   pkg/RSienaTest/ChangeLog
   pkg/RSienaTest/DESCRIPTION
   pkg/RSienaTest/NAMESPACE
   pkg/RSienaTest/R/phase2.r
   pkg/RSienaTest/R/print01Report.r
   pkg/RSienaTest/R/runit.r
   pkg/RSienaTest/R/sienaModelCreate.r
   pkg/RSienaTest/R/sienaeffects.r
   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/effectsDocumentation.Rd
   pkg/RSienaTest/man/extract.sienaBayes.Rd
   pkg/RSienaTest/man/getEffects.Rd
   pkg/RSienaTest/man/print01Report.Rd
   pkg/RSienaTest/man/sienaFit.Rd
   pkg/RSienaTest/man/sienaGOF-auxiliary.Rd
   pkg/RSienaTest/src/data/ChangingDyadicCovariate.h
   pkg/RSienaTest/src/data/ConstantDyadicCovariate.cpp
   pkg/RSienaTest/src/data/ConstantDyadicCovariate.h
   pkg/RSienaTest/src/data/DyadicCovariateValueIterator.cpp
   pkg/RSienaTest/src/data/DyadicCovariateValueIterator.h
   pkg/RSienaTest/src/data/NetworkConstraint.cpp
   pkg/RSienaTest/src/data/NetworkConstraint.h
   pkg/RSienaTest/src/data/NetworkLongitudinalData.h
   pkg/RSienaTest/src/model/effects/DyadicCovariateAvAltEffect.cpp
   pkg/RSienaTest/src/model/effects/FourCyclesEffect.cpp
Log:
Version 1.1-296; small changes.

Modified: pkg/RSiena/ChangeLog
===================================================================
--- pkg/RSiena/ChangeLog	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/ChangeLog	2016-08-18 07:45:44 UTC (rev 296)
@@ -1,3 +1,17 @@
+2016-08-17 R-Forge Revision 296
+Changes in RSiena and RSienaTest:
+   * Warning if includeEffects is used with parameter initialValue.
+   * 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.
+
+2016-07-23 R-Forge Revision 295
+Changes in RSienaTest (Felix Schoenenberger):
+   * buildsystem: added Makefile and src/sources.list
+     unitTests: removed sink('/dev/null')
+
 2016-05-28 R-Forge Revision 294
 Changes in RSiena and RSienaTest:
    * In SimilarityEffect.cpp and SimilarityWEffect.cpp, changed
@@ -3,5 +17,5 @@
      abs to std::abs to avoid ambiguity, dropping #include <cmath>.
 Changes in RSienaTest:
-   * configure given Mac line endings.
+   * Mac line endings given to configure file.
 
 2016-05-23 R-Forge Revision 293

Modified: pkg/RSiena/DESCRIPTION
===================================================================
--- pkg/RSiena/DESCRIPTION	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/DESCRIPTION	2016-08-18 07:45:44 UTC (rev 296)
@@ -1,8 +1,8 @@
 Package: RSiena
 Type: Package
 Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.1-294
-Date: 2016-05-25
+Version: 1.1-296
+Date: 2016-08-17
 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/NAMESPACE
===================================================================
--- pkg/RSiena/NAMESPACE	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/NAMESPACE	2016-08-18 07:45:44 UTC (rev 296)
@@ -12,21 +12,26 @@
        OutdegreeDistribution, IndegreeDistribution, BehaviorDistribution,
        siena.table, xtable,
        Wald.RSiena, Multipar.RSiena)
+
+import(Matrix, tcltk, lattice, parallel, MASS)
 importFrom("grDevices", "rgb", "xy.coords")
-importFrom("graphics", "axis", "barplot", "layout", "mtext", "pairs",
-           "panel.smooth", "par", "pie", "plot", "points", "strwidth","text")
-importFrom("methods", "as", "is")
-importFrom("stats", ".getXlevels", "acf", "contr.helmert", "cor",
-           "cor.test", "cov", "dnorm", "ecdf", "hatvalues", "lm",
-           "lm.wfit", "mad", "median", "model.matrix", "model.offset",
-           "model.response", "model.weights", "naprint", "optimize",
-           "pchisq", "plot.ts", "pnorm", "predict.lm", "pt", "qchisq",
-           "qnorm", "quantile", "runif", "sd", "ts", "uniroot", "var",
-           "weighted.mean")
-importFrom("utils", "browseURL", "flush.console", "getFromNamespace",
+importFrom("graphics", "axis", "barplot", "contour", "layout", "lines",
+           "mtext", "pairs", "panel.smooth", "par", "pie", "plot",
+           "points", "stem", "strwidth", "text")
+importFrom("methods", "as", "is", "hasArg")
+importFrom("stats", ".getXlevels", "acf", "as.formula", "coef",
+           "contr.helmert", "cor", "cor.test", "cov", "density",
+           "dnorm", "ecdf", "hatvalues", "lm", "lm.wfit", "mad",
+           "mahalanobis", "median", "model.matrix", "model.offset",
+           "model.response", "model.weights", "na.omit", "naprint",
+           "optim", "optimize", "pchisq", "plot.ts", "pnorm", "poly",
+           "predict.lm", "pt", "qchisq", "qnorm", "quantile",
+           "rWishart", "rnorm", "runif", "sd", "ts", "uniroot", "var",
+           "weighted.mean", "weights")
+importFrom("utils", "browseURL", "capture.output", "edit",
+           "flush.console", "getFromNamespace", "object.size",
            "packageDescription", "read.csv", "read.delim",
            "read.table", "write.csv", "write.table")
-import(Matrix, tcltk, lattice, parallel, MASS)
 S3method(print, siena)
 S3method(print, sienaGroup)
 S3method(print, sienaDependent)

Modified: pkg/RSiena/R/print01Report.r
===================================================================
--- pkg/RSiena/R/print01Report.r	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/R/print01Report.r	2016-08-18 07:45:44 UTC (rev 296)
@@ -358,8 +358,7 @@
 												  "3"=, "23"=, "33"= "rd",
 												  "th"), sep="")
 					Report(c(mystr, " dependent actor variable named ",
-							 netname), sep="", outf)
-					Report(".\n", outf)
+							 netname,".\n"), sep="", outf)
 					ranged <- atts$range2
 					Report(c("Maximum and minimum rounded values are ",
 							 round(ranged[1]), " and ",
@@ -862,11 +861,6 @@
 		Report("\n\n", outf) ## end of reportDataObject
 	}
 	## create output file. ## start of print01Report proper
-	if (getDocumentation)
-	{
-		tt <- getInternals()
-		return(tt)
-	}
 	if (!(inherits(data, "siena")))
 	{
 		stop("The first argument needs to be a siena data object.")
@@ -877,6 +871,15 @@
 		cat(" in the call of print01Report. Consult the help file.\n")
 		stop("print01Report needs no effects object.")
 	}
+	if (!inherits(getDocumentation, 'logical'))
+	{
+		stop('wrong parameters; note: do not include an effects object as parameter!')
+	}
+	if (getDocumentation)
+	{
+		tt <- getInternals()
+		return(tt)
+	}
 	Report(openfiles=TRUE, type="w", projname=modelname)
 	Report("							************************\n", outf)
 	Report(c("									 ", modelname, ".out\n"),

Modified: pkg/RSiena/R/sienaModelCreate.r
===================================================================
--- pkg/RSiena/R/sienaModelCreate.r	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/R/sienaModelCreate.r	2016-08-18 07:45:44 UTC (rev 296)
@@ -10,107 +10,107 @@
 # *****************************************************************************/
 
 ModelTypeStrings <- c("Standard actor-oriented model",
-                      "Forcing model",
-                      "Initiative model",
-                      "Pairwise forcing model",
-                      "Pairwise mutual model",
-                      "Pairwise joint model")
+					  "Forcing model",
+					  "Initiative model",
+					  "Pairwise forcing model",
+					  "Pairwise mutual model",
+					  "Pairwise joint model")
 
 ##@sienaModelCreate DataCreate
 sienaModelCreate <-
-    function(fn,
-             projname="Siena", MaxDegree=0, useStdInits=FALSE,
-n3=1000, nsub=4, n2start = NULL, dolby=TRUE,
-maxlike=FALSE, diagonalize=0.2*!maxlike,
-             condvarno=0, condname='',
-             firstg=0.2, reduceg=0.5, cond=NA, findiff=FALSE,  seed=NULL,
-             pridg=0.05, prcdg=0.05, prper=0.2, pripr=0.3, prdpr=0.3,
-             prirms=0.05, prdrms=0.05, maximumPermutationLength=40,
-             minimumPermutationLength=2, initialPermutationLength=20,
-modelType=1, mult=5, simOnly=FALSE, localML=FALSE,
-truncation=5, doubleAveraging=0, standardizeVar=(diagonalize<1))
+	function(fn,
+			projname="Siena", MaxDegree=0, useStdInits=FALSE,
+			n3=1000, nsub=4, n2start = NULL, dolby=TRUE,
+			maxlike=FALSE, diagonalize=0.2*!maxlike,
+			condvarno=0, condname='',
+			firstg=0.2, reduceg=0.5, cond=NA, findiff=FALSE,  seed=NULL,
+			pridg=0.05, prcdg=0.05, prper=0.2, pripr=0.3, prdpr=0.3,
+			prirms=0.05, prdrms=0.05, maximumPermutationLength=40,
+			minimumPermutationLength=2, initialPermutationLength=20,
+			modelType=1, mult=5, simOnly=FALSE, localML=FALSE,
+			truncation=5, doubleAveraging=0, standardizeVar=(diagonalize<1))
 {
-    model <- NULL
-    model$projname <- projname
-    model$useStdInits <- useStdInits
-    model$checktime <- TRUE
-    model$n3 <- n3
-    model$firstg <- firstg
-    model$reduceg <- reduceg
-    model$maxrat <- 1.0
-    model$maxlike <-  maxlike
+	model <- NULL
+	model$projname <- projname
+	model$useStdInits <- useStdInits
+	model$checktime <- TRUE
+	model$n3 <- n3
+	model$firstg <- firstg
+	model$reduceg <- reduceg
+	model$maxrat <- 1.0
+	model$maxlike <-  maxlike
 	model$simOnly <- simOnly
 	model$localML <- localML
-    model$FRANname <- deparse(substitute(fn))
-    if (maxlike)
-    {
-        if (missing(fn))
-        {
-            model$FRANname <- "maxlikec"
-        }
-        if (is.na(cond))
-        {
-            cond <- FALSE
-        }
-        if (cond)
-        {
-            stop("Conditional estimation is not possible with",
-                  "maximum likelihood estimation")
-        }
-        if (findiff)
-        {
-            stop("Finite differences estimation of derivatives",
-                 "is not possible with maximum likelihood estimation")
-        }
-    }
-    else
-    {
-        if (missing(fn))
-        {
-            model$FRANname <- "simstats0c"
-        }
-    }
-    model$cconditional <- cond
-    if (!is.na(cond) && cond && condvarno == 0 && condname == "")
-    {
-        model$condvarno <-  1
-        model$condname <- ""
-    }
-    else
-    {
-        model$condvarno <-  condvarno
-        model$condname <- condname
-    }
-    model$FinDiff.method <-  findiff
-    model$nsub <- nsub
-model$n2start <- n2start
+	model$FRANname <- deparse(substitute(fn))
+	if (maxlike)
+	{
+		if (missing(fn))
+		{
+			model$FRANname <- "maxlikec"
+		}
+		if (is.na(cond))
+		{
+			cond <- FALSE
+		}
+		if (cond)
+		{
+			stop("Conditional estimation is not possible with",
+				  "maximum likelihood estimation")
+		}
+		if (findiff)
+		{
+			stop("Finite differences estimation of derivatives",
+				 "is not possible with maximum likelihood estimation")
+		}
+	}
+	else
+	{
+		if (missing(fn))
+		{
+			model$FRANname <- "simstats0c"
+		}
+	}
+	model$cconditional <- cond
+	if (!is.na(cond) && cond && condvarno == 0 && condname == "")
+	{
+		model$condvarno <-  1
+		model$condname <- ""
+	}
+	else
+	{
+		model$condvarno <-  condvarno
+		model$condname <- condname
+	}
+	model$FinDiff.method <-  findiff
+	model$nsub <- nsub
+	model$n2start <- n2start
 	model$dolby <- (dolby && (!maxlike))
 	if (diagonalize < 0) {diagonalize <- 0}
 	if (diagonalize > 1) {diagonalize <- 1}
-    model$diagg <- (diagonalize >= 0.9999)
+	model$diagg <- (diagonalize >= 0.9999)
 	model$diagonalize <- diagonalize
-    model$modelType <- modelType
-    model$MaxDegree <- MaxDegree
-    model$randomSeed <- seed
-    model$pridg <- pridg
-    model$prcdg <- prcdg
-    model$prper <- prper
-    model$pripr <- pripr
-    model$prdpr <- prdpr
-    model$prirms <- prirms
-    model$prdrms <- prdrms
-    model$maximumPermutationLength <- maximumPermutationLength
-    model$minimumPermutationLength <- minimumPermutationLength
-    model$initialPermutationLength <- initialPermutationLength
-    model$mult <- mult
-model$truncation <- truncation
-model$doubleAveraging <- doubleAveraging
-model$standardizeWithTruncation <- standardizeVar
-model$standardizeVar <- standardizeVar
+	model$modelType <- modelType
+	model$MaxDegree <- MaxDegree
+	model$randomSeed <- seed
+	model$pridg <- pridg
+	model$prcdg <- prcdg
+	model$prper <- prper
+	model$pripr <- pripr
+	model$prdpr <- prdpr
+	model$prirms <- prirms
+	model$prdrms <- prdrms
+	model$maximumPermutationLength <- maximumPermutationLength
+	model$minimumPermutationLength <- minimumPermutationLength
+	model$initialPermutationLength <- initialPermutationLength
+	model$mult <- mult
+	model$truncation <- truncation
+	model$doubleAveraging <- doubleAveraging
+	model$standardizeWithTruncation <- standardizeVar
+	model$standardizeVar <- standardizeVar
 # The difference between these two is a hidden, non-documented option,
 # perhaps for being tried out
 # by later modification of the sienaAlgorithm object.
-model$noAggregation <- FALSE
+	model$noAggregation <- FALSE
 # This also is a hidden, non-documented option, perhaps for being tried out.
 #  \item{noAggregation}{Logical:
 #   do not replace current parameter value after subphase 1
@@ -118,11 +118,8 @@
 #   then is larger than .5. May be helpful if initial value was very far away.
 # The two options model$noAggregation and model$standardizeWithTruncation
 # are used only in phase2.r.
-model$browse1 <- FALSE # non-documented options for browsing in phase 2.
-model$browse2 <- FALSE
-model$browse3 <- FALSE
-    class(model) <- "sienaAlgorithm"
-    model
+	class(model) <- "sienaAlgorithm"
+	model
 }
 
 model.create <- sienaModelCreate

Modified: pkg/RSiena/R/sienaeffects.r
===================================================================
--- pkg/RSiena/R/sienaeffects.r	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/R/sienaeffects.r	2016-08-18 07:45:44 UTC (rev 296)
@@ -65,6 +65,11 @@
 #			"interaction1", "interaction2", "include")])
 		print.sienaEffects(myeff[use,])
 	}
+	if (hasArg('initialValue'))
+	{
+		cat
+("Warning: argument 'initialValue' has no effect in includeEffects; use setEffect.\n")
+	}
 	myeff
 }
 ##@includeInteraction DataCreate
@@ -185,32 +190,14 @@
 		if (nrow(ints) == 0)
 		{
 			baseEffect<- myeff[myeff$name == name, ][1, ]
-			if (baseEffect$netType != "behavior")
+			if (baseEffect$netType == "behavior")
 			{
-				tmprow <- createEffects("unspecifiedNetInteraction", name=name,
-										netType=baseEffect$netType,
-										groupName=baseEffect$groupName,
-										group=baseEffect$group)
+				stop("Use getEffects() with a larger value for behNintn.")
 			}
 			else
 			{
-				tmprow <- createEffects("unspecifiedBehaviorInteraction",
-										name=name,
-										netType=baseEffect$netType,
-										groupName=baseEffect$groupName,
-										group=baseEffect$group)
+				stop("Use getEffects() with a larger value for nintn.")
 			}
-			tmprow$include <- TRUE
-			tmprow <- tmprow[tmprow$type==type, ]
-			tmprow$effectNumber <- max(myeff$effectNumber) + 1
-			rownames(tmprow) <-
-				paste(name, "obj", "type", tmprow$effectNumber, sep='.')
-		   # if ('requested' %in% names(myeff))
-		   # {
-			#    tmprow$requested <- TRUE
-		   # }
-			myeff <- rbind(myeff, tmprow)
-			ints <- tmprow
 		}
 		ints <- ints[1, ]
 		intn <- myeff$effectNumber == ints$effectNumber

Modified: pkg/RSiena/man/RSiena-package.Rd
===================================================================
--- pkg/RSiena/man/RSiena-package.Rd	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/man/RSiena-package.Rd	2016-08-18 07:45:44 UTC (rev 296)
@@ -44,8 +44,8 @@
 \tabular{ll}{
 Package: \tab RSiena\cr
 Type: \tab Package\cr
-Version: \tab 1.1-294\cr
-Date: \tab 2016-05-25\cr
+Version: \tab 1.1-296\cr
+Date: \tab 2016-08-17\cr
 Depends: \tab R (>= 3.0.0)\cr
 Imports: \tab Matrix\cr
 Suggests: \tab tcltk, network, codetools, lattice, MASS, parallel,

Modified: pkg/RSiena/man/getEffects.Rd
===================================================================
--- pkg/RSiena/man/getEffects.Rd	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/man/getEffects.Rd	2016-08-18 07:45:44 UTC (rev 296)
@@ -78,7 +78,8 @@
 }
 \references{See \url{http://www.stats.ox.ac.uk/~snijders/siena/}}
 \author{Ruth Ripley}
-\seealso{\code{\link{sienaDataCreate}}, \code{\link{effectsDocumentation}}}
+\seealso{\code{\link{sienaDataCreate}}, \code{\link{sienaDataCreate}},
+        \code{\link{includeEffects}}, {\link{setEffect}}}
 \examples{
 mynet1 <- sienaDependent(array(c(s501, s502, s503), dim=c(50, 50, 3)))
 mybeh <- sienaDependent(s50a, type="behavior")

Modified: pkg/RSiena/man/includeEffects.Rd
===================================================================
--- pkg/RSiena/man/includeEffects.Rd	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/man/includeEffects.Rd	2016-08-18 07:45:44 UTC (rev 296)
@@ -54,9 +54,10 @@
   and values of interaction1 and interaction2 (if any),
   is obtained by executing \code{\link{effectsDocumentation}(myeff)}.
 
-  The function \code{}includeEffects operates by providing an interface
-  to set the "include" column on
-  selected rows of the effects object, to the value requested (TRUE or FALSE).
+  The function \code{}includeEffects operates as an interface
+  setting the "include" column on selected rows of the effects object,
+  to the value requested (TRUE or FALSE).
+  
 }
 \value{
 	An updated version of the input effects object, with the include, test, and fix

Modified: pkg/RSiena/man/sienaFit.Rd
===================================================================
--- pkg/RSiena/man/sienaFit.Rd	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/man/sienaFit.Rd	2016-08-18 07:45:44 UTC (rev 296)
@@ -27,9 +27,9 @@
     \code{\link{siena07}}.}
   \item{x}{An object of class \code{sienaFit}, or
     \code{summary.sienaFit} as appropriate.}
-  \item{matrices}{Boolean: should the covariance matrix of the estimates,
-    the derivative matrix of expected statistics,
-    and the covariance matrix of the expected statistics be printed.}
+  \item{matrices}{Boolean: whether also to print in the summary the 
+   covariance matrix of the estimates, the derivative matrix of expected 
+   statistics X by parameters, and the covariance matrix of the statistics.}
   \item{tstat}{Boolean: if this is NULL, the t-statistics for convergence
      will not be added to the report.}
   \item{type}{Type of output to produce; must be either \code{"tex"} or
@@ -69,14 +69,13 @@
 
   The function \code{summary.sienaFit} prints a table containing
   estimated parameter values, standard errors and t-statistics for
-  convergence, score-type tests (if any), and if \code{matrices =TRUE}
-  also the covariance matrix of the estimates, the
+  convergence together with the covariance matrix of the estimates, the
   derivative matrix of expected statistics \code{X} by parameters, and the
   covariance matrix of the expected statistics \code{X}.
 
   The function \code{xtable.sienaFit} creates an object of class
   \code{xtable.sienaFit} which inherits from class \code{xtable} and
-  passes any extra arguments to \code{print.xtable}.
+  passes an extra arguments to the \code{print.xtable}.
 
   The function \code{siena.table} outputs a latex or html table of
   the estimates and standards errors of a \code{sienaFit} object.

Modified: pkg/RSiena/man/sienaGOF-auxiliary.Rd
===================================================================
--- pkg/RSiena/man/sienaGOF-auxiliary.Rd	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/man/sienaGOF-auxiliary.Rd	2016-08-18 07:45:44 UTC (rev 296)
@@ -70,6 +70,8 @@
  The three given here are far from a complete set;
  they will be supplemented in due time by statistics depending on networks and
  behavior jointly.
+ The examples below give a number of other statistics, using the packages
+ sna and igraph.
 
  The \code{levls} parameter must be adapted to the range of values that is
  considered important. For indegrees and outdegrees, the whole range should 
@@ -239,7 +241,6 @@
    TriadCensus <- function(i, data, sims, wave, groupName, varName, levls=1:16){
        unloadNamespace("igraph") # to avoid package clashes
        require(sna)
-       require(network)
        x <- networkExtraction(i, data, sims, wave, groupName, varName)
 	   if (network.edgecount(x) <= 0){x <- symmetrize(x)}
        # because else triad.census(x) will lead to an error
@@ -248,6 +249,20 @@
        tc
    }
 
+   # CliqueCensus calculates the distribution of the clique census
+   # of the symmetrized network; see ?sna::clique.census.
+   CliqueCensus<-function (i, obsData, sims, period, groupName, varName, levls = 1:5){
+       require(sna)
+       x <- networkExtraction(i, obsData, sims, period, groupName, varName)
+       cc0 <- sna::clique.census(x, mode='graph', tabulate.by.vertex = FALSE,
+                                 enumerate=FALSE)[[1]]
+       cc <- 0*levls
+       names(cc) <- as.character(levls)
+       levels.used <- as.numeric(intersect(names(cc0), names(cc)))
+       cc[levels.used] <- cc0[levels.used]
+       cc
+   }
+
   # Distribution of Bonacich eigenvalue centrality; see ?igraph::evcent.
   EigenvalueDistribution <- function (i, data, sims, period, groupName, varName,
                            levls=c(seq(0,1,by=0.125)), cumulative=TRUE){

Modified: pkg/RSiena/src/data/BehaviorLongitudinalData.h
===================================================================
--- pkg/RSiena/src/data/BehaviorLongitudinalData.h	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/src/data/BehaviorLongitudinalData.h	2016-08-18 07:45:44 UTC (rev 296)
@@ -91,7 +91,7 @@
 	// lobservedDistributions[observation][value] stores the frequency of
 	// the given value at the given observation.
 
-	map<int, double> * lobservedDistributions;
+	std::map<int, double> * lobservedDistributions;
 };
 
 }

Modified: pkg/RSiena/src/model/effects/DyadicCovariateAvAltEffect.cpp
===================================================================
--- pkg/RSiena/src/model/effects/DyadicCovariateAvAltEffect.cpp	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/src/model/effects/DyadicCovariateAvAltEffect.cpp	2016-08-18 07:45:44 UTC (rev 296)
@@ -34,7 +34,7 @@
 	// if not, used as the variable.
 	this->lpar2 = (pEffectInfo->internalEffectParameter() >= 2);
 	// specifies type of denominator
-	if (!lasWeight) {lpar2 <- false;}
+	if (!lasWeight) {lpar2 = false;}
 }
 
 

Modified: pkg/RSiena/src/model/effects/FourCyclesEffect.cpp
===================================================================
--- pkg/RSiena/src/model/effects/FourCyclesEffect.cpp	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSiena/src/model/effects/FourCyclesEffect.cpp	2016-08-18 07:45:44 UTC (rev 296)
@@ -18,6 +18,8 @@
 #include "model/EffectInfo.h"
 #include "model/variables/NetworkVariable.h"
 
+using namespace std;
+
 namespace siena
 {
 
@@ -213,7 +215,14 @@
 	// Avoid counting each 4-cycle four times in the evaluation statistic.
 	// TODO: Is it okay to divide by 4 for endowment statistic as well?
 
+	if (this->lroot)
+	{
+	return (this->lpSqrtTable->sqrt(this->lcounters[alter]))/2;
+	}
+	else
+	{
 	return this->lcounters[alter] * 0.25;
+	}
 }
 
 }

Modified: pkg/RSienaTest/ChangeLog
===================================================================
--- pkg/RSienaTest/ChangeLog	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSienaTest/ChangeLog	2016-08-18 07:45:44 UTC (rev 296)
@@ -1,3 +1,18 @@
+2016-08-17 R-Forge Revision 296
+Changes in RSiena and RSienaTest:
+   * Warning if includeEffects is used with parameter initialValue.
+   * 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):
+   * buildsystem: added Makefile and src/sources.list
+     unitTests: removed sink('/dev/null')
+
 2016-05-28 R-Forge Revision 294
 Changes in RSiena and RSienaTest:
    * In SimilarityEffect.cpp and SimilarityWEffect.cpp, changed
@@ -3,5 +18,5 @@
      abs to std::abs to avoid ambiguity, dropping #include <cmath>.
 Changes in RSienaTest:
-   * configure given Mac line endings.
+   * Mac line endings given to configure file.
 
 2016-05-23 R-Forge Revision 293

Modified: pkg/RSienaTest/DESCRIPTION
===================================================================
--- pkg/RSienaTest/DESCRIPTION	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSienaTest/DESCRIPTION	2016-08-18 07:45:44 UTC (rev 296)
@@ -1,8 +1,8 @@
 Package: RSienaTest
 Type: Package
 Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.1-295
-Date: 2016-07-23
+Version: 1.1-296
+Date: 2016-08-17
 Author: Ruth Ripley, Krists Boitmanis, Tom A.B. Snijders, Felix Schoenenberger
 Depends: R (>= 2.15.0), utils
 Imports: Matrix, tcltk, lattice, parallel, MASS, RUnit, methods

Modified: pkg/RSienaTest/NAMESPACE
===================================================================
--- pkg/RSienaTest/NAMESPACE	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSienaTest/NAMESPACE	2016-08-18 07:45:44 UTC (rev 296)
@@ -3,8 +3,7 @@
        siena01Gui, siena07, sienaCompositionChange, sienaBayes, glueBayes,
        simpleBayesTest, multipleBayesTest, extract.sienaBayes, updateTheta,
        sienaCompositionChangeFromFile, sienaDataCreate,
-	   sienaDataCreateFromSession, sienaGroupCreate, sienaModelCreate,
-	   sienaAlgorithmCreate, sienaNet,
+       sienaGroupCreate, sienaModelCreate, sienaAlgorithmCreate, sienaNet,
        sienaDependent, sienaNodeSet, xtable.sienaFit,
        varCovar, varDyadCovar, setEffect, includeEffects, includeInteraction,
        effectsDocumentation, sienaDataConstraint, print.xtable.sienaFit,
@@ -20,7 +19,7 @@
 importFrom("graphics", "axis", "barplot", "contour", "layout", "lines",
            "mtext", "pairs", "panel.smooth", "par", "pie", "plot",
            "points", "stem", "strwidth", "text")
-importFrom("methods", "as", "is")
+importFrom("methods", "as", "is", "hasArg")
 importFrom("stats", ".getXlevels", "acf", "as.formula", "coef",
            "contr.helmert", "cor", "cor.test", "cov", "density",
            "dnorm", "ecdf", "hatvalues", "lm", "lm.wfit", "mad",

Modified: pkg/RSienaTest/R/phase2.r
===================================================================
--- pkg/RSienaTest/R/phase2.r	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSienaTest/R/phase2.r	2016-08-18 07:45:44 UTC (rev 296)
@@ -51,8 +51,6 @@
 		z$sf.invcov <-
 		 solve(msf[!z$fixed, !z$fixed] + 0.0001 * diag(z$pp - sum(z$fixed)))
 	}
-if (is.null(x$browse1)){x$browse1 <- FALSE}
-if (x$browse1){browser()}
     Report(paste('\nPhase 2 has', x$nsub, 'subphases.\n'), cf)
     z$gain <- x$firstg
     z$reduceg <- x$reduceg
@@ -166,8 +164,6 @@
     {
         Report('The user asked for early end of phase 2.\n', outf)
     }
-if (is.null(x$browse3)){x$browse3 <- FALSE}
-if (x$browse3){browser()}
     ##    cat('it',z$nit,'\n')
     ##recalculate autocor using -1 instead of -2 as error
     ac <- ifelse (z$prod0 > 1e-12, z$prod1 / z$prod0, -1)
@@ -376,8 +372,6 @@
 # still with default 5;
 # and for the case !x$diagg, a multivariate truncation is used.
 
-if (is.null(x$browse2)){x$browse2 <- FALSE}
-if (x$browse2){browser()}
 		if (x$diagg)
 		{
 			maxRatio <- max(ifelse(z$fixed, 1.0, abs(fra)/ z$sd), na.rm=TRUE)

Modified: pkg/RSienaTest/R/print01Report.r
===================================================================
--- pkg/RSienaTest/R/print01Report.r	2016-07-23 14:11:28 UTC (rev 295)
+++ pkg/RSienaTest/R/print01Report.r	2016-08-18 07:45:44 UTC (rev 296)
@@ -8,8 +8,7 @@
 # * Description: This module contains the function to print the initial report
 # *****************************************************************************/
 ##@print01Report Reporting
-print01Report <- function(data, modelname="Siena", session=NULL,
-						  getDocumentation=FALSE)
+print01Report <- function(data, modelname="Siena", getDocumentation=FALSE)
 {
 	##@reportDataObject1 internal print01Report
 	reportDataObject1 <- function(x)
@@ -33,8 +32,7 @@
 		}
 	}
 	##@reportDataObject internal print01Report
-	reportDataObject <- function(x, periodFromStart=0, multi=FALSE,
-								 session=session)
+	reportDataObject <- function(x, periodFromStart=0, multi=FALSE)
 	{
 		##@reportStart internal print01Report
 		reportStart <- function()
@@ -129,31 +127,6 @@
 					}
 					for (k in 1:x$observations)
 					{
-						if (!is.null(session))
-						{
-							namesession <-
-								session[session$Name == netname, ]
-							filename <- namesession$Filename
-							if (length(filename) > 1)
-							{
-								if (namesession$Format[1] == "Siena net")
-								{
-									period <-
-										strsplit(namesession$Period, " ")
-									sub <- sapply(period, function(x) k %in% x)
-								}
-								else
-								{
-								   period <-
-									unlist(strsplit(namesession$Period, " "))
-								 sub <- match(k, period)
-								}
-								filename <- filename[sub]
-							}
-							Report(c("Observation moment ", k + periodFromStart,
-									 " was read from file ", filename, '. \n'),
-								   sep='', outf)
-						}
 						Report(c("For observation moment ", k + periodFromStart,
 								 ", degree distributions are as ",
 								 "follows:\nNodes\n"),
@@ -385,18 +358,7 @@
 												  "3"=, "23"=, "33"= "rd",
 												  "th"), sep="")
 					Report(c(mystr, " dependent actor variable named ",
-							 netname), sep="", outf)
-					if (!is.null(session))
-					{
-						filename <-
-							session$Filename[session$Name == netname]
-							Report(c(" was read from file ", filename, ".\n"),
-								   sep="", outf)
-					}
-					else
-					{
-						Report(".\n", outf)
-					}
+							 netname,".\n"), sep="", outf)
 					ranged <- atts$range2
 					Report(c("Maximum and minimum rounded values are ",
 							 round(ranged[1]), " and ",
@@ -486,29 +448,12 @@
 			nCovars <- length(x$cCovars)
 			covars <- names(x$cCovars)
 			Heading(2, outf, "Reading constant actor covariates.")
-			if (!is.null(session))
+			Report(c(nCovars, "variable"),outf)
+			Report(ifelse(nCovars == 1, ", named:\n", "s, named:\n"), outf)
+			for (i in seq(along=covars))
 			{
-				covarssession <- session[session$Type == "constant covariate", ]
-				for (i in 1:nrow(covarssession))
-				{
-					names <- strsplit(covarssession$Name[i],
-									  " ", fixed=TRUE)[[1]]
-					ncases <- length(x$cCovars[[match(names[1], covars)]])
-					Report(c("Covariate data file", covarssession$Filename[i],
-						   "with", length(names), "variables,", ncases,
-							 "cases, named:\n"), outf)
-					Report(paste(names, "\n"), outf, sep="")
-				}
+				Report(c(format(covars[i], width=15), '\n'), outf)
 			}
-			else
-			{
-				Report(c(nCovars, "variable"),outf)
-				Report(ifelse(nCovars == 1, ", named:\n", "s, named:\n"), outf)
-				for (i in seq(along=covars))
-				{
-					Report(c(format(covars[i], width=15), '\n'), outf)
-				}
-			}
 			Report(c("\nA total of", nCovars,
 					 "non-changing individual covariate"), outf)
 			Report(ifelse(nCovars == 1, ".\n\n", "s.\n\n"), outf)
@@ -575,45 +520,12 @@
 			use <- ! covars %in% names(x$cCovars)
 			nCovars <- length(x$vCovars[use])
 			Heading(2, outf, "Reading exogenous changing actor covariates.")
-			if (!is.null(session))
+			Report(c(nCovars, "variable"),outf)
+			Report(ifelse(nCovars == 1, ", named:\n", "s, named:\n"), outf)
+			for (i in seq(along=covars[use]))
 			{
-				if (nData > 1)
-				{
-					covarssession <-
-						session[session$Type == "constant covariate", ]
-					for (i in 1:nrow(covarssession))
-					{
-						names <- strsplit(covarssession$Name[i],
-										  " ", fixed=TRUE)[[1]]
-						ncases <- length(x$vCovars[[match(names[1], covars)]])
-						Report(c("Covariate data file",
-								 covarssession$Filename[i],
-								 "with", length(names), "variables,", ncases,
-								 "cases, named:\n"), outf)
-						Report(paste(names, "\n"), outf, sep="")
-					}
-				}
-				covarssession <- session[session$Type == "changing covariate", ]
-				for (i in seq(along=covarssession[,1]))
-				{
-					ncases <- nrow(x$vCovars[[match(covarssession$Name[i],
-													covars)]])
-					Report(c("Exogenous changing covariate ",
-							 covarssession$name[i], " read from file ",
-							 covarssession$Filename[i], ".\n"), sep="", outf)
-					Report(c("Number of cases is ", ncases, ".\n"), sep="",
-						   outf)
-				}
+				Report(c(format(covars[use][i], width=15), '\n'), outf)
 			}
-			else
-			{
-				Report(c(nCovars, "variable"),outf)
-				Report(ifelse(nCovars == 1, ", named:\n", "s, named:\n"), outf)
-				for (i in seq(along=covars[use]))
-				{
-					Report(c(format(covars[use][i], width=15), '\n'), outf)
-				}
-			}
 			Report(c("\nA total of", nCovars,
 					 "exogenous changing actor covariate"), outf)
 				Report(ifelse(nCovars == 1, ".\n\n", "s.\n\n"), outf)
@@ -949,22 +861,25 @@
 		Report("\n\n", outf) ## end of reportDataObject
 	}
 	## create output file. ## start of print01Report proper
-	if (getDocumentation)
-	{
-		tt <- getInternals()
-		return(tt)
-	}
 	if (!(inherits(data, "siena")))
 	{
 		stop("The first argument needs to be a siena data object.")
 	}
-	if ((!(inherits(modelname, "character")))|
-			(inherits(session,"sienaEffects")))
+	if (!(inherits(modelname, "character")))
 	{
 		cat("Since version 1.1-279, an effects object should not be given\n")
 		cat(" in the call of print01Report. Consult the help file.\n")
 		stop("print01Report needs no effects object.")
 	}
+	if (!inherits(getDocumentation, 'logical'))
+	{
+		stop('wrong parameters; note: do not include an effects object as parameter!')
+	}
+	if (getDocumentation)
+	{
+		tt <- getInternals()
+		return(tt)
+	}
 	Report(openfiles=TRUE, type="w", projname=modelname)
 	Report("							************************\n", outf)
 	Report(c("									 ", modelname, ".out\n"),
@@ -1016,16 +931,14 @@
 					paste("Subproject ", i, ": <", names(data)[i], ">",
 						  sep="", collapse="")
 					)
-			thisSession <- session[session$Group == names(data)[i],]
-			reportDataObject(data[[i]], periodFromStart, multi=TRUE,
-							 session=thisSession)
+			reportDataObject(data[[i]], periodFromStart, multi=TRUE)
 			periodFromStart <- periodFromStart + data[[i]]$observations
 	   }
 	}
 	else
 	{
 		Heading(1, outf, "Data input.")
-		reportDataObject(data[[1]], 0, multi=FALSE, session=session)
+		reportDataObject(data[[1]], 0, multi=FALSE)
 	}
 	atts <- attributes(data)
 	nets <- atts$types != "behavior"

Modified: pkg/RSienaTest/R/runit.r
===================================================================
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/rsiena -r 296


More information about the Rsiena-commits mailing list