[Rsiena-commits] r275 - in pkg: RSiena RSiena/R RSiena/inst/doc RSiena/man RSiena/src RSiena/src/model RSiena/src/network RSiena/tests RSienaTest RSienaTest/R RSienaTest/inst/doc RSienaTest/man RSienaTest/src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jun 10 12:07:56 CEST 2014
Author: tomsnijders
Date: 2014-06-10 12:07:55 +0200 (Tue, 10 Jun 2014)
New Revision: 275
Modified:
pkg/RSiena/ChangeLog
pkg/RSiena/DESCRIPTION
pkg/RSiena/NAMESPACE
pkg/RSiena/R/Sienatest.r
pkg/RSiena/R/effectsDocumentation.r
pkg/RSiena/R/initializeFRAN.r
pkg/RSiena/R/phase2.r
pkg/RSiena/R/phase3.r
pkg/RSiena/R/print01Report.r
pkg/RSiena/R/print07Report.r
pkg/RSiena/R/siena01.r
pkg/RSiena/R/sienaDataCreate.r
pkg/RSiena/R/sienaGOF.r
pkg/RSiena/R/sienaRI.r
pkg/RSiena/R/sienaeffects.r
pkg/RSiena/R/sienaprint.r
pkg/RSiena/R/sienatable.r
pkg/RSiena/R/simstatsc.r
pkg/RSiena/inst/doc/RSiena.bib
pkg/RSiena/inst/doc/RSiena_Manual.pdf
pkg/RSiena/inst/doc/RSiena_Manual.tex
pkg/RSiena/man/RSiena-package.Rd
pkg/RSiena/man/getEffects.Rd
pkg/RSiena/man/includeEffects.Rd
pkg/RSiena/man/setEffect.Rd
pkg/RSiena/man/sienaAlgorithmCreate.Rd
pkg/RSiena/man/sienaCompositionChange.Rd
pkg/RSiena/man/sienaGOF.Rd
pkg/RSiena/man/sienaRI.Rd
pkg/RSiena/src/Makevars
pkg/RSiena/src/Makevars.win
pkg/RSiena/src/model/StatisticCalculator.cpp
pkg/RSiena/src/model/StatisticCalculator.h
pkg/RSiena/src/network/CommonNeighborIterator.cpp
pkg/RSiena/src/network/CommonNeighborIterator.h
pkg/RSiena/src/network/Network.cpp
pkg/RSiena/src/network/OneModeNetwork.cpp
pkg/RSiena/src/siena07models.cpp
pkg/RSiena/tests/parallel.Rout.save
pkg/RSienaTest/ChangeLog
pkg/RSienaTest/DESCRIPTION
pkg/RSienaTest/NAMESPACE
pkg/RSienaTest/R/document.r
pkg/RSienaTest/R/effectsMethods.r
pkg/RSienaTest/R/initializeFRAN.r
pkg/RSienaTest/R/phase2.r
pkg/RSienaTest/R/phase3.r
pkg/RSienaTest/R/print07Report.r
pkg/RSienaTest/R/siena01.r
pkg/RSienaTest/R/sienaBayes.r
pkg/RSienaTest/R/sienaeffects.r
pkg/RSienaTest/R/sienaprint.r
pkg/RSienaTest/inst/doc/RSiena_Manual.pdf
pkg/RSienaTest/inst/doc/RSiena_Manual.tex
pkg/RSienaTest/man/RSiena-package.Rd
pkg/RSienaTest/man/includeEffects.Rd
pkg/RSienaTest/man/print.sienaBayesFit.Rd
pkg/RSienaTest/man/setEffect.Rd
pkg/RSienaTest/man/sienaBayes.Rd
pkg/RSienaTest/src/siena07utilities.cpp
Log:
Modified: pkg/RSiena/ChangeLog
===================================================================
--- pkg/RSiena/ChangeLog 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/ChangeLog 2014-06-10 10:07:55 UTC (rev 275)
@@ -1,3 +1,23 @@
+2014-06-02 R-Forge Revision 276
+Changes in RSiena and RSienaTest:
+ * Higher writefreq for batch operation (phase2.r, phase3.r)
+ * Error check for name of dependent variable to condition upon (initializeFRAN.r)
+ * Some corrections to account for behavior dependent variables that are not
+ coded as integer (in initializeFRAN and unpackBehavior, initializeFRAN.r)
+ * Parameters fix and test now used in includeEffects() (sienaeffects.r)
+ * Small bug fix in CalculateDerivative3 (phase3.r)
+Changes in RSienaTest:
+ * Changes in sienaBayes.r and its print and summary methods;
+ new function glueBayes.
+
+2014-05-05 R-Forge Revision 275
+Changes in RSiena and RSienaTest:
+ * Error message and stop in case of mismatch variable names
+ in algorithm object and in data (initializeFRAN.r).
+ * Force behavior and its attribute "change" to be integer in function
+ unpackBehavior() (initializeFRAN.r).
+ * Some tabs in .Rd files change to spaces.
+
2014-04-26 R-Forge Revision 274
Changes in RSiena and RSienaTest:
* Replaced (!strcmp...) by (!(strcmp...)) one more time
@@ -7,7 +27,7 @@
Changes in RSiena and RSienaTest:
* NAMESPACE: removed entries sienaRIDynamics with the corresponding
print, summary, and plot methods (to be entered later when
- problems have been solved).
+ problems have been solved).
* Removed sienaRIDynamics.Rd (ditto).
* Some changes in sienaRIDynamics.r but not enough to make it work.
* Duplication of outInv and outSqInv effects for two-mode networks
@@ -24,7 +44,7 @@
Changes in RSiena and RSienaTest:
* sienaRIDynamics.Rd: added
* sienaRIDynamics.r: small changes
- * NAMESPACE: added entries sienaRIDynamics with the corresponding
+ * NAMESPACE: added entries sienaRIDynamics with the corresponding
print, summary, and plot methods.
2014-04-17 R-Forge Revision 271
@@ -45,7 +65,7 @@
* Changes of version 1.1.268 in sienaRIDynamics ported from RSiena to RSienaTest.
* Small changes in sienaRI.r.
* sienaRI.Rd ported from RSiena to RSienaTest, with small changes.
- * NAMESPACE: added entry sienaRI with the corresponding
+ * NAMESPACE: added entry sienaRI with the corresponding
print, summary, and plot methods.
* sienaBayes.r, sienaprint.r: updates to let sienaBayes.r accept
a wider range of data and models (e.g., user-defined interactions).
@@ -54,8 +74,8 @@
* Small changes in sienaRI.r and sienaRI.Rd.
Changes in RSiena and RSienaTest:
* sienaDataCreate.r, sienautils.r, print01Report.r:
- In coDyadCovar() and varDyadCovar(), centering now also is optional by the
- new option "centered" (like it was done for coCovar() and varCovar()
+ In coDyadCovar() and varDyadCovar(), centering now also is optional by the
+ new option "centered" (like it was done for coCovar() and varCovar()
in revision 1.1-251).
* sienaprint.r: correct bug when printing siena object with symmetric network.
* varDyadCovar: repaired bug occurring when calling it with a named list.
@@ -64,7 +84,7 @@
Changes in RSiena:
* sienaRI.Rd: added
* sienaRIDynamics.r: bugfix
- * NAMESPACE: added entries sienaRI and sienaRIDynamics with the corresponding
+ * NAMESPACE: added entries sienaRI and sienaRIDynamics with the corresponding
print, summary, and plot methods.
2014-03-30 R-Forge Revision 267
@@ -74,33 +94,33 @@
* sienaRIDynamics.r: new
Changes in RSiena and RSienaTest:
* Model.cpp: bugfix
-
+
2014-03-17 R-Forge Revision 266
Changes in RSiena and RSienaTest:
- * getTargets.r: Added actorTargets function for use with multiple imputation
+ * getTargets.r: Added actorTargets function for use with multiple imputation
of behaviour variable.
* sienaModelCreate.r, initializeFRAN.r, setup07setup.cpp, Model.cpp, Model.h,
MLSimulation.cpp, MLSimulation.h: added localML option to sienaAlgorithm.
* allEffects.csv: added "local" column for use with localML option.
2014-03-14 R-Forge Revisions 261-265
-Changes in RSiena: Included exactly the same changes in RSiena
+Changes in RSiena: Included exactly the same changes in RSiena
as have been included in RSienaTest in Revision 255
2014-03-14 R-Forge Revisions 255-260
Changes in RSienaTest:
- * Modified getTargets(...) such that it is possible to return target statistics of individual actors
+ * Modified getTargets(...) such that it is possible to return target statistics of individual actors
as well as change contributions necessary for calculating relative importances of effects (siena07setup.cpp).
* Call of getTargets(...) is correspondingly adapted (initializeFRAN.r).
- * Modified simstats0c(...) such that it is possible to return
- statistics of individual actors in simulated networks
+ * Modified simstats0c(...) such that it is possible to return
+ statistics of individual actors in simulated networks
as well as statistic contributions of all potential tie flips or behavior changes
for all simulated micro-steps (simstatsc.r).
* Modified model(...) such that it calculates and returns the statistics newly needed in
simstats0c(...) (siena07model.cpp)
* Added methods, functions, constructors, and fields needed due to changes in getTargets(...) and model(...):
public void needChangeContributions(bool flag) (Model.h, Model.cpp)
- public bool needChangeContributions() (Model.h, Model.cpp)
+ public bool needChangeContributions() (Model.h, Model.cpp)
private bool lneedChangeContributions2 (Model.h)
SEXP getChangeContributionsList(...) (siena07utilities.h, siena07utilities.cpp)
SEXP createRObjectAttributes(...) (siena07utilities.h, siena07utilities.cpp)
@@ -109,7 +129,7 @@
public StatisticCalculator(..., bool) (StatisticCalculator.h, StatisticCalculator.cpp)
public StatisticCalculator(..., bool, bool) (StatisticCalculator.h, StatisticCalculator.cpp)
public vector<double *> staticChangeContributions(...) (StatisticCalculator.h, StatisticCalculator.cpp)
- public double * actorStatistics(...) (StatisticCalculator.h, StatisticCalculator.cpp)
+ public double * actorStatistics(...) (StatisticCalculator.h, StatisticCalculator.cpp)
private bool lneedActorStatistics (StatisticCalculator.h, StatisticCalculator.cpp)
private bool lcountStaticChangeContributions (StatisticCalculator.h, StatisticCalculator.cpp)
private map<EffectInfo *, double * > lactorStatistics (StatisticCalculator.h, StatisticCalculator.cpp)
@@ -124,10 +144,10 @@
private map<const EffectInfo *, vector<double> > * lpChangeContributions (MiniStep.h, MiniStep.cpp)
public map<const EffectInfo *, vector<double> >* changeContributions() (MiniStep.h, MiniStep.cpp)
public void changeContributions(map<const EffectInfo *, vector<double> > * contributions) (MiniStep.h, MiniStep.cpp)
- * Added field to class DependentVariable (DependentVariable.h, DependentVariable.cpp)
+ * Added field to class DependentVariable (DependentVariable.h, DependentVariable.cpp)
protected map<const EffectInfo *, vector<double> > * lpChangeContribution;
- * Modifications of functions makeChange() and calculateTieFlipProbabilities()
- in class NetworkVariable (NetworkVariable.cpp)
+ * Modifications of functions makeChange() and calculateTieFlipProbabilities()
+ in class NetworkVariable (NetworkVariable.cpp)
calculateProbabilities(), totalEvaluationContribution(), totalEndowmentContribution(), and totalCreationContribution()
in class BehaviorVariable (BehaviorVariable.cpp)
in order to store statistic contributions of effects to all possible choices od an actor in the current micro-step
@@ -137,7 +157,7 @@
public virtual pair <double, double * > evaluationStatistic(...,bool needActorStatistics)
public virtual pair <double, double * > endowmentStatistic(..., bool needActorStatistics)
public virtual pair <double, double * > creationStatistic(..., bool needActorStatistics)
-
+
2014-02-17 R-Forge Revision 254
Changes in RSiena and RSienaTest:
* Give the capital P to HomCovariateMixedTwoPathFunction.cpp
@@ -199,7 +219,7 @@
* Error occurrence with message about cvalue in EvaluateTestStatistic
corrected (Sienatest.r).
* Divergent parameters in siena07() get NA for their rows and columns
- in the covariance matrix (function phase3.2 in phase3.r).
+ in the covariance matrix (function phase3.2 in phase3.r).
The following changes in revision 244 were ported from RSienaTest to RSiena:
* In siena08, also report Bonferroni combination
of the two Fisher combinations.
@@ -209,8 +229,8 @@
* Minor changes of output in siena.table, print07Report.r, print.siena,
printInitialDescription.r, and in error message for includeEffects.
* Change artificial results from 999 to NA (robmon.r, phase3.r)
- * For ML estimation: added autocorrelations during phase 3
- to print.summary.sienaFit (sienaprint.r)
+ * For ML estimation: added autocorrelations during phase 3
+ to print.summary.sienaFit (sienaprint.r)
2013-11-29 R-Forge Revision 249
Changes in RSiena and RSienaTest:
@@ -237,8 +257,8 @@
2013-10-16 R-Forge Revision 245
Changes in RSienaTest:
* New structural rate effect outRateLog
- (allEffects.csv, StatisticCalculator.cpp, DependentVariable.cpp,
- siena07Internals.cpp, StructuralRateEffect.cpp, Utils.h, Utils.cpp,
+ (allEffects.csv, StatisticCalculator.cpp, DependentVariable.cpp,
+ siena07Internals.cpp, StructuralRateEffect.cpp, Utils.h, Utils.cpp,
RSiena_Manual.tex).
* In siena08, also report Bonferroni combination
of the two Fisher combinations.
@@ -249,7 +269,7 @@
* Minor changes of output in siena.table, print07Report.r, print.siena,
printInitialDescription.r, and in error message for includeEffects.
* Change artificial results from 999 to NA (robmon.r, phase3.r)
- * For ML estimation: added autocorrelations during phase 3
+ * For ML estimation: added autocorrelations during phase 3
to print.summary.sienaFit (sienaprint.r)
* Small addition to siena_Algorithms4.tex (statistics for rate effects).
* Bit of cleaning up (phase3.r)
Modified: pkg/RSiena/DESCRIPTION
===================================================================
--- pkg/RSiena/DESCRIPTION 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/DESCRIPTION 2014-06-10 10:07:55 UTC (rev 275)
@@ -1,13 +1,13 @@
Package: RSiena
Type: Package
Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.1-274
-Date: 2014-04-26
+Version: 1.1-276
+Date: 2014-06-02
Author: Ruth Ripley, Krists Boitmanis, Tom A.B. Snijders
Depends: R (>= 2.15.0)
Imports: Matrix
Suggests: tcltk, network, codetools, lattice, MASS, parallel,
- xtable, tools
+ xtable, tools, utils
SystemRequirements: GNU make, tcl/tk 8.5, Tktable
Maintainer: Tom A.B. Snijders <tom.snijders at nuffield.ox.ac.uk>
Description: Fits models to longitudinal network data
Modified: pkg/RSiena/NAMESPACE
===================================================================
--- pkg/RSiena/NAMESPACE 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/NAMESPACE 2014-06-10 10:07:55 UTC (rev 275)
@@ -2,11 +2,11 @@
export(coCovar, coDyadCovar, getEffects, model.create, print01Report,
siena01Gui, siena07, sienaCompositionChange, 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,
- installGui, siena08, iwlsm, sienaTimeTest, includeTimeDummy,
+ installGui, siena08, iwlsm, sienaTimeTest, includeTimeDummy,
sienaGOF, descriptives.sienaGOF, sienaRI, sparseMatrixExtraction,
networkExtraction, behaviorExtraction,
OutdegreeDistribution, IndegreeDistribution, BehaviorDistribution,
Modified: pkg/RSiena/R/Sienatest.r
===================================================================
--- pkg/RSiena/R/Sienatest.r 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/R/Sienatest.r 2014-06-10 10:07:55 UTC (rev 275)
@@ -265,23 +265,23 @@
}
else
{
- cvalue <- t(ov) %*% vav %*% ov
- if (cvalue < 0) cvalue <- 0
- if (sum(test) == 1)
- {
- if (vav > 0)
- oneSided <- ov * sqrt(vav)
- else
- oneSided <- 0
- if (!maxlike) oneSided <- - oneSided
- ## change the sign for intuition for users
- }
- else
- {
- oneSided <- 0
- }
+ cvalue <- t(ov) %*% vav %*% ov
+ if (cvalue < 0) cvalue <- 0
+ if (sum(test) == 1)
+ {
+ if (vav > 0)
+ oneSided <- ov * sqrt(vav)
+ else
+ oneSided <- 0
+ if (!maxlike) oneSided <- - oneSided
+ ## change the sign for intuition for users
+ }
+ else
+ {
+ oneSided <- 0
+ }
+ }
}
- }
list(cvalue=cvalue, oneSided=oneSided, covMatrix=v9)
}
Modified: pkg/RSiena/R/effectsDocumentation.r
===================================================================
--- pkg/RSiena/R/effectsDocumentation.r 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/R/effectsDocumentation.r 2014-06-10 10:07:55 UTC (rev 275)
@@ -12,11 +12,11 @@
##@effectsDocumentation Documentation
effectsDocumentation <- function(effects= NULL, type="html",
display=(type=="html"),
- filename=ifelse(is.null(effects), "effects", deparse(substitute(effects))))
+ filename=ifelse(is.null(effects), "effects", deparse(substitute(effects))))
{
if (is.null(effects))
{
- x <- allEffects[, c("effectGroup", "effectName", "shortName",
+ x <- allEffects[, c("effectGroup", "effectName", "shortName",
"endowment", "interaction1", "interaction2",
"parm", "interactionType")]
}
Modified: pkg/RSiena/R/initializeFRAN.r
===================================================================
--- pkg/RSiena/R/initializeFRAN.r 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/R/initializeFRAN.r 2014-06-10 10:07:55 UTC (rev 275)
@@ -192,6 +192,14 @@
if (x$condname != "")
{
z$condvarno <- match(x$condname, attr(data, "netnames"))
+ if (is.na(z$condvarno))
+ {
+ cat("\nNo match between variable name in algorithm object\n")
+ cat("and those in data set.\n")
+ cat("Algorithm object: ", x$condname, "\n")
+ cat("Data set: ", attr(data, "netnames"), "\n")
+ stop("Incorrect variable name.\n")
+ }
z$condname <- x$condname
}
else
@@ -277,8 +285,8 @@
if (z$cconditional)
{
attr(f, "change") <-
- sapply(f, function(xx)attr(xx$depvars[[z$condname]],
- "distance"))
+ sapply(f, function(xx)as.integer(attr(xx$depvars[[z$condname]],
+ "distance")))
attr(f,"condEffects") <- requestedEffects[z$condvar,]
effcondvar <-
(1:nrow(effects))[effects$name==
@@ -546,6 +554,8 @@
ans <- .Call("setupModelOptions", PACKAGE=pkgname,
pData, pModel, MAXDEGREE, CONDVAR, CONDTARGET,
profileData, z$parallelTesting, x$modelType, z$simpleRates)
+# Here came an error
+# Error: INTEGER() can only be applied to a 'integer', not a 'double'
if (x$maxlike)
{
if (!initC)
@@ -589,7 +599,7 @@
if (z$localML & any(!local))
{
- stop("Non-local effect chosen.")
+ stop("Non-local effect chosen.")
}
z$probs <- c(x$pridg, x$prcdg, x$prper, x$pripr, x$prdpr, x$prirms,
@@ -1488,7 +1498,8 @@
##@unpackBehavior siena07 Reformat data for C++
unpackBehavior<- function(depvar, observations)
{
- beh <- depvar[, 1, ]
+ dimdv <- dim(depvar[,1,])
+ beh <- matrix(as.integer(depvar[, 1, ]), dimdv[1], dimdv[2])
behmiss <- is.na(beh)
allna <- apply(beh, 1, function(x)all(is.na(x)))
modes <- attr(depvar, "modes")
Modified: pkg/RSiena/R/phase2.r
===================================================================
--- pkg/RSiena/R/phase2.r 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/R/phase2.r 2014-06-10 10:07:55 UTC (rev 275)
@@ -231,6 +231,11 @@
z$writefreq <- 20
}
z$writefreq <- roundfreq(z$writefreq)
+ if (is.batch())
+ {
+ z$writefreq <- z$writefreq * 10 ##compensation for it
+ ## running faster with no tcl/tk
+ }
}
if ((z$nit <= 10) || (z$nit %% z$writefreq ==0))
{
@@ -322,7 +327,7 @@
DisplayThetaAutocor(z)
}
}
- ## limit change. Reporting is delayed to end of phase.
+## limit change. Reporting is delayed to end of phase.
# The truncation has been different from version 1.1-227 to 1.1-243,
# due to a misunderstanding.
# In version 1.1-244 it was changed back to the old Siena 3 way.
Modified: pkg/RSiena/R/phase3.r
===================================================================
--- pkg/RSiena/R/phase3.r 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/R/phase3.r 2014-06-10 10:07:55 UTC (rev 275)
@@ -71,7 +71,7 @@
writefreq <- z$writefreq
if (is.null(z$writefreq))
{
- z$writefreq <- 10
+ z$writefreq <- 20
}
z <- doPhase1or3Iterations(3, z, x, zsmall, xsmall, nits, 0, nits11,
writefreq)
@@ -319,7 +319,9 @@
CalculateDerivative3<- function(z,x)
{
z$mnfra <- colMeans(z$sf)
- estMeans <- z$mnfra + z$targets
+ estMeans <- z$mnfra + z$targets
+ z$regrCoef <- rep(0, z$pp)
+ z$regrCor <- rep(0, z$pp)
if (z$FinDiff.method || x$maxlike)
{
dfra <- t(as.matrix(Reduce("+", z$sdf) / length(z$sdf)))
@@ -346,10 +348,9 @@
z$regrCoef[i] <- cov(z$sf[,i], scores[,i])/var(scores[,i])
z$regrCor[i] <- cor(z$sf[,i], scores[,i])
}
- }
+ }
if (x$dolby)
{
-# mean.scores <- colMeans(scores)
estMeans <- estMeans - (z$regrCoef * colMeans(scores))
}
Report('Correlations between scores and statistics:\n', cf)
@@ -519,7 +520,7 @@
}
if (is.batch())
{
- z$writefreq <- z$writefreq * 2 ##compensation for it
+ z$writefreq <- z$writefreq * 5 ##compensation for it
## running faster with no tcl/tk
}
z$writefreq <- roundfreq(z$writefreq)
Modified: pkg/RSiena/R/print01Report.r
===================================================================
--- pkg/RSiena/R/print01Report.r 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/R/print01Report.r 2014-06-10 10:07:55 UTC (rev 275)
@@ -541,11 +541,11 @@
{
if (any.noncent <= 0)
{
- Report(c("The mean value", ifelse(nCovars == 1, " is", "s are"),
+ Report(c("The mean value", ifelse(nCovars == 1, " is", "s are"),
" subtracted from the",
ifelse(nCovars == 1, " centered", ""), " covariate",
- ifelse(nCovars == 1, ".\n\n", "s.\n\n")), sep="", outf)
- }
+ ifelse(nCovars == 1, ".\n\n", "s.\n\n")), sep="", outf)
+ }
else if (any.cent >= 1)
{
s.plural <- ""
@@ -754,8 +754,8 @@
Report(c("The mean value", ifelse(nCovars == 1, " is", "s are"),
" subtracted from the",
ifelse(nCovars == 1, " centered", ""), " covariate",
- ifelse(nCovars == 1, ".\n\n", "s.\n\n")), sep="", outf)
- }
+ ifelse(nCovars == 1, ".\n\n", "s.\n\n")), sep="", outf)
+ }
else if (any.cent >= 1)
{
Report(c("For the centered variable", s.plural,
@@ -842,11 +842,11 @@
if (any.noncent <= 0)
{
Report(c("The mean value",
- ifelse(nCovars == 1, " is ", "s are "),
+ ifelse(nCovars == 1, " is", "s are"),
" subtracted from the",
ifelse(nCovars == 1, " centered", ""), " covariate",
- ifelse(nCovars ==1, ".\n\n", "s.\n\n")), sep="", outf)
- }
+ ifelse(nCovars == 1, ".\n\n", "s.\n\n")), sep="", outf)
+ }
else if (any.cent >= 1)
{
Report(c("For the centered variable", s.plural,
@@ -1008,22 +1008,22 @@
periodFromStart <- periodFromStart + data[[i]]$observations
}
Report("\n", outf)
- if (length(atts$vCovars) == 1)
+ if (length(atts$vCovars) == 1)
{
Report(c("The overall mean value ",
- format(round(atts$vCovarMean, 4), nsmall=3, width=12),
- " is subtracted from covariate ", atts$vCovars,
+ format(round(atts$vCovarMean, 4), nsmall=3, width=12),
+ " is subtracted from covariate ", atts$vCovars,
".\n\n"), sep="", outf)
}
- else if (length(atts$vCovars) >= 2)
+ else if (length(atts$vCovars) >= 2)
{
Report(c("The mean values are subtracted from the covariates:\n"), outf)
for (i in seq(along=atts$vCovars))
{
- Report(c(format(atts$vCovars[i], width=15),
+ Report(c(format(atts$vCovars[i], width=15),
format(round(atts$vCovarMean[i], 4), nsmall=3, width=12), '\n'), outf)
}
- }
+ }
}
periodNos <- attr(data, "periodNos")
if (any(atts$anyUpOnly[nets]))
Modified: pkg/RSiena/R/print07Report.r
===================================================================
--- pkg/RSiena/R/print07Report.r 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/R/print07Report.r 2014-06-10 10:07:55 UTC (rev 275)
@@ -176,7 +176,7 @@
Report('Estimated means and standard deviations, standard errors of the mean \n', bof)
Report('Estimated means and standard deviations, standard errors of the mean \n', outf)
dmsf <- diag(z$msf)
-# sf and cov.dev may be dropped - just for now (07-10-13) I keep them in
+# sf and cov.dev may be dropped - just for now (07-10-13) I keep them in
# sf <- colMeans(z$sf)
mean.stats <- colMeans(z$sf) + z$targets
# cov.dev <- z$msf
Modified: pkg/RSiena/R/siena01.r
===================================================================
--- pkg/RSiena/R/siena01.r 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/R/siena01.r 2014-06-10 10:07:55 UTC (rev 275)
@@ -517,7 +517,8 @@
{
effEdit[,i] <- as.numeric(effEdit[,i])
}
- effEdit <- utils:::edit.data.frame(effEdit, edit.row.names=FALSE)
+ effEdit <- utils::edit(effEdit, edit.row.names=FALSE)
+ # was utils:::edit.data.frame
for (i in c("include", "fix", "test"))
{
effEdit[,i] <- as.logical(effEdit[,i])
@@ -716,7 +717,8 @@
{
effEdit[,i] <- as.numeric(effEdit[,i])
}
- utils:::edit.data.frame(effEdit, edit.row.names=FALSE)
+ utils::edit(effEdit, edit.row.names=FALSE)
+ # was utils:::edit.data.frame
## tkfocus(tt)
## make sure this window is top with a global grab,
## but only for a second
Modified: pkg/RSiena/R/sienaDataCreate.r
===================================================================
--- pkg/RSiena/R/sienaDataCreate.r 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/R/sienaDataCreate.r 2014-06-10 10:07:55 UTC (rev 275)
@@ -22,7 +22,7 @@
nonMissingCount <- sum(!is.na(x))
if (attr(x, "centered"))
{
- x <- x - varmean
+ x <- x - varmean
}
else
{
@@ -65,7 +65,7 @@
attr(x, 'mean') <- varmean
if (attr(x, "centered"))
{
- x <- x - varmean
+ x <- x - varmean
}
else
{
@@ -1216,22 +1216,21 @@
attr(group[[i]]$vCovars[[j]], "nonMissingCount")
}
varmean <- vartotal / nonMissingCount
-#browser() # Hier kijken hoe je moet centreren in de groep.
- j <- match(atts$vCovars[covar], names(group[[1]]$vCovars))
+#browser() # Hier kijken hoe je moet centreren in de groep.
+ j <- match(atts$vCovars[covar], names(group[[1]]$vCovars))
if (attr(group[[1]]$vCovars[[j]],"centered"))
{
- for (i in 1:length(group))
- {
- j <- match(atts$vCovars[covar], names(group[[i]]$vCovars))
- if (is.na(j))
+ for (i in 1:length(group))
{
+ j <- match(atts$vCovars[covar], names(group[[i]]$vCovars))
+ if (is.na(j))
+ {
stop("inconsistent actor covariate names")
+ }
+ group[[i]]$vCovars[[j]] <- group[[i]]$vCovars[[j]] -
+ varmean
}
-
- group[[i]]$vCovars[[j]] <- group[[i]]$vCovars[[j]] -
- varmean
}
- }
simTotal <- 0
simCnt <- 0
anyMissing <- FALSE
Modified: pkg/RSiena/R/sienaGOF.r
===================================================================
--- pkg/RSiena/R/sienaGOF.r 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/R/sienaGOF.r 2014-06-10 10:07:55 UTC (rev 275)
@@ -817,7 +817,7 @@
}
X[is.na(X)] <- 0
drop0(X)
- }
+}
##@changeToNewStructural sienaGOF Utility to change
# values in X to structural values in SAfter
@@ -833,18 +833,17 @@
S1 <- (SA>SB)*Matrix(SAfter==11)
# the 1* turns the logical into numeric
X <- 1*((X - S0 + S1)>=1)
-}
+ }
X[is.na(X)] <- 0
drop0(X)
- }
+}
-
##@sparseMatrixExtraction sienaGOF Extracts simulated networks
# This function returns the simulated network as a dgCMatrix;
# this is the "standard" class for sparse numeric matrices
# in the Matrix package. See the help file for "dgCMatrix-class".
# Ties for ordered pairs with a missing value for wave=period or period+1
-# are zeroed;
+# are zeroed;
# note that this also is done in RSiena for calculation of target statistics.
# To obtain equality between observed and simulated tie values
# in the case of structurally determined values, the following is done.
@@ -932,8 +931,8 @@
returnValue <- changeToNewStructural(returnValue,
Matrix(obsData[[groupName]]$depvars[[varName]][,,period]),
Matrix(obsData[[groupName]]$depvars[[varName]][,,period+1]))
+ }
}
- }
## Zero missings (the 1* turns the logical into numeric):
1*drop0((returnValue - missings) > 0)
}
@@ -975,8 +974,8 @@
sparseMatrixNetwork <- as(matrixNetwork, "dgTMatrix")
# For dgTMatrix, slots i and j are the rows and columns,
# numbered from 0 to dimension - 1. Slot x are the values.
- # Actors in class network are numbered starting from 1.
- # Hence 1 must be added to missings at i and missings at j.
+# Actors in class network are numbered starting from 1.
+# Hence 1 must be added to missings at i and missings at j.
# sparseMatrixNetwork at x is a column of ones;
# the 1 in the 3d column of cbind below is redundant
# because of the default ignore.eval=TRUE in network.edgelist.
@@ -992,7 +991,7 @@
sparseMatrixNetwork at j + bipartiteOffset, 1),
emptyNetwork)
}
- returnValue
+ returnValue
}
##@behaviorExtraction sienaGOF Extracts simulated behavioral variables.
Modified: pkg/RSiena/R/sienaRI.r
===================================================================
--- pkg/RSiena/R/sienaRI.r 2014-04-26 16:33:37 UTC (rev 274)
+++ pkg/RSiena/R/sienaRI.r 2014-06-10 10:07:55 UTC (rev 275)
@@ -6,7 +6,7 @@
# * File: sienaRI.r
# *
# * Description: Used to determine, print, and plots relative importances of effects
-# * in for potential desicions of actors at observation moments.
+# * in for potential desicions of actors at observation moments.
# *****************************************************************************/
##@sienaRI. Use as RSiena:::sienaRI()
@@ -20,7 +20,7 @@
{
if (!inherits(ans, "sienaFit"))
{
- stop(paste("ans is not a legitimate Siena fit object", sep=""))
+ stop(paste("ans is not a legitimate Siena fit object", sep=""))
}
if(!is.null(algorithm)||!is.null(theta)||!is.null(effects))
{
@@ -40,7 +40,7 @@
if (!inherits(effects, "sienaEffects"))
{
stop(paste("effects is not a legitimate Siena effects object", sep=""))
- }
+ }
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")
@@ -54,9 +54,9 @@
{
if(length(theta) != sum(effs$include==TRUE))
{
- stop("theta is not a legitimate parameter vector \n number of parameters has to match number of effects")
+ stop("theta is not a legitimate parameter vector \n number of parameters has to match number of effects")
}
- warning("length of theta does not match the number of objective function effects\n theta is treated as if containing rate parameters")
+ warning("length of theta does not match the number of objective function effects\n theta is treated as if containing rate parameters")
paras <- theta
## all necessary information available
## call getChangeContributions
@@ -81,7 +81,7 @@
## is more or less copied from "getTargets" in "getTargets.r".
## However, some modifications have been necessary to get it to work.
f <- unpackData(data,algorithm)
-
+
effects <- effects[effects$include,]
if (!is.null(algorithm$settings))
{
@@ -108,28 +108,28 @@
pData,list(f$dycCovars))
ans<-.Call('ChangingDyadicCovariates',PACKAGE=pkgname,
pData, list(f$dyvCovars))
-
+
storage.mode(effects$parm) <- 'integer'
storage.mode(effects$group) <- 'integer'
storage.mode(effects$period) <- 'integer'
-
+
effects$effectPtr <- rep(NA, nrow(effects))
depvarnames <- names(data$depvars)
tmpeffects <- split(effects, effects$name)
myeffectsOrder <- match(depvarnames, names(tmpeffects))
ans <- .Call("effects", PACKAGE=pkgname, pData, tmpeffects)
pModel <- ans[[1]][[1]]
- for (i in 1:length(ans[[2]]))
+ for (i in 1:length(ans[[2]]))
{
effectPtr <- ans[[2]][[i]]
tmpeffects[[i]]$effectPtr <- effectPtr
- }
+ }
myeffects <- tmpeffects
for(i in 1:length(myeffectsOrder)){
myeffects[[i]]<-tmpeffects[[myeffectsOrder[i]]]
}
ans <- .Call("getTargets", PACKAGE=pkgname, pData, pModel, myeffects, parallelrun=TRUE, returnActorStatistics=FALSE, returnStaticChangeContributions=TRUE)
- ans
+ ans
}
expectedRelativeImportance <- function(conts, effects, theta, effectNames = NULL)
@@ -137,7 +137,7 @@
waves <- length(conts[[1]])
effects <- effects[effects$include == TRUE,]
noRate <- effects$type != "rate"
- effects <- effects[noRate,]
+ effects <- effects[noRate,]
if(sum(noRate)!=length(theta))
{
theta <- theta[noRate]
@@ -147,14 +147,14 @@
networkNames <- attr(conts,"networkNames")
networkTypes <- attr(conts,"networkTypes")
networkInteraction <- effects$interaction1
- effectIds <- paste(effectNa,effectTypes,networkInteraction, sep = ".")
-
- currentDepName <- ""
+ effectIds <- paste(effectNa,effectTypes,networkInteraction, sep = ".")
+
+ currentDepName <- ""
depNumber <- 0
for(eff in 1:length(effectIds))
{
if(networkNames[eff] != currentDepName)
- {
+ {
currentDepName <- networkNames[eff]
actors <- length(conts[[1]][[1]][[1]])
if(networkTypes[eff] == "oneMode")
@@ -165,17 +165,17 @@
}else{
stop("so far, sienaRI works only for dependent variables of type 'oneMode' or 'behavior'")
}
- depNumber <- depNumber + 1
+ depNumber <- depNumber + 1
currentDepEffs <- effects$name == currentDepName
effNumber <- sum(currentDepEffs)
-
+
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=".")
-
+
expectedRI <- list()
RIActors <- list()
absoluteSumActors <- list()
@@ -184,19 +184,19 @@
{
currentDepEffectContributions <- conts[[1]][[w]][currentDepEffs]
currentDepEffectContributions <- sapply(lapply(currentDepEffectContributions, unlist), matrix, nrow=actors, ncol=choices, byrow=TRUE, simplify="array")
-
+
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)})
-
+
entropy_vector <- unlist(lapply(distributions,function(x){entropy(x[1,])}))
## If one wishes another measure than the L^1-difference between distributions,
## here is the right place to call some new function instead of "L1D".
RIs_list <- lapply(distributions,function(x){L1D(x[1,], x[2:dim(x)[1],])})
RIs_matrix <-(matrix(unlist(RIs_list),nrow=effNumber, ncol=actors, byrow=F))
-
- RIs <- RIs_matrix
+
+ RIs <- RIs_matrix
entropies <- entropy_vector
-
+
RIActors[[w]] <- apply(RIs, 2, function(x){x/sum(x)})
absoluteSumActors[[w]] <- colSums(RIs)
entropyActors[[w]] <- entropies
@@ -225,14 +225,14 @@
}else{
RI[[depNumber]]<-RItmp
}
- }
+ }
}
if(depNumber>1)
{
- warning("more than one dependent variable\n return value is therefore not of class 'sienaRI'\n but a list of objects of class 'sienaRI'")
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rsiena -r 275
More information about the Rsiena-commits
mailing list