[Rsiena-commits] r306 - in pkg: . RSiena RSiena/R RSiena/data RSiena/man RSiena/src RSiena/src/data RSiena/src/model RSiena/src/model/effects RSiena/src/model/variables RSiena/tests RSienaTest RSienaTest/R RSienaTest/data RSienaTest/doc RSienaTest/man RSienaTest/src RSienaTest/src/data RSienaTest/src/model RSienaTest/src/model/effects RSienaTest/src/model/variables RSienaTest/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed May 10 17:32:05 CEST 2017
Author: tomsnijders
Date: 2017-05-10 17:32:04 +0200 (Wed, 10 May 2017)
New Revision: 306
Added:
pkg/RSiena/R/checkImpossibleChanges.r
pkg/RSiena/src/model/effects/BothDegreesEffect.cpp
pkg/RSiena/src/model/effects/BothDegreesEffect.h
pkg/RSienaTest/R/checkImpossibleChanges.r
pkg/RSienaTest/doc/RSienaArchitecture.png
pkg/init_cpp.R
Removed:
pkg/RSiena/.Rbuildignore
pkg/RSiena/Makefile
Modified:
pkg/RSiena/ChangeLog
pkg/RSiena/DESCRIPTION
pkg/RSiena/NAMESPACE
pkg/RSiena/R/effects.r
pkg/RSiena/R/effectsMethods.r
pkg/RSiena/R/initializeFRAN.r
pkg/RSiena/R/maxlike.r
pkg/RSiena/R/phase1.r
pkg/RSiena/R/phase2.r
pkg/RSiena/R/phase3.r
pkg/RSiena/R/printDataReport.r
pkg/RSiena/R/robmon.r
pkg/RSiena/R/siena08.r
pkg/RSiena/R/sienaGOF.r
pkg/RSiena/R/sienaModelCreate.r
pkg/RSiena/R/sienaTimeTest.r
pkg/RSiena/R/sienaeffects.r
pkg/RSiena/R/sienaprint.r
pkg/RSiena/data/allEffects.R
pkg/RSiena/data/allEffects.csv
pkg/RSiena/man/RSiena-package.Rd
pkg/RSiena/man/allEffects.Rd
pkg/RSiena/man/getEffects.Rd
pkg/RSiena/man/includeInteraction.Rd
pkg/RSiena/man/includeTimeDummy.Rd
pkg/RSiena/man/print.sienaMeta.Rd
pkg/RSiena/man/setEffect.Rd
pkg/RSiena/man/siena07.Rd
pkg/RSiena/man/siena08.Rd
pkg/RSiena/man/sienaAlgorithmCreate.Rd
pkg/RSiena/man/sienaTimeTest.Rd
pkg/RSiena/man/updateTheta.Rd
pkg/RSiena/src/data/BehaviorLongitudinalData.cpp
pkg/RSiena/src/data/BehaviorLongitudinalData.h
pkg/RSiena/src/data/NetworkLongitudinalData.cpp
pkg/RSiena/src/data/NetworkLongitudinalData.h
pkg/RSiena/src/model/EffectInfo.cpp
pkg/RSiena/src/model/EffectInfo.h
pkg/RSiena/src/model/EpochSimulation.cpp
pkg/RSiena/src/model/Model.cpp
pkg/RSiena/src/model/Model.h
pkg/RSiena/src/model/StatisticCalculator.cpp
pkg/RSiena/src/model/effects/AllEffects.h
pkg/RSiena/src/model/effects/AverageAlterEffect.cpp
pkg/RSiena/src/model/effects/AverageAlterEffect.h
pkg/RSiena/src/model/effects/BehaviorEffect.cpp
pkg/RSiena/src/model/effects/BehaviorEffect.h
pkg/RSiena/src/model/effects/CovariateAlterEffect.cpp
pkg/RSiena/src/model/effects/CovariateAlterEffect.h
pkg/RSiena/src/model/effects/CovariateDependentNetworkEffect.cpp
pkg/RSiena/src/model/effects/CovariateDependentNetworkEffect.h
pkg/RSiena/src/model/effects/CovariateDiffEffect.cpp
pkg/RSiena/src/model/effects/CovariateDiffEffect.h
pkg/RSiena/src/model/effects/CovariateEgoEffect.cpp
pkg/RSiena/src/model/effects/CovariateEgoEffect.h
pkg/RSiena/src/model/effects/DoubleInPopEffect.cpp
pkg/RSiena/src/model/effects/DoubleOutActEffect.cpp
pkg/RSiena/src/model/effects/EffectFactory.cpp
pkg/RSiena/src/model/effects/FourCyclesEffect.cpp
pkg/RSiena/src/model/effects/InteractionCovariateEffect.cpp
pkg/RSiena/src/model/effects/NetworkDependentBehaviorEffect.cpp
pkg/RSiena/src/model/effects/NetworkDependentBehaviorEffect.h
pkg/RSiena/src/model/effects/NetworkEffect.cpp
pkg/RSiena/src/model/effects/NetworkEffect.h
pkg/RSiena/src/model/variables/BehaviorVariable.cpp
pkg/RSiena/src/model/variables/BehaviorVariable.h
pkg/RSiena/src/model/variables/DependentVariable.cpp
pkg/RSiena/src/model/variables/DependentVariable.h
pkg/RSiena/src/model/variables/NetworkVariable.cpp
pkg/RSiena/src/model/variables/NetworkVariable.h
pkg/RSiena/src/siena07internals.cpp
pkg/RSiena/src/siena07setup.cpp
pkg/RSiena/src/siena07setup.h
pkg/RSiena/src/sources.list
pkg/RSiena/tests/parallel.R
pkg/RSienaTest/ChangeLog
pkg/RSienaTest/DESCRIPTION
pkg/RSienaTest/NAMESPACE
pkg/RSienaTest/R/CInterface.r
pkg/RSienaTest/R/algorithms.r
pkg/RSienaTest/R/effects.r
pkg/RSienaTest/R/effectsMethods.r
pkg/RSienaTest/R/initializeFRAN.r
pkg/RSienaTest/R/maxlike.r
pkg/RSienaTest/R/phase1.r
pkg/RSienaTest/R/phase2.r
pkg/RSienaTest/R/phase3.r
pkg/RSienaTest/R/printDataReport.r
pkg/RSienaTest/R/robmon.r
pkg/RSienaTest/R/siena07.r
pkg/RSienaTest/R/siena08.r
pkg/RSienaTest/R/sienaBayes.r
pkg/RSienaTest/R/sienaGOF.r
pkg/RSienaTest/R/sienaModelCreate.r
pkg/RSienaTest/R/sienaTimeTest.r
pkg/RSienaTest/R/sienaeffects.r
pkg/RSienaTest/R/sienaprint.r
pkg/RSienaTest/data/allEffects.csv
pkg/RSienaTest/doc/
pkg/RSienaTest/doc/RSiena.bib
pkg/RSienaTest/doc/RSiena_Manual.pdf
pkg/RSienaTest/doc/RSiena_Manual.tex
pkg/RSienaTest/doc/Siena_algorithms.tex
pkg/RSienaTest/man/CInterface.Rd
pkg/RSienaTest/man/RSiena-package.Rd
pkg/RSienaTest/man/getEffects.Rd
pkg/RSienaTest/man/includeInteraction.Rd
pkg/RSienaTest/man/includeTimeDummy.Rd
pkg/RSienaTest/man/print.sienaMeta.Rd
pkg/RSienaTest/man/setEffect.Rd
pkg/RSienaTest/man/siena07.Rd
pkg/RSienaTest/man/siena08.Rd
pkg/RSienaTest/man/sienaAlgorithmCreate.Rd
pkg/RSienaTest/man/sienaBayes.Rd
pkg/RSienaTest/man/sienaRI.Rd
pkg/RSienaTest/man/sienaTimeTest.Rd
pkg/RSienaTest/man/updateTheta.Rd
pkg/RSienaTest/src/data/BehaviorLongitudinalData.cpp
pkg/RSienaTest/src/data/BehaviorLongitudinalData.h
pkg/RSienaTest/src/data/NetworkLongitudinalData.cpp
pkg/RSienaTest/src/data/NetworkLongitudinalData.h
pkg/RSienaTest/src/model/EffectInfo.h
pkg/RSienaTest/src/model/EpochSimulation.cpp
pkg/RSienaTest/src/model/EpochSimulation.h
pkg/RSienaTest/src/model/Model.cpp
pkg/RSienaTest/src/model/Model.h
pkg/RSienaTest/src/model/State.cpp
pkg/RSienaTest/src/model/State.h
pkg/RSienaTest/src/model/StatisticCalculator.cpp
pkg/RSienaTest/src/model/StatisticCalculator.h
pkg/RSienaTest/src/model/effects/AllEffects.h
pkg/RSienaTest/src/model/effects/AverageAlterEffect.cpp
pkg/RSienaTest/src/model/effects/AverageAlterEffect.h
pkg/RSienaTest/src/model/effects/CovariateAlterEffect.cpp
pkg/RSienaTest/src/model/effects/CovariateAlterEffect.h
pkg/RSienaTest/src/model/effects/CovariateDependentNetworkEffect.cpp
pkg/RSienaTest/src/model/effects/CovariateDiffEffect.cpp
pkg/RSienaTest/src/model/effects/CovariateDiffEffect.h
pkg/RSienaTest/src/model/effects/CovariateEgoEffect.cpp
pkg/RSienaTest/src/model/effects/CovariateEgoEffect.h
pkg/RSienaTest/src/model/effects/DoubleInPopEffect.cpp
pkg/RSienaTest/src/model/effects/DoubleOutActEffect.cpp
pkg/RSienaTest/src/model/effects/EffectFactory.cpp
pkg/RSienaTest/src/model/effects/FourCyclesEffect.cpp
pkg/RSienaTest/src/model/effects/IndegreePopularityEffect.h
pkg/RSienaTest/src/model/effects/InteractionCovariateEffect.cpp
pkg/RSienaTest/src/model/effects/NetworkDependentBehaviorEffect.cpp
pkg/RSienaTest/src/model/effects/NetworkDependentBehaviorEffect.h
pkg/RSienaTest/src/model/effects/NetworkEffect.h
pkg/RSienaTest/src/model/effects/OutdegreeActivityEffect.h
pkg/RSienaTest/src/model/effects/OutdegreeActivitySqrtEffect.h
pkg/RSienaTest/src/model/variables/BehaviorVariable.cpp
pkg/RSienaTest/src/model/variables/BehaviorVariable.h
pkg/RSienaTest/src/model/variables/DependentVariable.cpp
pkg/RSienaTest/src/model/variables/DependentVariable.h
pkg/RSienaTest/src/model/variables/NetworkVariable.cpp
pkg/RSienaTest/src/model/variables/NetworkVariable.h
pkg/RSienaTest/src/siena07internals.cpp
pkg/RSienaTest/src/siena07setup.cpp
pkg/RSienaTest/src/sources.list
pkg/RSienaTest/tests/parallel.R
pkg/RSienaTest/tests/parallel.Rout.save
Log:
Version 1.1-306; lot of changes.
Deleted: pkg/RSiena/.Rbuildignore
===================================================================
--- pkg/RSiena/.Rbuildignore 2016-10-20 15:24:31 UTC (rev 305)
+++ pkg/RSiena/.Rbuildignore 2017-05-10 15:32:04 UTC (rev 306)
@@ -1,17 +0,0 @@
-^doc
-^RSienaTest_.*\.tar\.gz
-
-Makefile
-
-src/Makefile.profile
-src/SienaProfile\..*
-
-src/RMath.dll
-src/libpgSn.a
-
-tests/testrefs
-tests/effectsTest.R
-tests/slowtest.R
-tests/sampson.r
-
-inst/.*\.(log|bbl|blg|aux|out|toc|bak)
Modified: pkg/RSiena/ChangeLog
===================================================================
--- pkg/RSiena/ChangeLog 2016-10-20 15:24:31 UTC (rev 305)
+++ pkg/RSiena/ChangeLog 2017-05-10 15:32:04 UTC (rev 306)
@@ -1,4 +1,77 @@
-2016-10-13 R-Forge Revision 303
+In the future
+ * For networkModelType 3 (Initiative, AAGREE), an offset is added to the
+ confirmation model; for the moment, this is taken from UniversalOffset
+ in the algorithm object. This required only a change in
+ NetworkVariable::checkAlterAgreement; documented in Siena_algorithms.
+
+2017-05-10 R-Forge Revision 306
+Changes in RSiena and RSienaTest:
+ * Added updateSpecification (effectsMethods)
+ * New effects inPopX, outPopX, inActX, outActX, sameWXClosure, degPlus,
+ absDiffX, avAltPop, totAltPop, egoPlusAltX, egoPlusAltSqX,
+ egoRThresholdX, egoLThresholdX, altRThresholdX, altLThresholdX.
+ * New effect group covarABipNetObjective.
+ * outActIntn added to effect group nonSymmetricSymmetricObjective.
+ * outOutAss dropped for symmetric networks; only outInAss remains.
+ * egoX effect has interactionType='ego' also for symmetric networks.
+ * The exclusion in effects.r of effects if the variance of a covariate is 0,
+ or a covariate has only two values, is dropped (these effects have no meaning,
+ but their exclusion was a potential nuisance for meta-analyses).
+ * Description of gwespFB and gwespBF corrected (allEffects.csv and manual).
+ * includeInteraction has an additional parameter random.
+ * siena08 now also accepts a list for ...
+ * somewhat extended help page for siena08.
+ * Longer example in sienaTimeTest.Rd.
+ * Indication of effect parameters dropped in names for altInDist2 and
+ totInDist2 (they have no effect parameters).
+ * ModelType now is specific to the dependent variable:
+ given as a named integer vector in sienaAlgorithmCreate, defined in
+ Dependentvariable.h and NetworkVariable.h as networkModelType.
+ * ModelTypeStrings now is a function instead of a string vector.
+ * behModelType added
+ (sienaAlgorithmCreate, siena07setup.cpp, BehaviorLongitudinalData,
+ BehaviorVariable),
+ and enum type BehaviorModelType specified in BehaviorVariable.cpp.
+ * New option 'absorb' for behModelType=2.
+ * sienaAlgorithmCreate, siena07: new option lessMem, reducing storage in
+ siena07 by leaving out z$ssc and z$sf2; but these are used by
+ sienaTimeTest and sienaGOF, so running those functions will be impossible
+ for sienaFit object obtained with lessMem=TRUE.
+ * modified print.sienaAlgorithm: added behModelType, n2start.
+ * small cosmetic change print.siena.
+ * Modified check for singular covariance matrix (phase3.2 in phase3.r).
+ * Warning if includeEffects is used with parameter random.
+ * Warning for impossible or zero changes if maximum likelihood.
+ * siena07: z$phase1devs, z$phase1dfra, z$phase1sdf, z$phase1sdf2,
+ z$phase1scores, z$phase1accepts, z$phase1rejects, z$phase1aborts,
+ z$sfl, z$msfinv, z$sf.invcov dropped from object produced.
+ * Checks for named vectors in initializeFRAN made more systematic.
+ * Check of effects object in mlInit (maxlike.r) does not use
+ is.data.frame any more.
+Changes in RSiena:
+ * test13 dropped from parallel.R (using clusters undesirable
+ for basic testing).
+Changes in RSienaTest:
+ * sienaBayes:
+ various changes to save memory (thanks to Ruth Ripley);
+ lessMem=TRUE in operation of siena07;
+ z$candidates removed, place of storing z$acceptances changed;
+ improved report of groups with no changes;
+ warning for impossible changes;
+ if priorRatesFromData=2, change to different robust covariance matrix
+ estimator when this is necessary (i.e., for small number of groups);
+ in print.summary, also report nImproveMH;
+ a few lines added to help file.
+ * test14 dropped from parallel.R (using clusters undesirable for basic testing)
+ and replaced by a test using maxlike.
+
+2016-10-20 R-Forge Revision 305
+Changes in RSienaTest:
+ * BehaviorEffect, NetworkDependentBehaviorEffect, StatisticCalculator:
+ initialize() with simulated state for GMM.
+ * Other effects: Fix [-Wreorder] warings.
+
+2016-10-14 R-Forge Revision 304
Changes in RSiena and RSienaTest (George Vega Yon):
* tests/parallel.R: Changing makeForkCluster to makeCluster.
* man/siena07.Rd: Adding a description of the -cl- option + examples.
Modified: pkg/RSiena/DESCRIPTION
===================================================================
--- pkg/RSiena/DESCRIPTION 2016-10-20 15:24:31 UTC (rev 305)
+++ pkg/RSiena/DESCRIPTION 2017-05-10 15:32:04 UTC (rev 306)
@@ -1,8 +1,8 @@
Package: RSiena
Type: Package
Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.1-304
-Date: 2016-10-14
+Version: 1.1-306
+Date: 2017-05-10
Author: Ruth Ripley, Krists Boitmanis, Tom A.B. Snijders, Felix Schoenenberger
Depends: R (>= 2.15.0), utils
Imports: Matrix, tcltk, lattice, parallel, MASS, methods
Deleted: pkg/RSiena/Makefile
===================================================================
--- pkg/RSiena/Makefile 2016-10-20 15:24:31 UTC (rev 305)
+++ pkg/RSiena/Makefile 2017-05-10 15:32:04 UTC (rev 306)
@@ -1,115 +0,0 @@
-# Build System
-#
-# With the introduction of MPI and therfore the need of autoconf things got
-# little more complicated. This is a Makefile providing simple targets. Short
-# run down of the manual build system:
-#
-# 1. Running `autoconf` transforms 'configure.ac' to 'configure'. The
-# configure.ac/configure.win files contain the logic for MPI discovery.
-#
-# 2. Calling `R CMD INSTALL {pkg}` will run configure and make.
-#
-# 2.1 `configure` builds the 'Makevars' file from the 'Makevars.in' template
-# replacing Variables enclosed in '@'. This includes compiler and linker
-# flags (@PKG_CPPFLAGS@, @PKG_LIBS@) as well as the list of source files
-# (@PKG_SOURCES@) which is stored in the 'src/sources.list' file and
-# generated by this 'Makefile'.
-
-# High level targets for this file:
-#
-# clean
-# Remove temporary files.
-# build, check, install
-# Correspond the to `R CMD *` versions.
-# test_capture, test
-# Trigger the regression testing. regsave captures the state, regtest
-# tests against the saved state.
-
-# Parse DESCRIPTION file.
-PKG_VERSION := $(shell grep -i ^version DESCRIPTION | cut -d\ -f2-)
-PKG_REVISION := $(shell echo $(PKG_VERSION) | cut -d- -f2-)
-PKG_NAME := $(shell grep -i ^package DESCRIPTION | cut -d\ -f2-)
-PKG_DATE := $(shell grep -i ^date DESCRIPTION | cut -d\ -f2-)
-PKG_TARBALL := $(PKG_NAME)_$(PKG_VERSION).tar.gz
-PKG_IMPORTS := $(shell grep -i ^imports DESCRIPTION | cut -d\ -f2-)
-PKG_SUGGESTS := $(shell grep -i ^suggests DESCRIPTION | cut -d\ -f2-)
-
-# Actual source information.
-# SRC_REVISION := $(shell svn info --show-item revision)
-SRC_LIST = src/sources.list
-
-# Top level source files containing the R binding.
-SRC_BINDING = \
- siena07internals.cpp \
- siena07models.cpp \
- siena07setup.cpp \
- siena07utilities.cpp
-
-# Folders in src/ needed entirely.
-SRC_MODULES = data model network utils
-
-# R command settings.
-R = R
-R_RUN = $(R) -e
-R_BUILD = $(R) CMD build
-R_CHECK = $(R) CMD check --as-cran
-R_INSTALL = $(R) CMD INSTALL
-
-.PHONY:
-all: clean check
-
-.PHONY:
-clean:
-# ifeq ($(OS),Windows_NT)
-# sh ./cleanup.win
-# else
-# ./cleanup
-# endif
- -rm -rf $(PKG_NAME).Rcheck
- -rm -f $(PKG_TARBALL)
- -rm -f $(SRC_LIST)
-
-.PHONY:
-check: $(PKG_TARBALL)
- $(R_CHECK) $<
-
-.PHONY:
-install: $(PKG_TARBALL)
- $(R_INSTALL) $<
-
-.PHONY:
-build: $(PKG_TARBALL)
-$(PKG_TARBALL): configure $(SRC_LIST)
- $(R_BUILD) .
-
-.PHONY:
-commitchecks: # test
- # test $(PKG_REVISION) -eq $$(($(SRC_REVISION)+1)) # DESCRIPTION revision
- test $(PKG_DATE) = $$(date -I) # DESCRIPTION date
- chmod a+x configure cleanup # script permissions
-
-configure: configure.ac
- autoconf
-
-# build the list of source files
-$(SRC_LIST): $(shell find src -iname '*.cpp')
- echo -n "$(SRC_BINDING)" >$@
- cd src && find $(SRC_MODULES) -iname '*.cpp' -printf ' %p' >>$(@:src/%=%)
-
-# dependencies
-.PHONY:
-install_dep:
- $(R_RUN) "options(repos='http://stat.ethz.ch/CRAN');\
- pkgs <- c(strsplit('$(PKG_IMPORTS)', ', '), strsplit('$(PKG_SUGGESTS)', ', '));\
- for (pkg in pkgs) install.packages(pkg)"
-
-# regression tests
-.PHONY:
-test_capture:
- cd inst/unitTests && \
- $(R_RUN) "require($(PKG_NAME)); record_values <- T; RSienaTest:::run_tests(dir='.')"
-
-.PHONY:
-test:
- cd inst/unitTests && \
- $(R_RUN) "require($(PKG_NAME)); RSienaTest:::run_tests(dir='.')"
Modified: pkg/RSiena/NAMESPACE
===================================================================
--- pkg/RSiena/NAMESPACE 2016-10-20 15:24:31 UTC (rev 305)
+++ pkg/RSiena/NAMESPACE 2017-05-10 15:32:04 UTC (rev 306)
@@ -1,7 +1,7 @@
-useDynLib(RSiena)
+useDynLib(RSiena, .registration = TRUE)
export(coCovar, coDyadCovar, getEffects, model.create, print01Report,
siena07, sienaCompositionChange, updateTheta,
- sienaCompositionChangeFromFile, sienaDataCreate,
+ updateSpecification, sienaCompositionChangeFromFile, sienaDataCreate,
sienaGroupCreate, sienaModelCreate, sienaAlgorithmCreate, sienaNet,
sienaDependent, sienaNodeSet, xtable.sienaFit,
varCovar, varDyadCovar, setEffect, includeEffects, includeInteraction,
Added: pkg/RSiena/R/checkImpossibleChanges.r
===================================================================
--- pkg/RSiena/R/checkImpossibleChanges.r (rev 0)
+++ pkg/RSiena/R/checkImpossibleChanges.r 2017-05-10 15:32:04 UTC (rev 306)
@@ -0,0 +1,68 @@
+##/*****************************************************************************
+## * SIENA: Simulation Investigation for Empirical Network Analysis
+## *
+## * Web: http://www.stats.ox.ac.uk/~snijders/siena
+## *
+## * File: checkImpossibleChanges.r
+## *
+## * Description: This file contains the function checkImpossibleChanges
+## * which checks for changes from structural values to
+## * different observed values.
+## * Used for maximum likelihood and Bayesian estimation.
+## *
+## ****************************************************************************/
+##args:x: Siena data object
+## returns 1*I{any structural zero changed to 1} +
+## 2*I{any structural one changed to 0} +
+## 10*I{any structural zero changed to NA} +
+##@checkImpossibleChanges checks for likelihood calculations
+checkImpossibleChanges <- function(x)
+{
+ if (!inherits(x,'siena'))
+ {
+ stop('checkImpossibleChanges can only be applied to siena data objects')
+ }
+ xd <- x$depvars
+ impossibleChangeOne <- function(dv)
+ {
+ ifelse((length(dim(dv))==3),
+ 1*any(sapply((2:dim(dv)[3]),
+ FUN=function(i){any((dv[,,i-1] == 10) &
+ (dv[,,i]==1), na.rm=TRUE)})), 0)
+ }
+ impossibleChangeZero <- function(dv)
+ {
+ ifelse((length(dim(dv))==3),
+ 1*any(sapply((2:dim(dv)[3]),
+ FUN=function(i){any((dv[,,i-1] == 11) &
+ (dv[,,i]==0), na.rm=TRUE)})), 0)
+ }
+ impossibleChangeNA <- function(dv)
+ {
+ ifelse((length(dim(dv))==3),
+ ifelse((dim(dv)[3] >= 3),
+ 1*any(sapply((3:dim(dv)[3]),
+ FUN=function(i){any(((dv[,,i-2] == 10) & (is.na(dv[,,i]))
+ (dv[,,i]==1)), na.rm=TRUE)})), 0), 0)
+ }
+ max(sapply(xd,impossibleChangeOne)) + 2*max(sapply(xd,impossibleChangeZero)) +
+ 10*max(sapply(xd,impossibleChangeNA))
+}
+
+
+##@checkZeroChanges checks for likelihood calculations
+checkZeroChanges <- function(x)
+{
+ if (!inherits(x,'siena'))
+ {
+ stop('checkZeroChanges can only be applied to siena data objects')
+ }
+ zeroChange <- function(dv){
+ dv[dv==10] <- 0
+ dv[dv==11] <- 1
+ ifelse((length(dim(dv))==3),
+ 1*any(sapply((2:dim(dv)[3]),
+ FUN=function(i){all(dv[,,i-1] == dv[,,i], na.rm = TRUE)})), 0)
+ }
+ sum(sapply(x$depvars,zeroChange))
+}
Property changes on: pkg/RSiena/R/checkImpossibleChanges.r
___________________________________________________________________
Added: svn:eol-style
+ native
Modified: pkg/RSiena/R/effects.r
===================================================================
--- pkg/RSiena/R/effects.r 2016-10-20 15:24:31 UTC (rev 305)
+++ pkg/RSiena/R/effects.r 2017-05-10 15:32:04 UTC (rev 306)
@@ -857,6 +857,46 @@
groupName=groupName, group=group,
netType=netType))
}
+ if (types[j] != "behavior") # other networks, irrespective of onemode/symmetric/twomode
+ {
+ for (k in seq(along=xx$cCovars))
+ {
+ if (attr(xx$cCovars[[k]], 'nodeSet') == nodeSets[1])
+ {
+ objEffects <-
+ rbind(objEffects,
+ createEffects("covarABipNetObjective", otherName,
+ names(xx$cCovars)[k], name=varname,
+ groupName=groupName, group=group,
+ netType=netType))
+ }
+ }
+ for (k in seq(along=xx$vCovars))
+ {
+ if (attr(xx$vCovars[[k]], 'nodeSet') == nodeSets[1])
+ {
+ objEffects <-
+ rbind(objEffects,
+ createEffects("covarABipNetObjective", otherName,
+ names(xx$vCovars)[k], name=varname,
+ groupName=groupName, group=group,
+ netType=netType))
+ }
+ }
+ for (k in seq(along=xx$depvars))
+ {
+ if (types[k] == 'behavior' &&
+ attr(xx$depvars[[k]], 'nodeSet') == nodeSets[1])
+ {
+ objEffects <-
+ rbind(objEffects,
+ createEffects("covarABipNetObjective", otherName,
+ names(xx$depvars)[k], name=varname,
+ groupName=groupName, group=group,
+ netType=netType))
+ }
+ }
+ }
}
if ((nOneModes + nBipartites) > 1) ## add the network name
{
@@ -926,7 +966,7 @@
netType=netType)
}
- if (!poszvar) # not (positive variance of z, or any z missing)
+ if (!tr & (!poszvar)) # not (positive variance of z, or any z missing)
{
if (symmetric)
{
@@ -941,10 +981,11 @@
c("egoX", "egoSqX"), ]
}
}
- if (!moreThan2)
+ if (!tr & (!moreThan2))
{
covObjEffects <-
- covObjEffects[!covObjEffects$shortName %in% c("altSqX"), ]
+ covObjEffects[!covObjEffects$shortName %in%
+ c("altSqX", "egoPlusAltSqX"), ]
}
list(objEff=covObjEffects, rateEff=covRateEffects)
@@ -964,15 +1005,16 @@
# restrict to covariates on first node set
covObjEffects <-
covObjEffects[covObjEffects$shortName %in%
- c("egoX", "egoSqX", "altInDist2", "totInDist2",
+ c("egoX", "egoSqX", "egoLThresholdX", "egoRThresholdX",
+ "altInDist2", "totInDist2",
"simEgoInDist2", "sameXInPop", "diffXInPop",
- "sameXCycle4"), ]
+ "sameXCycle4", "inPopX", "inActX"), ]
covRateEffects <- createEffects("covarBipartiteRate", covarname,
name=varname,
groupName=groupName, group=group,
netType=netType)
}
- else if (poszvar) # positive variance of z, or any z missing
+ else if (tr | poszvar) # positive variance of z, or any z missing
{
covObjEffects <- createEffects("covarBipartiteObjective", covarname,
name=varname,
@@ -981,8 +1023,10 @@
# restrict to covariates on second node set
covObjEffects <-
covObjEffects[covObjEffects$shortName %in%
- c("altX", "altSqX", "homXOutAct", "altXOutAct"), ]
- if (!moreThan2)
+ c("altX", "altSqX", "altLThresholdX", "altRThresholdX",
+ "homXOutAct", "altXOutAct",
+ "inActX", "outActX"), ]
+ if (!tr & (!moreThan2))
{
covObjEffects <-
covObjEffects[!covObjEffects$shortName %in% c("altSqX"), ]
@@ -1084,7 +1128,7 @@
##@covarNetNetEff internal getEffects
covarNetNetEff<- function(othernetname, covarname, nodeSetsj, nodeSetk, poszvar, name)
{
- if (poszvar) # positive variance of z, or any z missing
+ if (tr | poszvar) # positive variance of z, or any z missing
{
if (length(nodeSetsj) <= 1) ## second network onemode
{
@@ -1155,6 +1199,7 @@
{
groupx <- FALSE
}
+ tr <- TRUE; # supersedes restrictions by poszvar and moreThan2; 1.1-306
## validate the object?
## find the total number of periods to be processed = local var observations
## then process the first or only data object. Fill in starting values
Modified: pkg/RSiena/R/effectsMethods.r
===================================================================
--- pkg/RSiena/R/effectsMethods.r 2016-10-20 15:24:31 UTC (rev 305)
+++ pkg/RSiena/R/effectsMethods.r 2017-05-10 15:32:04 UTC (rev 306)
@@ -199,3 +199,79 @@
class(tmp) <- c("sienaEffects", class(tmp))
tmp
}
+
+##@updateSpecification Methods add specified effects from other effects object
+updateSpecification <- function(effects.to, effects.from, name.to=NULL, name.from=NULL)
+{
+ if (!inherits(effects.to, "data.frame"))
+ {
+ stop("effects.to is not a data.frame")
+ }
+ if (!inherits(effects.from, "data.frame"))
+ {
+ stop("effects.from is not a data.frame")
+ }
+ if (is.null(name.from))
+ {
+ prevEffects <-
+ effects.from[which((effects.from$type != 'gmm')&((effects.from$include))),]
+ }
+ else
+ {
+ if (!is.character(name.from))
+ {
+ stop("name.from should be a string")
+ }
+ prevEffects <-
+ effects.from[which((effects.from$type != 'gmm')&((effects.from$include))&
+ (effects.from$name == name.from)),]
+ }
+ oldlist <- apply(prevEffects, 1, function(x)
+ paste(x[c("name", "shortName",
+ "type", "groupName",
+ "interaction1", "interaction2",
+ "period", "effect1", "effect2", "effect3")],
+ collapse="|"))
+ efflist <- apply(effects.to, 1, function(x)
+ paste(x[c("name", "shortName",
+ "type", "groupName",
+ "interaction1", "interaction2",
+ "period", "effect1", "effect2", "effect3")],
+ collapse="|"))
+ if (!(is.null(name.to)))
+ {
+ if (!is.character(name.to))
+ {
+ stop("name.to should be a string")
+ }
+ else if (name.to == "all") # omit matching on "name"
+ {
+ oldlist <- apply(prevEffects, 1, function(x)
+ paste(x[c("shortName",
+ "type", "groupName",
+ "interaction1", "interaction2",
+ "period", "effect1", "effect2", "effect3")],
+ collapse="|"))
+ efflist <- apply(effects.to, 1, function(x)
+ paste(x[c("shortName",
+ "type", "groupName",
+ "interaction1", "interaction2",
+ "period", "effect1", "effect2", "effect3")],
+ collapse="|"))
+ }
+ }
+ use <- (efflist %in% oldlist)
+ correspondence <- match(efflist, oldlist)
+ if (!(is.null(name.to)))
+ {
+ if (name.to != "all")
+ {
+ use <- (use & (effects.to$name == name.to))
+ }
+ }
+ effects.to$include[use] <- TRUE
+ effects.to$fix[use] <- prevEffects$fix[correspondence][use]
+ effects.to$test[use] <- prevEffects$test[correspondence][use]
+ effects.to$parameter[use] <- prevEffects$parameter[correspondence][use]
+ effects.to
+}
\ No newline at end of file
Modified: pkg/RSiena/R/initializeFRAN.r
===================================================================
--- pkg/RSiena/R/initializeFRAN.r 2016-10-20 15:24:31 UTC (rev 305)
+++ pkg/RSiena/R/initializeFRAN.r 2017-05-10 15:32:04 UTC (rev 306)
@@ -15,6 +15,66 @@
returnDataFrame=FALSE, byWave=FALSE,
returnLoglik=FALSE, onlyLoglik=FALSE)
{
+##@checkNames used in initializeFRAN for siena07
+checkNames <- function(xx){
+# checks whether names of named vectors are in names of dependent variables,
+# and whether there are any names, or the vector has length 1.
+# For this check:
+# if there are no names, then (names(xx) %in% names(data$depvars))
+# will be logical(0), and all(logical(0)) is TRUE.
+ wrongName <- (((inherits(data, "sienaGroup")) &&
+ (!all(names(xx) %in% names(data[[1]]$depvars)))) ||
+ ((!inherits(data, "sienaGroup")) &&
+ (!all(names(xx) %in% names(data$depvars)))))
+ if ((!wrongName) && (length(xx) >= 2))
+ {
+ if (is.null(names(xx)))
+ {
+ wrongName <- TRUE
+ }
+ else
+ {
+ if (any(is.na(names(xx))))
+ {
+ wrongName <- TRUE
+ }
+ }
+ }
+ if (wrongName)
+ {
+ cat(deparse(substitute(xx)),
+ 'in the algorithm object x should be a named vector\n')
+ cat(' with only names of dependent variables in the data set.\n')
+ stop('Invalid algorithm-data combination.')
+ }
+ invisible(!wrongName)
+}
+
+##@withNames used in initializeFRAN for siena07
+withNames <- function(xx, types){
+ if (inherits(data, "sienaGroup"))
+ {
+ theVars <- sapply(data[[1]]$depvars, function(x){attr(x,'type') %in% types})
+ theVarNames <- names(data[[1]]$depvars)[theVars]
+ }
+ else
+ {
+ theVars <- sapply(data$depvars, function(x){attr(x,'type') %in% types})
+ theVarNames <- names(data$depvars)[theVars]
+ }
+ if (!(length(xx) %in% c(1, sum(theVars))))
+ {
+ cat('Lenght of',deparse(substitute(xx)),
+ 'should be equal to number of variables.\n')
+ stop('Invalid algorithm-data combination.')
+ }
+ xxx <- rep(1, sum(theVars)) * xx
+# this will work if length(xx)==1 but also if length(xx)==sum(theVars)
+ names(xxx) <- theVarNames
+ xxx
+}
+
+# start of initializeFRAN proper
z$effectsName <- deparse(substitute(effects))
## fix up the interface so can call from outside robmon framework
if (is.null(z$FinDiff.method))
@@ -57,7 +117,8 @@
bad <- which(!(userlist %in% deflist))
print(userlist[bad])
cat("invalid effect requested: see above; \n")
- stop("there seems to be a mismatch between data set and effects object.")
+ cat("there seems to be a mismatch between data set and effects object.\n")
+ stop("Perhaps the effects object must be created from scratch.")
}
}
if (!inherits(effects, "data.frame"))
@@ -73,15 +134,91 @@
}
effects$initialValue <- defaultEffects$initialValue
}
- if (((inherits(data, "sienaGroup")) &&
- (!all(names(x$MaxDegree) %in% names(data[[1]]$depvars)))) ||
- ((!inherits(data, "sienaGroup")) &&
- (!all(names(x$MaxDegree) %in% names(data$depvars)))))
+
+# Give names if they did not yet exist.
+ if (length(x$MaxDegree) == 1)
{
- cat(' MaxDegree in the algorithm should be a named vector\n')
- cat(' with only names of dependent variables in the data set.\n')
- stop('Invalid algorithm-data combination.')
+ x$MaxDegree <- withNames(x$MaxDegree, c('oneMode','bipartite'))
}
+ if (length(x$modelType) == 1)
+ {
+ x$modelType <- withNames(x$modelType, c('oneMode','bipartite'))
+ }
+ if (length(x$behModelType) == 1)
+ {
+ x$behModelType <- withNames(x$behModelType, 'behavior')
+ }
+ if (length(x$UniversalOffset) == 1)
+ {
+ x$UniversalOffset <- withNames(x$UniversalOffset, c('oneMode','bipartite'))
+ }
+# Check that the following attributes have correct or absent names
+ checkNames(x$MaxDegree)
+ checkNames(x$UniversalOffset)
+ checkNames(x$modelType)
+ checkNames(x$behModelType)
+ # The following error will occur if ML estimation is requested
+ # and there are any impossible changes from structural values
+ # to different observed values.
+ if (x$maxlike)
+ {
+ if (inherits(data, "sienaGroup"))
+ {
+ impossible <- FALSE
+ zerochange <- FALSE
+ imp.change <- lapply(data, checkImpossibleChanges)
+ if (sum(unlist(imp.change)) > 0)
+ {
+ cat('For some groups, there are impossible changes;\n')
+ cat('This occurs for groups\n', which(sapply(imp.change,
+ function(ic){(sum(ic) > 0)})),'\n')
+ impossible <- TRUE
+ }
+ z.changes <- sapply(data, checkZeroChanges)
+ if (sum(z.changes >= 1))
+ {
+ cat(' For some groups and some period, there is no change.\n')
+ cat('This occurs for groups ', which(sapply(z.changes,
+ function(zc){(zc > 0)})),'\n')
+ zerochange <- TRUE
+ }
+ }
+ else
+ {
+ imp.change <- checkImpossibleChanges(data)
+ if (imp.change %in% c(1,3))
+ {
+ cat('There are some changes from structural zero to observed 1.\n')
+ }
+ if (imp.change %in% c(2,3))
+ {
+ cat('There are some changes from structural one to observed 0.\n')
+ }
+ if (imp.change >= 4)
+ {
+ cat('There are some impossible changes between structural and observed values,\n')
+ cat('some through intermediary NA.\n')
+ }
+ impossible <- (imp.change > 0)
+ zerochange <- FALSE
+ z.changes <- checkZeroChanges(data)
+ if (sum(z.changes >= 1))
+ {
+ cat(' For some period, there is no change.\n')
+ zerochange <- TRUE
+ }
+ }
+ if (impossible || zerochange)
+ {
+ cat('This is not allowed for likelihood-based estimation.\n')
+ if (impossible)
+ {
+ cat('Possible remedies are: represent periods by multiple groups,\n')
+ cat('or change the offending values.\n')
+ }
+ stop('Impossible changes')
+ }
+ }
## get data object into group format to save coping with two
## different formats
if (inherits(data, "sienaGroup"))
@@ -110,10 +247,16 @@
# If all works, this can be deleted,
# and also the function addSettingsEffects can be deleted.
# I used this function as a template for the change to getEffects.
-# I wonder why the next line cannot be dropped;
+# I wonder why the next 8 lines cannot be dropped;
# gives error message "cannot find setting col".
- effects$setting <- rep("", nrow(effects))
-
+# if (!is.null(x$settings))
+# {
+# effects <- addSettingsEffects(effects, x)
+# }
+# else
+# {
+# effects$setting <- rep("", nrow(effects))
+# }
## find any effects not included which are needed for interactions
tmpEffects <- effects[effects$include, ]
interactionNos <- unique(c(tmpEffects$effect1, tmpEffects$effect2,
@@ -267,12 +410,13 @@
stop("Finite difference method for derivatives not available",
"with Maximum likelihood method")
}
- ## if any networks symmetric must use finite differences and not maxlike
- ## scores are now available (30.10.10) but still not maxlike.
+ ## maxlike not available for symmetric networks; or is it?.
## check model type: default for symmetric is type 2 (forcing model).
+ ## maxlike only for some model types?
syms <- attr(data,"symmetric")
z$FinDiffBecauseSymmetric <- FALSE
z$modelType <- x$modelType
+ z$behModelType <- x$behModelType
if (any(!is.na(syms) & syms))
{
## z$FinDiff.method <- TRUE
@@ -282,10 +426,9 @@
# stop("Maximum likelihood method not implemented",
# "for symmetric networks")
}
- if (x$modelType == 1)
- {
- z$modelType <- 2
- }
+ symms <- syms
+ symms[is.na(symms)] <- FALSE
+ z$modelType[(z$modelType == 1) & symms] <- 2
}
if (z$cconditional)
{
@@ -487,10 +630,74 @@
x[x$requested, ]
}
)
+
+ ##store address of model
+ f$pModel <- pModel
+ ans <- reg.finalizer(f$pModel, clearModel, onexit = FALSE)
+ if (x$MaxDegree == 0 || is.null(x$MaxDegree))
+ {
+ MAXDEGREE <- NULL
+ }
+ else
+ {
+ MAXDEGREE <- x$MaxDegree
+ storage.mode(MAXDEGREE) <- "integer"
+ }
+ if (x$UniversalOffset == 0 || is.null(x$UniversalOffset))
+ {
+ UNIVERSALOFFSET <- NULL
+ }
+ else
+ {
+ UNIVERSALOFFSET <- x$UniversalOffset
+ storage.mode(UNIVERSALOFFSET) <- "double"
+ }
+ if ((length(x$modelType) == 0)||(x$modelType == 0) || is.null(x$modelType))
+ {
+ MODELTYPE <- NULL
+ }
+ else
+ {
+ MODELTYPE <- x$modelType
+ storage.mode(MODELTYPE) <- "integer"
+ }
+ if ((length(x$behModelType) == 0)||(x$behModelType == 0) || is.null(x$behModelType))
+ {
+ BEHMODELTYPE <- NULL
+ }
+ else
+ {
+ BEHMODELTYPE <- x$behModelType
+ storage.mode(BEHMODELTYPE) <- "integer"
+ }
+ if (z$cconditional)
+ {
+ CONDVAR <- z$condname
+ CONDTARGET <- attr(f, "change")
+ ## cat(CONDTARGET, "\n")
+ }
+ else
+ {
+ CONDVAR <- NULL
+ CONDTARGET <- NULL
+ }
+
+ simpleRates <- TRUE
+ if (any(!z$effects$basicRate & z$effects$type =="rate"))
+ {
+ simpleRates <- FALSE
+ }
+ z$simpleRates <- simpleRates
+
+ ans <- .Call("setupModelOptions", PACKAGE=pkgname,
+ pData, pModel, MAXDEGREE, UNIVERSALOFFSET, CONDVAR, CONDTARGET,
+ profileData, z$parallelTesting, MODELTYPE, BEHMODELTYPE,
+ z$simpleRates, x$normSetRates)
if (!initC)
{
ans <- .Call("getTargets", PACKAGE=pkgname, pData, pModel, myeffects,
- z$parallelTesting, returnActorStatistics=FALSE, returnStaticChangeContributions=FALSE)
+ z$parallelTesting, returnActorStatistics=FALSE,
+ returnStaticChangeContributions=FALSE)
##stop("done")
## create a grid of periods with group names in case want to
## parallelize using this or to access chains easily
@@ -522,43 +729,9 @@
}
}
- ##store address of model
- f$pModel <- pModel
- ans <- reg.finalizer(f$pModel, clearModel, onexit = FALSE)
- if (x$MaxDegree == 0 || is.null(x$MaxDegree))
- {
- MAXDEGREE <- NULL
- }
- else
- {
- MAXDEGREE <- x$MaxDegree
- storage.mode(MAXDEGREE) <- "integer"
- }
- if (z$cconditional)
- {
- CONDVAR <- z$condname
- CONDTARGET <- attr(f, "change")
- ## cat(CONDTARGET, "\n")
- }
- else
- {
- CONDVAR <- NULL
- CONDTARGET <- NULL
- }
-
- simpleRates <- TRUE
- if (any(!z$effects$basicRate & z$effects$type =="rate"))
- {
- ## browser()
- simpleRates <- FALSE
- }
- z$simpleRates <- simpleRates
-
- 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'
+# This was because storage.mode had not been set properly for some variable
if (x$maxlike)
{
if (!initC)
@@ -1156,6 +1329,7 @@
attr(edgeLists, "averageInDegree") <- attr(depvar, "averageInDegree")
attr(edgeLists, "averageOutDegree") <- attr(depvar, "averageOutDegree")
attr(edgeLists, "settings") <- attr(depvar, "settings")
+ attr(edgeLists, "settingsinfo") <- attr(depvar, "settingsinfo")
return(edgeLists = edgeLists)
}
##@unpackBipartite siena07 Reformat data for C++
Modified: pkg/RSiena/R/maxlike.r
===================================================================
--- pkg/RSiena/R/maxlike.r 2016-10-20 15:24:31 UTC (rev 305)
+++ pkg/RSiena/R/maxlike.r 2017-05-10 15:32:04 UTC (rev 306)
@@ -15,9 +15,9 @@
{
effects <- getEffects(data)
}
- if (!is.data.frame(effects))
+ if(!inherits(effects, "sienaEffects"))
{
- stop('effects is not a data.frame')
+ stop("effects is not a legitimate Siena effects object")
}
effects <- effects[effects$include, ]
z$theta <- effects$initialValue
Modified: pkg/RSiena/R/phase1.r
===================================================================
--- pkg/RSiena/R/phase1.r 2016-10-20 15:24:31 UTC (rev 305)
+++ pkg/RSiena/R/phase1.r 2017-05-10 15:32:04 UTC (rev 306)
@@ -143,9 +143,16 @@
# for dolby option: regress deviations fra on scores ssc
z$regrCoef <- rep(0, z$pp)
z$regrCor <- rep(0, z$pp)
- if (!is.null(z$ssc))
+ if (x$dolby && ((!is.null(z$ssc)) || (!is.null(z$scores))))
{
+ if ((!is.null(z$ssc)) & (z$sf2.byIteration))
+ {
scores <- apply(z$ssc, c(1,3), sum)
+ }
+ else
+ {
+ scores <- z$scores
+ }
for (i in 1:z$pp)
{
oldwarn <- getOption("warn")
@@ -154,9 +161,16 @@
{
z$regrCoef[i] <- cov(z$sf[,i], scores[,i])/var(scores[,i])
z$regrCor[i] <- cor(z$sf[,i], scores[,i])
+# covi <- sum(sapply(1:dim(z$sf2)[2], function(m){cov(z$sf2[,m,i], z$ssc[,m,i])}))
+# vari.sc <- sum(sapply(1:dim(z$sf2)[2], function(m){var(z$ssc[,m,i])}))
+# vari.fra <- sum(sapply(1:dim(z$sf2)[2], function(m){var(z$sf2[,m,i])}))
+# z$regrCoef[i] <- covi/vari.sc
+# z$regrCor[i] <- covi/sqrt(vari.sc * vari.fra)
}
if (is.na(z$regrCor[i])){z$regrCor[i] <- 0}
if (is.na(z$regrCoef[i])){z$regrCoef[i] <- 0}
+ if (!is.finite(z$regrCor[i])){z$regrCor[i] <- 0}
+ if (!is.finite(z$regrCoef[i])){z$regrCoef[i] <- 0}
options(warn = oldwarn)
}
Report('Correlations between scores and statistics:\n', cf)
@@ -276,14 +290,14 @@
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rsiena -r 306
More information about the Rsiena-commits
mailing list