[Rsiena-commits] r345 - in pkg: RSiena RSiena/R RSiena/data RSiena/man RSiena/src RSiena/src/model/ml RSiena/tests RSienaTest RSienaTest/R RSienaTest/data RSienaTest/doc RSienaTest/man RSienaTest/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jan 6 16:55:32 CET 2020
Author: tomsnijders
Date: 2020-01-06 16:55:32 +0100 (Mon, 06 Jan 2020)
New Revision: 345
Modified:
pkg/RSiena/ChangeLog
pkg/RSiena/DESCRIPTION
pkg/RSiena/R/Sienatest.r
pkg/RSiena/R/globals.r
pkg/RSiena/R/sienaGOF.r
pkg/RSiena/R/sienaModelCreate.r
pkg/RSiena/configure
pkg/RSiena/cran-comments.md
pkg/RSiena/data/allEffects.csv
pkg/RSiena/man/RSiena-package.Rd
pkg/RSiena/man/Wald.Rd
pkg/RSiena/man/sienaGOF.Rd
pkg/RSiena/man/sienaRI.Rd
pkg/RSiena/src/init.cpp
pkg/RSiena/src/model/ml/Chain.cpp
pkg/RSiena/src/model/ml/Chain.h
pkg/RSiena/src/siena07models.cpp
pkg/RSiena/src/siena07models.h
pkg/RSiena/tests/parallel.R
pkg/RSiena/tests/parallel.Rout.save
pkg/RSienaTest/ChangeLog
pkg/RSienaTest/DESCRIPTION
pkg/RSienaTest/R/Sienatest.r
pkg/RSienaTest/R/sienaBayes.r
pkg/RSienaTest/R/sienaGOF.r
pkg/RSienaTest/data/allEffects.csv
pkg/RSienaTest/doc/RSiena.bib
pkg/RSienaTest/man/RSiena-package.Rd
pkg/RSienaTest/man/Wald.Rd
pkg/RSienaTest/tests/parallel.R
pkg/RSienaTest/tests/parallel.Rout.save
Log:
New version 1.2-22
Modified: pkg/RSiena/ChangeLog
===================================================================
--- pkg/RSiena/ChangeLog 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/ChangeLog 2020-01-06 15:55:32 UTC (rev 345)
@@ -1,3 +1,23 @@
+2020-01-04 R-Forge Revision 345, package version 1.2-22.
+Changes in RSiena and RSienaTest:
+ * Tested effects reported in print of Multipar.RSiena and score.Test.
+ * Reordered effects object so that reciAct comes after instead of
+ before inAct and inAct.c.
+ * Operation of siena07 in Test 14 silenced (message Brian Ripley about
+ apparently minor changes depending on the platform).
+
+2019-12-18 packages version 1.2-21.
+Changes in RSiena and RSienaTest:
+ * Tests ended with deleting file Siena.out by unlink instead of file.remove.
+
+2019-12-16 packages version 1.2-20.
+Changes in RSiena:
+ * dumpChain (Chain) and getChainProbabilities (siena07models) dropped;
+ kept in RSienaTest.
+ * Configure line 2274 changed to RBIN="${R_HOME}/bin"
+Changes in RSiena and RSienaTest:
+ * Tests ended with deleting file Siena.out.
+
2019-12-16 R-Forge Revision 344, package version 1.2-19.
Changes in RSiena and RSienaTest:
* SienaTimeTest: some corrections with consequences probably only if
Modified: pkg/RSiena/DESCRIPTION
===================================================================
--- pkg/RSiena/DESCRIPTION 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/DESCRIPTION 2020-01-06 15:55:32 UTC (rev 345)
@@ -2,8 +2,8 @@
Package: RSiena
Type: Package
Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.2-19
-Date: 2019-12-16
+Version: 1.2-22
+Date: 2020-01-04
Author: Ruth Ripley, Krists Boitmanis, Tom A.B. Snijders, Felix Schoenenberger,
Nynke Niezink
Depends: R (>= 2.15.0)
Modified: pkg/RSiena/R/Sienatest.r
===================================================================
--- pkg/RSiena/R/Sienatest.r 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/R/Sienatest.r 2020-01-06 15:55:32 UTC (rev 345)
@@ -321,7 +321,7 @@
}
if (sum(test) <= 0) stop(paste('Something should be tested, but the total requested is',
sum(test)))
- if (length(test) != ans$pp) stop('Dimensions of must agree')
+ if (length(test) != ans$pp) stop('Dimensions of test must agree')
if (any(test & (!ans$fix))) warning('Warning: some tested parameters were not fixed; do you know what you are doing??? \n')
fra <- colMeans(ans$sf, na.rm=TRUE)
redundant <- (ans$fix & (!test))
@@ -337,7 +337,12 @@
onesided <- NULL
}
pval <- 1 - pchisq(teststat, df)
- t.ans <- list(chisquare=teststat, df=df, pvalue=pval, onesided=onesided)
+ efnames <- paste(ans$effects$name[test], ans$effects$effectName[test], sep=': ')
+ if (any(ans$effects$type != "eval"))
+ {
+ efnames <- paste(efnames, ans$effects$type[test], sep=' ')
+ }
+ t.ans <- list(chisquare=teststat, df=df, pvalue=pval, onesided=onesided, efnames=efnames)
class(t.ans) <- "sienaTest"
t.ans
}
@@ -381,10 +386,18 @@
Multipar.RSiena <- function(ans, ...)
{
p <- length(ans$theta)
- k <- length(c(...))
+ tested <- c(...)
+ efnames <- paste(ans$effects$name[tested], ans$effects$effectName[tested], sep=': ')
+ if (any(ans$effects$type != "eval"))
+ {
+ efnames <- paste(efnames, ans$effects$type[tested], sep=' ')
+ }
+ k <- length(tested)
A <- matrix(0, nrow=k, ncol=p)
- A[cbind(1:k,c(...))] <- 1
- Wald.RSiena(A, ans)
+ A[cbind(1:k,tested)] <- 1
+ t.ans <- Wald.RSiena(A, ans)
+ t.ans$efnames <- efnames
+ t.ans
}
##@print.sienaTest Methods
@@ -394,6 +407,11 @@
{
stop("not a legitimate sienaTest object")
}
+ if (!is.null(x$efnames))
+ {
+ cat('Tested effects:\n ')
+ cat(paste(x$efnames,'\n'))
+ }
cat(paste('chi-squared = ',
format(round(x$chisquare, digits=2), nsmall = 2),
', d.f. = ', x$df, '; ', sep=''))
Modified: pkg/RSiena/R/globals.r
===================================================================
--- pkg/RSiena/R/globals.r 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/R/globals.r 2020-01-06 15:55:32 UTC (rev 345)
@@ -50,9 +50,9 @@
}
else if (closefiles)
{
- close(x[["outf"]])
- x$outf <<- NULL
- }
+ close(x[["outf"]])
+ x$outf <<- NULL
+ }
else
{
if (missing(dest) && missing(hdest))
@@ -111,7 +111,7 @@
}
}
}
- }
+ }
}
@@ -141,50 +141,50 @@
##@Heading Reporting Global function
Heading<- function(level=1, dest, text, fill=FALSE)
{
- ch <- c("=", "-", " ")[level]
- if (missing(dest))
- {
+ ch <- c("=", "-", " ")[level]
+ if (missing(dest))
+ {
Report(c("\n", "@", level, "\n", text, "\n"), sep="", fill=fill)
Report(rep(ch, sum(nchar(text)) + 3), sep="", fill=fill)
- Report("\n\n")
- }
- else
- {
- dest <- deparse(substitute(dest))
- Report(c("\n", "@", level, "\n", text, "\n"), hdest=dest, sep="", fill=fill)
+ Report("\n\n")
+ }
+ else
+ {
+ dest <- deparse(substitute(dest))
+ Report(c("\n", "@", level, "\n", text, "\n"), hdest=dest, sep="", fill=fill)
Report(rep(ch, sum(nchar(text))), hdest=dest, sep="", fill=fill)
- if (level < 3)
- {
- Report("\n\n", hdest = dest)
- }
- else
- {
- Report("\n", hdest = dest)
- }
- }
+ if (level < 3)
+ {
+ Report("\n\n", hdest = dest)
+ }
+ else
+ {
+ Report("\n", hdest = dest)
+ }
+ }
}
##@PrtOutMat Reporting
PrtOutMat<- function(mat, dest)
-{
+ {
if (is.null(mat))
- {
- return()
- }
- testing <- Sys.getenv("RSIENATESTING")
- testing <- testing != ""
- if (missing(dest))
- {
- Report(format(t(mat), scientific=testing),
- sep=c(rep.int(" ", ncol(mat) - 1), "\n"))
- }
- else
- {
- Report(format(t(mat), scientific=testing),
- sep=c(rep.int(" ", ncol(mat) - 1), "\n"),
- hdest=deparse(substitute(dest)))
- Report("\n", hdest=deparse(substitute(dest)))
- }
+ {
+ return()
+ }
+ testing <- Sys.getenv("RSIENATESTING")
+ testing <- testing != ""
+ if (missing(dest))
+ {
+ Report(format(t(mat), scientific=testing),
+ sep=c(rep.int(" ", ncol(mat) - 1), "\n"))
+ }
+ else
+ {
+ Report(format(t(mat), scientific=testing),
+ sep=c(rep.int(" ", ncol(mat) - 1), "\n"),
+ hdest=deparse(substitute(dest)))
+ Report("\n", hdest=deparse(substitute(dest)))
+ }
}
##@NullChecks siena07/GlobalFunctions Resets global flags
NullChecks <- function()
Modified: pkg/RSiena/R/sienaGOF.r
===================================================================
--- pkg/RSiena/R/sienaGOF.r 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/R/sienaGOF.r 2020-01-06 15:55:32 UTC (rev 345)
@@ -138,7 +138,7 @@
sienaFitObject$f,
sienaFitObject$sims, j, groupName, varName, ...)
})
- cat(" > Completed ", iterations, " calculations\n")
+ cat(" > Completed ", iterations, " calculations\n\n")
flush.console()
simStatsByPeriod <-
matrix(simStatsByPeriod, ncol=iterations)
Modified: pkg/RSiena/R/sienaModelCreate.r
===================================================================
--- pkg/RSiena/R/sienaModelCreate.r 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/R/sienaModelCreate.r 2020-01-06 15:55:32 UTC (rev 345)
@@ -11,7 +11,7 @@
##@sienaModelCreate DataCreate
sienaModelCreate <- function(fn,
- projname="Siena", MaxDegree=NULL, Offset=NULL,
+ projname="Siena", MaxDegree=NULL, Offset=NULL,
useStdInits=FALSE,
n3=1000, nsub=4, n2start = NULL, dolby=TRUE,
maxlike=FALSE, diagonalize=0.2*!maxlike,
Modified: pkg/RSiena/configure
===================================================================
--- pkg/RSiena/configure 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/configure 2020-01-06 15:55:32 UTC (rev 345)
@@ -2267,7 +2267,7 @@
if test -z "${R_HOME}"; then
as_fn_error $? "could not determine R_HOME" "$LINENO" 5
fi
-RBIN="${R_HOME}/bin/R"
+RBIN="${R_HOME}/bin"
CC=`"${RBIN}" CMD config CC`;
CFLAGS=`"${RBIN}" CMD config CFLAGS`
LIBS="${PKG_LIBS}"
Modified: pkg/RSiena/cran-comments.md
===================================================================
--- pkg/RSiena/cran-comments.md 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/cran-comments.md 2020-01-06 15:55:32 UTC (rev 345)
@@ -1,12 +1,35 @@
+# RSiena new version 1.2-21 (2019-12-18)
+
+## The only remaining NOTE was that on x86_64-pc-linux-gnu (64-bit)
+ apparently the file Siena.out was not deleted. This now is done
+ by calling unlink().
+
+# RSiena new version 1.2-20 (2019-12-16)
+
+## The note in Debian about existence of file Siena.out in the
+ check directory was fixed, using file.remove().
+
+## The additional issue for the earlier version 1.2-12 in LTO
+ (about getChainProbabilities) was fixed by dropping this function
+ which was not used anyway.
+
+## The additional issue for the earlier version 1.2-12 in rchk (about DumpChain)
+ was fixed by dropping this function which was not used anyway.
+
+
# RSiena new version 1.2-19 (2019-12-16)
## Kurt Hornik sent me a message that it was necessary to replace the use of
- (class(..) == ... ) by (inherits(...)). This was done.
+ (class(..) == ... ) by (inherits(...)).
+ This was done, and fixes the error in the earlier version 1.2-12 occurring
+ for r-devel-linux-x86_64-debian-clang.
## Passed checks on Windows, Mac, and Linux for R-release and R-devel.
* No ERRORs or WARNINGs.
* On some systems there is a NOTE about the installed package size,
which is due to the use of a lot of compiled C++ code.
+* Sometimes NOTEs about computation times of examples.
+ These require simulations, and times are barely over 5s.
## There are quite some parts in the .Rd files with donttest.
This is because executing them is too time-consuming.
Modified: pkg/RSiena/data/allEffects.csv
===================================================================
--- pkg/RSiena/data/allEffects.csv 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/data/allEffects.csv 2020-01-06 15:55:32 UTC (rev 345)
@@ -338,9 +338,9 @@
nonSymmetricObjective,outdegree - activity,Sum of squared outdegrees,outAct,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,TRUE
nonSymmetricObjective,outdegree-activity (centrd),Sum of squared outdegrees (centrd),outAct.c,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,,TRUE
nonSymmetricObjective,outdegree - activity (sqrt),Sum of outdegrees^(1.5),outActSqrt,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,TRUE
-nonSymmetricObjective,rec.degree^(1/#) - activity,Sum rec.degr^(1/#) x outdegr,reciAct,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,TRUE
nonSymmetricObjective,indegree - activity,Sum of crossproducts indegree x outdegree,inAct,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,ego,TRUE
nonSymmetricObjective,indegree-activity (centrd),Sum crossprod indegree x outdegree (centrd),inAct.c,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,ego,TRUE
+nonSymmetricObjective,rec.degree^(1/#) - activity,Sum rec.degr^(1/#) x outdegr,reciAct,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,TRUE
nonSymmetricObjective,outdegree-trunc(#),Sum of outdegrees trunc(#),outTrunc,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,TRUE
nonSymmetricObjective,outdegree-trunc(#),Sum of outdegrees trunc(#),outTrunc2,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,5,objective,NA,NA,0,0,0,0,,TRUE
nonSymmetricObjective,outdegree more(#),Sum of outdegrees more(#),outMore,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,,TRUE
Modified: pkg/RSiena/man/RSiena-package.Rd
===================================================================
--- pkg/RSiena/man/RSiena-package.Rd 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/man/RSiena-package.Rd 2020-01-06 15:55:32 UTC (rev 345)
@@ -44,8 +44,8 @@
\tabular{ll}{
Package: \tab RSiena\cr
Type: \tab Package\cr
- Version: \tab 1.2-19\cr
- Date: \tab 2019-12-16\cr
+ Version: \tab 1.2-22\cr
+ Date: \tab 2020-01-02\cr
Depends: \tab R (>= 3.0.0)\cr
Imports: \tab Matrix\cr
Suggests: \tab tcltk, network, codetools, lattice, MASS, parallel,
Modified: pkg/RSiena/man/Wald.Rd
===================================================================
--- pkg/RSiena/man/Wald.Rd 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/man/Wald.Rd 2020-01-06 15:55:32 UTC (rev 345)
@@ -58,6 +58,8 @@
\item{df: }{ The degrees of freedom.}
\item{pvalue: }{ The associated \emph{p}-value.}
\item{onesided: }{For \code{df}=1, the onesided test statistic.}
+ \item{efnames: }{For \code{Multipar.RSiena} and \code{score.Test}, the names
+ of the tested effects.}
}
}
\references{See the manual and \url{http://www.stats.ox.ac.uk/~snijders/siena/}}
Modified: pkg/RSiena/man/sienaGOF.Rd
===================================================================
--- pkg/RSiena/man/sienaGOF.Rd 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/man/sienaGOF.Rd 2020-01-06 15:55:32 UTC (rev 345)
@@ -233,7 +233,7 @@
myeff <- includeEffects(myeff, transTrip)
myeff <- setEffect(myeff, cycle3, fix=TRUE, test=TRUE)
myeff <- setEffect(myeff, transTies, fix=TRUE, test=TRUE)
-myalgorithm <- sienaAlgorithmCreate(nsub=1, n3=50)
+myalgorithm <- sienaAlgorithmCreate(nsub=1, n3=25)
# Shorter phases 2 and 3, just for example.
ans <- siena07(myalgorithm, data=mydata, effects=myeff, batch=TRUE, returnDeps=TRUE)
gofi <- sienaGOF(ans, IndegreeDistribution, verbose=TRUE, join=TRUE,
@@ -250,7 +250,6 @@
myeff <- getEffects(mydata)
myeff <- includeEffects(myeff, transTrip)
myeff <- includeEffects(myeff, recip, name="mynet2")
-# Shorter phases 2 and 3, just for example.
ans <- siena07(myalgorithm, data=mydata, effects=myeff, batch=TRUE, returnDeps=TRUE)
gofi <- sienaGOF(ans, IndegreeDistribution, verbose=TRUE, join=TRUE,
varName="mynet1")
Modified: pkg/RSiena/man/sienaRI.Rd
===================================================================
--- pkg/RSiena/man/sienaRI.Rd 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/man/sienaRI.Rd 2020-01-06 15:55:32 UTC (rev 345)
@@ -167,7 +167,7 @@
\code{print} method for \code{sienaRI} objects.}
\item{- \code{sigma}}{a list of effects by ego matrices of the values of the within-ego
standard deviations of the change statistics. Their averages (over egos)
- are printed if \code{printSigma=TRUE}.}
+ are printed if \code{printSigma=TRUE}.}
\item{- \code{changeStatistics}}{a list of arrays (effects by alters by egos)
containing for each observation moment,
the values of the change statistics for toggling the tie from actor
@@ -187,7 +187,7 @@
}
\author{Natalie Indlekofer, some additions by Tom Snijders}
\examples{
-myalgorithm <- sienaAlgorithmCreate(nsub=2, n3=50)
+myalgorithm <- sienaAlgorithmCreate(nsub=1, n3=50)
mynet1 <- sienaDependent(array(c(tmp3, tmp4), dim=c(32, 32, 2)))
mydata <- sienaDataCreate(mynet1)
myeff <- getEffects(mydata)
@@ -201,7 +201,7 @@
plot(RI, actors=1:20, addPieChart=TRUE, radius=1.08)
}
-myalgorithm <- sienaAlgorithmCreate(nsub=2, n3=50)
+myalgorithm <- sienaAlgorithmCreate(nsub=1, n3=50)
mynet2 <- sienaDependent(array(c(s502, s503), dim=c(50, 50, 2)))
mybeh <- sienaDependent(s50a[,2:3], type="behavior")
mydata2 <- sienaDataCreate(mynet2, mybeh)
Modified: pkg/RSiena/src/init.cpp
===================================================================
--- pkg/RSiena/src/init.cpp 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/src/init.cpp 2020-01-06 15:55:32 UTC (rev 345)
@@ -34,7 +34,6 @@
CALLDEF(effects, 2),
CALLDEF(ExogEvent, 2),
CALLDEF(forwardModel, 16),
- CALLDEF(getChainProbabilities, 8),
CALLDEF(getTargets, 6),
CALLDEF(interactionEffects, 2),
CALLDEF(mlInitializeSubProcesses, 10),
Modified: pkg/RSiena/src/model/ml/Chain.cpp
===================================================================
--- pkg/RSiena/src/model/ml/Chain.cpp 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/src/model/ml/Chain.cpp 2020-01-06 15:55:32 UTC (rev 345)
@@ -1331,49 +1331,10 @@
// }
return pChain;
}
-void Chain::dumpChain() const
-{
- Rprintf(" period %d %x\n",this->lperiod, this->lpInitialState);
- for (unsigned i = 0; i < this->lminiSteps.size(); i++)
- {
- PrintValue(getMiniStepDF(*this->lminiSteps[i]));
- }
- for (unsigned i = 0; i < this->ldiagonalMiniSteps.size(); i++)
- {
- PrintValue(getMiniStepDF(*(this->ldiagonalMiniSteps[i])));
- }
- for (unsigned i = 0; i < this->lccpMiniSteps.size(); i++)
- {
- PrintValue(getMiniStepDF(*this->lccpMiniSteps[i]));
- }
- for (unsigned i = 0; i < this->lmissingNetworkMiniSteps.size(); i++)
- {
- PrintValue(getMiniStepDF(*this->lmissingNetworkMiniSteps[i]));
- }
- for (unsigned i = 0; i < this->lmissingBehaviorMiniSteps.size(); i++)
- {
- PrintValue(getMiniStepDF(*this->lmissingBehaviorMiniSteps[i]));
- }
-// Rprintf("%d\n", this->lfirstMiniStepPerOption.size());
- map<const Option, MiniStep *>::const_iterator iter;
- for (iter = this->lfirstMiniStepPerOption.begin(); iter !=
- this->lfirstMiniStepPerOption.end();
- iter++)
- {
- //Option myOption = iter->first;
- if (iter->second)
- {
- PrintValue(getMiniStepDF(*iter->second));
- }
- //MiniStep * myMiniStep = iter->second;
- //Rprintf("%d \n",myMiniStep->ego());
- //PrintValue(getMiniStepDF(*iter->second));
- }
- for(unsigned i = 0; i < this->linitialStateDifferences.size(); i++)
- {
- PrintValue(getMiniStepDF(*(this->linitialStateDifferences[i])));
+//void Chain::dumpChain() const
+// see RSienaTest
+
+
}
-}
-}
Modified: pkg/RSiena/src/model/ml/Chain.h
===================================================================
--- pkg/RSiena/src/model/ml/Chain.h 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/src/model/ml/Chain.h 2020-01-06 15:55:32 UTC (rev 345)
@@ -108,7 +108,7 @@
// Copy
Chain * copyChain() const;
- void dumpChain() const;
+// void dumpChain() const;
private:
void resetOrderingKeys();
Modified: pkg/RSiena/src/siena07models.cpp
===================================================================
--- pkg/RSiena/src/siena07models.cpp 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/src/siena07models.cpp 2020-01-06 15:55:32 UTC (rev 345)
@@ -763,127 +763,5 @@
}
-/** Recalculates the probabilities for a stored chain
- * corresponding to a specific group and period and
- * (negative) index. (index 1 is final).
- */
-SEXP getChainProbabilities(SEXP DATAPTR, SEXP MODELPTR,
- SEXP GROUP, SEXP PERIOD, SEXP INDEX, SEXP EFFECTSLIST, SEXP THETA,
- SEXP GETSCORES)
-{
- /* need to make sure the parameters have been updated first */
- /* get hold of the data vector */
- vector<Data *> * pGroupData = (vector<Data *> *)
- R_ExternalPtrAddr(DATAPTR);
-
- int group = asInteger(GROUP) - 1;
- int period = asInteger(PERIOD) - 1;
- int groupPeriod = periodFromStart(*pGroupData, group, period);
- Data * pData = (*pGroupData)[group];
- /* get hold of the model object */
- Model * pModel = (Model *) R_ExternalPtrAddr(MODELPTR);
-
- /* update the parameters */
- updateParameters(EFFECTSLIST, THETA, pGroupData, pModel);
-
- /* create the ML simulation object */
- MLSimulation * pMLSimulation = new MLSimulation(pData, pModel);
-
- pMLSimulation->simpleRates(pModel->simpleRates());
-
- // get chain for this period from model
- int index = pModel->rChainStore(groupPeriod).size() - asInteger(INDEX);
- //Rprintf(" %d \n",pModel->rChainStore(groupPeriod).size());
- if (index < 0)
- {
- error("index invalid");
- }
- Chain * pChain = pModel->rChainStore(groupPeriod)[index];
- // then copy the chain to the MLSimulation object. (deleting new one first)
- pMLSimulation->pChain(pChain->copyChain());
-
- int needScores = asInteger(GETSCORES);
- int deriv = 0;
- pModel->needScores(needScores);
- pModel->needDerivatives(deriv);
-
- /* set the number of steps to zero */
- pModel->numberMLSteps(0);
-
- /* run the epoch simulation for this period (do initialization) */
- pMLSimulation->runEpoch(period);
-
- SEXP ans;
- PROTECT(ans = allocVector(VECSXP, 3));
-
- double loglik = pMLSimulation->calculateLikelihood();
-
- SET_VECTOR_ELT(ans, 0, ScalarReal(loglik));
-
- if (needScores)
- {
- int dim = 0;
- for (int i = 0; i < length(EFFECTSLIST); i++)
- {
- dim += length(VECTOR_ELT(VECTOR_ELT(EFFECTSLIST, i), 0));
- }
-
- /* fra will contain the scores and must be initialised
- to 0. Use rfra to reduce function evaluations. */
- SEXP fra;
- double * rfra;
- PROTECT(fra = allocVector(REALSXP, dim));
- rfra = REAL(fra);
- for (int i = 0; i < length(fra); i++)
- {
- rfra[i] = 0;
- }
-
- /* dff will hold the return values of the derivatives */
- SEXP dff;
- double *rdff;
- if (deriv)
- {
- PROTECT(dff = allocVector(REALSXP, dim * dim));
- rdff = REAL(dff);
- for (int i = 0; i < length(dff); i++)
- {
- rdff[i] = 0.0;
- }
- }
-
- /* collect the scores and derivatives */
- vector<double> derivs(dim * dim);
- vector<double> score(dim);
- getScores(EFFECTSLIST, period, group, pMLSimulation,
- &derivs, &score);
- /* fill up vectors for return value list */
- for (unsigned effectNo = 0; effectNo < score.size();
- effectNo++)
- {
- rfra[effectNo] = score[effectNo];
- }
- if (deriv)
- {
- for (unsigned ii = 0; ii < derivs.size(); ii++)
- {
- rdff[ii] = derivs[ii];
- }
- }
- SET_VECTOR_ELT(ans, 1, fra);
- UNPROTECT(1);
- if (deriv)
- {
- SET_VECTOR_ELT(ans, 2, dff);
- UNPROTECT(1);
- }
- }
-
- delete pMLSimulation;
-
- UNPROTECT(1);
- return ans;
}
-
-}
Modified: pkg/RSiena/src/siena07models.h
===================================================================
--- pkg/RSiena/src/siena07models.h 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/src/siena07models.h 2020-01-06 15:55:32 UTC (rev 345)
@@ -40,10 +40,6 @@
SEXP clearStoredChains(SEXP MODELPTR, SEXP KEEP, SEXP GROUPPERIOD);
-SEXP getChainProbabilities(SEXP DATAPTR, SEXP MODELPTR,
- SEXP GROUP, SEXP PERIOD, SEXP INDEX, SEXP EFFECTSLIST, SEXP THETA,
- SEXP GETSCORES);
-
} // extern "C"
#endif /*SIENA07MODELS_H_*/
Modified: pkg/RSiena/tests/parallel.R
===================================================================
--- pkg/RSiena/tests/parallel.R 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/tests/parallel.R 2020-01-06 15:55:32 UTC (rev 345)
@@ -5,7 +5,7 @@
mynet1 <- sienaDependent(array(c(tmp3, tmp4),dim=c(32, 32, 2)))
mydata <- sienaDataCreate(mynet1)
myeff<- getEffects(mydata)
-mymodel<- model.create(findiff=TRUE, fn = simstats0c, projname='test3',
+mymodel<- model.create(findiff=TRUE, fn = simstats0c,
cond=FALSE, nsub=2, n3=50, seed=3)
print('test3')
ans<- siena07(mymodel, data=mydata, effects=myeff,
@@ -15,7 +15,6 @@
(myeff <- includeEffects(myeff, transTrip, cycle4))
(myeff <- includeEffects(myeff, cycle4, include=FALSE))
##test4
-mymodel$projname <- 'test4'
mymodel$cconditional <- TRUE
mymodel$condvarno<- 1
print('test4')
@@ -27,7 +26,7 @@
mynet1 <- sienaDependent(array(c(tmp3,tmp4),dim=c(32,32,2)))
mydata <- sienaDataCreate(mynet1)
myeff<- getEffects(mydata)
-mymodel<- model.create(fn = simstats0c, projname='test5', nsub=2, n3=50,
+mymodel<- model.create(fn = simstats0c, nsub=2, n3=50,
cond=FALSE, seed=5)
print('test5')
ans<- siena07(mymodel, data=mydata, effects=myeff, batch=TRUE,
@@ -42,7 +41,7 @@
mynet1 <- sienaDependent(array(c(tmp3,tmp4),dim=c(32,32,2)))
mydata <- sienaDataCreate(mynet1)
myeff<- getEffects(mydata)
-mymodel<- model.create(fn = simstats0c, projname='test6', nsub=2, n3=50,
+mymodel<- model.create(fn = simstats0c, nsub=2, n3=50,
cond=FALSE, doubleAveraging=0,seed=5)
print('test6')
ans<- siena07(mymodel, data=mydata, effects=myeff, batch=TRUE,
@@ -52,7 +51,7 @@
mynet1 <- sienaDependent(array(c(tmp3,tmp4),dim=c(32,32,2)))
mydata <- sienaDataCreate(mynet1)
myeff<- getEffects(mydata)
-mymodel<- model.create(fn = simstats0c, projname='test7', nsub=2, n3=50,
+mymodel<- model.create(fn = simstats0c, nsub=2, n3=50,
cond=FALSE, diagonalize=0.5, seed=5)
print('test7')
ans<- siena07(mymodel, data=mydata, effects=myeff, batch=TRUE,
@@ -60,7 +59,7 @@
##, verbose=TRUE)#,dll='../siena/src/RSiena.dll')
ans
##test8
-mymodel<- model.create(fn = simstats0c, projname='test8', nsub=1, n3=50,
+mymodel<- model.create(fn = simstats0c, nsub=1, n3=50,
cond=TRUE, condvarno=1, seed=5)
print('test8')
ans <- siena07(mymodel, data=mydata, effects=myeff, batch=TRUE,
@@ -78,7 +77,6 @@
##myeff$initialValue[98] <- 0.34699930338 ## siena3 starting values differ
##test10
print('test10')
-mymodel$projname <- 'test10'
mymodel$cconditional <- TRUE
mymodel$condvarno<- 1
ans <- siena07(mymodel, data=mydata, effects=myeff, batch=TRUE,
@@ -87,7 +85,7 @@
ans
##test11
print('test11')
-mymodel<- model.create(fn = simstats0c, projname='test11', nsub=1, n3=50,
+mymodel<- model.create(fn = simstats0c, nsub=1, n3=50,
behModelType=c(mynet2=2), seed=6)
(ans <- siena07(mymodel, data=mydata, effects=myeff, batch=TRUE,
parallelTesting=TRUE, silent=TRUE))
@@ -104,8 +102,7 @@
myeff <- getEffects(mydata)
myeff <- includeEffects(myeff, inPop)
myeff <- setEffect(myeff, altInDist2, interaction1="myvar1", parameter=1)
-ans <- siena07(sienaModelCreate(n3=50, nsub=2,
- seed=1, projname="test12"),
+ans <- siena07(sienaModelCreate(n3=50, nsub=2, seed=1),
data=mydata, effects=myeff, batch=TRUE, silent=TRUE)
ans
tt <- sienaTimeTest(ans)
@@ -123,8 +120,7 @@
myeff <- getEffects(mydata)
myeff <- setEffect(myeff, altInDist2, interaction1="myvar1", parameter=1)
myeff <- setEffect(myeff, egoX, interaction1="myvar1")
-(ans <- siena07(sienaModelCreate(n3=50, nsub=2,
- seed=1, projname="test13"),
+(ans <- siena07(sienaModelCreate(n3=50, nsub=2, seed=1),
data=mydata, effects=myeff, batch=TRUE, silent=TRUE))
##test14
print('test14')
@@ -133,7 +129,7 @@
myeff <- getEffects(dataset)
myeff <- includeEffects(myeff, inPop)
algo <- sienaAlgorithmCreate(nsub=1, n3=20, maxlike=TRUE, seed=15, mult=1)
-(ans <- siena07(algo, data=dataset, effects=myeff, batch=TRUE))
+(ans <- siena07(algo, data=dataset, effects=myeff, batch=TRUE, silent=TRUE))
##test16
print('test16')
set.seed(123) # simulate behavior data according to dZ(t) = [-0.1 Z + 1] dt + 1 dW(t)
@@ -143,5 +139,7 @@
behavior <- sienaDependent(matrix(c(y1,y2), 50,2), type = "continuous")
(mydata <- sienaDataCreate(friend, behavior))
(myeff <- getEffects(mydata, onePeriodSde = TRUE))
-algorithmMoM <- sienaAlgorithmCreate(nsub=1, n3=20, seed=321, projname='test16')
+algorithmMoM <- sienaAlgorithmCreate(nsub=1, n3=20, seed=321)
(ans <- siena07(algorithmMoM, data = mydata, effects = myeff, batch=TRUE))
+## delete output file
+if (file.exists('Siena.out')){unlink('Siena.out')}
\ No newline at end of file
Modified: pkg/RSiena/tests/parallel.Rout.save
===================================================================
--- pkg/RSiena/tests/parallel.Rout.save 2019-12-16 15:39:36 UTC (rev 344)
+++ pkg/RSiena/tests/parallel.Rout.save 2020-01-06 15:55:32 UTC (rev 345)
@@ -22,7 +22,7 @@
> mynet1 <- sienaDependent(array(c(tmp3, tmp4),dim=c(32, 32, 2)))
> mydata <- sienaDataCreate(mynet1)
> myeff<- getEffects(mydata)
-> mymodel<- model.create(findiff=TRUE, fn = simstats0c, projname='test3',
+> mymodel<- model.create(findiff=TRUE, fn = simstats0c,
+ cond=FALSE, nsub=2, n3=50, seed=3)
> print('test3')
[1] "test3"
@@ -63,7 +63,6 @@
3 reciprocity TRUE FALSE FALSE 0.00000 0
4 transitive triplets TRUE FALSE FALSE 0.00000 0
> ##test4
-> mymodel$projname <- 'test4'
> mymodel$cconditional <- TRUE
> mymodel$condvarno<- 1
> print('test4')
@@ -94,7 +93,7 @@
> mynet1 <- sienaDependent(array(c(tmp3,tmp4),dim=c(32,32,2)))
> mydata <- sienaDataCreate(mynet1)
> myeff<- getEffects(mydata)
-> mymodel<- model.create(fn = simstats0c, projname='test5', nsub=2, n3=50,
+> mymodel<- model.create(fn = simstats0c, nsub=2, n3=50,
+ cond=FALSE, seed=5)
> print('test5')
[1] "test5"
@@ -143,12 +142,14 @@
Total of 395 iteration steps.
> score.Test(ans, 4)
+Tested effects:
+ mynet1: outdegree-activity eval
chi-squared = 5.52, d.f. = 1; one-sided Z = 2.35; p = 0.019.
> ##test6
> mynet1 <- sienaDependent(array(c(tmp3,tmp4),dim=c(32,32,2)))
> mydata <- sienaDataCreate(mynet1)
> myeff<- getEffects(mydata)
-> mymodel<- model.create(fn = simstats0c, projname='test6', nsub=2, n3=50,
+> mymodel<- model.create(fn = simstats0c, nsub=2, n3=50,
+ cond=FALSE, doubleAveraging=0,seed=5)
> print('test6')
[1] "test6"
@@ -172,7 +173,7 @@
> mynet1 <- sienaDependent(array(c(tmp3,tmp4),dim=c(32,32,2)))
> mydata <- sienaDataCreate(mynet1)
> myeff<- getEffects(mydata)
-> mymodel<- model.create(fn = simstats0c, projname='test7', nsub=2, n3=50,
+> mymodel<- model.create(fn = simstats0c, nsub=2, n3=50,
+ cond=FALSE, diagonalize=0.5, seed=5)
> print('test7')
[1] "test7"
@@ -194,7 +195,7 @@
Total of 545 iteration steps.
> ##test8
-> mymodel<- model.create(fn = simstats0c, projname='test8', nsub=1, n3=50,
+> mymodel<- model.create(fn = simstats0c, nsub=1, n3=50,
+ cond=TRUE, condvarno=1, seed=5)
> print('test8')
[1] "test8"
@@ -235,7 +236,6 @@
> ##test10
> print('test10')
[1] "test10"
-> mymodel$projname <- 'test10'
> mymodel$cconditional <- TRUE
> mymodel$condvarno<- 1
> ans <- siena07(mymodel, data=mydata, effects=myeff, batch=TRUE,
@@ -271,7 +271,7 @@
> ##test11
> print('test11')
[1] "test11"
-> mymodel<- model.create(fn = simstats0c, projname='test11', nsub=1, n3=50,
+> mymodel<- model.create(fn = simstats0c, nsub=1, n3=50,
+ behModelType=c(mynet2=2), seed=6)
> (ans <- siena07(mymodel, data=mydata, effects=myeff, batch=TRUE,
+ parallelTesting=TRUE, silent=TRUE))
@@ -319,8 +319,7 @@
> myeff <- setEffect(myeff, altInDist2, interaction1="myvar1", parameter=1)
effectName include fix test initialValue parm
1 myvar1 in-alter dist 2 TRUE FALSE FALSE 0 1
-> ans <- siena07(sienaModelCreate(n3=50, nsub=2,
-+ seed=1, projname="test12"),
+> ans <- siena07(sienaModelCreate(n3=50, nsub=2, seed=1),
+ data=mydata, effects=myeff, batch=TRUE, silent=TRUE)
> ans
Estimates, standard errors and convergence t-ratios
@@ -399,8 +398,7 @@
> myeff <- setEffect(myeff, egoX, interaction1="myvar1")
effectName include fix test initialValue parm
1 myvar1 ego TRUE FALSE FALSE 0 0
-> (ans <- siena07(sienaModelCreate(n3=50, nsub=2,
-+ seed=1, projname="test13"),
+> (ans <- siena07(sienaModelCreate(n3=50, nsub=2, seed=1),
+ data=mydata, effects=myeff, batch=TRUE, silent=TRUE))
Estimates, standard errors and convergence t-ratios
@@ -430,59 +428,7 @@
effectName include fix test initialValue parm
1 indegree - popularity TRUE FALSE FALSE 0 0
> algo <- sienaAlgorithmCreate(nsub=1, n3=20, maxlike=TRUE, seed=15, mult=1)
-> (ans <- siena07(algo, data=dataset, effects=myeff, batch=TRUE))
-
-Start phase 0
-theta: 4.81 -0.56 0.00 0.00
-
-Start phase 1
-Phase 1 Iteration 1 Progress: 0%
-Phase 1 Iteration 2 Progress: 1%
-Phase 1 Iteration 3 Progress: 1%
-Phase 1 Iteration 4 Progress: 1%
-Phase 1 Iteration 5 Progress: 1%
-Phase 1 Iteration 6 Progress: 2%
-Phase 1 Iteration 7 Progress: 2%
-Phase 1 Iteration 8 Progress: 2%
-Phase 1 Iteration 9 Progress: 3%
-Phase 1 Iteration 10 Progress: 3%
-Phase 1 Iteration 11 Progress: 3%
-Phase 1 Iteration 12 Progress: 4%
-Phase 1 Iteration 13 Progress: 4%
-Phase 1 Iteration 14 Progress: 4%
-Phase 1 Iteration 15 Progress: 4%
-Phase 1 Iteration 16 Progress: 5%
-Phase 1 Iteration 17 Progress: 5%
-Phase 1 Iteration 18 Progress: 5%
-Phase 1 Iteration 19 Progress: 6%
-theta: 4.78357 -0.62565 0.12958 0.00709
-
-Start phase 2.1
-Phase 2 Subphase 1 Iteration 1 Progress: 28%
-Phase 2 Subphase 1 Iteration 2 Progress: 28%
-theta 4.7601 -0.7322 0.3177 0.0171
-ac 0.410 0.905 1.163 0.981
-Phase 2 Subphase 1 Iteration 3 Progress: 29%
-Phase 2 Subphase 1 Iteration 4 Progress: 29%
-theta 4.5553 -1.0509 0.8932 0.0487
-ac 0.567 0.951 1.204 1.027
-Phase 2 Subphase 1 Iteration 5 Progress: 29%
-Phase 2 Subphase 1 Iteration 6 Progress: 30%
-theta 4.4930 -1.2943 1.3546 0.0727
-ac 0.285 0.883 1.216 0.982
-Phase 2 Subphase 1 Iteration 7 Progress: 30%
-Phase 2 Subphase 1 Iteration 8 Progress: 30%
-theta 4.3276 -1.3769 1.5587 0.0837
-ac 0.416 0.896 1.211 0.984
-Phase 2 Subphase 1 Iteration 9 Progress: 30%
-Phase 2 Subphase 1 Iteration 10 Progress: 31%
-theta 4.1928 -1.3873 1.6731 0.0851
-ac 0.547 0.886 1.210 0.974
-theta 3.750 -1.622 1.805 0.125
-ac 0.468 0.625 0.966 0.654
-theta: 3.750 -1.622 1.805 0.125
-
-Start phase 3
+> (ans <- siena07(algo, data=dataset, effects=myeff, batch=TRUE, silent=TRUE))
Estimated by Maximum Likelihood
Estimates, standard errors and convergence t-ratios
@@ -537,7 +483,7 @@
5 behavior wiener (behavior.behavior) TRUE FALSE FALSE 0.85769 0
6 behavior feedback from behavior TRUE FALSE FALSE -0.11172 0
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rsiena -r 345
More information about the Rsiena-commits
mailing list