[Rsiena-commits] r17 - in pkg/RSiena: . R data man src src/data src/model src/model/effects src/model/effects/generic src/model/tables src/model/variables src/network src/utils tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Oct 31 23:31:57 CET 2009
Author: ripleyrm
Date: 2009-10-31 23:31:57 +0100 (Sat, 31 Oct 2009)
New Revision: 17
Added:
pkg/RSiena/data/allEffects.R
pkg/RSiena/data/allEffects.csv
pkg/RSiena/man/allEffects.Rd
pkg/RSiena/src/model/effects/generic/
pkg/RSiena/src/model/effects/generic/AlterFunction.cpp
pkg/RSiena/src/model/effects/generic/AlterFunction.h
pkg/RSiena/src/model/effects/generic/BetweennessFunction.cpp
pkg/RSiena/src/model/effects/generic/BetweennessFunction.h
pkg/RSiena/src/model/effects/generic/ConstantFunction.cpp
pkg/RSiena/src/model/effects/generic/ConstantFunction.h
pkg/RSiena/src/model/effects/generic/DifferenceFunction.cpp
pkg/RSiena/src/model/effects/generic/DifferenceFunction.h
pkg/RSiena/src/model/effects/generic/EgoInDegreeFunction.cpp
pkg/RSiena/src/model/effects/generic/EgoInDegreeFunction.h
pkg/RSiena/src/model/effects/generic/EgoOutDegreeFunction.cpp
pkg/RSiena/src/model/effects/generic/EgoOutDegreeFunction.h
pkg/RSiena/src/model/effects/generic/GenericNetworkEffect.cpp
pkg/RSiena/src/model/effects/generic/GenericNetworkEffect.h
pkg/RSiena/src/model/effects/generic/InDegreeFunction.cpp
pkg/RSiena/src/model/effects/generic/InDegreeFunction.h
pkg/RSiena/src/model/effects/generic/InStarFunction.cpp
pkg/RSiena/src/model/effects/generic/InStarFunction.h
pkg/RSiena/src/model/effects/generic/InTieFunction.cpp
pkg/RSiena/src/model/effects/generic/InTieFunction.h
pkg/RSiena/src/model/effects/generic/IntAlterFunction.cpp
pkg/RSiena/src/model/effects/generic/IntAlterFunction.h
pkg/RSiena/src/model/effects/generic/IntSqrtFunction.cpp
pkg/RSiena/src/model/effects/generic/IntSqrtFunction.h
pkg/RSiena/src/model/effects/generic/NetworkAlterFunction.cpp
pkg/RSiena/src/model/effects/generic/NetworkAlterFunction.h
pkg/RSiena/src/model/effects/generic/OutDegreeFunction.cpp
pkg/RSiena/src/model/effects/generic/OutDegreeFunction.h
pkg/RSiena/src/model/effects/generic/OutTieFunction.cpp
pkg/RSiena/src/model/effects/generic/OutTieFunction.h
pkg/RSiena/src/model/effects/generic/ProductFunction.cpp
pkg/RSiena/src/model/effects/generic/ProductFunction.h
pkg/RSiena/src/model/effects/generic/ReciprocatedTwoPathFunction.cpp
pkg/RSiena/src/model/effects/generic/ReciprocatedTwoPathFunction.h
pkg/RSiena/src/model/effects/generic/TwoPathFunction.cpp
pkg/RSiena/src/model/effects/generic/TwoPathFunction.h
pkg/RSiena/src/network/
pkg/RSiena/src/network/CommonNeighborIterator.cpp
pkg/RSiena/src/network/CommonNeighborIterator.h
pkg/RSiena/src/network/IncidentTieIterator.cpp
pkg/RSiena/src/network/IncidentTieIterator.h
pkg/RSiena/src/network/Network.cpp
pkg/RSiena/src/network/Network.h
pkg/RSiena/src/network/NetworkUtils.cpp
pkg/RSiena/src/network/NetworkUtils.h
pkg/RSiena/src/network/OneModeNetwork.cpp
pkg/RSiena/src/network/OneModeNetwork.h
pkg/RSiena/src/network/TieIterator.cpp
pkg/RSiena/src/network/TieIterator.h
pkg/RSiena/tests/
pkg/RSiena/tests/parallel.R
pkg/RSiena/tests/parallel.Rout.save
pkg/RSiena/tests/s50-network1.dat
pkg/RSiena/tests/s50-network2.dat
pkg/RSiena/tests/s50-network3.dat
pkg/RSiena/tests/s50.csv
pkg/RSiena/tests/s50_d1.net
pkg/RSiena/tests/s50_d2.net
pkg/RSiena/tests/s50_d3.net
pkg/RSiena/tests/s50e.csv
pkg/RSiena/tests/s50e.dat
pkg/RSiena/tests/s50paj.csv
Removed:
pkg/RSiena/R/effectsInfo.R
pkg/RSiena/src/data/CommonNeighborIterator.cpp
pkg/RSiena/src/data/CommonNeighborIterator.h
pkg/RSiena/src/data/DataUtils.cpp
pkg/RSiena/src/data/DataUtils.h
pkg/RSiena/src/data/IncidentTieIterator.cpp
pkg/RSiena/src/data/IncidentTieIterator.h
pkg/RSiena/src/data/Network.cpp
pkg/RSiena/src/data/Network.h
pkg/RSiena/src/data/OneModeNetwork.cpp
pkg/RSiena/src/data/OneModeNetwork.h
pkg/RSiena/src/data/TieIterator.cpp
pkg/RSiena/src/data/TieIterator.h
Modified:
pkg/RSiena/DESCRIPTION
pkg/RSiena/NAMESPACE
pkg/RSiena/R/RSienaRDocumentation.r
pkg/RSiena/R/effects.r
pkg/RSiena/R/phase1.r
pkg/RSiena/R/phase2.r
pkg/RSiena/R/phase3.r
pkg/RSiena/R/print01Report.r
pkg/RSiena/R/print07Report.r
pkg/RSiena/R/printDataReport.r
pkg/RSiena/R/printInitialDescription.r
pkg/RSiena/R/robmon.r
pkg/RSiena/R/siena01.r
pkg/RSiena/R/siena07.r
pkg/RSiena/R/sienaDataCreate.r
pkg/RSiena/R/sienaDataCreateFromSession.r
pkg/RSiena/R/sienaprint.r
pkg/RSiena/R/sienautils.r
pkg/RSiena/R/simstatsc.r
pkg/RSiena/cleanup
pkg/RSiena/cleanup.win
pkg/RSiena/man/RSiena-package.Rd
pkg/RSiena/man/simstats0c.Rd
pkg/RSiena/src/Makefile.profile
pkg/RSiena/src/Makefile.win
pkg/RSiena/src/Makevars
pkg/RSiena/src/data/BehaviorLongitudinalData.cpp
pkg/RSiena/src/data/BehaviorLongitudinalData.h
pkg/RSiena/src/data/Data.cpp
pkg/RSiena/src/data/LongitudinalData.h
pkg/RSiena/src/data/NetworkLongitudinalData.cpp
pkg/RSiena/src/data/NetworkLongitudinalData.h
pkg/RSiena/src/model/EpochSimulation.cpp
pkg/RSiena/src/model/EpochSimulation.h
pkg/RSiena/src/model/Model.cpp
pkg/RSiena/src/model/Model.h
pkg/RSiena/src/model/State.cpp
pkg/RSiena/src/model/State.h
pkg/RSiena/src/model/StatisticCalculator.cpp
pkg/RSiena/src/model/StatisticCalculator.h
pkg/RSiena/src/model/effects/AllEffects.h
pkg/RSiena/src/model/effects/AverageAlterEffect.cpp
pkg/RSiena/src/model/effects/AverageSimilarityEffect.cpp
pkg/RSiena/src/model/effects/BalanceEffect.cpp
pkg/RSiena/src/model/effects/BalanceEffect.h
pkg/RSiena/src/model/effects/BehaviorDependentBehaviorEffect.cpp
pkg/RSiena/src/model/effects/BehaviorDependentBehaviorEffect.h
pkg/RSiena/src/model/effects/BehaviorEffect.cpp
pkg/RSiena/src/model/effects/BehaviorEffect.h
pkg/RSiena/src/model/effects/BehaviorMainBehaviorEffect.cpp
pkg/RSiena/src/model/effects/BehaviorMainBehaviorEffect.h
pkg/RSiena/src/model/effects/BetweennessEffect.cpp
pkg/RSiena/src/model/effects/BetweennessEffect.h
pkg/RSiena/src/model/effects/ChangingCovariateBehaviorEffect.cpp
pkg/RSiena/src/model/effects/ChangingCovariateBehaviorEffect.h
pkg/RSiena/src/model/effects/ChangingCovariateMainBehaviorEffect.cpp
pkg/RSiena/src/model/effects/ConstantCovariateBehaviorEffect.cpp
pkg/RSiena/src/model/effects/ConstantCovariateBehaviorEffect.h
pkg/RSiena/src/model/effects/ConstantCovariateMainBehaviorEffect.cpp
pkg/RSiena/src/model/effects/CovariateAlterEffect.cpp
pkg/RSiena/src/model/effects/CovariateAlterEffect.h
pkg/RSiena/src/model/effects/CovariateDependentNetworkEffect.cpp
pkg/RSiena/src/model/effects/CovariateDependentNetworkEffect.h
pkg/RSiena/src/model/effects/CovariateEgoAlterEffect.cpp
pkg/RSiena/src/model/effects/CovariateEgoAlterEffect.h
pkg/RSiena/src/model/effects/CovariateEgoEffect.cpp
pkg/RSiena/src/model/effects/CovariateEgoEffect.h
pkg/RSiena/src/model/effects/CovariateIndirectTiesEffect.cpp
pkg/RSiena/src/model/effects/CovariateIndirectTiesEffect.h
pkg/RSiena/src/model/effects/CovariateSimilarityEffect.cpp
pkg/RSiena/src/model/effects/CovariateSimilarityEffect.h
pkg/RSiena/src/model/effects/DenseTriadsEffect.cpp
pkg/RSiena/src/model/effects/DenseTriadsEffect.h
pkg/RSiena/src/model/effects/DensityEffect.cpp
pkg/RSiena/src/model/effects/DensityEffect.h
pkg/RSiena/src/model/effects/DistanceTwoEffect.cpp
pkg/RSiena/src/model/effects/DistanceTwoEffect.h
pkg/RSiena/src/model/effects/DyadicCovariateDependentNetworkEffect.cpp
pkg/RSiena/src/model/effects/DyadicCovariateDependentNetworkEffect.h
pkg/RSiena/src/model/effects/DyadicCovariateMainEffect.cpp
pkg/RSiena/src/model/effects/DyadicCovariateMainEffect.h
pkg/RSiena/src/model/effects/DyadicCovariateReciprocityEffect.cpp
pkg/RSiena/src/model/effects/DyadicCovariateReciprocityEffect.h
pkg/RSiena/src/model/effects/Effect.cpp
pkg/RSiena/src/model/effects/Effect.h
pkg/RSiena/src/model/effects/EffectFactory.cpp
pkg/RSiena/src/model/effects/EffectFactory.h
pkg/RSiena/src/model/effects/FourCyclesEffect.cpp
pkg/RSiena/src/model/effects/FourCyclesEffect.h
pkg/RSiena/src/model/effects/HigherCovariateEffect.cpp
pkg/RSiena/src/model/effects/HigherCovariateEffect.h
pkg/RSiena/src/model/effects/InInDegreeAssortativityEffect.cpp
pkg/RSiena/src/model/effects/InInDegreeAssortativityEffect.h
pkg/RSiena/src/model/effects/InOutDegreeAssortativityEffect.cpp
pkg/RSiena/src/model/effects/InOutDegreeAssortativityEffect.h
pkg/RSiena/src/model/effects/IndegreeActivityEffect.cpp
pkg/RSiena/src/model/effects/IndegreeActivityEffect.h
pkg/RSiena/src/model/effects/IndegreeEffect.cpp
pkg/RSiena/src/model/effects/IndegreeEffect.h
pkg/RSiena/src/model/effects/IndegreePopularityEffect.cpp
pkg/RSiena/src/model/effects/IndegreePopularityEffect.h
pkg/RSiena/src/model/effects/InverseOutdegreeEffect.cpp
pkg/RSiena/src/model/effects/InverseOutdegreeEffect.h
pkg/RSiena/src/model/effects/InverseSquaredOutdegreeEffect.cpp
pkg/RSiena/src/model/effects/InverseSquaredOutdegreeEffect.h
pkg/RSiena/src/model/effects/LinearShapeEffect.cpp
pkg/RSiena/src/model/effects/NetworkDependentBehaviorEffect.cpp
pkg/RSiena/src/model/effects/NetworkDependentBehaviorEffect.h
pkg/RSiena/src/model/effects/NetworkEffect.cpp
pkg/RSiena/src/model/effects/NetworkEffect.h
pkg/RSiena/src/model/effects/OutInDegreeAssortativityEffect.cpp
pkg/RSiena/src/model/effects/OutInDegreeAssortativityEffect.h
pkg/RSiena/src/model/effects/OutOutDegreeAssortativityEffect.cpp
pkg/RSiena/src/model/effects/OutOutDegreeAssortativityEffect.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/effects/OutdegreeEffect.cpp
pkg/RSiena/src/model/effects/OutdegreePopularityEffect.cpp
pkg/RSiena/src/model/effects/OutdegreePopularityEffect.h
pkg/RSiena/src/model/effects/QuadraticShapeEffect.cpp
pkg/RSiena/src/model/effects/ReciprocityEffect.cpp
pkg/RSiena/src/model/effects/ReciprocityEffect.h
pkg/RSiena/src/model/effects/SameCovariateEffect.cpp
pkg/RSiena/src/model/effects/SameCovariateEffect.h
pkg/RSiena/src/model/effects/StructuralRateEffect.cpp
pkg/RSiena/src/model/effects/ThreeCyclesEffect.cpp
pkg/RSiena/src/model/effects/ThreeCyclesEffect.h
pkg/RSiena/src/model/effects/TotalSimilarityEffect.cpp
pkg/RSiena/src/model/effects/TransitiveMediatedTripletsEffect.cpp
pkg/RSiena/src/model/effects/TransitiveMediatedTripletsEffect.h
pkg/RSiena/src/model/effects/TransitiveTiesEffect.cpp
pkg/RSiena/src/model/effects/TransitiveTiesEffect.h
pkg/RSiena/src/model/effects/TransitiveTriadsEffect.cpp
pkg/RSiena/src/model/effects/TransitiveTriadsEffect.h
pkg/RSiena/src/model/effects/TransitiveTripletsEffect.cpp
pkg/RSiena/src/model/effects/TransitiveTripletsEffect.h
pkg/RSiena/src/model/effects/WWXClosureEffect.cpp
pkg/RSiena/src/model/effects/WWXClosureEffect.h
pkg/RSiena/src/model/effects/WXXClosureEffect.cpp
pkg/RSiena/src/model/effects/WXXClosureEffect.h
pkg/RSiena/src/model/effects/XWXClosureEffect.cpp
pkg/RSiena/src/model/effects/XWXClosureEffect.h
pkg/RSiena/src/model/tables/ConfigurationTable.cpp
pkg/RSiena/src/model/tables/ConfigurationTable.h
pkg/RSiena/src/model/tables/CriticalInStarTable.cpp
pkg/RSiena/src/model/tables/CriticalInStarTable.h
pkg/RSiena/src/model/tables/TwoPathTable.cpp
pkg/RSiena/src/model/tables/TwoPathTable.h
pkg/RSiena/src/model/variables/BehaviorVariable.cpp
pkg/RSiena/src/model/variables/BehaviorVariable.h
pkg/RSiena/src/model/variables/DependentVariable.cpp
pkg/RSiena/src/model/variables/DependentVariable.h
pkg/RSiena/src/model/variables/NetworkVariable.cpp
pkg/RSiena/src/model/variables/NetworkVariable.h
pkg/RSiena/src/siena07.cpp
pkg/RSiena/src/utils/Random.cpp
pkg/RSiena/src/utils/SqrtTable.h
Log:
New version: new effects system in C++ and in R. Many bug fixes.
Modified: pkg/RSiena/DESCRIPTION
===================================================================
--- pkg/RSiena/DESCRIPTION 2009-10-31 21:31:02 UTC (rev 16)
+++ pkg/RSiena/DESCRIPTION 2009-10-31 22:31:57 UTC (rev 17)
@@ -1,12 +1,12 @@
Package: RSiena
Type: Package
Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.0.5
-Date: 2009-08-10
+Version: 1.0.6
+Date: 2009-10-31
Author: Various
Depends: R (>= 2.7.0)
-Imports: Matrix
-Suggests: tcltk, snow, rlecuyer, network, codetools, xtable
+Imports: Matrix, xtable
+Suggests: tcltk, snow, rlecuyer, network, codetools
SystemRequirements: GNU make, tcl/tk 8.5, Tktable
Maintainer: <ruth at stats.ox.ac.uk>
Description: Fits models to longitudinal networks
@@ -14,4 +14,3 @@
LazyLoad: yes
LazyData: yes
URL: http://www.stats.ox.ac.uk/~snijders/siena
-Packaged: 2009-09-22 21:01:10 UTC; ruth
Modified: pkg/RSiena/NAMESPACE
===================================================================
--- pkg/RSiena/NAMESPACE 2009-10-31 21:31:02 UTC (rev 16)
+++ pkg/RSiena/NAMESPACE 2009-10-31 22:31:57 UTC (rev 17)
@@ -6,6 +6,7 @@
installGui)
import(Matrix)
+import(xtable)
S3method(print, siena)
S3method(print, sienaGroup)
@@ -13,3 +14,4 @@
S3method(print, summary.sienaFit)
S3method(print, sienaModel)
S3method(summary, sienaFit)
+S3method(xtable, sienaFit)
Modified: pkg/RSiena/R/RSienaRDocumentation.r
===================================================================
--- pkg/RSiena/R/RSienaRDocumentation.r 2009-10-31 21:31:02 UTC (rev 16)
+++ pkg/RSiena/R/RSienaRDocumentation.r 2009-10-31 22:31:57 UTC (rev 17)
@@ -39,7 +39,7 @@
##@getRSienaDocumentation Documentation
getRSienaRDocumentation <- function(Rdir)
{
- library(xtable)
+ # library(xtable)
library(codetools)
thisdir <- getwd()
Modified: pkg/RSiena/R/effects.r
===================================================================
--- pkg/RSiena/R/effects.r 2009-10-31 21:31:02 UTC (rev 16)
+++ pkg/RSiena/R/effects.r 2009-10-31 22:31:57 UTC (rev 17)
@@ -11,246 +11,271 @@
##@getEffects DataCreate
getEffects<- function(x, nintn = 10, getDocumentation=FALSE)
{
+ ##@duplicateDataFrameRow internal getEffects Put period numbers in
+ duplicateDataFrameRow <- function(x, n)
+ {
+ tmp <- NULL
+ for (i in 1:n)
+ {
+ xx <- x
+ xx[, c("effectName", "functionName", "period")] <-
+ sub("nnnnnn", i, xx[, c("effectName", "functionName",
+ "period")])
+ tmp <- rbind(tmp, xx)
+ }
+ tmp
+ }
+ ##@substituteNames internal getEffects replace xxxxxx, yyyyyy, zzzzzz
+ substituteNames <- function(nameVectors, xName=NULL, yName=NULL, zName=NULL)
+ {
+ effects <- nameVectors[, c("effectName", "functionName",
+ "interaction1", "interaction2")]
+ if (!is.null(xName))
+ {
+ effects <- sapply(effects, function(x)
+ gsub("xxxxxx", xName, x))
+ }
+ if (!is.null(yName))
+ {
+ effects <- sapply(effects, function(x)
+ gsub("yyyyyy", yName, x))
+ }
+ if (!is.null(zName))
+ {
+ effects <- sapply(effects, function(x)
+ gsub("zzzzzz", zName, x))
+ }
+ nameVectors[, c("effectName", "functionName",
+ "interaction1", "interaction2")] <- effects
+ nameVectors
+ }
+ ##@createEffects internal getEffects Extract required rows and change text
+ createEffects <- function(effectGroup, xName=NULL, yName=NULL)
+ {
+ effects <- allEffects[allEffects$effectGroup == effectGroup, ]
+ if (nrow(effects) == 0)
+ {
+ stop("empty effect group")
+ }
+ if (any(is.na(effects$effectName)))
+ {
+ stop("missing effect name")
+ }
+ effects <- substituteNames(effects, xName, yName)
+ effects
+ }
+ ##@networkRateEffects internal getEffects create a set of rate effects
+ networkRateEffects <- function(depvar, varname, symmetric, bipartite)
+ {
+ if (symmetric)
+ {
+ rateEffects <- createEffects("symmetricRate", varname)
+ }
+ else if (bipartite)
+ {
+ rateEffects <- createEffects("bipartiteRate", varname)
+ }
+ else
+ {
+ rateEffects <- createEffects("nonSymmetricRate", varname)
+ }
+ if (observations == 1)
+ {
+ rateEffects <- rateEffects[-2, ] ## remove the extra period
+ }
+ else
+ {
+ ## get correct number of rows
+ rateEffects <- rbind(duplicateDataFrameRow(rateEffects[2, ],
+ observations),
+ rateEffects[-c(1, 2), ])
+ }
+ rateEffects
+ }
##@oneModeNet internal getEffects
oneModeNet <- function(depvar, varname)
{
+ symmetric <- attr(depvar, "symmetric")
nodeSet <- attr(depvar, 'nodeSet')
- if (attr(depvar, 'symmetric'))
+
+ rateEffects <- networkRateEffects(depvar, varname, symmetric=symmetric,
+ bipartite=FALSE)
+
+ if (symmetric)
{
- if (observations > 1)
+ objEffects <- createEffects("symmetricObjective", varname)
+ }
+ else
+ {
+ objEffects <- createEffects("nonSymmetricObjective", varname)
+ }
+ for (j in seq(along = xx$dycCovars))
+ {
+ if (attr(x$dycCovars[[j]], 'nodeSet')[1] == nodeSet)
{
- rateEffects <- paste('constant', varname,' rate (period ',
- periodNos, ')', sep = '')
- rateFunctions <- paste("Amount of network change in period",
- periodNos)
- rateShortNames <- rep('Rate', observations)
- ratePeriods <- 1:observations
- rateTypes <- rep(NA, observations)
+ objEffects <- rbind(objEffects,
+ createEffects("dyadObjective",
+ names(xx$dycCovars)[j]))
}
- else
+ }
+ for (j in seq(along = xx$dyvCovars))
+ {
+ if (attr(x$dvvCovars[[j]], 'nodeSet')[1] == nodeSet)
{
- rateEffects <- paste('basic rate parameter', varname)
- rateShortNames <- 'Rate'
- rateFunctions <- "Amount of network change"
- ratePeriods <- 1
- rateTypes <- NA
- }
- rateEffects <- c(rateEffects,
- paste(symmetricRateEffects[-(1:2), 1], varname))
- rateFunctions <- c(rateFunctions, symmetricRateEffects[-(1:2), 2])
- ratePeriods <- c(ratePeriods, rep(NA, nrow(symmetricRateEffects)-2))
- rateTypes <- c(rateTypes, rep('structural',
- nrow(symmetricRateEffects)-2))
- objEffects <- symmetricObjEffects[, 1]
- objFunctions <- symmetricObjEffects[, 2]
- objEndowment <- symmetricObjEffects[, 3]
- objShortNames <- symmetricObjEffects[, 4]
- objParms <- symmetricObjEffects[, 5]
- objEffects <- createObjEffectList(objEffects, objFunctions,
- objEndowment, objShortNames,
- objParms, varname)
- rateEffects <- createRateEffectList(rateEffects, rateFunctions,
- rateShortNames, ratePeriods,
- rateTypes,
- varname)
- for (j in seq(along = xx$dycCovars))
- {
- if (attr(x$dycCovars[[j]], 'nodeSet')[1] == nodeSet)
- {
- tmp <- dyadNetObjEff(names(xx$dycCovars)[j],
- symmetric=TRUE)
- objEffects <- rbind(objEffects, tmp$objEffects)
- }
+ objEffects <- rbind(objEffects,
+ createEffects("dyadObjective",
+ names(xx$dyvCovars)[j]))
}
- for (j in seq(along = xx$dyvCovars))
+ }
+ for (j in seq(along = xx$cCovars))
+ {
+ if (attr(x$cCovars[[j]], 'nodeSet') == nodeSet)
{
- if (attr(x$dvvCovars[[j]], 'nodeSet')[1] == nodeSet)
- {
- tmp <- dyadNetObjEff(names(xx$dyvCovars)[j],
- symmetric = TRUE)
- objEffects <- rbind(objEffects, tmp$objEffects)
- }
+ tmp <- covarOneModeEff(names(xx$cCovars)[j],
+ attr(xx$cCovars[[j]], 'poszvar'),
+ attr(xx$cCovars[[j]], 'moreThan2'),
+ symmetric)
+ objEffects <- rbind(objEffects, tmp$objEff)
+ rateEffects <- rbind(rateEffects, tmp$rateEff)
}
- for (j in seq(along = xx$cCovars))
+ }
+ for (j in seq(along=xx$depvars))
+ {
+ if (types[j] == 'behavior' &&
+ attr(xx$depvars[[j]], 'nodeSet') == nodeSet)
{
- if (attr(x$cCovars[[j]], 'nodeSet') == nodeSet)
- {
- tmp <- covSymmNetEff(names(xx$cCovars)[j],
- attr(xx$cCovars[[j]], 'poszvar'),
- attr(xx$cCovars[[j]], 'moreThan2'))
- objEffects <- rbind(objEffects, tmp$objEff)
- rateEffects <- rbind(rateEffects, tmp$rateEff)
- }
+ tmp <- covarOneModeEff(names(xx$depvars)[j],
+ poszvar=TRUE,
+ attr(xx$depvars[[j]], 'moreThan2'),
+ symmetric)
+ objEffects <- rbind(objEffects, tmp$objEff)
+ rateEffects <- rbind(rateEffects, tmp$rateEff)
}
- for (j in seq(along=x$depvars))
- {
- if (types[j] == 'behavior' &&
- attr(x$depvars[[j]], 'nodeSet') == nodeSet)
- {
- tmp <- covSymmNetEff(names(xx$depvars)[j],
- poszvar=TRUE,
- attr(xx$depvars[[j]], 'moreThan2'))
- objEffects <- rbind(objEffects, tmp$objEff)
- rateEffects <- rbind(rateEffects, tmp$rateEff)
- }
- }
- for (j in seq(along=x$vCovars))
- {
- if (attr(x$cCovars[[j]], 'nodeSet') == nodeSet)
- {
- tmp <- covSymmNetEff(names(xx$vCovars)[j],
- attr(xx$vCovars[[j]], 'poszvar'),
- attr(xx$vCovars[[j]], 'moreThan2'))
- objEffects <- rbind(objEffects,tmp$objEff)
- rateEffects<- rbind(rateEffects,tmp$rateEff)
- }
- }
}
- else ##not symmetric
+ for (j in seq(along=x$vCovars))
{
- if (observations > 1)
+ if (attr(x$cCovars[[j]], 'nodeSet') == nodeSet)
{
- rateEffects <- paste('constant ', varname,' rate (period ',
- periodNos, ')', sep = '')
- rateFunctions <- paste("Amount of network change in period",
- periodNos)
- rateShortNames <- rep('Rate', observations)
- ratePeriods <- 1:observations
- rateTypes <- rep(NA, observations)
+ tmp <- covarOneModeEff(names(xx$vCovars)[j],
+ attr(xx$vCovars[[j]], 'poszvar'),
+ attr(xx$vCovars[[j]], 'moreThan2'),
+ symmetric)
+ objEffects <- rbind(objEffects,tmp$objEff)
+ rateEffects<- rbind(rateEffects,tmp$rateEff)
}
- else
- {
- rateEffects <- paste('basic rate parameter', varname)
- rateFunctions <- "Amount of network change"
- rateShortNames <- 'Rate'
- ratePeriods <- 1
- rateTypes <- NA
- }
- rateEffects <- c(rateEffects, nonSymmetricRateEffects[-(1:2), 1])
- ratePeriods <- c(ratePeriods,
- rep(NA, nrow(nonSymmetricRateEffects) - 2))
- rateTypes <- c(rateTypes, rep('structural',
- nrow(nonSymmetricRateEffects) - 2))
- objEffects <- nonSymmetricObjEffects[, 1]
- rateFunctions <- c(rateFunctions, nonSymmetricRateEffects[-(1:2),2])
- rateShortNames <- c(rateShortNames,
- nonSymmetricRateEffects[-c(1:2), 3])
- objFunctions <- nonSymmetricObjEffects[, 2]
- objEndowment <- nonSymmetricObjEffects[, 3]
- objShortNames <- nonSymmetricObjEffects[, 4]
- objParms <- nonSymmetricObjEffects[, 5]
+ }
- objEffects <- createObjEffectList(objEffects, objFunctions,
- objEndowment, objShortNames,
- objParms, varname)
- rateEffects <- createRateEffectList(rateEffects, rateFunctions,
- rateShortNames, ratePeriods,
- rateTypes, varname)
- for (j in seq(along = xx$dycCovars))
+### not sure we need this: if so then check relevant combinations of nodesets
+ if (length(xx$cCovars) + length(xx$vCovars) +
+ length(xx$dycCovars) + length(xx$dyvCovars) +
+ length(types=='behavior') > 0)
+ {
+ interaction <- createEffects("unspecifiedNetInteraction")
+ objEffects <- rbind(objEffects, interaction[rep(1, nintn), ])
+ }
+
+ for (j in seq(along=xx$depvars))
+ {
+ otherName <- names(xx$depvars)[j]
+ if (types[j] == 'oneMode' &&
+ attr(xx$depvars[[j]], 'nodeSet') == nodeSet &&
+ varname != otherName)
{
- if (attr(xx$dycCovars[[j]], 'nodeSet')[1] == nodeSet)
+ if (attr(xx$depvars[[j]], "symmetric"))
{
- tmp <- dyadNetObjEff(names(xx$dycCovars)[j],
- symmetric = FALSE)
- objEffects <- rbind(objEffects, tmp$objEff)
+ objEffects <-
+ rbind(objEffects,
+ createEffects("nonSymmetricSymmetricObjective",
+ otherName))
}
- }
- for (j in seq(along = xx$dyvCovars))
- {
- if (attr(xx$dyvCovars[[j]], 'nodeSet')[1] == nodeSet)
+ else
{
- tmp <- dyadNetObjEff(names(xx$dyvCovars)[j],
- symmetric = FALSE)
- objEffects <- rbind(objEffects, tmp$objEff)
+ objEffects <-
+ rbind(objEffects,
+ createEffects("nonSymmetricNonSymmetricObjective",
+ otherName))
}
}
- for (j in seq(along = xx$cCovars))
+ if (types[j] == 'bipartite' &&
+ any(attr(xx$depvars[[j]], 'nodeSet') == nodeSet))
+ ## not sure what this test should be
{
- if (attr(xx$cCovars[[j]], 'nodeSet') == nodeSet)
- {
- tmp<- covNonSymmNetEff(names(xx$cCovars)[j],
- attr(xx$cCovars[[j]],
- 'poszvar'),
- attr(xx$cCovars[[j]],
- 'moreThan2'))
- objEffects <- rbind(objEffects, tmp$objEff)
- rateEffects <- rbind(rateEffects, tmp$rateEff)
- }
+ objEffects <-
+ rbind(objEffects,
+ createEffects("nonSymmetricBipartiteObjective",
+ otherName))
}
- for (j in seq(along=xx$depvars))
+ if (types[j] != "behavior" && varname != otherName)
{
- if (types[j] == 'behavior' &&
- attr(xx$depvars[[j]], 'nodeSet') == nodeSet)
+ for (k in seq(along=xx$cCovars))
{
- tmp <- covNonSymmNetEff(names(xx$depvars)[j],
- poszvar=TRUE,
- attr(xx$depvars[[j]],
- 'moreThan2'))
- objEffects <- rbind(objEffects,tmp$objEff)
- rateEffects <- rbind(rateEffects,tmp$rateEff)
+ if (attr(xx$cCovars[[k]], 'nodeSet') == nodeSet)
+ {
+ objEffects <-
+ rbind(objEffects,
+ createEffects("covarNetNetObjective",
+ otherName, names(xx$cCovars)[k]))
+ }
}
- }
- for (j in seq(along=xx$vCovars))
- {
- if (attr(xx$vCovars[[j]], 'nodeSet') == nodeSet)
+ for (k in seq(along=xx$vCovars))
{
- tmp <- covNonSymmNetEff(names(xx$vCovars)[j],
- attr(xx$vCovars[[j]],
- 'poszvar'),
- attr(xx$vCovars[[j]],
- 'moreThan2'))
- objEffects <- rbind(objEffects, tmp$objEff)
- rateEffects <- rbind(rateEffects, tmp$rateEff)
+ if (attr(xx$vCovars[[k]], 'nodeSet') == nodeSet)
+ {
+ objEffects <-
+ rbind(objEffects,
+ createEffects("covarNetNetObjective",
+ otherName, names(xx$vCovars)[k]))
+ }
}
+ for (k in seq(along=xx$depvars))
+ {
+ if (types[j] == 'behavior' &&
+ attr(xx$depvars[[j]], 'nodeSet') == nodeSet)
+ {
+ objEffects <-
+ rbind(objEffects,
+ createEffects("covarNetNetObjective",
+ otherName,
+ names(xx$depvars)[k]))
+ }
+ }
+
}
}
-### not sure we need this: if so then check relevant combinations of nodesets
- if (length(xx$cCovars) + length(xx$vCovars) +
- length(xx$dycCovars) + length(xx$dyvCovars) +
- length(types=='behavior') > 0)
+ if ((nOneModes + nBipartites) > 1) ## add the network name
{
- objEff <- rep('unspecified interaction effect', nintn)
- objEnd <- rep(TRUE, nintn)
- objFun <- rep('unspecified interaction statistic', nintn)
- objSho <- rep('unspInt', nintn)
- objParms <- rep(0, nintn)
- objEffects <- rbind(objEffects, createObjEffectList(objEff, objFun,
- objEnd, objSho, objParms, varname))
- }
- if (nOneModes > 1)
- {
- rateEffects$functionName <- paste(varname, ': ',
- rateEffects$functionName,
- sep = '')
+ # rateEffects$functionName <- paste(varname, ': ',
+ # rateEffects$functionName,
+ # sep = '')
objEffects$functionName <- paste(varname, ': ',
objEffects$functionName, sep = '')
+ objEffects$effectName <- paste(varname, ': ',
+ objEffects$effectName, sep = '')
}
+ ## now create the real effects, extra rows for endowment effects etc
+ objEffects <- createObjEffectList(objEffects, varname)
+ rateEffects <- createRateEffectList(rateEffects, varname)
+
+ ## replace the text for endowment effects
tmp <- objEffects$functionName[objEffects$type =='endow']
tmp <- paste('Lost ties:', tmp)
objEffects$functionName[objEffects$type == 'endow'] <- tmp
+
+ ## get starting values
starts <- getNetworkStartingVals(depvar)
+
##set defaults
- if (observations == 1)
- effectname <- paste('basic rate parameter', varname)
- else
- effectname <- paste('constant ', varname,' rate (period ',
- 1:noPeriods,')',sep='')
- rateEffects[rateEffects$effectName %in%
- effectname, 'include'] <- TRUE
- rateEffects[rateEffects$effectName %in% effectname,
- 'initialValue'] <- starts$startRate
+ rateEffects[1:noPeriods, "include"] <- TRUE
+ rateEffects[1:noPeriods, "initialValue"] <- starts$startRate
rateEffects$basicRate[1:observations] <- TRUE
+
objEffects$untrimmedValue <- rep(0, nrow(objEffects))
if (attr(depvar,'symmetric'))
{
- objEffects[objEffects$effectName == 'degree (density)' &
- objEffects$type == 'eval', 'include'] <- TRUE
- objEffects[objEffects$effectName =='degree (density)' &
- objEffects$type == 'eval', 'initialValue'] <-
- starts$degree
- objEffects[objEffects$effectName =='degree (density)' &
- objEffects$type == 'eval', 'untrimmedValue'] <-
- starts$untrimmed
+ objEffects[objEffects$effectName == "degree (density)" &
+ objEffects$type == "eval",
+ c('include', "initialValue", "untrimmedValue")] <-
+ list(TRUE, starts$degree, starts$untrimmed)
objEffects[objEffects$effectName=='transitive triads' &
objEffects$type=='eval','include'] <- TRUE
}
@@ -259,26 +284,18 @@
if (!(attr(depvar,'anyUpOnly') || attr(depvar, 'anyDownOnly')))
{
objEffects[objEffects$effectName =='outdegree (density)'&
- objEffects$type == 'eval', 'include'] <- TRUE
- objEffects[objEffects$effectName ==
- 'outdegree (density)' &
- objEffects$type == 'eval', 'initialValue'] <-
- starts$degree
- objEffects[objEffects$effectName ==
- 'outdegree (density)' &
- objEffects$type == 'eval', 'untrimmedValue'] <-
- starts$untrimmed
-
+ objEffects$type == 'eval',
+ c('include', "initialValue", "untrimmedValue")] <-
+ list(TRUE, starts$degree, starts$untrimmed)
}
objEffects[objEffects$effectName == 'reciprocity'&
objEffects$type == 'eval','include'] <- TRUE
- ##if (attr(x$depvars[[i]],'uponly') ||attr(x$depvars[[i]],
+ ##if (attr(xx$depvars[[i]],'uponly') ||attr(xx$depvars[[i]],
##'downonly'))
##effects[['outdegree (density)']]$eval$fix <- TRUE
## maybe when you run it in siena07!
}
rateEffects$basicRate[1:observations] <- TRUE
- rateEffects$untrimmedValue <- rep(0, nrow(rateEffects))
list(effects=rbind(rateEffects = rateEffects, objEffects = objEffects),
starts=starts)
}
@@ -287,48 +304,44 @@
behaviorNet <- function(depvar, varname)
{
nodeSet <- attr(depvar,'nodeSet')
- objEffects <- paste('behavior', varname,
- behaviorObjEffects[1:2, 1])
- objFunctions <- paste('beh.', varname,
- behaviorObjEffects[1:2, 2])
- objEndowment <- behaviorObjEffects[1:2, 3]
- objShortNames <- behaviorObjEffects[1:2, 4]
- objParms <- rep(0, length(objEffects))
- if (observations==1)
+
+ rateEffects <- createEffects("behaviorRate", varname)
+ if (observations == 1)
{
- rateEffects <- paste('rate ',varname,' period ',
- 1, sep='')
- ##rateEffects <- paste('rate', varname)
- rateFunctions <- "Amount of behavioral change"
- rateShortNames <- 'Rate'
- ratePeriods <- 1
- rateTypes <- NA
- }
+ rateEffects <- rateEffects[-2, ] ## remove the extra period
+ }
else
{
- rateEffects <- paste('rate ',varname,' (period ',
- periodNos, ')', sep='')
- rateFunctions <- paste("Amount of behavioral change in period",
- periodNos, 'on', varname)
- rateShortNames <- rep('Rate', observations)
- ratePeriods <- 1:observations
- rateTypes <- rep(NA, observations)
- }
- objEffects <- createObjEffectList(objEffects, objFunctions,
- objEndowment, objShortNames,
- objParms, varname)
- rateEffects <- createRateEffectList(rateEffects, rateFunctions,
- rateShortNames, ratePeriods,
- rateTypes, varname)
+ ## get correct number of rows
+ rateEffects <- rbind(duplicateDataFrameRow(rateEffects[2, ],
+ observations),
+ rateEffects[-c(1, 2), ])
+ }
+
+ objEffects <- createEffects("behaviorObjective", varname)
+
for (j in seq(along=xx$depvars))
{
if (types[j] == 'oneMode' &&
attr(xx$depvars[[j]], 'nodeSet') == nodeSet)
{
- tmp <- netBehEff(varname, names(xx$depvars)[j])
- objEffects<- rbind(objEffects, tmp$objEff)
- rateEffects<- rbind(rateEffects, tmp$rateEff)
+ objEffects <- rbind(objEffects,
+ createEffects("behaviorOneModeObjective",
+ varname, names(xx$depvars)[j]))
+ rateEffects <- rbind(rateEffects,
+ createEffects("behaviorOneModeRate",
+ varname, names(xx$depvars)[j]))
}
+ if (types[j] == 'bipartite' &&
+ (attr(xx$depvars[[j]], 'nodeSet')[[1]] == nodeSet))
+ {
+ objEffects <- rbind(objEffects,
+ createEffects("behaviorBipartiteObjective",
+ varname, names(xx$depvars)[j]))
+ rateEffects <- rbind(rateEffects,
+ createEffects("behaviorBipartiteRate",
+ varname, names(xx$depvars)[j]))
+ }
}
for (j in seq(along = xx$cCovars))
@@ -367,203 +380,291 @@
if (types[j] == 'oneMode' &&
attr(xx$depvars[[j]], 'nodeSet') == nodeSet)
{
- netObjEffect <- paste('behavior ', varname,
- ': infl. one-sided ? x ', varname,
- ' alter', sep='')
- netObjFunction <- paste('beh. ', varname,
- ': infl. interaction? x ', varname,
- ' alter', sep='')
- netShortName <- 'behInfl1sid'
- objEff <- createObjEffectList(netObjEffect, netObjFunction,
- TRUE, netShortName, 0,
- varname,
- varname2=names(xx$depvars)[j])
- objEffects<- rbind(objEffects, objEff)
+ objEffects <- rbind(objEffects,
+ createEffects("behaviorOneModeObjective2",
+ varname, names(xx$depvars)[j]))
}
+ if (types[j] == 'bipartite' &&
+ any(attr(xx$depvars[[j]], 'nodeSet') == nodeSet))
+ {
+ objEffects <- rbind(objEffects,
+ createEffects("behaviorBipartiteObjective2",
+ varname, names(xx$depvars)[j]))
+ }
}
- objEff <- rep(paste('behavior ', varname,
- ': unspecified interaction', sep=''), 4)
- objFun <- rep(paste('behavior ', varname,
- ': unspecified interaction', sep=''), 4)
- objEnd <- rep(TRUE, 4)
- objShortNames <- rep('behUnspInt', 4)
- objParms <- rep(0, 4)
- objEffects <- rbind(objEffects,
- createObjEffectList(objEff, objFun,
- objEnd, objShortNames, objParms, varname))
- objEffects$untrimmedValue <- rep(0, nrow(objEffects))
+ interaction <- createEffects("unspecifiedBehaviorInteraction",
+ varname)
+ objEffects <- rbind(objEffects, interaction[rep(1, 4),])
+
+ ## now create the real effects, extra rows for endowment effects etc
+ objEffects <- createObjEffectList(objEffects, varname)
+ rateEffects <- createRateEffectList(rateEffects, varname)
+
+ ## get starting values
starts <- getBehaviorStartingVals(depvar)
+ ## set defaults
if (!(attr(depvar,'anyUpOnly') || attr(depvar, 'anyDownOnly')))
{
- effectname <- paste('behavior', varname, 'linear shape')
- objEffects[objEffects$effectName == effectname &
+ objEffects[grepl("linear shape", objEffects$effectName) &
+ objEffects$type == 'eval',
+ c('include', 'initialValue','untrimmedValue')] <-
+ list(TRUE, starts$tendency, starts$untrimmed)
+ objEffects[grepl("quadratic shape", objEffects$effectName) &
objEffects$type == 'eval','include'] <- TRUE
- objEffects[objEffects$effectName == effectname &
- objEffects$type=='eval','initialValue'] <-
- starts$tendency
- objEffects[objEffects$effectName == effectname &
- objEffects$type=='eval','untrimmedValue'] <-
- starts$untrimmed
- effectname <- paste('behavior', varname, 'quadratic shape')
- objEffects[objEffects$effectName == effectname &
- objEffects$type == 'eval','include'] <- TRUE
## no starting value yet for quadratic effect
}
- if (observations == 1)
- # effectname <- paste('rate', varname)
- effectname <- paste('rate ', varname,' period ',
- 1:noPeriods, sep='')
- else
- effectname <- paste('rate ', varname,' (period ',
- 1:noPeriods, ')', sep='')
- rateEffects[rateEffects$effectName %in%
- effectname, 'include'] <- TRUE
- rateEffects[rateEffects$effectName %in% effectname,
- 'initialValue'] <- starts$startRate
+
+ rateEffects[1:observations, 'include'] <- TRUE
+ rateEffects[1:noPeriods, 'initialValue'] <- starts$startRate
rateEffects$basicRate[1:observations] <- TRUE
- rateEffects$untrimmedValue <- rep(0, nrow(rateEffects))
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rsiena -r 17
More information about the Rsiena-commits
mailing list