[Rsiena-commits] r323 - in pkg/RSienaTest: . src src/model
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Sep 18 14:56:52 CEST 2017
Author: fschoenen
Date: 2017-09-18 14:56:52 +0200 (Mon, 18 Sep 2017)
New Revision: 323
Modified:
pkg/RSienaTest/ChangeLog
pkg/RSienaTest/DESCRIPTION
pkg/RSienaTest/Makefile
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/siena07internals.cpp
Log:
delete Network clones not owned by State
Modified: pkg/RSienaTest/ChangeLog
===================================================================
--- pkg/RSienaTest/ChangeLog 2017-09-18 12:50:40 UTC (rev 322)
+++ pkg/RSienaTest/ChangeLog 2017-09-18 12:56:52 UTC (rev 323)
@@ -1,3 +1,15 @@
+2017-09-18 R-Forge Revision 323
+Changes in RSienaTest:
+ * StatisticCalculator.cpp: delete Network clones not owned by State.
+
+2017-09-18 R-Forge Revision 322
+Changes in RSiena:
+ * StatisticCalculator.cpp: delete Network clones not owned by State.
+
+2017-09-10 R-Forge Revision 321
+Changes in RSiena:
+ * Merge RSienaTest changes r319-r320. Renamed init.c to init.cpp.
+
2017-09-10 R-Forge Revision 320
Changes in RSienaTest:
* siena07*.h: Update method declarations.
Modified: pkg/RSienaTest/DESCRIPTION
===================================================================
--- pkg/RSienaTest/DESCRIPTION 2017-09-18 12:50:40 UTC (rev 322)
+++ pkg/RSienaTest/DESCRIPTION 2017-09-18 12:56:52 UTC (rev 323)
@@ -2,7 +2,7 @@
Type: Package
Title: Siena - Simulation Investigation for Empirical Network Analysis
Version: 1.2-4
-Date: 2017-09-10
+Date: 2017-09-18
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/Makefile
===================================================================
--- pkg/RSienaTest/Makefile 2017-09-18 12:50:40 UTC (rev 322)
+++ pkg/RSienaTest/Makefile 2017-09-18 12:56:52 UTC (rev 323)
@@ -99,3 +99,8 @@
test:
cd inst/unitTests && \
$(R_RUN) "require($(PKG_NAME)); RSienaTest:::run_tests(dir='.')"
+
+.PHONY:
+memtest:
+ R CMD INSTALL .
+ R -d 'valgrind --leak-check=full' -f tests/parallel.R
Modified: pkg/RSienaTest/src/model/Model.h
===================================================================
--- pkg/RSienaTest/src/model/Model.h 2017-09-18 12:50:40 UTC (rev 322)
+++ pkg/RSienaTest/src/model/Model.h 2017-09-18 12:56:52 UTC (rev 323)
@@ -62,7 +62,7 @@
double settingRateParameter(NetworkLongitudinalData * pNetworkData,
std::string setting,
int period) const;
- const int numberOfSettings(NetworkLongitudinalData * pNetworkData) const;
+ int numberOfSettings(NetworkLongitudinalData * pNetworkData) const;
// Other effects
Modified: pkg/RSienaTest/src/model/State.cpp
===================================================================
--- pkg/RSienaTest/src/model/State.cpp 2017-09-18 12:50:40 UTC (rev 322)
+++ pkg/RSienaTest/src/model/State.cpp 2017-09-18 12:56:52 UTC (rev 323)
@@ -17,9 +17,9 @@
/**
* Creates a state of variables as of the given observation of the given
* Data object. The values may be copied or referenced directly as indicated
- * by the parameter <code>copyValues</code>.
+ * by the parameter <code>ownedValues</code>.
*/
-State::State(const Data * pData, int observation, bool copyValues)
+State::State(const Data * pData, int observation, bool ownedValues)
{
const vector<LongitudinalData *> & rVariables =
pData->rDependentVariableData();
@@ -35,7 +35,7 @@
{
const Network * pNetwork = pNetworkData->pNetwork(observation);
- if (copyValues)
+ if (ownedValues)
{
pNetwork = pNetwork->clone();
}
@@ -46,7 +46,7 @@
{
const int * values = pBehaviorData->values(observation);
- if (copyValues)
+ if (ownedValues)
{
int * copies = new int[pBehaviorData->n()];
@@ -66,7 +66,7 @@
}
}
- this->lownedValues = copyValues;
+ this->lownedValues = ownedValues;
}
@@ -108,7 +108,7 @@
*/
State::State()
{
- this->lownedValues = false;
+ this->lownedValues = false; // depends on the passed pointers
}
@@ -130,16 +130,13 @@
*/
const Network * State::pNetwork(string name) const
{
- const Network * pNetwork = 0;
map<string, const Network *>::const_iterator iter =
this->lnetworks.find(name);
-
if (iter != this->lnetworks.end())
{
- pNetwork = iter->second;
+ return iter->second;
}
-
- return pNetwork;
+ return 0;
}
@@ -181,7 +178,7 @@
/**
- * Deletes the values stored in this state.
+ * Deletes the values stored in this state (only called if lownedValues).
*/
void State::deleteValues()
{
Modified: pkg/RSienaTest/src/model/State.h
===================================================================
--- pkg/RSienaTest/src/model/State.h 2017-09-18 12:50:40 UTC (rev 322)
+++ pkg/RSienaTest/src/model/State.h 2017-09-18 12:56:52 UTC (rev 323)
@@ -18,7 +18,7 @@
class State
{
public:
- State(const Data * pData, int observation, bool copyValues = false);
+ State(const Data * pData, int observation, bool ownedValues = false);
State(EpochSimulation * pSimulation);
State();
virtual ~State();
Modified: pkg/RSienaTest/src/model/StatisticCalculator.cpp
===================================================================
--- pkg/RSienaTest/src/model/StatisticCalculator.cpp 2017-09-18 12:50:40 UTC (rev 322)
+++ pkg/RSienaTest/src/model/StatisticCalculator.cpp 2017-09-18 12:56:52 UTC (rev 323)
@@ -298,13 +298,10 @@
// Duplicate the current network and remove those ties that are
// missing at either end of the period.
- Network * pNetwork =
- this->lpState->pNetwork(pNetworkData->name())->clone();
+ Network * pNetwork = this->lpState->pNetwork(pNetworkData->name())->clone();
- subtractNetwork(pNetwork,
- pNetworkData->pMissingTieNetwork(this->lperiod));
- subtractNetwork(pNetwork,
- pNetworkData->pMissingTieNetwork(this->lperiod + 1));
+ subtractNetwork(pNetwork, pNetworkData->pMissingTieNetwork(this->lperiod));
+ subtractNetwork(pNetwork, pNetworkData->pMissingTieNetwork(this->lperiod + 1));
// for not-targets, overwrite the current network for values
// structurally fixed for the next period. (no effect for targets)
@@ -320,12 +317,14 @@
pNetworkData->pNetwork(this->lperiod),
pNetworkData->pStructuralTieNetwork(this->lperiod));
+ // NOTE: pass delete responsibility to state
this->lpStateLessMissingsEtc->pNetwork(name, pNetwork);
+ // delete pNetwork;
}
else if (pBehaviorData)
{
- // create a copy of the start of the period and zero any values
+ // create a copy of the start of the period and zero any values
// missing at (either end?) start of period
const int * values =
@@ -364,6 +363,20 @@
throw domain_error("Unexpected class of dependent variable");
}
}
+
+ // clean up created data not owned by states
+ for (unsigned i = 0; i < rVariables.size(); i++)
+ {
+ NetworkLongitudinalData * pNetworkData =
+ dynamic_cast<NetworkLongitudinalData *>(rVariables[i]);
+ string name = rVariables[i]->name();
+
+ if (pNetworkData)
+ {
+ const Network * pNetwork = this->lpStateLessMissingsEtc->pNetwork(name);
+ delete pNetwork;
+ }
+ }
}
/**
@@ -622,10 +635,8 @@
// remove missings and current
- subtractNetwork(pLostTieNetwork,
- pCurrentNetwork);
- subtractNetwork(pLostTieNetwork,
- pNetworkData->pMissingTieNetwork(this->lperiod + 1));
+ subtractNetwork(pLostTieNetwork, pCurrentNetwork);
+ subtractNetwork(pLostTieNetwork, pNetworkData->pMissingTieNetwork(this->lperiod + 1));
// overwrite the predictor network with only start missings removed
const Network * pPredictor =
@@ -1089,8 +1100,7 @@
// missing at either end of the period. TODO set leavers back.
// (Is the TODO not done for the current network?)
- pNetwork =
- this->lpState->pNetwork(pNetworkData->name())->clone();
+ pNetwork = this->lpState->pNetwork(pNetworkData->name())->clone();
subtractNetwork(pNetwork,
pNetworkData->pMissingTieNetwork(this->lperiod));
subtractNetwork(pNetwork,
Modified: pkg/RSienaTest/src/siena07internals.cpp
===================================================================
--- pkg/RSienaTest/src/siena07internals.cpp 2017-09-18 12:50:40 UTC (rev 322)
+++ pkg/RSienaTest/src/siena07internals.cpp 2017-09-18 12:56:52 UTC (rev 323)
@@ -500,7 +500,7 @@
//Rprintf("%f %f\n", pOneModeNetworkLongitudinalData->
// averageInDegree(), pOneModeNetworkLongitudinalData->
// averageOutDegree());
- UNPROTECT(16);
+ UNPROTECT(15);
}
}
@@ -612,37 +612,37 @@
*/
void setupBipartiteGroup(SEXP BIPARTITEGROUP, Data * pData)
{
- int nBipartite = length(BIPARTITEGROUP);
+ int nBipartite = length(BIPARTITEGROUP);
- for (int bipartite = 0; bipartite < nBipartite; bipartite++)
- {
- SEXP as;
- PROTECT(as = install("nodeSet"));
- SEXP actorSet = getAttrib(VECTOR_ELT(BIPARTITEGROUP, bipartite), as);
- SEXP nm;
- PROTECT(nm = install("name"));
- SEXP name = getAttrib(VECTOR_ELT(BIPARTITEGROUP, bipartite), nm);
+ for (int bipartite = 0; bipartite < nBipartite; bipartite++)
+ {
+ SEXP as;
+ PROTECT(as = install("nodeSet"));
+ SEXP actorSet = getAttrib(VECTOR_ELT(BIPARTITEGROUP, bipartite), as);
+ SEXP nm;
+ PROTECT(nm = install("name"));
+ SEXP name = getAttrib(VECTOR_ELT(BIPARTITEGROUP, bipartite), nm);
SEXP avout;
- PROTECT(avout = install("averageOutDegree"));
- SEXP averageOutDegree = getAttrib(VECTOR_ELT(BIPARTITEGROUP,
- bipartite), avout);
- const ActorSet * pSenders = pData->pActorSet(CHAR(STRING_ELT(
- actorSet, 0)));
- const ActorSet * pReceivers = pData->pActorSet(CHAR(STRING_ELT(
- actorSet, 1)));
+ PROTECT(avout = install("averageOutDegree"));
+ SEXP averageOutDegree = getAttrib(VECTOR_ELT(BIPARTITEGROUP,
+ bipartite), avout);
+ const ActorSet * pSenders = pData->pActorSet(CHAR(STRING_ELT(
+ actorSet, 0)));
+ const ActorSet * pReceivers = pData->pActorSet(CHAR(STRING_ELT(
+ actorSet, 1)));
NetworkLongitudinalData * pNetworkLongitudinalData =
pData->createNetworkData(CHAR(STRING_ELT(name, 0)),
- pSenders, pReceivers);
- pNetworkLongitudinalData->averageOutDegree(*(REAL(averageOutDegree)));
+ pSenders, pReceivers);
+ pNetworkLongitudinalData->averageOutDegree(*(REAL(averageOutDegree)));
setupBipartiteObservations(VECTOR_ELT(BIPARTITEGROUP, bipartite),
- pNetworkLongitudinalData);
+ pNetworkLongitudinalData);
// Once all network data has been stored, calculate some
// statistical properties of that data.
pNetworkLongitudinalData->calculateProperties();
- UNPROTECT(3);
- }
+ UNPROTECT(3);
+ }
}
/**
@@ -650,45 +650,44 @@
*
*/
void setupBehavior(SEXP BEHAVIOR, BehaviorLongitudinalData * pBehaviorData)
-
{
- int observations = ncols(VECTOR_ELT(BEHAVIOR, 0));
+ int observations = ncols(VECTOR_ELT(BEHAVIOR, 0));
- if (observations != pBehaviorData->observationCount())
- {
+ if (observations != pBehaviorData->observationCount())
+ {
error ("wrong number of observations in Behavior");
- }
- int nActors = nrows(VECTOR_ELT(BEHAVIOR, 0));
+ }
+ int nActors = nrows(VECTOR_ELT(BEHAVIOR, 0));
- if (nActors != pBehaviorData->n())
- {
- error ("wrong number of actors");
- }
- int * start = INTEGER(VECTOR_ELT(BEHAVIOR, 0));
+ if (nActors != pBehaviorData->n())
+ {
+ error ("wrong number of actors");
+ }
+ int * start = INTEGER(VECTOR_ELT(BEHAVIOR, 0));
int * missing = LOGICAL(VECTOR_ELT(BEHAVIOR, 1));
- for (int period = 0; period < observations; period++)
- {
- for (int actor = 0; actor < nActors; actor++)
- {
- pBehaviorData->value(period, actor, *start++);
+ for (int period = 0; period < observations; period++)
+ {
+ for (int actor = 0; actor < nActors; actor++)
+ {
+ pBehaviorData->value(period, actor, *start++);
pBehaviorData->missing(period, actor, *missing++);
- }
- }
- SEXP uo;
- PROTECT(uo = install("uponly"));
- SEXP uponly = getAttrib(VECTOR_ELT(BEHAVIOR, 0), uo);
- SEXP dow;
- PROTECT(dow = install("downonly"));
- SEXP downonly = getAttrib(VECTOR_ELT(BEHAVIOR,0), dow);
- for (int period = 0; period < (observations - 1); period++)
- {
- pBehaviorData->upOnly(period, LOGICAL(uponly)[period]);
- pBehaviorData->downOnly(period, LOGICAL(downonly)[period]);
- }
- SEXP sim;
- PROTECT(sim = install("simMean"));
- SEXP simMean = getAttrib(VECTOR_ELT(BEHAVIOR,0), sim);
+ }
+ }
+ SEXP uo;
+ PROTECT(uo = install("uponly"));
+ SEXP uponly = getAttrib(VECTOR_ELT(BEHAVIOR, 0), uo);
+ SEXP dow;
+ PROTECT(dow = install("downonly"));
+ SEXP downonly = getAttrib(VECTOR_ELT(BEHAVIOR,0), dow);
+ for (int period = 0; period < (observations - 1); period++)
+ {
+ pBehaviorData->upOnly(period, LOGICAL(uponly)[period]);
+ pBehaviorData->downOnly(period, LOGICAL(downonly)[period]);
+ }
+ SEXP sim;
+ PROTECT(sim = install("simMean"));
+ SEXP simMean = getAttrib(VECTOR_ELT(BEHAVIOR,0), sim);
pBehaviorData->similarityMean(REAL(simMean)[0]);
SEXP sims;
PROTECT(sims = install("simMeans"));
@@ -699,48 +698,50 @@
for (int net = 0; net < numberNetworks; net++)
{
pBehaviorData->similarityMeans(REAL(simMeans)[net],
- CHAR(STRING_ELT(simNames, net)));
+ CHAR(STRING_ELT(simNames, net)));
}
- // Now that the values are set, calculate some important statistics
+ // Now that the values are set, calculate some important statistics
pBehaviorData->calculateProperties();
UNPROTECT(5);
}
+
/**
* Create one group of Behavior Networks
*
*/
void setupBehaviorGroup(SEXP BEHGROUP, Data *pData)
{
- int nBehavior = length(BEHGROUP);
+ int nBehavior = length(BEHGROUP);
- for (int behavior= 0; behavior < nBehavior; behavior++)
- {
+ for (int behavior= 0; behavior < nBehavior; behavior++)
+ {
SEXP as;
PROTECT(as = install("nodeSet"));
- SEXP actorSet = getAttrib(VECTOR_ELT(VECTOR_ELT(BEHGROUP, behavior), 0),
- as);
+ SEXP actorSet = getAttrib(VECTOR_ELT(VECTOR_ELT(BEHGROUP, behavior), 0),
+ as);
- SEXP nm;
- PROTECT(nm = install("name"));
- SEXP name = getAttrib(VECTOR_ELT(VECTOR_ELT(BEHGROUP, behavior), 0),
- nm);
+ SEXP nm;
+ PROTECT(nm = install("name"));
+ SEXP name = getAttrib(VECTOR_ELT(VECTOR_ELT(BEHGROUP, behavior), 0),
+ nm);
- const ActorSet * myActorSet = pData->pActorSet(CHAR(STRING_ELT(
- actorSet, 0)));
- BehaviorLongitudinalData * pBehaviorData =
- pData->createBehaviorData(CHAR(STRING_ELT(name, 0)), myActorSet);
-// Rprintf("%x\n", pBehaviorData);
- setupBehavior(VECTOR_ELT(BEHGROUP, behavior), pBehaviorData);
- UNPROTECT(2);
- }
+ const ActorSet * myActorSet = pData->pActorSet(CHAR(STRING_ELT(
+ actorSet, 0)));
+ BehaviorLongitudinalData * pBehaviorData =
+ pData->createBehaviorData(CHAR(STRING_ELT(name, 0)), myActorSet);
+ // Rprintf("%x\n", pBehaviorData);
+ setupBehavior(VECTOR_ELT(BEHGROUP, behavior), pBehaviorData);
+ UNPROTECT(2);
+ }
}
+
/**
* Create a constant covariate
*
*/
-void setupConstantCovariate(SEXP COCOVAR, ConstantCovariate *
- pConstantCovariate)
+void setupConstantCovariate(SEXP COCOVAR,
+ ConstantCovariate * pConstantCovariate)
{
int nActors = length(COCOVAR);
// Rprintf("%x\n", pConstantCovariate);
@@ -764,29 +765,29 @@
{
impute = TRUE;
imputationValues = REAL(ans);
-// Rprintf("We have something to impute\n");
+ // Rprintf("We have something to impute\n");
}
- for (int actor = 0; actor < nActors; actor++)
- {
+ for (int actor = 0; actor < nActors; actor++)
+ {
double value = *start++;
if (ISNAN(value))
{
if (impute) // imputationValues already were centered, if necessary
{
pConstantCovariate->value(actor, imputationValues[actor]);
-// Rprintf("We impute value %f for actor %d\n",
-// imputationValues[actor], actor + 1);
+ // Rprintf("We impute value %f for actor %d\n",
+ // imputationValues[actor], actor + 1);
}
else if (centered) // no user input provided
{
- pConstantCovariate->value(actor, 0);
-// Rprintf("We use 0 for actor %d\n", actor + 1);
+ pConstantCovariate->value(actor, 0);
+ // Rprintf("We use 0 for actor %d\n", actor + 1);
}
else // no user input provided, not centered
{
pConstantCovariate->value(actor, mean);
-// Rprintf("We use the mean %f for actor %d\n", mean, actor + 1);
+ // Rprintf("We use the mean %f for actor %d\n", mean, actor + 1);
}
pConstantCovariate->missing(actor, 1);
}
@@ -796,7 +797,7 @@
pConstantCovariate->missing(actor, 0);
}
- }
+ }
UNPROTECT(3);
}
/**
@@ -805,32 +806,32 @@
*/
void setupConstantCovariateGroup(SEXP COCOVARGROUP, Data *pData)
{
- int nConstantCovariate = length(COCOVARGROUP);
-// Rprintf("nConstantCovariate %d\n", nConstantCovariate);
- for (int constantCovariate = 0; constantCovariate < nConstantCovariate;
- constantCovariate++)
- {
- SEXP as;
- PROTECT(as = install("nodeSet"));
- SEXP actorSet = getAttrib(VECTOR_ELT(COCOVARGROUP, constantCovariate),
- as);
- SEXP nm;
- PROTECT(nm = install("name"));
- SEXP name = getAttrib(VECTOR_ELT(COCOVARGROUP, constantCovariate), nm);
- const ActorSet * myActorSet = pData->pActorSet(CHAR(STRING_ELT(
- actorSet, 0)));
- int nActors = length(VECTOR_ELT(COCOVARGROUP, constantCovariate));
-// Rprintf("nactors %d\n", nActors);
+ int nConstantCovariate = length(COCOVARGROUP);
+ // Rprintf("nConstantCovariate %d\n", nConstantCovariate);
+ for (int constantCovariate = 0; constantCovariate < nConstantCovariate;
+ constantCovariate++)
+ {
+ SEXP as;
+ PROTECT(as = install("nodeSet"));
+ SEXP actorSet = getAttrib(VECTOR_ELT(COCOVARGROUP, constantCovariate),
+ as);
+ SEXP nm;
+ PROTECT(nm = install("name"));
+ SEXP name = getAttrib(VECTOR_ELT(COCOVARGROUP, constantCovariate), nm);
+ const ActorSet * myActorSet = pData->pActorSet(CHAR(STRING_ELT(
+ actorSet, 0)));
+ int nActors = length(VECTOR_ELT(COCOVARGROUP, constantCovariate));
+ // Rprintf("nactors %d\n", nActors);
- if (nActors != myActorSet->n())
- {
- error ("wrong number of actors");
- }
+ if (nActors != myActorSet->n())
+ {
+ error ("wrong number of actors");
+ }
ConstantCovariate * pConstantCovariate =
pData->createConstantCovariate(CHAR(STRING_ELT(name, 0)),
- myActorSet);
- setupConstantCovariate(VECTOR_ELT(COCOVARGROUP, constantCovariate),
- pConstantCovariate);
+ myActorSet);
+ setupConstantCovariate(VECTOR_ELT(COCOVARGROUP, constantCovariate),
+ pConstantCovariate);
SEXP mn;
PROTECT(mn = install("mean"));
SEXP obsmean = getAttrib(VECTOR_ELT(COCOVARGROUP, constantCovariate), mn);
@@ -849,28 +850,29 @@
SEXP sim;
PROTECT(sim = install("simMean"));
SEXP simMean = getAttrib(VECTOR_ELT(COCOVARGROUP, constantCovariate),
- sim);
+ sim);
pConstantCovariate->similarityMean(REAL(simMean)[0]);
SEXP sims;
PROTECT(sims = install("simMeans"));
SEXP simMeans = getAttrib(VECTOR_ELT(COCOVARGROUP, constantCovariate),
- sims);
+ sims);
SEXP simNames;
PROTECT(simNames = getAttrib(simMeans, R_NamesSymbol));
int numberNetworks = length(simMeans);
for (int net = 0; net < numberNetworks; net++)
{
pConstantCovariate->similarityMeans(REAL(simMean)[net],
- CHAR(STRING_ELT(simNames, net)));
+ CHAR(STRING_ELT(simNames, net)));
}
SEXP range;
PROTECT(range = install("range"));
SEXP Range = getAttrib(VECTOR_ELT(COCOVARGROUP, constantCovariate),
- range);
+ range);
pConstantCovariate->range(REAL(Range)[0]);
- UNPROTECT(8);
- }
+ UNPROTECT(8);
+ }
}
+
/**
* Create all observations for a changing covariate
*
@@ -918,20 +920,20 @@
if (impute) // imputationValues have been centered, if necessary
{
pChangingCovariate->value(actor, period, imputationValue);
-// Rprintf("We impute value %f for actor %d in period %d\n",
-// imputationValue, actor + 1, period + 1);
+ // Rprintf("We impute value %f for actor %d in period %d\n",
+ // imputationValue, actor + 1, period + 1);
}
else if (centered) // no user input provided
{
pChangingCovariate->value(actor, period, 0);
-// Rprintf("We use 0 for actor %d in period %d\n",
-// actor + 1, period + 1);
+ // Rprintf("We use 0 for actor %d in period %d\n",
+ // actor + 1, period + 1);
}
else // no user input provided, not centered
{
pChangingCovariate->value(actor, period, mean);
-// Rprintf("We use the mean %f for actor %d in period %d\n",
-// mean, actor + 1, period + 1);
+ // Rprintf("We use the mean %f for actor %d in period %d\n",
+ // mean, actor + 1, period + 1);
}
pChangingCovariate->missing(actor, period, 1);
}
@@ -941,37 +943,38 @@
pChangingCovariate->missing(actor, period, 0);
}
}
- }
+ }
UNPROTECT(3);
}
+
/**
* Create one group of changing covariates
*
*/
void setupChangingCovariateGroup(SEXP VARCOVARGROUP, Data *pData)
{
- if (length(VARCOVARGROUP) == 0)
- return;
- int observations = ncols(VECTOR_ELT(VARCOVARGROUP,0));
- if (observations != pData->observationCount() - 1)
- {
+ if (length(VARCOVARGROUP) == 0)
+ return;
+ int observations = ncols(VECTOR_ELT(VARCOVARGROUP,0));
+ if (observations != pData->observationCount() - 1)
+ {
error ("wrong number of observations in Changing Covariate");
- }
- int nChangingCovariate = length(VARCOVARGROUP);
+ }
+ int nChangingCovariate = length(VARCOVARGROUP);
for (int changingCovariate = 0;
- changingCovariate < nChangingCovariate;
- changingCovariate++)
+ changingCovariate < nChangingCovariate;
+ changingCovariate++)
{
SEXP as;
PROTECT(as = install("nodeSet"));
SEXP actorSet = getAttrib(VECTOR_ELT(VARCOVARGROUP, changingCovariate),
- as);
+ as);
SEXP nm;
PROTECT(nm = install("name"));
SEXP name = getAttrib(VECTOR_ELT(VARCOVARGROUP, changingCovariate),
- nm);
+ nm);
const ActorSet * myActorSet = pData->pActorSet(CHAR(STRING_ELT(
- actorSet, 0)));
+ actorSet, 0)));
int nActors = nrows(VECTOR_ELT(VARCOVARGROUP,changingCovariate));
if (nActors != myActorSet->n())
@@ -980,9 +983,9 @@
}
ChangingCovariate * pChangingCovariate =
pData->createChangingCovariate(CHAR(STRING_ELT(name, 0)),
- myActorSet);
+ myActorSet);
setupChangingCovariate(VECTOR_ELT(VARCOVARGROUP, changingCovariate),
- pChangingCovariate);
+ pChangingCovariate);
SEXP mn;
PROTECT(mn = install("mean"));
SEXP obsmean = getAttrib(VECTOR_ELT(VARCOVARGROUP, changingCovariate), mn);
@@ -1001,42 +1004,43 @@
SEXP sim;
PROTECT(sim = install("simMean"));
SEXP simMean = getAttrib(VECTOR_ELT(VARCOVARGROUP, changingCovariate),
- sim);
+ sim);
pChangingCovariate->similarityMean(REAL(simMean)[0]);
SEXP sims;
PROTECT(sims = install("simMeans"));
SEXP simMeans = getAttrib(VECTOR_ELT(VARCOVARGROUP, changingCovariate),
- sims);
+ sims);
SEXP simNames;
PROTECT(simNames = getAttrib(simMeans, R_NamesSymbol));
int numberNetworks = length(simMeans);
for (int net = 0; net < numberNetworks; net++)
{
pChangingCovariate->similarityMeans(REAL(simMean)[net],
- CHAR(STRING_ELT(simNames, net)));
+ CHAR(STRING_ELT(simNames, net)));
}
SEXP range;
PROTECT(range = install("range"));
SEXP Range = getAttrib(VECTOR_ELT(VARCOVARGROUP, changingCovariate),
- range);
+ range);
pChangingCovariate->range(REAL(Range)[0]);
UNPROTECT(8);
}
}
+
/**
* Create a constant dyadic covariate
*
*/
void setupDyadicCovariate(SEXP DYADVAR,
- ConstantDyadicCovariate * pConstantDyadicCovariate)
+ ConstantDyadicCovariate * pConstantDyadicCovariate)
{
- double *start = REAL(VECTOR_ELT(DYADVAR, 0));
- double *missingstart = REAL(VECTOR_ELT(DYADVAR, 1));
- int listlen = ncols(VECTOR_ELT(DYADVAR, 0));
-// Rprintf("listlen = %d\n", listlen);
- int pos = 0;
- for (int row = 0; row < listlen; row++)
- {
+ double *start = REAL(VECTOR_ELT(DYADVAR, 0));
+ double *missingstart = REAL(VECTOR_ELT(DYADVAR, 1));
+ int listlen = ncols(VECTOR_ELT(DYADVAR, 0));
+ // Rprintf("listlen = %d\n", listlen);
+ int pos = 0;
+ for (int row = 0; row < listlen; row++)
+ {
int i;
int j;
double val;
@@ -1045,10 +1049,10 @@
val = start[pos++];
pConstantDyadicCovariate->value(i-1, j-1, val);
}
- listlen = ncols(VECTOR_ELT(DYADVAR, 1));
- pos = 0;
- for (int row = 0; row < listlen; row++)
- {
+ listlen = ncols(VECTOR_ELT(DYADVAR, 1));
+ pos = 0;
+ for (int row = 0; row < listlen; row++)
+ {
int i;
int j;
double val;
@@ -1065,35 +1069,35 @@
*/
void setupDyadicCovariateGroup(SEXP DYADVARGROUP, Data *pData)
{
- int nDyadicCovariate = length(DYADVARGROUP);
-// Rprintf("nDyadicCovariate %d\n", nDyadicCovariate);
- for (int dyadicCovariate = 0; dyadicCovariate < nDyadicCovariate;
- dyadicCovariate++)
- {
- SEXP as;
- PROTECT(as = install("nodeSet"));
- SEXP actorSet = getAttrib(VECTOR_ELT(DYADVARGROUP, dyadicCovariate),
- as);
- SEXP nm;
- PROTECT(nm = install("name"));
- SEXP name = getAttrib(VECTOR_ELT(DYADVARGROUP, dyadicCovariate),
- nm);
- const ActorSet * myActorSet1 = pData->pActorSet(CHAR(STRING_ELT(
- actorSet, 0)));
- const ActorSet * myActorSet2 = pData->pActorSet(CHAR(STRING_ELT(
- actorSet, 1)));
+ int nDyadicCovariate = length(DYADVARGROUP);
+ // Rprintf("nDyadicCovariate %d\n", nDyadicCovariate);
+ for (int dyadicCovariate = 0; dyadicCovariate < nDyadicCovariate;
+ dyadicCovariate++)
+ {
+ SEXP as;
+ PROTECT(as = install("nodeSet"));
+ SEXP actorSet = getAttrib(VECTOR_ELT(DYADVARGROUP, dyadicCovariate),
+ as);
+ SEXP nm;
+ PROTECT(nm = install("name"));
+ SEXP name = getAttrib(VECTOR_ELT(DYADVARGROUP, dyadicCovariate),
+ nm);
+ const ActorSet * myActorSet1 = pData->pActorSet(CHAR(STRING_ELT(
+ actorSet, 0)));
+ const ActorSet * myActorSet2 = pData->pActorSet(CHAR(STRING_ELT(
+ actorSet, 1)));
ConstantDyadicCovariate * pConstantDyadicCovariate =
pData->createConstantDyadicCovariate(CHAR(STRING_ELT(name, 0)),
- myActorSet1, myActorSet2);
+ myActorSet1, myActorSet2);
setupDyadicCovariate(VECTOR_ELT(DYADVARGROUP, dyadicCovariate),
- pConstantDyadicCovariate);
+ pConstantDyadicCovariate);
SEXP mean;
PROTECT(mean = install("mean"));
SEXP Mean = getAttrib(VECTOR_ELT(DYADVARGROUP, dyadicCovariate),
- mean);
+ mean);
pConstantDyadicCovariate->mean(REAL(Mean)[0]);
- UNPROTECT(3);
- }
+ UNPROTECT(3);
+ }
}
/**
@@ -1101,14 +1105,14 @@
*
*/
void unpackChangingDyadicPeriod(SEXP VARDYADVALS, ChangingDyadicCovariate *
- pChangingDyadicCovariate, int period)
+ pChangingDyadicCovariate, int period)
{
- double *start = REAL(VECTOR_ELT(VARDYADVALS, 0));
+ double *start = REAL(VECTOR_ELT(VARDYADVALS, 0));
int listlen = ncols(VECTOR_ELT(VARDYADVALS, 0));
-// Rprintf("listlen = %d\n", listlen);
- int pos = 0;
- for (int row = 0; row < listlen; row++)
- {
+ // Rprintf("listlen = %d\n", listlen);
+ int pos = 0;
+ for (int row = 0; row < listlen; row++)
+ {
int i;
int j;
double val;
@@ -1116,13 +1120,13 @@
j = start[pos++];
val = start[pos++];
pChangingDyadicCovariate->value(i - 1, j - 1, period, val);
- }
- double *missingstart = REAL(VECTOR_ELT(VARDYADVALS, 1));
- listlen = ncols(VECTOR_ELT(VARDYADVALS, 1));
-// Rprintf("listlen = %d\n", listlen);
+ }
+ double *missingstart = REAL(VECTOR_ELT(VARDYADVALS, 1));
+ listlen = ncols(VECTOR_ELT(VARDYADVALS, 1));
+ // Rprintf("listlen = %d\n", listlen);
pos = 0;
- for (int row = 0; row < listlen; row++)
- {
+ for (int row = 0; row < listlen; row++)
+ {
int i;
int j;
double val;
@@ -1130,73 +1134,73 @@
j = missingstart[pos++];
val = missingstart[pos++];
pChangingDyadicCovariate->missing(i - 1, j - 1, period, val);
- }
+ }
}
/**
* Create all observations for a changing dyadic covariate
*
*/
void setupChangingDyadicObservations(SEXP VARDYAD,
- ChangingDyadicCovariate *
- pChangingDyadicCovariate)
-
+ ChangingDyadicCovariate * pChangingDyadicCovariate)
{
- int observations = length(VARDYAD);
- // if (observations != pworkLongitudinalData->observationCount())
- // {
- // error ("wrong number of observations in OneMode");
- // }
- for (int period = 0; period < (observations - 1); period++)
- {
+ int observations = length(VARDYAD);
+ // if (observations != pworkLongitudinalData->observationCount())
+ // {
+ // error ("wrong number of observations in OneMode");
+ // }
+ for (int period = 0; period < (observations - 1); period++)
+ {
unpackChangingDyadicPeriod(VECTOR_ELT(VARDYAD, period),
- pChangingDyadicCovariate, period);
- }
+ pChangingDyadicCovariate, period);
+ }
}
+
/**
* Create one group of changing dyadic covariates
*
*/
void setupChangingDyadicCovariateGroup(SEXP VARDYADGROUP, Data * pData)
{
- int nChangingDyadic = length(VARDYADGROUP);
+ int nChangingDyadic = length(VARDYADGROUP);
- for (int changingDyadic = 0; changingDyadic < nChangingDyadic;
- changingDyadic++)
- {
- SEXP as;
- PROTECT(as = install("nodeSet"));
- SEXP actorSet = getAttrib(VECTOR_ELT(VARDYADGROUP, changingDyadic), as);
- SEXP nm;
- PROTECT(nm = install("name"));
- SEXP name = getAttrib(VECTOR_ELT(VARDYADGROUP, changingDyadic), nm);
- const ActorSet * myActorSet1 = pData->pActorSet(CHAR(STRING_ELT(
- actorSet, 0)));
- const ActorSet * myActorSet2 = pData->pActorSet(CHAR(STRING_ELT(
- actorSet, 1)));
+ for (int changingDyadic = 0; changingDyadic < nChangingDyadic;
+ changingDyadic++)
+ {
+ SEXP as;
+ PROTECT(as = install("nodeSet"));
+ SEXP actorSet = getAttrib(VECTOR_ELT(VARDYADGROUP, changingDyadic), as);
+ SEXP nm;
+ PROTECT(nm = install("name"));
+ SEXP name = getAttrib(VECTOR_ELT(VARDYADGROUP, changingDyadic), nm);
+ const ActorSet * myActorSet1 = pData->pActorSet(CHAR(STRING_ELT(
+ actorSet, 0)));
+ const ActorSet * myActorSet2 = pData->pActorSet(CHAR(STRING_ELT(
+ actorSet, 1)));
ChangingDyadicCovariate * pChangingDyadicCovariate =
pData->createChangingDyadicCovariate(CHAR(STRING_ELT(name, 0)),
- myActorSet1, myActorSet2);
+ myActorSet1, myActorSet2);
setupChangingDyadicObservations(VECTOR_ELT(VARDYADGROUP,
- changingDyadic),
- pChangingDyadicCovariate);
- SEXP mean;
+ changingDyadic),
+ pChangingDyadicCovariate);
+ SEXP mean;
PROTECT(mean = install("mean"));
SEXP Mean = getAttrib(VECTOR_ELT(VARDYADGROUP, changingDyadic),
- mean);
+ mean);
pChangingDyadicCovariate->mean(REAL(Mean)[0]);
UNPROTECT(3);
- }
+ }
}
+
/**
* Create the exogenous composition change events for one actor set within
* one group.
*/
void setupExogenousEventSet(SEXP EXOGEVENTSET, Data *pData)
{
- /* pass in the data for one actor set as two items: first
- a list of columns: event type, period, actor, time.
- Secondly a matrix of booleans, indicating whether active at start
- of period.*/
+ /* pass in the data for one actor set as two items: first
+ a list of columns: event type, period, actor, time.
+ Secondly a matrix of booleans, indicating whether active at start
+ of period.*/
/* first find the actor set */
SEXP as;
@@ -1205,39 +1209,39 @@
/* now process the events */
SEXP EVENTS = VECTOR_ELT(EXOGEVENTSET, 0);
- int nEvents = length(VECTOR_ELT(EVENTS, 0));
- //Rprintf("number of rows of data frame %d\n",nEvents);
+ int nEvents = length(VECTOR_ELT(EVENTS, 0));
+ //Rprintf("number of rows of data frame %d\n",nEvents);
//Rprintf("%d\n", length(EVENTS));
- int * type = INTEGER(VECTOR_ELT(EVENTS, 0));
+ int * type = INTEGER(VECTOR_ELT(EVENTS, 0));
//Rprintf("type %d\n",*type);
int * period = INTEGER(VECTOR_ELT(EVENTS, 1));
//Rprintf("period %d\n",*period);
int * actor = INTEGER(VECTOR_ELT(EVENTS, 2));
//Rprintf("actor %d\n",*actor);
- double * time = REAL(VECTOR_ELT(EVENTS, 3));
+ double * time = REAL(VECTOR_ELT(EVENTS, 3));
//Rprintf("time %5.4f\n",*time);
const ActorSet * myActorSet = pData->pActorSet(CHAR(STRING_ELT(actorSet,
- 0)));
- for (int event = 0; event < nEvents; event++)
- {
+ 0)));
+ for (int event = 0; event < nEvents; event++)
+ {
if (*type == 1)
{
- pData->addJoiningEvent(*period-1, myActorSet, *actor-1, *time);
+ pData->addJoiningEvent(*period-1, myActorSet, *actor-1, *time);
}
else
{
pData->addLeavingEvent(*period-1, myActorSet, *actor-1, *time);
}
type++;
- period++;
- actor++;
- time++;
- }
-/* retrieve some to check*/
-// const EventSet * myeventset= pData->pEventSet(0);
-// EventSet::iterator myit = myeventset->begin();
-// Rprintf("period 1 first event? %d %3.2f\n",(*myit)->actor(),
-// (*myit)->time());
+ period++;
+ actor++;
+ time++;
+ }
+ /* retrieve some to check*/
+ // const EventSet * myeventset= pData->pEventSet(0);
+ // EventSet::iterator myit = myeventset->begin();
+ // Rprintf("period 1 first event? %d %3.2f\n",(*myit)->actor(),
+ // (*myit)->time());
/* initialise the active flags */
SEXP ACTIVES= VECTOR_ELT(EXOGEVENTSET, 1);
@@ -1248,11 +1252,11 @@
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rsiena -r 323
More information about the Rsiena-commits
mailing list