[Rsiena-commits] r308 - in pkg/RSienaTest: . R src/model src/model/effects

[noreply at r-forge.r-project.org]

Author: fschoenen
Date: 2017-08-30 16:02:25 +0200 (Wed, 30 Aug 2017)
New Revision: 308

Modified:
   pkg/RSienaTest/ChangeLog
   pkg/RSienaTest/R/effects.r
   pkg/RSienaTest/src/model/Model.cpp
   pkg/RSienaTest/src/model/effects/NetworkDependentBehaviorEffect.cpp
Log:
gmm type interactions


Modified: pkg/RSienaTest/ChangeLog
===================================================================
--- pkg/RSienaTest/ChangeLog	2017-05-12 13:51:01 UTC (rev 307)
+++ pkg/RSienaTest/ChangeLog	2017-08-30 14:02:25 UTC (rev 308)
@@ -4,6 +4,12 @@
      in the algorithm object. This required only a change in 
      NetworkVariable::checkAlterAgreement; documented in Siena_algorithms.
 
+2017-08-30 R-Forge Revision 308
+Changes in RSienaTest:
+   * effects.r: remove hard coded number of types of interactions
+   * Model.cpp: allow gmm type interaction effects
+   * NetworkDependentBehaviorEffect.cpp: fix uninitialized network pointer
+
 2017-05-12 R-Forge Revision 307
 Changes in RSiena and RSienaTest:
    * Operation of option 'absorb' (behModelType=2) corrected.

Modified: pkg/RSienaTest/R/effects.r
===================================================================
--- pkg/RSienaTest/R/effects.r	2017-05-12 13:51:01 UTC (rev 307)
+++ pkg/RSienaTest/R/effects.r	2017-08-30 14:02:25 UTC (rev 308)
@@ -241,7 +241,7 @@
 										 name=varname,
 										 groupName=groupName, group=group,
 										 netType=netType)
-			objEffects <-  rbind(objEffects, interaction[rep(1:3, nintn), ])
+			objEffects <-  rbind(objEffects, interaction[rep(1:nrow(interaction), nintn), ])
 		}
 
 		for (j in seq(along=xx$depvars))
@@ -718,7 +718,7 @@
 									 varname, name=varname,
 										 groupName=groupName, group=group,
 									 netType=netType)
-		objEffects <- rbind(objEffects, interaction[rep(1:3, behNintn),])
+		objEffects <- rbind(objEffects, interaction[rep(1:nrow(interaction), behNintn),])
 
 		## get starting values
 		starts <- getBehaviorStartingVals(depvar)
@@ -855,7 +855,7 @@
 										 name=varname,
 										 groupName=groupName, group=group,
 										 netType=netType)
-			objEffects <-  rbind(objEffects, interaction[rep(1:3, nintn), ])
+			objEffects <-  rbind(objEffects, interaction[rep(1:nrow(interaction), nintn), ])
 		}
 
 		for (j in seq(along=xx$depvars))

Modified: pkg/RSienaTest/src/model/Model.cpp
===================================================================
--- pkg/RSienaTest/src/model/Model.cpp	2017-05-12 13:51:01 UTC (rev 307)
+++ pkg/RSienaTest/src/model/Model.cpp	2017-08-30 14:02:25 UTC (rev 308)
@@ -535,6 +535,11 @@
 	{
 		this->lcreationEffects[variableName].push_back(pInfo);
 	}
+	else if (effectType == "gmm")
+	{
+		this->lGMMModel = true;
+		this->lgmmEffects[variableName].push_back(pInfo);
+	}
 	else
 	{
 		throw invalid_argument("Unexpected effect type '" + effectType + "'.");

Modified: pkg/RSienaTest/src/model/effects/NetworkDependentBehaviorEffect.cpp
===================================================================
--- pkg/RSienaTest/src/model/effects/NetworkDependentBehaviorEffect.cpp	2017-05-12 13:51:01 UTC (rev 307)
+++ pkg/RSienaTest/src/model/effects/NetworkDependentBehaviorEffect.cpp	2017-08-30 14:02:25 UTC (rev 308)
@@ -98,6 +98,8 @@
 {
 	BehaviorEffect::initialize(pData, pState, period, pCache);
 	string networkName = this->pEffectInfo()->interactionName1();
+	this->lpNetwork = pState->pNetwork(networkName);
+
 	if (!this->lpNetwork) 
 	{
 		throw logic_error("Network '" + networkName + "' expected.");