[Rsiena-commits] r293 - in pkg: RSiena RSiena/R RSiena/data RSiena/inst RSiena/inst/doc RSiena/inst/scripts RSiena/man RSiena/po RSiena/src/model/effects RSiena/src/model/effects/generic RSiena/src/model/variables RSienaTest RSienaTest/R RSienaTest/data RSienaTest/doc RSienaTest/inst/doc RSienaTest/man RSienaTest/src/model/effects RSienaTest/src/model/effects/generic RSienaTest/src/network RSienaTest/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue May 24 22:37:14 CEST 2016
Author: tomsnijders
Date: 2016-05-24 22:37:13 +0200 (Tue, 24 May 2016)
New Revision: 293
Added:
pkg/RSiena/src/model/effects/CovariateDiffEffect.cpp
pkg/RSiena/src/model/effects/CovariateDiffEffect.h
pkg/RSiena/src/model/effects/CovariateDiffEgoEffect.cpp
pkg/RSiena/src/model/effects/CovariateDiffEgoEffect.h
pkg/RSiena/src/model/effects/CovariateEgoSquaredEffect.cpp
pkg/RSiena/src/model/effects/CovariateEgoSquaredEffect.h
pkg/RSiena/src/model/effects/DyadicCovariateAndNetworkBehaviorEffect.cpp
pkg/RSiena/src/model/effects/DyadicCovariateAndNetworkBehaviorEffect.h
pkg/RSiena/src/model/effects/DyadicCovariateAvAltEffect.cpp
pkg/RSiena/src/model/effects/DyadicCovariateAvAltEffect.h
pkg/RSiena/src/model/effects/SimilarityWEffect.cpp
pkg/RSiena/src/model/effects/SimilarityWEffect.h
pkg/RSiena/src/model/effects/generic/SameCovariateInStarFunction.cpp
pkg/RSiena/src/model/effects/generic/SameCovariateInStarFunction.h
pkg/RSiena/src/model/effects/generic/SameCovariateOutStarFunction.cpp
pkg/RSiena/src/model/effects/generic/SameCovariateOutStarFunction.h
pkg/RSienaTest/doc/RSiena.bib
pkg/RSienaTest/doc/RSiena_Manual.pdf
pkg/RSienaTest/doc/RSiena_Manual.tex
pkg/RSienaTest/doc/gwesp.png
pkg/RSienaTest/doc/gwespCurves.png
pkg/RSienaTest/doc/ilcampo.jpg
pkg/RSienaTest/src/model/effects/AverageSimmelianAlterEffect.cpp
pkg/RSienaTest/src/model/effects/AverageSimmelianAlterEffect.h
pkg/RSienaTest/src/model/effects/CovariateDiffEffect.cpp
pkg/RSienaTest/src/model/effects/CovariateDiffEffect.h
pkg/RSienaTest/src/model/effects/CovariateDiffEgoEffect.cpp
pkg/RSienaTest/src/model/effects/CovariateDiffEgoEffect.h
pkg/RSienaTest/src/model/effects/CovariateEgoSquaredEffect.cpp
pkg/RSienaTest/src/model/effects/CovariateEgoSquaredEffect.h
pkg/RSienaTest/src/model/effects/DyadicCovariateAndNetworkBehaviorEffect.cpp
pkg/RSienaTest/src/model/effects/DyadicCovariateAndNetworkBehaviorEffect.h
pkg/RSienaTest/src/model/effects/DyadicCovariateAvAltEffect.cpp
pkg/RSienaTest/src/model/effects/DyadicCovariateAvAltEffect.h
pkg/RSienaTest/src/model/effects/SimilarityWEffect.cpp
pkg/RSienaTest/src/model/effects/SimilarityWEffect.h
pkg/RSienaTest/src/model/effects/SimmelianEffect.cpp
pkg/RSienaTest/src/model/effects/SimmelianEffect.h
pkg/RSienaTest/src/model/effects/generic/SameCovariateInStarFunction.cpp
pkg/RSienaTest/src/model/effects/generic/SameCovariateInStarFunction.h
pkg/RSienaTest/src/model/effects/generic/SameCovariateOutStarFunction.cpp
pkg/RSienaTest/src/model/effects/generic/SameCovariateOutStarFunction.h
Removed:
pkg/RSiena/R/siena01.r
pkg/RSiena/R/sienaDataCreateFromSession.r
pkg/RSiena/inst/doc/RSiena.bib
pkg/RSiena/inst/doc/RSiena_Manual.pdf
pkg/RSiena/inst/doc/RSiena_Manual.tex
pkg/RSiena/inst/doc/gwesp.png
pkg/RSiena/inst/doc/gwespCurves.png
pkg/RSiena/inst/doc/rsiena01gui.pdf
pkg/RSiena/inst/doc/rsiena01gui.tex
pkg/RSiena/inst/doc/siena1.png
pkg/RSiena/inst/doc/siena2.png
pkg/RSiena/inst/doc/siena3.png
pkg/RSiena/man/installGui.Rd
pkg/RSiena/man/siena01Gui.Rd
pkg/RSiena/man/sienaDataCreateFromSession.Rd
pkg/RSiena/man/sienaModelOptions.Rd
pkg/RSienaTest/inst/doc/RSiena.bib
pkg/RSienaTest/inst/doc/RSiena_Manual.pdf
pkg/RSienaTest/inst/doc/RSiena_Manual.tex
pkg/RSienaTest/inst/doc/gwesp.png
pkg/RSienaTest/inst/doc/gwespCurves.png
Modified:
pkg/RSiena/.Rinstignore
pkg/RSiena/ChangeLog
pkg/RSiena/DESCRIPTION
pkg/RSiena/NAMESPACE
pkg/RSiena/R/Sienatest.r
pkg/RSiena/R/effects.r
pkg/RSiena/R/effectsDocumentation.r
pkg/RSiena/R/print01Report.r
pkg/RSiena/R/sienaprint.r
pkg/RSiena/data/allEffects.csv
pkg/RSiena/inst/scripts/Rscript02SienaVariableFormat.R
pkg/RSiena/inst/sienascript
pkg/RSiena/man/RSiena-package.Rd
pkg/RSiena/man/print01Report.Rd
pkg/RSiena/man/sienaCompositionChange.Rd
pkg/RSiena/man/sienaFit.Rd
pkg/RSiena/man/tmp3.Rd
pkg/RSiena/man/tmp4.Rd
pkg/RSiena/po/R-RSiena.pot
pkg/RSiena/po/R-ko.po
pkg/RSiena/src/model/effects/AllEffects.h
pkg/RSiena/src/model/effects/AltersCovariateAvAltEffect.cpp
pkg/RSiena/src/model/effects/AltersCovariateAvAltEffect.h
pkg/RSiena/src/model/effects/BehaviorEffect.cpp
pkg/RSiena/src/model/effects/BehaviorEffect.h
pkg/RSiena/src/model/effects/CovariateEgoEffect.cpp
pkg/RSiena/src/model/effects/EffectFactory.cpp
pkg/RSiena/src/model/effects/IndegreeActivityEffect.cpp
pkg/RSiena/src/model/effects/IndegreeActivityEffect.h
pkg/RSiena/src/model/effects/InteractionCovariateEffect.cpp
pkg/RSiena/src/model/effects/InteractionCovariateEffect.h
pkg/RSiena/src/model/effects/OutdegreeActivityEffect.cpp
pkg/RSiena/src/model/effects/OutdegreeActivityEffect.h
pkg/RSiena/src/model/effects/OutdegreeActivitySqrtEffect.cpp
pkg/RSiena/src/model/effects/OutdegreeActivitySqrtEffect.h
pkg/RSiena/src/model/variables/BehaviorVariable.cpp
pkg/RSiena/src/model/variables/NetworkVariable.cpp
pkg/RSienaTest/ChangeLog
pkg/RSienaTest/DESCRIPTION
pkg/RSienaTest/NAMESPACE
pkg/RSienaTest/R/CInterface.r
pkg/RSienaTest/R/Sienatest.r
pkg/RSienaTest/R/effects.r
pkg/RSienaTest/R/effectsDocumentation.r
pkg/RSienaTest/R/print01Report.r
pkg/RSienaTest/R/siena01.r
pkg/RSienaTest/R/sienaprint.r
pkg/RSienaTest/data/allEffects.csv
pkg/RSienaTest/doc/Siena_algorithms.tex
pkg/RSienaTest/man/RSiena-package.Rd
pkg/RSienaTest/man/sienaCompositionChange.Rd
pkg/RSienaTest/man/sienaFit.Rd
pkg/RSienaTest/man/tmp3.Rd
pkg/RSienaTest/man/tmp4.Rd
pkg/RSienaTest/src/model/effects/AllEffects.h
pkg/RSienaTest/src/model/effects/AltersCovariateAvAltEffect.cpp
pkg/RSienaTest/src/model/effects/AltersCovariateAvAltEffect.h
pkg/RSienaTest/src/model/effects/AverageAlterEffect.cpp
pkg/RSienaTest/src/model/effects/BehaviorEffect.cpp
pkg/RSienaTest/src/model/effects/BehaviorEffect.h
pkg/RSienaTest/src/model/effects/CovariateSimmelianAlterEffect.cpp
pkg/RSienaTest/src/model/effects/EffectFactory.cpp
pkg/RSienaTest/src/model/effects/IndegreeActivityEffect.cpp
pkg/RSienaTest/src/model/effects/IndegreeActivityEffect.h
pkg/RSienaTest/src/model/effects/InteractionCovariateEffect.cpp
pkg/RSienaTest/src/model/effects/InteractionCovariateEffect.h
pkg/RSienaTest/src/model/effects/OutdegreeActivityEffect.cpp
pkg/RSienaTest/src/model/effects/OutdegreeActivityEffect.h
pkg/RSienaTest/src/model/effects/OutdegreeActivitySqrtEffect.cpp
pkg/RSienaTest/src/model/effects/OutdegreeActivitySqrtEffect.h
pkg/RSienaTest/src/network/Simmelian.cpp
pkg/RSienaTest/tests/parallel.R
pkg/RSienaTest/tests/parallel.Rout.save
Log:
Version 1.1-293. Various updates.
Modified: pkg/RSiena/.Rinstignore
===================================================================
--- pkg/RSiena/.Rinstignore 2016-05-22 18:06:40 UTC (rev 292)
+++ pkg/RSiena/.Rinstignore 2016-05-24 20:37:13 UTC (rev 293)
@@ -8,3 +8,4 @@
inst/.*[.]aux
inst/.*[.]out
inst/.*[.]toc
+inst/.*[.]bak
Modified: pkg/RSiena/ChangeLog
===================================================================
--- pkg/RSiena/ChangeLog 2016-05-22 18:06:40 UTC (rev 292)
+++ pkg/RSiena/ChangeLog 2016-05-24 20:37:13 UTC (rev 293)
@@ -1,3 +1,35 @@
+2016-05-23 R-Forge Revision 293
+Changes in RSiena and RSienaTest:
+ * Removed manual and bibliography from installation;
+ still available in \RSienaTest\doc.
+ * Added functions initializeStatisticCalculation() and
+ cleanupStatisticCalculation() to class BehaviorEffect.
+ * New effects totAltEgoX, totAltAltX, egoSqX, diffX, diffSqX, egoDiffX,
+ avAltW, totAltW, avSimW, totSimW, jumpFrom, jumpSharedIn, mixedInXW, mixedInWX,
+ avWalt, totWAlt.
+ * New effect class DyadicCovariateDependentBehaviorEffect corresponding
+ to group dyadBehaviorNetObjective (effects.r, effectsDocumentation.r).
+ * added endowment and creation effects for inAct, inActSqrt, outAct, outActSqrt.
+ * inActIntn also implemented for two-mode dependent networks.
+ * New argument 'matrices' in print.summary.sienaFit.
+ * Changes to NAMESPACE and DESCRIPTION files to satisfy R3.3.0 for
+ external functions from base packages.
+Changes in RSiena:
+ * siena01Gui and associated functions dropped.
+ * sienaDataCreateFromSession dropped.
+Changes in RSienaTest:.
+ * Change in endowment effect estimation for avAlt effect.
+ * New effects simmelian, simmelianAltX, avSimmelianAlt, totSimmelianAlt.
+
+2016-02-22 R-Forge Revision 292
+Changes in RSienaTest:
+ * Fixed permission filter for 2-mode networks (NetworkVariable.cpp).
+
+2016-02-03 R-Forge Revision 291
+Changes in RSienaTest:
+ * Fixed include order.
+ * Removed `using namespace` from all headers.
+
2016-01-31 R-Forge Revision 290
Changes in RSiena and RSienaTest:
* New effects FBDeg, FRDeg, BRDeg (RFDeg was mentioned earlier
Modified: pkg/RSiena/DESCRIPTION
===================================================================
--- pkg/RSiena/DESCRIPTION 2016-05-22 18:06:40 UTC (rev 292)
+++ pkg/RSiena/DESCRIPTION 2016-05-24 20:37:13 UTC (rev 293)
@@ -1,11 +1,11 @@
Package: RSiena
Type: Package
Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.1-290
-Date: 2016-01-31
+Version: 1.1-293
+Date: 2016-05-23
Author: Ruth Ripley, Krists Boitmanis, Tom A.B. Snijders, Felix Schoenenberger
Depends: R (>= 2.15.0), utils
-Imports: Matrix, tcltk, lattice, parallel, MASS
+Imports: Matrix, tcltk, lattice, parallel, MASS, methods
Suggests: xtable, network, tools, codetools
SystemRequirements: GNU make, tcl/tk 8.5, Tktable
Maintainer: Tom A.B. Snijders <tom.snijders at nuffield.ox.ac.uk>
Modified: pkg/RSiena/NAMESPACE
===================================================================
--- pkg/RSiena/NAMESPACE 2016-05-22 18:06:40 UTC (rev 292)
+++ pkg/RSiena/NAMESPACE 2016-05-24 20:37:13 UTC (rev 293)
@@ -1,20 +1,32 @@
useDynLib(RSiena)
export(coCovar, coDyadCovar, getEffects, model.create, print01Report,
-siena01Gui, siena07, sienaCompositionChange, updateTheta,
-sienaCompositionChangeFromFile, sienaDataCreate, sienaDataCreateFromSession,
-sienaGroupCreate, sienaModelCreate, sienaAlgorithmCreate, sienaNet,
+ siena07, sienaCompositionChange, updateTheta,
+ 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,
+ siena08, iwlsm, sienaTimeTest, includeTimeDummy,
sienaGOF, descriptives.sienaGOF, sienaRI,
- sparseMatrixExtraction, networkExtraction, behaviorExtraction,
+ sparseMatrixExtraction, networkExtraction, behaviorExtraction,
OutdegreeDistribution, IndegreeDistribution, BehaviorDistribution,
siena.table, xtable,
Wald.RSiena, Multipar.RSiena)
-
+importFrom("grDevices", "rgb", "xy.coords")
+importFrom("graphics", "axis", "barplot", "layout", "mtext", "pairs",
+ "panel.smooth", "par", "pie", "plot", "points", "strwidth","text")
+importFrom("methods", "as", "is")
+importFrom("stats", ".getXlevels", "acf", "contr.helmert", "cor",
+ "cor.test", "cov", "dnorm", "ecdf", "hatvalues", "lm",
+ "lm.wfit", "mad", "median", "model.matrix", "model.offset",
+ "model.response", "model.weights", "naprint", "optimize",
+ "pchisq", "plot.ts", "pnorm", "predict.lm", "pt", "qchisq",
+ "qnorm", "quantile", "runif", "sd", "ts", "uniroot", "var",
+ "weighted.mean")
+importFrom("utils", "browseURL", "flush.console", "getFromNamespace",
+ "packageDescription", "read.csv", "read.delim",
+ "read.table", "write.csv", "write.table")
import(Matrix, tcltk, lattice, parallel, MASS)
-
S3method(print, siena)
S3method(print, sienaGroup)
S3method(print, sienaDependent)
Modified: pkg/RSiena/R/Sienatest.r
===================================================================
--- pkg/RSiena/R/Sienatest.r 2016-05-22 18:06:40 UTC (rev 292)
+++ pkg/RSiena/R/Sienatest.r 2016-05-24 20:37:13 UTC (rev 293)
@@ -247,7 +247,7 @@
z2 <- fra[test]
if (inherits(try(id11 <- solve(d11), silent=TRUE), "try-error"))
{
- cat('Error for inversion of d11 \n')
+ cat('Score test: Error for inversion of d11 \n')
oneSided <- NA
v9 <- d22
v9[] <- NA
@@ -275,7 +275,7 @@
if (inherits(try(vav <- solve(v9), silent=TRUE), "try-error"))
## vav is the inverse variance matrix of ov
{
- cat('Error for inversion of v9\n')
+ cat('Score test: Error for inversion of v9\n')
vav <- v9
vav[] <- NA
cvalue <- NA
Modified: pkg/RSiena/R/effects.r
===================================================================
--- pkg/RSiena/R/effects.r 2016-05-22 18:06:40 UTC (rev 292)
+++ pkg/RSiena/R/effects.r 2016-05-24 20:37:13 UTC (rev 293)
@@ -470,7 +470,7 @@
groupName=groupName, group=group,
netType=netType)
}
- else
+ else # non-symmetric
{
tmpObjEffects <-
createEffects("behaviorOneModeObjective",
@@ -525,6 +525,33 @@
groupName=groupName, group=group,
netType=netType)
}
+# Now irrespective of (attr(xx$depvars[[j]], "symmetric"))
+ for (k in seq(along = xx$dycCovars))
+ {
+ if (attr(xx$dycCovars[[k]], "type") == "oneMode" &&
+ attr(xx$dycCovars[[k]], 'nodeSet')[1] == nodeSet)
+ {
+ othervarname <- names(xx$dycCovars)[k]
+ tmpObjEffects3 <- createEffects("dyadBehaviorNetObjective",
+ varname, depvarname, othervarname,
+ name=varname, groupName=groupName,
+ group=group, netType=netType)
+ tmpObjEffects2 <- rbind(tmpObjEffects2, tmpObjEffects3)
+ }
+ }
+ for (k in seq(along = xx$dyvCovars))
+ {
+ if (attr(xx$dyvCovars[[k]], "type") == "oneMode" &&
+ attr(xx$dyvCovars[[k]], 'nodeSet')[1] == nodeSet)
+ {
+ othervarname <- names(xx$dyvCovars)[k]
+ tmpObjEffects3 <- createEffects("dyadBehaviorNetObjective",
+ varname, depvarname, othervarname,
+ name=varname, groupName=groupName,
+ group=group, netType=netType)
+ tmpObjEffects2 <- rbind(tmpObjEffects2, tmpObjEffects3)
+ }
+ }
if ((nOneModes + nBipartites) > 1) ## add the network name
{
tmpObjEffects$functionName <-
@@ -911,7 +938,7 @@
{
covObjEffects <-
covObjEffects[covObjEffects$shortName %in%
- c("egoX"), ]
+ c("egoX", "egoSqX"), ]
}
}
if (!moreThan2)
@@ -937,7 +964,7 @@
# restrict to covariates on first node set
covObjEffects <-
covObjEffects[covObjEffects$shortName %in%
- c("egoX", "altInDist2", "totInDist2",
+ c("egoX", "egoSqX", "altInDist2", "totInDist2",
"simEgoInDist2", "sameXInPop", "diffXInPop"), ]
covRateEffects <- createEffects("covarBipartiteRate", covarname,
name=varname,
Modified: pkg/RSiena/R/effectsDocumentation.r
===================================================================
--- pkg/RSiena/R/effectsDocumentation.r 2016-05-22 18:06:40 UTC (rev 292)
+++ pkg/RSiena/R/effectsDocumentation.r 2016-05-24 20:37:13 UTC (rev 293)
@@ -96,6 +96,7 @@
"behaviorBipBipObjective",
"covarBehaviorObjective",
"covarBehaviorNetObjective",
+ "dyadBehaviorNetObjective",
"covarABehaviorBipartiteObjective",
"covarBBehaviorBipartiteObjective",
"unspecifiedBehaviorInteraction")
Modified: pkg/RSiena/R/print01Report.r
===================================================================
--- pkg/RSiena/R/print01Report.r 2016-05-22 18:06:40 UTC (rev 292)
+++ pkg/RSiena/R/print01Report.r 2016-05-24 20:37:13 UTC (rev 293)
@@ -8,8 +8,7 @@
# * Description: This module contains the function to print the initial report
# *****************************************************************************/
##@print01Report Reporting
-print01Report <- function(data, modelname="Siena", session=NULL,
- getDocumentation=FALSE)
+print01Report <- function(data, modelname="Siena", getDocumentation=FALSE)
{
##@reportDataObject1 internal print01Report
reportDataObject1 <- function(x)
@@ -33,8 +32,7 @@
}
}
##@reportDataObject internal print01Report
- reportDataObject <- function(x, periodFromStart=0, multi=FALSE,
- session=session)
+ reportDataObject <- function(x, periodFromStart=0, multi=FALSE)
{
##@reportStart internal print01Report
reportStart <- function()
@@ -129,31 +127,6 @@
}
for (k in 1:x$observations)
{
- if (!is.null(session))
- {
- namesession <-
- session[session$Name == netname, ]
- filename <- namesession$Filename
- if (length(filename) > 1)
- {
- if (namesession$Format[1] == "Siena net")
- {
- period <-
- strsplit(namesession$Period, " ")
- sub <- sapply(period, function(x) k %in% x)
- }
- else
- {
- period <-
- unlist(strsplit(namesession$Period, " "))
- sub <- match(k, period)
- }
- filename <- filename[sub]
- }
- Report(c("Observation moment ", k + periodFromStart,
- " was read from file ", filename, '. \n'),
- sep='', outf)
- }
Report(c("For observation moment ", k + periodFromStart,
", degree distributions are as ",
"follows:\nNodes\n"),
@@ -361,6 +334,7 @@
"the value 0 is imputed.\n"), outf)
}
}
+ Report("\n", outf)
}
Report("\n", outf)
}
@@ -385,17 +359,7 @@
"th"), sep="")
Report(c(mystr, " dependent actor variable named ",
netname), sep="", outf)
- if (!is.null(session))
- {
- filename <-
- session$Filename[session$Name == netname]
- Report(c(" was read from file ", filename, ".\n"),
- sep="", outf)
- }
- else
- {
- Report(".\n", outf)
- }
+ Report(".\n", outf)
ranged <- atts$range2
Report(c("Maximum and minimum rounded values are ",
round(ranged[1]), " and ",
@@ -485,29 +449,12 @@
nCovars <- length(x$cCovars)
covars <- names(x$cCovars)
Heading(2, outf, "Reading constant actor covariates.")
- if (!is.null(session))
+ Report(c(nCovars, "variable"),outf)
+ Report(ifelse(nCovars == 1, ", named:\n", "s, named:\n"), outf)
+ for (i in seq(along=covars))
{
- covarssession <- session[session$Type == "constant covariate", ]
- for (i in 1:nrow(covarssession))
- {
- names <- strsplit(covarssession$Name[i],
- " ", fixed=TRUE)[[1]]
- ncases <- length(x$cCovars[[match(names[1], covars)]])
- Report(c("Covariate data file", covarssession$Filename[i],
- "with", length(names), "variables,", ncases,
- "cases, named:\n"), outf)
- Report(paste(names, "\n"), outf, sep="")
- }
+ Report(c(format(covars[i], width=15), '\n'), outf)
}
- else
- {
- Report(c(nCovars, "variable"),outf)
- Report(ifelse(nCovars == 1, ", named:\n", "s, named:\n"), outf)
- for (i in seq(along=covars))
- {
- Report(c(format(covars[i], width=15), '\n'), outf)
- }
- }
Report(c("\nA total of", nCovars,
"non-changing individual covariate"), outf)
Report(ifelse(nCovars == 1, ".\n\n", "s.\n\n"), outf)
@@ -574,45 +521,12 @@
use <- ! covars %in% names(x$cCovars)
nCovars <- length(x$vCovars[use])
Heading(2, outf, "Reading exogenous changing actor covariates.")
- if (!is.null(session))
+ Report(c(nCovars, "variable"),outf)
+ Report(ifelse(nCovars == 1, ", named:\n", "s, named:\n"), outf)
+ for (i in seq(along=covars[use]))
{
- if (nData > 1)
- {
- covarssession <-
- session[session$Type == "constant covariate", ]
- for (i in 1:nrow(covarssession))
- {
- names <- strsplit(covarssession$Name[i],
- " ", fixed=TRUE)[[1]]
- ncases <- length(x$vCovars[[match(names[1], covars)]])
- Report(c("Covariate data file",
- covarssession$Filename[i],
- "with", length(names), "variables,", ncases,
- "cases, named:\n"), outf)
- Report(paste(names, "\n"), outf, sep="")
- }
- }
- covarssession <- session[session$Type == "changing covariate", ]
- for (i in seq(along=covarssession[,1]))
- {
- ncases <- nrow(x$vCovars[[match(covarssession$Name[i],
- covars)]])
- Report(c("Exogenous changing covariate ",
- covarssession$name[i], " read from file ",
- covarssession$Filename[i], ".\n"), sep="", outf)
- Report(c("Number of cases is ", ncases, ".\n"), sep="",
- outf)
- }
+ Report(c(format(covars[use][i], width=15), '\n'), outf)
}
- else
- {
- Report(c(nCovars, "variable"),outf)
- Report(ifelse(nCovars == 1, ", named:\n", "s, named:\n"), outf)
- for (i in seq(along=covars[use]))
- {
- Report(c(format(covars[use][i], width=15), '\n'), outf)
- }
- }
Report(c("\nA total of", nCovars,
"exogenous changing actor covariate"), outf)
Report(ifelse(nCovars == 1, ".\n\n", "s.\n\n"), outf)
@@ -957,8 +871,7 @@
{
stop("The first argument needs to be a siena data object.")
}
- if ((!(inherits(modelname, "character")))|
- (inherits(session,"sienaEffects")))
+ if (!(inherits(modelname, "character")))
{
cat("Since version 1.1-279, an effects object should not be given\n")
cat(" in the call of print01Report. Consult the help file.\n")
@@ -1015,16 +928,14 @@
paste("Subproject ", i, ": <", names(data)[i], ">",
sep="", collapse="")
)
- thisSession <- session[session$Group == names(data)[i],]
- reportDataObject(data[[i]], periodFromStart, multi=TRUE,
- session=thisSession)
+ reportDataObject(data[[i]], periodFromStart, multi=TRUE)
periodFromStart <- periodFromStart + data[[i]]$observations
}
}
else
{
Heading(1, outf, "Data input.")
- reportDataObject(data[[1]], 0, multi=FALSE, session=session)
+ reportDataObject(data[[1]], 0, multi=FALSE)
}
atts <- attributes(data)
nets <- atts$types != "behavior"
Deleted: pkg/RSiena/R/siena01.r
===================================================================
--- pkg/RSiena/R/siena01.r 2016-05-22 18:06:40 UTC (rev 292)
+++ pkg/RSiena/R/siena01.r 2016-05-24 20:37:13 UTC (rev 293)
@@ -1,1237 +0,0 @@
-#/******************************************************************************
-# * SIENA: Simulation Investigation for Empirical Network Analysis
-# *
-# * Web: http://www.stats.ox.ac.uk/~snijders/siena
-# *
-# * File: siena01.r
-# *
-# * Description: This module contains the code for the gui for creation of a
-# * Siena data object.
-# *****************************************************************************/
-##@installGui Miscellaneous
-installGui <- function()
-{
- if (.Platform$OS.type =="windows")
- {
- message("The standalone gui is no longer available. ",
- "To run the gui within R:\n",
- "Start R, load RSiena using Packages menu ",
- "then type siena01Gui() (and <ENTER>)")
- }
- else
- {
- stop("Gui only needs installing on Windows: on Linux use sienascript")
- }
-}
-
-##@siena01Gui siena01
-siena01Gui <- function(getDocumentation=FALSE)
-{
- ##DONE (FALSE) ## this is so we can exit cleanly, but seems redundant here
- ## require(tcltk)
- maxDegree <- NULL
- nMaxDegree <- NULL
- resultsFileID <- NULL
- estimAns <- NULL
- modelName <- NULL
- ## effEdit <- NULL
- noFiles <- 0
- filename <- NA
- files <- NULL
- fileEditFlag <- FALSE
- depvarnames <- NULL
- ndepvars <- 0
- nettypes <- NULL
- estimVar <- NULL
- effectsVar <- NULL
- condVar <- NULL
- gainVar <- NULL
- stdstartVar <- NULL
- ph2spinVar <- NULL
- rsspinVar <- NULL
- rsVar <- NULL
- clustVar <- NULL
- clustspinVar <- NULL
- derivVar <- NULL
- ph3spinVar <- NULL
- maxdfVar <- NULL
- session <- NULL
- defaults <- c("Group1","Var1", "","", " ", "Actors",
- "","Yes", "NA", "1", " ")
- mydata <- NULL
- myeff <- NULL
- mymodel <- NULL
- ##@addFile internal siena01Gui
- addFile<- function()
- {
- noFiles <<- noFiles+1
- addFiletypes <- paste("{{Data Files} .dat}",
- "{{Pajek network files} .net}",
- "{{All files} *}")
- filename[noFiles] <<-
- basename(tclvalue(tkgetOpenFile(filetypes=addFiletypes,
- initialdir=initialDir)))
- if (filename[noFiles] == "")
- {
- noFiles <<- noFiles - 1
- return()
- }
- if (tableRows < noFiles)
- {
- addTableRow(tableRows+1)
- tableRows <<- tableRows + 1
- }
- mytkarray[[noFiles, 3]] <<- as.tclObj(format(filename[noFiles],
- length=50), drop=TRUE)
- mytkarray[[noFiles, 6]] <<- "Actors"
- mytkarray[[noFiles, 8]] <<- "Yes"
- mytkarray[[noFiles, 5]] <<- noFiles ## period
- if (substring(filename[noFiles], nchar(filename[noFiles]) - 3,
- nchar(filename[noFiles]))=='.net')
- tkset(formatspins[[noFiles]], "pajek net")
- tcl(table1, "selection", "clear", "all") ## unselect everything
- tcl(table1, "selection", 'set', paste(noFiles,',3', sep=''))
- tcl(table1, "yview", noFiles)
- ## find the directory we are in and use it next time
- initialDir <<- dirname(filename[noFiles])
- }
-
- ##@addTableRow internal siena01Gui
- addTableRow <- function(i)
- {
- tkinsert(table1,"rows","end","1")
- ##create spinbox for format
- formatspins[[i]] <<- tkwidget(table1, 'spinbox', state='readonly',
- width=20, values=ff, cursor="arrow")
- mypos <- paste(i, ',',4, sep='')
- tkwindow.configure(table1, mypos, window=formatspins[[i]])
- tkbind(formatspins[[i]], "<FocusIn>",
- function(x)tcl(table1,"activate",'1,4'))
- ##create spinbox for type
- typespins[[i]] <<- tkwidget(table1, 'spinbox', state='readonly',
- width=25, values=typelist, cursor="arrow")
- mypos <- paste(i, ',',7, sep='')
- tkwindow.configure(table1, mypos, window=typespins[[i]])
- tkbind(typespins[[i]], "<FocusIn>",
- function(x) tcl(table1,"activate",'1,4'))
- tkconfigure(table1, height=i+1)
- }
-
- ##@applyFn internal siena01Gui
- applyFn <- function() ## prompt to save, then try to create data, then
- ## sienaModelOptions
- {
- if (noFiles == 0)
- {
- tkmessageBox(message='No data to apply', icon='error')
- return()
- }
- ans <- tkmessageBox(message='Do you want to save the session?',
- type='yesno', icon='question')
- if (tclvalue(ans)=='yes')
- {
- saveFn()
- }
- else
- {
- sessionFromTcl()
- if (is.null(modelName))
- {
- modelName <<- "Siena"
- }
- }
- if (inherits(resp <-
- try(sienaDataCreateFromSession(session=session,
- modelName=modelName,
- edited=fileEditFlag,
- files=files),
- silent=TRUE), "try-error"))
- {
- tkmessageBox(message=resp, icon='error')
- }
- else
- {
- mydata <<- resp$mydata
- myeff <<- resp$myeff
- mymodel <<- sienaAlgorithmCreate()
- savedObjectName <- paste(modelName, ".Rdata", sep="")
- save(mydata, myeff, mymodel, file=savedObjectName)
- sienaModelOptions()
- }
- }
- ##@clearFn internal siena01Gui
- clearFn <- function()
- {
- noFiles <<- 0
- filename <<- NULL
- for (i in 1:tableRows)
- for (j in 1:11)
- mytkarray[[i,j]] <<- NULL
- lapply(typespins, function(x) tkset(x, 'network'))
- lapply(formatspins, function(x) tkset(x,'matrix' ))
-
- }
- ##@deleteTableRow internal siena01Gui
- deleteTableRow <- function(i)
- {
- ## unmap the format window from the table
- mypos <- paste(i,',4', sep='')
- tkwindow.configure(table1, mypos, window="")
- ## delete the window
- tcl(table1, 'window', 'delete', mypos)
- ## remove the tcl variable behind it
- formatspins <<- formatspins[-i]
- ## unmap the type window from the table
- mypos <- paste(i,',7', sep='')
- tkwindow.configure(table1, mypos, window="")
- ## delete the window
- tcl(table1, 'window', 'delete', mypos)
- ## remove the tcl variable behind it
- typespins <<- typespins[-i]
- ## delete the row from the table
- tkdelete(table1, 'rows', i, '1')
- tableRows <<- tableRows - 1
- ## sessionFromTcl()
- if (noFiles > 0)
- {
- noFiles <<- noFiles - 1
- files <<- files[-i]
- }
- else
- files <<- NULL
- }
- ##@editFile internal siena01Gui
- editFile<- function()
- {
- ##try: may be nothing selected or a box beneath spinbox
- selcursor <- tclvalue(tcl(table1, 'curselection'))
- if (selcursor == "")
- {
- tkmessageBox(message="No file selected")
- return()
- }
- else
- {
- fileno <- as.numeric(strsplit(selcursor, ',')[[1]][1])
- sessionFromTcl()
- files <<- readInFiles(session, fileEditFlag, files)
- tmpfile <- files[[fileno]]
- files[[fileno]] <<- edit(tmpfile) ## may need to undo
- fileEditFlag[fileno] <<- TRUE
- }
- tkfocus(tt)
- ## put on top globally temporarily
- tcl('wm', 'attributes', tt, '-topmost', 1)
- Sys.sleep(0.1)
- tcl('wm', 'attributes', tt, '-topmost', 0)
- invisible()
- }
- ##@fromFileFn internal siena01Gui
- fromFileFn <- function()
- {
-
- sessionFiletypes <- paste("{{Text Files} {.txt .csv .prn}}",
- ## " {{Excel files} .xls}",
- "{{All files} *}")
- loadfilename <- tclvalue(tkgetOpenFile(filetypes =
- sessionFiletypes))
- ## browser()
- if (loadfilename == "")
- {
- return(FALSE)
- }
- modelName <<- basename(loadfilename)
- ipos <- max(c(0, gregexpr('.', modelName, fixed=TRUE)[[1]]))
- if (ipos > 1)
- {
- modelName <<- substring(modelName, 1, (ipos - 1))
- }
- session <<- sessionFromFile(loadfilename, tk=TRUE)
- procSession()
- TRUE
- }
- ##@fromFileContFn internal siena01Gui
- fromFileContFn <- function()
- {
- OK <- fromFileFn()
- if (OK)
- {
- ## try to read in the project object
- savedModelName <- paste(modelName, ".Rdata", sep='')
- #browser()
- if (inherits(try(load(savedModelName), silent=TRUE), "try-error"))
- {
- tkmessageBox(message="Unable to load saved model", icon="error")
- }
- else
- {
- mydata <<- mydata
- mymodel <<- mymodel
- myeff <<- myeff
- sienaModelOptions()
- }
- }
- }
- ##@helpFn internal siena01Gui
- helpFn <- function() ## display the manual
- {
- RShowDoc("RSiena_Manual", package=pkgname)
- }
- ##@myStop internal siena01Gui
- myStop<- function()
- {
- if (!DONE() && exists("mydata") && exists("myeff") &&
- exists("mymodel") && !is.null(mydata) && !is.null(myeff) &&
- !is.null(mymodel))
- {
- ans <- tkmessageBox(message='Do you want to save the model?',
- type='yesno', icon='question')
- if (tclvalue(ans)=='yes')
- {
- savefileFn()
- }
- }
- tkdestroy(tt)
- DONE(TRUE)
- }
- ##@procSession internal siena01Gui
- procSession <- function(replace=FALSE) ##
- {
- if (replace)
- {
- if(tableRows != nrow(session))
- browser()
- }
- if (!replace)
- {
- if (tableRows < nrow(session))
- for (i in (tableRows + 1) :(nrow(session)))
- addTableRow(i)
- else if (tableRows > nrow(session))
- for (i in (nrow(session) + 1) : tableRows)
- deleteTableRow(i)
- }
- for (i in 1:nrow(session))
- {
- for (j in 1: ncol(session))
- mytkarray[[i, j]] <<- as.tclObj(session[i,j], drop=TRUE)
- tkset(formatspins[[i]], session[i,4])
- tkset(typespins[[i]], session[i, 7])
- filename[[i]] <<- session[i, 3]
- }
- tableRows <<- nrow(session)
- noFiles <<- tableRows
- tcl(table1, "selection", "clear", "all") ## unselect everything
- tcl(table1, "activate", "1, 3")
- tcl(table1, "selection", 'set', paste('1', ',3', sep=''))
- }
- ##@removeFile internal siena01Gui
- removeFile <- function()
- {
- selcursor <- tclvalue(tcl(table1, 'curselection'))
- fileno <- as.numeric(strsplit(selcursor, ',')[[1]][1])
- if (is.na(fileno) || !is.numeric(fileno))
- {
- tkmessageBox(message='No file selected to remove')
- return()
- }
- session <<- NULL
- deleteTableRow(fileno)
- tcl(table1, "selection", "clear", "all") ## unselect everything
- tcl(table1, "activate", '1, 4')
- }
- ##@saveFn internal siena01Gui
- saveFn <- function() ## saves session file
- {
- if (noFiles == 0)
- {
- tkmessageBox(message='No data to save')
- return()
- }
- sessionFromTcl()
- sessionFiletypes <- "{{csv file} *.csv}"
- if (!is.null(modelName))
- {
- init <- modelName
- }
- else
- {
- init <- "Siena"
- }
- savefilename <- tclvalue(tkgetSaveFile(filetypes=sessionFiletypes,
- defaultextension='.csv',
- initialfile=init))
- if (savefilename != "")
- {
- write.table(session, file=savefilename, sep=',', row.names=FALSE)
- }
- modelName <<- basename(savefilename)
- ipos <- max(c(0, gregexpr('.', modelName, fixed=TRUE)[[1]]))
- if (ipos > 1)
- {
- modelName <<- substring(modelName, 1, (ipos - 1))
- }
- }
- ##@savefileFn internal siena01Gui
- savefileFn <- function() ## saves data and model
- {
- mymodel <<- modelFromTcl()
- modelFiletypes <- "{{R object} *.Rdata}"
- if (!is.null(modelName))
- {
- init <- modelName
- }
- else
- {
- init <- "Siena"
- }
- savefilename <- tclvalue(tkgetSaveFile(filetypes=modelFiletypes,
- defaultextension='.Rdata',
- initialfile=init))
- if (savefilename != "")
- save(mymodel, mydata, myeff, file=savefilename)
- }
- ##@sessionFromTcl internal siena01Gui
- sessionFromTcl <- function()
- {
- rows <- as.numeric(strsplit(tclvalue(tkconfigure(table1, '-rows')),
- " ")[[1]][5])
- ##height <- as.numeric(strsplit(tclvalue(tkconfigure(table1, '-height')),
- ## " ")[[1]][5])
- if (tableRows != (rows-1))
- browser()
- if (is.null(session))
- {
- session <<- data.frame(Group = 1, Name ="",
- Filename = "",
- Format = "Matrix",
- Period = "1",
- ActorSet = "Actors",
- Type = "network",
- Selected = "Yes",
- MissingValues = "NA",
- NonZeroCode = "1",
- NbrOfActors = "",
- stringsAsFactors = FALSE)
-
- session <<- session[rep(1, noFiles),]
- row.names(session) <<- 1:noFiles
- }
- for (i in 1:noFiles)
- {
- for (j in c(1,2,3,5,6,8,9,10,11))
- {
- if (is.null( mytkarray[[i,j]]) ||
- tclvalue(mytkarray[[i,j]]) =="")
- {
- mytkarray[[i,j]] <<- as.tclObj(defaults[j], drop=TRUE)
- }
- session[i, j] <<- trim.blanks(tclvalue(mytkarray[[i,j]]))
- }
- session[i, 4] <<- tclvalue(tkget(formatspins[[i]]))
- session[i, 7] <<- tclvalue(tkget(typespins[[i]]))
- }
- ##one day we will validate too!
- }
-
- ##@modelFromTcl internal siena01Gui
- modelFromTcl <- function()
- {
- # model <- NULL
- if (!is.null(modelName))
- {
- projname <- modelName
- }
- else
- {
- projname <- "Siena"
- }
- cond <- tclvalue(estimVar) ==
- '1. conditional Method of Moments'
- firstg <- as.numeric(tclvalue(gainVar))
- useStdInits <- tclvalue(stdstartVar) == '1'
- nsub <- as.numeric(tclvalue(ph2spinVar))
- if (tclvalue(rsVar) == '0')
- {
- seed <- NULL
- }
- else
- {
- seed <- as.numeric(tclvalue(rsspinVar))
- }
- FinDiff.method <- tclvalue(derivVar) == '0. crude Monte Carlo'
- n3 <- as.numeric(tclvalue(ph3spinVar))
- degs <- rep(0, nMaxDegree)
- for (i in 1:nMaxDegree)
- {
- degs[i] <- as.integer(tclvalue(maxdfVar[[i, 2]]))
- }
- names(degs) <- depvarnames[maxDegree]
- condvarno <- 0
- condname <- ""
- if (cond)
- {
- if (ndepvars == 1)
- {
- condvarno <- 1
- condname <- ""
- }
- else
- {
- condname <- tclvalue(condVar)
- }
- }
- sienaAlgorithmCreate(projname=projname, useStdInits=useStdInits,
- cond=cond, firstg=firstg, seed=seed,
- nsub=nsub, n3=n3, findiff=FinDiff.method,
- MaxDegree=degs, condvarno=condvarno, condname=condname)
- }
- ##@sienaModelOptions internal siena01Gui
- sienaModelOptions <- function()
- {
- ##@editFn internal siena01Gui
- editFn <- function()
- {
- ## split effects if a variable is selected
- theseEffects <- tclvalue(effectsVar)
- myeffcopy <- myeff
- if (theseEffects != "")
- {
- myeffcopy <- myeff[myeff$name == theseEffects, ]
- }
- if (is.null(myeffcopy$effectNumber))
- {
- myeffcopy <- cbind(effectNumber=1:nrow(myeff), myeff,
- effect1=rep(0, nrow(myeff)),
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rsiena -r 293
More information about the Rsiena-commits
mailing list