[Rsiena-commits] r319 - in pkg/RSienaTest: . R src src/estimator/update/step/normalization src/sim tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Sep 10 19:07:28 CEST 2017
Author: fschoenen
Date: 2017-09-10 19:07:28 +0200 (Sun, 10 Sep 2017)
New Revision: 319
Added:
pkg/RSienaTest/src/init.cpp
pkg/RSienaTest/src/siena07models.h
pkg/RSienaTest/src/siena07setup.h
Modified:
pkg/RSienaTest/ChangeLog
pkg/RSienaTest/NAMESPACE
pkg/RSienaTest/R/CInterface.r
pkg/RSienaTest/R/algorithms.r
pkg/RSienaTest/R/getActorStatistics.r
pkg/RSienaTest/R/getTargets.r
pkg/RSienaTest/R/initializeFRAN.r
pkg/RSienaTest/R/maxlikec.r
pkg/RSienaTest/R/sienaBayes.r
pkg/RSienaTest/R/sienaRI.r
pkg/RSienaTest/R/simstatsc.r
pkg/RSienaTest/R/zzz.R
pkg/RSienaTest/src/Makevars.in
pkg/RSienaTest/src/RInterface.cpp
pkg/RSienaTest/src/RInterface.h
pkg/RSienaTest/src/RUtil.h
pkg/RSienaTest/src/estimator/update/step/normalization/SDStepNormalization.h
pkg/RSienaTest/src/siena07setup.cpp
pkg/RSienaTest/src/sim/Simulation.h
pkg/RSienaTest/tests/parallel.Rout.save
Log:
init.cpp
Modified: pkg/RSienaTest/ChangeLog
===================================================================
--- pkg/RSienaTest/ChangeLog 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/ChangeLog 2017-09-10 17:07:28 UTC (rev 319)
@@ -1,3 +1,8 @@
+2017-09-10 R-Forge Revision 319
+Changes in RSienaTest:
+ * init.cpp: Register native routines.
+ * *.R: Apdapt .Call statements.
+
2017-09-09 R-Forge Revision 318, packages version 1.2-4.
Changes in RSiena and RSienaTest:
* Longer Description field in DESCRIPTION, as per CRAN suggestions.
Modified: pkg/RSienaTest/NAMESPACE
===================================================================
--- pkg/RSienaTest/NAMESPACE 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/NAMESPACE 2017-09-10 17:07:28 UTC (rev 319)
@@ -1,19 +1,24 @@
-useDynLib(RSienaTest)
-export(coCovar, coDyadCovar, getEffects, model.create, print01Report,
- siena01Gui, siena07, sienaCompositionChange, sienaBayes, glueBayes,
- simpleBayesTest, multipleBayesTest, extract.sienaBayes, updateTheta,
- updateSpecification, sienaCompositionChangeFromFile, sienaDataCreate,
- sienaGroupCreate, sienaModelCreate, sienaAlgorithmCreate, sienaNet,
- sienaDependent, sienaNodeSet, xtable.sienaFit,
- varCovar, varDyadCovar, setEffect, includeEffects, includeInteraction,
- effectsDocumentation, sienaDataConstraint, print.xtable.sienaFit,
- installGui, siena08, iwlsm, sienaTimeTest, includeTimeDummy,
- sienaGOF, descriptives.sienaGOF, sienaRI, sienaRIDynamics,
- sparseMatrixExtraction, networkExtraction, behaviorExtraction,
- OutdegreeDistribution, IndegreeDistribution, BehaviorDistribution,
- xtable, algorithms, profileLikelihoods, siena.table, score.Test,
- Wald.RSiena, Multipar.RSiena)
+useDynLib(RSienaTest, .registration = TRUE, .fixes="C_")
+
+export(
+ coCovar, coDyadCovar, getEffects, model.create, print01Report,
+ siena01Gui, siena07, sienaCompositionChange, sienaBayes, glueBayes,
+ simpleBayesTest, multipleBayesTest, extract.sienaBayes, updateTheta,
+ updateSpecification, sienaCompositionChangeFromFile, sienaDataCreate,
+ sienaGroupCreate, sienaModelCreate, sienaAlgorithmCreate, sienaNet,
+ sienaDependent, sienaNodeSet, xtable.sienaFit,
+ varCovar, varDyadCovar, setEffect, includeEffects, includeInteraction,
+ effectsDocumentation, sienaDataConstraint, print.xtable.sienaFit,
+ installGui, siena08, iwlsm, sienaTimeTest, includeTimeDummy,
+ sienaGOF, descriptives.sienaGOF, sienaRI, sienaRIDynamics,
+ sparseMatrixExtraction, networkExtraction, behaviorExtraction,
+ OutdegreeDistribution, IndegreeDistribution, BehaviorDistribution,
+ xtable, algorithms, profileLikelihoods, siena.table, score.Test,
+ Wald.RSiena, Multipar.RSiena
+)
+
export(sienacpp)
+
import(Matrix, tcltk, lattice, parallel, MASS)
importFrom("grDevices", "rgb", "xy.coords")
importFrom("graphics", "axis", "barplot", "contour", "layout", "lines",
Modified: pkg/RSienaTest/R/CInterface.r
===================================================================
--- pkg/RSienaTest/R/CInterface.r 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/R/CInterface.r 2017-09-10 17:07:28 UTC (rev 319)
@@ -75,17 +75,16 @@
#cat('[', clean.callstack(callstack), '] ', msg, '\n', sep='')
cat(msg, '\n', sep='')
} else {
- .Call("sienaLog", priority,
- paste(clean.callstack(callstack), msg, collapse="\n"),
- PACKAGE=pkgname)
+ .Call(C_sienaLog, PACKAGE=pkgname,
+ priority, paste(clean.callstack(callstack), msg, collapse="\n"))
}
}
# Helper function to setup the C++ logger for the old siena07 functions.
sienaSetupLogger <- function(logLevelConsole='INFO', logLevelFile='DEBUG',
logBaseName, logIncludeLocation=F) {
- .Call("sienaSetupLogger", logLevelConsole, logLevelFile, logBaseName,
- logIncludeLocation, 1, PACKAGE=pkgname)
+ .Call(C_sienaSetupLogger, PACKAGE=pkgname,
+ logLevelConsole, logLevelFile, logBaseName, logIncludeLocation, 1)
}
# The RNG setup use by siena07.
@@ -114,7 +113,7 @@
# Mostly copied from the parallel package.
# See: R sources (R/src/library/parallel/R/RngStream.R)
mpiClusterSetRNGStream <- function(iseed) {
- if (.Call("sienaMPISize", PACKAGE=pkgname) > 1) {
+ if (.Call(C_sienaMPISize, PACKAGE=pkgname) > 1) {
RNGkind("L'Ecuyer-CMRG")
# Fix (as in the value can't change anymore) iseed (use it in some way,
# print(iseed) would also work).
@@ -149,7 +148,7 @@
# ##########
# require(parallel) # Not really, just to set up the seeds (nextRNGStream)
set.seed(iseed) # Now set the correct seed
- rank <- .Call("sienaMPIRank", PACKAGE=pkgname)
+ rank <- .Call(C_sienaMPIRank, PACKAGE=pkgname)
seeds <- vector("list", rank+1)
seeds[[1]] <- .Random.seed
for(i in seq_len(rank)) seeds[[i+1]] <- parallel::nextRNGStream(seeds[[i]])
@@ -176,8 +175,8 @@
...
)
{
- rank <- .Call("sienaMPIRank", PACKAGE=pkgname)
- .Call("sienaSetupLogger", logLevelConsole, logLevelFile,
+ rank <- .Call(C_sienaMPIRank, PACKAGE=pkgname)
+ .Call(C_sienaSetupLogger, logLevelConsole, logLevelFile,
paste(logBaseName, rank, sep='-'),
logIncludeLocation, nThreads, PACKAGE=pkgname)
@@ -245,8 +244,8 @@
# Run the estimation.
z$estimationtime <- proc.time()['elapsed']
- z$sienafit <- .Call("sienaEstimateGroup", z,
- f$pModel, f$pData, nThreads, PACKAGE=pkgname)
+ z$sienafit <- .Call(C_sienaEstimateGroup, PACKAGE=pkgname, z,
+ f$pModel, f$pData, nThreads)
z$estimationtime <- proc.time()['elapsed'] - z$estimationtime
z <- reformatSienaFit(z)
# Since we have not set all fields terminateFRAN() would fail.
@@ -682,35 +681,33 @@
# nGroup <- f$nGroup
# f[(nGroup + 1): length(f)] <- NULL
# }
- pData <- .Call("setupData", PACKAGE=pkgname,
+ pData <- .Call(C_setupData, PACKAGE=pkgname,
lapply(f, function(x)(as.integer(x$observations))),
lapply(f, function(x)(x$nodeSets)))
- ans <- .Call("OneMode", PACKAGE=pkgname,
+ ans <- .Call(C_OneMode, PACKAGE=pkgname,
pData, lapply(f, function(x)x$nets))
- ans <- .Call("Bipartite", PACKAGE=pkgname,
+ ans <- .Call(C_Bipartite, PACKAGE=pkgname,
pData, lapply(f, function(x)x$bipartites))
- ans <- .Call("Behavior", PACKAGE=pkgname,
+ ans <- .Call(C_Behavior, PACKAGE=pkgname,
pData, lapply(f, function(x)x$behavs))
- ans <-.Call("ConstantCovariates", PACKAGE=pkgname,
+ ans <-.Call(C_ConstantCovariates, PACKAGE=pkgname,
pData, lapply(f, function(x)x$cCovars))
- ans <-.Call("ChangingCovariates", PACKAGE=pkgname,
+ ans <-.Call(C_ChangingCovariates, PACKAGE=pkgname,
pData, lapply(f, function(x)x$vCovars))
- ans <-.Call("DyadicCovariates", PACKAGE=pkgname,
+ ans <-.Call(C_DyadicCovariates, PACKAGE=pkgname,
pData, lapply(f, function(x)x$dycCovars))
- ans <-.Call("ChangingDyadicCovariates", PACKAGE=pkgname,
+ ans <-.Call(C_ChangingDyadicCovariates, PACKAGE=pkgname,
pData, lapply(f, function(x)x$dyvCovars))
- ans <-.Call("ExogEvent", PACKAGE=pkgname,
+ ans <-.Call(C_ExogEvent, PACKAGE=pkgname,
pData, lapply(f, function(x)x$exog))
## split the names of the constraints
higher <- attr(f, "allHigher")
disjoint <- attr(f, "allDisjoint")
atLeastOne <- attr(f, "allAtLeastOne")
- froms <- sapply(strsplit(names(higher), ","), function(x)x[1])
- tos <- sapply(strsplit(names(higher), ","), function(x)x[2])
- ans <- .Call("Constraints", PACKAGE=pkgname,
- pData, froms[higher], tos[higher],
- froms[disjoint], tos[disjoint],
- froms[atLeastOne], tos[atLeastOne])
+ froms <- sapply(strsplit(names(higher), ","), function(x) x[1])
+ tos <- sapply(strsplit(names(higher), ","), function(x) x[2])
+ ans <- .Call(C_Constraints, PACKAGE = pkgname, pData, froms[higher], tos[higher],
+ froms[disjoint], tos[disjoint], froms[atLeastOne], tos[atLeastOne])
##store the address
f$pData <- pData
@@ -763,7 +760,7 @@
# interactionEffectsl <- ff$interactionEffectsl
# types <- ff$types
# }
- ans <- .Call("effects", PACKAGE=pkgname, pData, basicEffects)
+ ans <- .Call(C_effects, PACKAGE=pkgname, pData, basicEffects)
pModel <- ans[[1]][[1]]
for (i in seq(along=(ans[[2]]))) ## ans[[2]] is a list of lists of
## pointers to effects. Each list corresponds to one
@@ -781,7 +778,7 @@
basicEffects[[i]]$effectPtr[match(interactionEffects[[i]]$effect3,
basicEffects[[i]]$effectNumber)]
}
- ans <- .Call("interactionEffects", PACKAGE=pkgname,
+ ans <- .Call(C_interactionEffects, PACKAGE=pkgname,
pModel, interactionEffects)
## copy these pointers to the interaction effects and then insert in
## effects object in the same rows for later use
@@ -854,7 +851,7 @@
simpleRates <- FALSE
}
z$simpleRates <- simpleRates
- ans <- .Call("setupModelOptions", PACKAGE=pkgname,
+ ans <- .Call(C_setupModelOptions, PACKAGE=pkgname,
pData, pModel, MAXDEGREE, UNIVERSALOFFSET, CONDVAR, CONDTARGET,
profileData, z$parallelTesting, MODELTYPE, BEHMODELTYPE, z$simpleRates,
x$normSetRates)
@@ -889,7 +886,7 @@
stop("Non-local effect chosen.")
}
z$probs <- c(x$pridg, x$prcdg, x$prper, x$pripr, x$prdpr, x$prirms, x$prdrms)
- ans <- .Call("mlMakeChains", PACKAGE=pkgname, pData, pModel,
+ ans <- .Call(C_mlMakeChains, PACKAGE=pkgname, pData, pModel,
z$probs, z$prmin, z$prmib, x$minimumPermutationLength,
x$maximumPermutationLength, x$initialPermutationLength,
z$localML)
Modified: pkg/RSienaTest/R/algorithms.r
===================================================================
--- pkg/RSienaTest/R/algorithms.r 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/R/algorithms.r 2017-09-10 17:07:28 UTC (rev 319)
@@ -180,7 +180,7 @@
parSapply(z$cl, 1:nrow(z$callGrid), function(i, keep)
{
f <- FRANstore()
- .Call("clearStoredChains", PACKAGE=pkgname,
+ .Call(C_clearStoredChains, PACKAGE=pkgname,
f$pModel, keep, i)
}, keep=keep)
}
@@ -189,7 +189,7 @@
sapply(1:nrow(z$callGrid), function(i)
{
f <- FRANstore()
- .Call("clearStoredChains", PACKAGE=pkgname,
+ .Call(C_clearStoredChains, PACKAGE=pkgname,
f$pModel, keep, i)
})
}
@@ -392,7 +392,7 @@
{
f <- FRANstore()
anss <- apply(z$callGrid, 1, function(x)
- .Call("getChainProbabilities", PACKAGE = pkgname, f$pData,
+ .Call(C_getChainProbabilities, PACKAGE = pkgname, f$pData,
f$pModel, as.integer(x[1]), as.integer(x[2]),
as.integer(index), f$myeffects, z$thetaMat[1,], getScores)
)
@@ -602,7 +602,7 @@
doCreateChains <- function()
{
f <- FRANstore()
- ans <- .Call("createChainStorage", PACKAGE=pkgname,
+ ans <- .Call(C_createChainStorage, PACKAGE=pkgname,
f$pData, f$pModel, f$simpleRates)
f$pChain <- ans
FRANstore(f)
@@ -1013,7 +1013,7 @@
clearStoredChains <- function()
{
f <- FRANstore()
- .Call("clearStoredChains", PACKAGE=pkgname, f$pModel)
+ .Call(C_clearStoredChains, PACKAGE=pkgname, f$pModel)
}
##@doChangeStep algorithms change step for use in algorithms NB may be out of sync with phase 2
Modified: pkg/RSienaTest/R/getActorStatistics.r
===================================================================
--- pkg/RSienaTest/R/getActorStatistics.r 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/R/getActorStatistics.r 2017-09-10 17:07:28 UTC (rev 319)
@@ -9,22 +9,22 @@
effects <- effects[effects$include,]
effects$setting <- rep("", nrow(effects))
- pData <- .Call("setupData", PACKAGE=pkgname,
+ pData <- .Call(C_setupData, PACKAGE=pkgname,
list(as.integer(f$observations)),
list(f$nodeSets))
## register a finalizer
ans <- reg.finalizer(pData, clearData, onexit = FALSE)
- ans<- .Call("OneMode", PACKAGE=pkgname,
+ ans<- .Call(C_OneMode, PACKAGE=pkgname,
pData, list(f$nets))
- ans<- .Call("Behavior", PACKAGE=pkgname, pData,
+ ans<- .Call(C_Behavior, PACKAGE=pkgname, pData,
list(f$behavs))
- ans<-.Call("ConstantCovariates", PACKAGE=pkgname,
+ ans<-.Call(C_ConstantCovariates, PACKAGE=pkgname,
pData, list(f$cCovars))
- ans<-.Call("ChangingCovariates",PACKAGE=pkgname,
+ ans<-.Call(C_ChangingCovariates,PACKAGE=pkgname,
pData,list(f$vCovars))
- ans<-.Call("DyadicCovariates",PACKAGE=pkgname,
+ ans<-.Call(C_DyadicCovariates,PACKAGE=pkgname,
pData,list(f$dycCovars))
- ans<-.Call("ChangingDyadicCovariates",PACKAGE=pkgname,
+ ans<-.Call(C_ChangingDyadicCovariates,PACKAGE=pkgname,
pData, list(f$dyvCovars))
storage.mode(effects$parm) <- 'integer'
@@ -35,7 +35,7 @@
depvarnames <- names(data$depvars)
tmpeffects <- split(effects, effects$name)
myeffectsOrder <- match(depvarnames, names(tmpeffects))
- ans <- .Call("effects", PACKAGE=pkgname, pData, tmpeffects)
+ ans <- .Call(C_effects, PACKAGE=pkgname, pData, tmpeffects)
pModel <- ans[[1]][[1]]
for (i in 1:length(ans[[2]]))
{
@@ -46,7 +46,7 @@
for(i in 1:length(myeffectsOrder)){
myeffects[[i]]<-tmpeffects[[myeffectsOrder[i]]]
}
- ans <- .Call("getTargets", PACKAGE=pkgname, pData, pModel,
+ ans <- .Call(C_getTargets, PACKAGE=pkgname, pData, pModel,
myeffects, parallelrun=TRUE, returnActorStatistics=TRUE,
returnStaticChangeContributions=FALSE)
ans
Modified: pkg/RSienaTest/R/getTargets.r
===================================================================
--- pkg/RSienaTest/R/getTargets.r 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/R/getTargets.r 2017-09-10 17:07:28 UTC (rev 319)
@@ -4,29 +4,29 @@
f <- unpackData(data)
effects <- effects[effects$include,]
##
- pData <- .Call('setupData', PACKAGE=pkgname,
+ pData <- .Call(C_setupData, PACKAGE=pkgname,
list(as.integer(f$observations)),
list(f$nodeSets))
## register a finalizer
ans <- reg.finalizer(pData, clearData, onexit = FALSE)
- ans<- .Call('OneMode', PACKAGE=pkgname,
+ ans<- .Call(C_OneMode, PACKAGE=pkgname,
pData, list(f$nets))
- ans<- .Call('Behavior', PACKAGE=pkgname, pData,
+ ans<- .Call(C_Behavior, PACKAGE=pkgname, pData,
list(f$behavs))
- ans<-.Call('ConstantCovariates', PACKAGE=pkgname,
+ ans<-.Call(C_ConstantCovariates, PACKAGE=pkgname,
pData, list(f$cCovars))
- ans<-.Call('ChangingCovariates',PACKAGE=pkgname,
+ ans<-.Call(C_ChangingCovariates,PACKAGE=pkgname,
pData,list(f$vCovars))
- ans<-.Call('DyadicCovariates',PACKAGE=pkgname,
+ ans<-.Call(C_DyadicCovariates,PACKAGE=pkgname,
pData,list(f$dycCovars))
- ans<-.Call('ChangingDyadicCovariates',PACKAGE=pkgname,
+ ans<-.Call(C_ChangingDyadicCovariates,PACKAGE=pkgname,
pData, list(f$dyvCovars))
storage.mode(effects$parm) <- 'integer'
storage.mode(effects$group) <- 'integer'
storage.mode(effects$period) <- 'integer'
effects$effectPtr <- NA
myeffects <- split(effects, effects$name)
- ans<- .Call('effects', PACKAGE=pkgname,
+ ans<- .Call(C_effects, PACKAGE=pkgname,
pData, myeffects)
pModel <- ans[[1]][[1]]
for (i in 1:length(ans[[2]])) ## ans[[2]] is a list of lists of
@@ -36,8 +36,10 @@
effectPtr <- ans[[2]][[i]]
myeffects[[i]]$effectPtr <- effectPtr
}
- ans <- .Call('getTargets', PACKAGE=pkgname,
- pData, pModel, myeffects)
+ ans <- .Call(C_getTargets, PACKAGE=pkgname,
+ pData, pModel, myeffects,
+ NULL, returnActorStatistics=FALSE,
+ returnStaticChangeContributions=FALSE)
ans
}
@@ -94,29 +96,29 @@
f <- unpackData(data,x)
- pData <- .Call('setupData', PACKAGE=pkgname,
+ pData <- .Call(C_setupData, PACKAGE=pkgname,
list(as.integer(f$observations)),
list(f$nodeSets))
## register a finalizer
ans <- reg.finalizer(pData, clearData, onexit = FALSE)
- ans<- .Call('OneMode', PACKAGE=pkgname,
+ ans<- .Call(C_OneMode, PACKAGE=pkgname,
pData, list(f$nets))
- ans<- .Call('Behavior', PACKAGE=pkgname, pData,
+ ans<- .Call(C_Behavior, PACKAGE=pkgname, pData,
list(f$behavs))
- ans<-.Call('ConstantCovariates', PACKAGE=pkgname,
+ ans<-.Call(C_ConstantCovariates, PACKAGE=pkgname,
pData, list(f$cCovars))
- ans<-.Call('ChangingCovariates',PACKAGE=pkgname,
+ ans<-.Call(C_ChangingCovariates,PACKAGE=pkgname,
pData,list(f$vCovars))
- ans<-.Call('DyadicCovariates',PACKAGE=pkgname,
+ ans<-.Call(C_DyadicCovariates,PACKAGE=pkgname,
pData,list(f$dycCovars))
- ans<-.Call('ChangingDyadicCovariates',PACKAGE=pkgname,
+ ans<-.Call(C_ChangingDyadicCovariates,PACKAGE=pkgname,
pData, list(f$dyvCovars))
storage.mode(effects$parm) <- 'integer'
storage.mode(effects$group) <- 'integer'
storage.mode(effects$period) <- 'integer'
effects$effectPtr <- NA
myeffects <- split(effects, effects$name)
- ans<- .Call('effects', PACKAGE=pkgname,
+ ans<- .Call(C_effects, PACKAGE=pkgname,
pData, myeffects)
pModel <- ans[[1]][[1]]
for (i in 1:length(ans[[2]])) ## ans[[2]] is a list of lists of
@@ -126,7 +128,7 @@
effectPtr <- ans[[2]][[i]]
myeffects[[i]]$effectPtr <- effectPtr
}
- ans <- .Call('getTargets', PACKAGE=pkgname,
+ ans <- .Call(C_getTargets, PACKAGE=pkgname,
pData, pModel, myeffects, NULL, returnActorStatistics=FALSE,
returnStaticChangeContributions=FALSE)
ans2[j,] <- ans[,w]
Modified: pkg/RSienaTest/R/initializeFRAN.r
===================================================================
--- pkg/RSienaTest/R/initializeFRAN.r 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/R/initializeFRAN.r 2017-09-10 17:07:28 UTC (rev 319)
@@ -483,24 +483,24 @@
nGroup <- f$nGroup
f[(nGroup + 1): length(f)] <- NULL
}
- pData <- .Call("setupData", PACKAGE=pkgname,
+ pData <- .Call(C_setupData, PACKAGE=pkgname,
lapply(f, function(x)(as.integer(x$observations))),
lapply(f, function(x)(x$nodeSets)))
- ans <- .Call("OneMode", PACKAGE=pkgname,
+ ans <- .Call(C_OneMode, PACKAGE=pkgname,
pData, lapply(f, function(x)x$nets))
- ans <- .Call("Bipartite", PACKAGE=pkgname,
+ ans <- .Call(C_Bipartite, PACKAGE=pkgname,
pData, lapply(f, function(x)x$bipartites))
- ans <- .Call("Behavior", PACKAGE=pkgname,
+ ans <- .Call(C_Behavior, PACKAGE=pkgname,
pData, lapply(f, function(x)x$behavs))
- ans <-.Call("ConstantCovariates", PACKAGE=pkgname,
+ ans <-.Call(C_ConstantCovariates, PACKAGE=pkgname,
pData, lapply(f, function(x)x$cCovars))
- ans <-.Call("ChangingCovariates", PACKAGE=pkgname,
+ ans <-.Call(C_ChangingCovariates, PACKAGE=pkgname,
pData, lapply(f, function(x)x$vCovars))
- ans <-.Call("DyadicCovariates", PACKAGE=pkgname,
+ ans <-.Call(C_DyadicCovariates, PACKAGE=pkgname,
pData, lapply(f, function(x)x$dycCovars))
- ans <-.Call("ChangingDyadicCovariates", PACKAGE=pkgname,
+ ans <-.Call(C_ChangingDyadicCovariates, PACKAGE=pkgname,
pData, lapply(f, function(x)x$dyvCovars))
- ans <-.Call("ExogEvent", PACKAGE=pkgname,
+ ans <-.Call(C_ExogEvent, PACKAGE=pkgname,
pData, lapply(f, function(x)x$exog))
## split the names of the constraints
higher <- attr(f, "allHigher")
@@ -508,7 +508,7 @@
atLeastOne <- attr(f, "allAtLeastOne")
froms <- sapply(strsplit(names(higher), ","), function(x)x[1])
tos <- sapply(strsplit(names(higher), ","), function(x)x[2])
- ans <- .Call("Constraints", PACKAGE=pkgname,
+ ans <- .Call(C_Constraints, PACKAGE=pkgname,
pData, froms[higher], tos[higher],
froms[disjoint], tos[disjoint],
froms[atLeastOne], tos[atLeastOne])
@@ -572,7 +572,7 @@
interactionEffectsl <- ff$interactionEffectsl
types <- ff$types
}
- ans <- .Call("effects", PACKAGE=pkgname, pData, basicEffects)
+ ans <- .Call(C_effects, PACKAGE=pkgname, pData, basicEffects)
pModel <- ans[[1]][[1]]
for (i in seq(along=(ans[[2]]))) ## ans[[2]] is a list of lists of
## pointers to effects. Each list corresponds to one
@@ -590,7 +590,7 @@
basicEffects[[i]]$effectPtr[match(interactionEffects[[i]]$effect3,
basicEffects[[i]]$effectNumber)]
}
- ans <- .Call("interactionEffects", PACKAGE=pkgname,
+ ans <- .Call(C_interactionEffects, PACKAGE=pkgname,
pModel, interactionEffects)
## copy these pointers to the interaction effects and then insert in
## effects object in the same rows for later use
@@ -673,14 +673,13 @@
simpleRates <- FALSE
}
z$simpleRates <- simpleRates
-
- ans <- .Call("setupModelOptions", PACKAGE=pkgname,
+ ans <- .Call(C_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,
+ ans <- .Call(C_getTargets, PACKAGE=pkgname, pData, pModel, myeffects,
z$parallelTesting, returnActorStatistics=FALSE,
returnStaticChangeContributions=FALSE)
##stop("done")
@@ -765,7 +764,7 @@
z$probs <- c(x$pridg, x$prcdg, x$prper, x$pripr, x$prdpr, x$prirms,
x$prdrms)
- ans <- .Call("mlMakeChains", PACKAGE=pkgname, pData, pModel,
+ ans <- .Call(C_mlMakeChains, PACKAGE=pkgname, pData, pModel,
z$probs, z$prmin, z$prmib,
x$minimumPermutationLength,
x$maximumPermutationLength,
@@ -776,7 +775,7 @@
}
else ## set up the initial chains in the sub processes
{
- ans <- .Call("mlInitializeSubProcesses",
+ ans <- .Call(C_mlInitializeSubProcesses,
PACKAGE=pkgname, pData, pModel,
z$probs, z$prmin, z$prmib,
x$minimumPermutationLength,
Modified: pkg/RSienaTest/R/maxlikec.r
===================================================================
--- pkg/RSienaTest/R/maxlikec.r 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/R/maxlikec.r 2017-09-10 17:07:28 UTC (rev 319)
@@ -28,7 +28,7 @@
{
theta <- z$theta
}
- ans <- .Call("mlPeriod", PACKAGE=pkgname, z$Deriv, f$pData,
+ ans <- .Call(C_mlPeriod, PACKAGE=pkgname, z$Deriv, f$pData,
f$pModel, f$myeffects, theta,
1, 1, z$nrunMH, z$addChainToStore,
z$returnDataFrame,
@@ -153,7 +153,7 @@
{
theta <- theta
}
- .Call("mlPeriod", PACKAGE=pkgname, Deriv, f$pData,
+ .Call(C_mlPeriod, PACKAGE=pkgname, Deriv, f$pData,
f$pModel, f$myeffects, theta,
as.integer(x[1]), as.integer(x[2]), nrunMH[x[3]], addChainToStore,
returnDataFrame, returnChains,
Modified: pkg/RSienaTest/R/sienaBayes.r
===================================================================
--- pkg/RSienaTest/R/sienaBayes.r 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/R/sienaBayes.r 2017-09-10 17:07:28 UTC (rev 319)
@@ -2077,7 +2077,7 @@
if (nrow(callGrid) == 1)
{
theta <- z$thetaMat[1,]
- ans <- .Call("getChainProbabilities", PACKAGE = pkgname, f$pData,
+ ans <- .Call(C_getChainProbabilities, PACKAGE = pkgname, f$pData,
f$pModel, as.integer(1), as.integer(1),
as.integer(index), f$myeffects, theta, getScores)
anss <- list(ans)
@@ -2126,7 +2126,7 @@
f <- FRANstore()
theta <- thetaMat[x[1], ]
# gcp <-
- .Call("getChainProbabilities", PACKAGE = pkgname, f$pData,
+ .Call(C_getChainProbabilities, PACKAGE = pkgname, f$pData,
f$pModel, as.integer(x[1]), as.integer(x[2]),
as.integer(index), f$myeffects, theta, getScores)
Modified: pkg/RSienaTest/R/sienaRI.r
===================================================================
--- pkg/RSienaTest/R/sienaRI.r 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/R/sienaRI.r 2017-09-10 17:07:28 UTC (rev 319)
@@ -109,24 +109,24 @@
{
effects$setting <- rep("", nrow(effects))
}
- pData <- .Call('setupData', PACKAGE=pkgname,
+ pData <- .Call(C_setupData, PACKAGE=pkgname,
list(as.integer(f$observations)),
list(f$nodeSets))
## register a finalizer
ans <- reg.finalizer(pData, clearData, onexit = FALSE)
- ans<- .Call('OneMode', PACKAGE=pkgname,
+ ans<- .Call(C_OneMode, PACKAGE=pkgname,
pData, list(f$nets))
- ans <- .Call("Bipartite", PACKAGE=pkgname, # added 1.1-299
+ ans <- .Call(C_Bipartite, PACKAGE=pkgname, # added 1.1-299
pData, list(f$bipartites))
- ans<- .Call('Behavior', PACKAGE=pkgname, pData,
+ ans<- .Call(C_Behavior, PACKAGE=pkgname, pData,
list(f$behavs))
- ans<-.Call('ConstantCovariates', PACKAGE=pkgname,
+ ans<-.Call(C_ConstantCovariates, PACKAGE=pkgname,
pData, list(f$cCovars))
- ans<-.Call('ChangingCovariates',PACKAGE=pkgname,
+ ans<-.Call(C_ChangingCovariates,PACKAGE=pkgname,
pData,list(f$vCovars))
- ans<-.Call('DyadicCovariates',PACKAGE=pkgname,
+ ans<-.Call(C_DyadicCovariates,PACKAGE=pkgname,
pData,list(f$dycCovars))
- ans<-.Call('ChangingDyadicCovariates',PACKAGE=pkgname,
+ ans<-.Call(C_ChangingDyadicCovariates,PACKAGE=pkgname,
pData, list(f$dyvCovars))
storage.mode(effects$parm) <- 'integer'
@@ -137,7 +137,7 @@
depvarnames <- names(data$depvars)
tmpeffects <- split(effects, effects$name)
myeffectsOrder <- match(depvarnames, names(tmpeffects))
- ans <- .Call("effects", PACKAGE=pkgname, pData, tmpeffects)
+ ans <- .Call(C_effects, PACKAGE=pkgname, pData, tmpeffects)
pModel <- ans[[1]][[1]]
for (i in 1:length(ans[[2]]))
{
@@ -148,7 +148,7 @@
for(i in 1:length(myeffectsOrder)){
myeffects[[i]]<-tmpeffects[[myeffectsOrder[i]]]
}
- ans <- .Call("getTargets", PACKAGE=pkgname, pData, pModel, myeffects,
+ ans <- .Call(C_getTargets, PACKAGE=pkgname, pData, pModel, myeffects,
parallelrun=TRUE, returnActorStatistics=FALSE,
returnStaticChangeContributions=TRUE)
# See getTargets in siena07setup.cpp; also see rTargets in StatisticsSimulation.cpp
Modified: pkg/RSienaTest/R/simstatsc.r
===================================================================
--- pkg/RSienaTest/R/simstatsc.r 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/R/simstatsc.r 2017-09-10 17:07:28 UTC (rev 319)
@@ -81,7 +81,7 @@
#}
## z$int2 is the number of processors if iterating by period, so 1 means
## we are not. Now have removed option to parallelize by period
- ans <- .Call('model', PACKAGE=pkgname, z$Deriv, f$pData, seeds,
+ ans <- .Call(C_model, PACKAGE=pkgname, z$Deriv, f$pData, seeds,
fromFiniteDiff, f$pModel, f$myeffects, z$theta,
randomseed2, returnDeps, z$FinDiff.method,
!is.null(z$cl) && useStreams, z$addChainToStore,
@@ -169,10 +169,10 @@
##@clearData siena07 Finalizer to clear Data object in C++
clearData <- function(pData)
{
- .Call('deleteData', PACKAGE=pkgname, pData)
+ .Call(C_deleteData, PACKAGE=pkgname, pData)
}
##@clearModel siena07 Finalizer to clear Model object in C++
clearModel <- function(pModel)
{
- .Call('deleteModel', PACKAGE=pkgname, pModel)
+ .Call(C_deleteModel, PACKAGE=pkgname, pModel)
}
Modified: pkg/RSienaTest/R/zzz.R
===================================================================
--- pkg/RSienaTest/R/zzz.R 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/R/zzz.R 2017-09-10 17:07:28 UTC (rev 319)
@@ -8,19 +8,24 @@
# * Description: This module contains the code for package attachment and
# * detachment.
# *****************************************************************************/
+
#dllpath <- ''
##@imagepath Objects/Path Path for image of Siena
-imagepath <- ''
+imagepath <- ""
+
##csvpath <- ''
## or .onAttach?
##@pkgpath Objects/Path Path for installation of siena.exe
-pkgpath <- ''
+pkgpath <- ""
+
##@pkgname Objects/Package name of package (RSiena or RSienaTest)
pkgname <- ""
+
##@pkgversion Objects/Package version of package
pkgvers <- ""
+
##@.onLoad Miscellaneous Start-up processing
-.onLoad <- function(libname,pkgname){
+.onLoad <- function(libname, pkgname) {
# dllpath <<- if (nzchar(.Platform$r_arch))
## file.path(libname, pkgname, "libs", .Platform$r_arch,
# paste('RSiena', .Platform$dynlib.ext, sep=''))
@@ -28,21 +33,21 @@
# file.path(libname,pkgname, "libs",
# paste('RSiena', .Platform$dynlib.ext, sep=''))
# # data('sysdata',package='RSiena')
- imagepath <<- file.path(libname, pkgname, paste('ilcampo.gif'))
- pkgpath<<- file.path(libname, pkgname)
- pkgname <<- pkgname
- pkgvers <<- utils::packageDescription(pkgname, fields=c("Version", "Date"))
+ imagepath <<- file.path(libname, pkgname, paste("ilcampo.gif"))
+ pkgpath <<- file.path(libname, pkgname)
+ pkgname <<- pkgname
+ pkgvers <<- utils::packageDescription(pkgname, fields = c("Version", "Date"))
#cat(pkgname,pkgpath,'\n')
## csvpath<<- file.path(libname,pkgname)
# library.dynam("RSiena",package=pkgname)
# cat (libname,pkgname,'\n')
- .Call("sienaInitialize", PACKAGE=pkgname)
+ .Call(C_sienaInitialize, PACKAGE = pkgname)
}
##@.onUnload Miscellaneous Unload processing
.onUnload <- function(libpath) {
- .Call("sienaFinalize", PACKAGE=pkgname)
- library.dynam.unload(pkgname, libpath)
+ .Call(C_sienaFinalize, PACKAGE = pkgname)
+ library.dynam.unload(pkgname, libpath)
}
#.Last.lib <- function(libpath)
Modified: pkg/RSienaTest/src/Makevars.in
===================================================================
--- pkg/RSienaTest/src/Makevars.in 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/src/Makevars.in 2017-09-10 17:07:28 UTC (rev 319)
@@ -4,7 +4,7 @@
EIGEN = lib/Eigen
EIGEN_CPP = -I$(EIGEN)
-OBJECTS = $(SOURCES:.cpp=.o)
+OBJECTS = init.o $(SOURCES:.cpp=.o)
SOURCES = @PKG_SOURCES@
PKG_CPPFLAGS = -I. $(RNGSTREAMS_CPP) $(EIGEN_CPP) @PKG_CPPFLAGS@ @OPENMP_CFLAGS@
Modified: pkg/RSienaTest/src/RInterface.cpp
===================================================================
--- pkg/RSienaTest/src/RInterface.cpp 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/src/RInterface.cpp 2017-09-10 17:07:28 UTC (rev 319)
@@ -7,6 +7,7 @@
* \brief Implements RInterface.h.
*****************************************************************************/
+#include "estimator/SienaFit.h"
#include "RInterface.h"
#include <Eigen/Core>
@@ -65,7 +66,7 @@
* @param rFit SienaFit object.
* @return R list containing the information in `rFit`.
*/
-SEXP rifySienaFit(const SienaFit& rFit) {
+static SEXP rifySienaFit(const SienaFit& rFit) {
int n = 21;
SEXP sList;
PROTECT(sList = allocVector(VECSXP, n));
Modified: pkg/RSienaTest/src/RInterface.h
===================================================================
--- pkg/RSienaTest/src/RInterface.h 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/src/RInterface.h 2017-09-10 17:07:28 UTC (rev 319)
@@ -10,12 +10,8 @@
#ifndef RSIENA_RINTERFACE_H_
#define RSIENA_RINTERFACE_H_
-#include "estimator/SienaFit.h"
-
#include <Rinternals.h>
-SEXP rifySienaFit(const siena::SienaFit& fit);
-
extern "C" {
SEXP sienaSetupLogger(SEXP sPriorityNameConsole, SEXP sPriorityNameFile,
Modified: pkg/RSienaTest/src/RUtil.h
===================================================================
--- pkg/RSienaTest/src/RUtil.h 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/src/RUtil.h 2017-09-10 17:07:28 UTC (rev 319)
@@ -10,6 +10,7 @@
#ifndef RUTIL_H_
#define RUTIL_H_
+#include "Eigen/Types.h" // custom Eigen type declarations
#include "RInterface.h"
#include <Eigen/Core>
@@ -17,7 +18,8 @@
#include <vector>
#include <string>
-namespace siena {
+namespace siena
+{
///////////////////////////////////////////////////////////////////////////////
// RNG state
Modified: pkg/RSienaTest/src/estimator/update/step/normalization/SDStepNormalization.h
===================================================================
--- pkg/RSienaTest/src/estimator/update/step/normalization/SDStepNormalization.h 2017-09-10 15:59:28 UTC (rev 318)
+++ pkg/RSienaTest/src/estimator/update/step/normalization/SDStepNormalization.h 2017-09-10 17:07:28 UTC (rev 319)
@@ -12,7 +12,8 @@
#include "StepNormalization.h"
-namespace siena {
+namespace siena
+{
/**
* Step sanitizing with the max step width based on the statistics of phase 1.
Added: pkg/RSienaTest/src/init.cpp
===================================================================
--- pkg/RSienaTest/src/init.cpp (rev 0)
+++ pkg/RSienaTest/src/init.cpp 2017-09-10 17:07:28 UTC (rev 319)
@@ -0,0 +1,64 @@
+
+#include <stdlib.h> // for NULL
+
+#include "siena07setup.h"
+#include "siena07models.h"
+#include "RInterface.h"
+
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rsiena -r 319
More information about the Rsiena-commits
mailing list