[Rsiena-commits] r144 - in pkg: RSiena RSiena/R RSiena/data RSiena/inst/doc RSiena/man RSiena/src/model/effects RSienaTest RSienaTest/R RSienaTest/data RSienaTest/doc RSienaTest/inst/doc RSienaTest/man RSienaTest/src/model/effects
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Apr 19 17:47:47 CEST 2011
Author: ripleyrm
Date: 2011-04-19 17:47:34 +0200 (Tue, 19 Apr 2011)
New Revision: 144
Added:
pkg/RSiena/R/observationErrors.r
pkg/RSiena/man/s50.Rd
pkg/RSiena/src/model/effects/OutTruncEffect.cpp
pkg/RSiena/src/model/effects/OutTruncEffect.h
pkg/RSienaTest/R/observationErrors.r
pkg/RSienaTest/doc/RscriptDataFormat.R
pkg/RSienaTest/doc/RscriptSienaBehaviour.R
pkg/RSienaTest/doc/RscriptSienaRunModel.R
pkg/RSienaTest/doc/RscriptSienaVariableFormat.R
pkg/RSienaTest/man/s50.Rd
pkg/RSienaTest/src/model/effects/OutTruncEffect.cpp
pkg/RSienaTest/src/model/effects/OutTruncEffect.h
Modified:
pkg/RSiena/DESCRIPTION
pkg/RSiena/R/siena08.r
pkg/RSiena/changeLog
pkg/RSiena/data/allEffects.csv
pkg/RSiena/inst/doc/s_man400.pdf
pkg/RSiena/man/RSiena-package.Rd
pkg/RSiena/man/includeEffects.Rd
pkg/RSiena/man/print.sienaMeta.Rd
pkg/RSiena/man/s501.Rd
pkg/RSiena/man/s502.Rd
pkg/RSiena/man/s503.Rd
pkg/RSiena/man/s50a.Rd
pkg/RSiena/man/siena08.Rd
pkg/RSiena/src/model/effects/AllEffects.h
pkg/RSiena/src/model/effects/EffectFactory.cpp
pkg/RSienaTest/DESCRIPTION
pkg/RSienaTest/R/initializeFRAN.r
pkg/RSienaTest/R/maxlikec.r
pkg/RSienaTest/R/siena08.r
pkg/RSienaTest/changeLog
pkg/RSienaTest/data/allEffects.csv
pkg/RSienaTest/doc/RSiena.bib
pkg/RSienaTest/doc/Siena_algorithms4.tex
pkg/RSienaTest/doc/s_man400.tex
pkg/RSienaTest/inst/doc/s_man400.pdf
pkg/RSienaTest/man/RSiena-package.Rd
pkg/RSienaTest/man/includeEffects.Rd
pkg/RSienaTest/man/print.sienaMeta.Rd
pkg/RSienaTest/man/s501.Rd
pkg/RSienaTest/man/s502.Rd
pkg/RSienaTest/man/s503.Rd
pkg/RSienaTest/man/s50a.Rd
pkg/RSienaTest/man/siena08.Rd
pkg/RSienaTest/man/summary.iwlsm.Rd
pkg/RSienaTest/src/model/effects/AllEffects.h
pkg/RSienaTest/src/model/effects/EffectFactory.cpp
Log:
Changes to siena08, new effect outTrunc effect, updates to documentation
Modified: pkg/RSiena/DESCRIPTION
===================================================================
--- pkg/RSiena/DESCRIPTION 2011-03-13 02:17:56 UTC (rev 143)
+++ pkg/RSiena/DESCRIPTION 2011-04-19 15:47:34 UTC (rev 144)
@@ -1,8 +1,8 @@
Package: RSiena
Type: Package
Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.0.12.143
-Date: 2011-03-13
+Version: 1.0.12.144
+Date: 2011-04-19
Author: Various
Depends: R (>= 2.9.0), xtable
Imports: Matrix
Added: pkg/RSiena/R/observationErrors.r
===================================================================
--- pkg/RSiena/R/observationErrors.r (rev 0)
+++ pkg/RSiena/R/observationErrors.r 2011-04-19 15:47:34 UTC (rev 144)
@@ -0,0 +1,179 @@
+#/******************************************************************************
+# * SIENA: Simulation Investigation for Empirical Network Analysis
+# *
+# * Web: http://www.stats.ox.ac.uk/~snijders/siena
+# *
+# * File: observationErrors.r
+# *
+# * Description: This module contains various functions for parameter estimation
+# * in models with observation errors
+# * by maximum likelihood under normality,
+# * extending Snijders & Baerveldt (2003), for use in siena08.
+# *****************************************************************************/
+##args:x: vector of observations
+## se: vector of same length as x: standard errors of observations
+## returns updated z
+
+##@deviance.observationErrors siena08: deviance under normality assumptions
+deviance.observationErrors <- function(mu, sig, x, se)
+{
+## deviance.observationErrors: given vector observations x, assuming model
+## x ~ normal(expected = mu, variance = sig^2 + se^2)
+## required is length(x) = length(se)
+ sig2 <- sig^2
+ sum((x - mu)^2/(sig2 + se^2)) + sum(log(sig2 + se^2))
+}
+
+##@profdev.mu siena08 (profile deviance =) minus twice profile loglik for mu
+profdev.mu <- function(mu,x,se)
+{
+## deviance.observationErrors maximized over sigma
+ ra <- max(x) - min(x) # easy upper bound for sigma
+ optimize(function(sig)deviance.observationErrors(mu, sig, x, se),
+ c(0, ra))
+}
+
+
+##@profdev.sig siena08 (profile deviance =) minus twice prof. loglik for sigma
+profdev.sig <- function(sig,x,se)
+{
+## deviance.observationErrors maximized over mu
+ optimize(function(mu)deviance.observationErrors(mu, sig, x, se),
+ range(x))
+}
+
+##@maxlik siena08 maximum likelihood estimator
+maxlik <- function(x,se)
+{
+ ## deviance.observationErrors minimized over mu and sigma
+ ## Minimize profile deviance for mu:
+ opmu <- optimize(function(mu)profdev.mu(mu, x, se)$objective,
+ range(x))
+ ## MLE for mu:
+ mu <- opmu$minimum
+ ## minimized deviance:
+ dev <- opmu$objective
+ ## Location for minimum of deviance for this value of mu:
+ sig <- profdev.mu(mu, x ,se)$minimum
+ ## Standard error of MLE(mu):
+ se.mu <- sqrt(1 / sum(1 / (se^2 + sig^2)))
+ return(list(mu = mu, se.mu = se.mu, sigma = sig, deviance = dev))
+}
+
+##@unisroot siena08 root finder when interval may be inadequate
+unisroot <- function(f, interval, ..., left=TRUE)
+{
+ ## tries to solve f(x) = 0,
+ ## first within interval,
+ ## if endpoints do not have opposite signs
+ ## then in interval extended to left or to right
+ ## Return value is a list which includes root = location of the root,
+ ## and f.root = function value at this location.
+ if (f(interval[1]) * f(interval[2]) < 0)
+ {
+ uniroot(f, interval, ...)
+ }
+ else
+ {
+ x1 <- interval[1]
+ x2 <- interval[2]
+ ra <- x2 - x1
+ for (it in (1:1000))
+ {
+ if (left)
+ {
+ x1 <- x1 - ra
+ }
+ else
+ {
+ x2 <- x2 + ra
+ }
+ if (f(x1)*f(x2) < 0)
+ {
+ break
+ }
+ }
+ if (f(x1) * f(x2) < 0)
+ {
+ uniroot(f, c(x1, x2), ...)
+ }
+ else
+ {
+ list(root=NA, f.root=NA)
+ }
+ }
+}
+
+##@ confint.mu siena08 confidence interval for mu
+confint.mu <- function(x, se, alpha=0.05)
+{
+ ## confidence interval for mu in model
+ ## x ~ normal(expected = mu, variance = sigma^2 + se^2)
+ ## with length(x) = length(se).
+ ## returns list consisting of bounds confidence interval and
+ ## confidence level (1-alpha).
+ ma <- max(x)
+ mi <- min(x)
+ ra <- max(x) - min(x) # easy upper bound for sigma
+ maxli <- maxlik(x, se) # ML estimators
+ mindev <- maxli$deviance # minimized deviance
+ mlemu <- maxli$mu # MLE for mu
+ chidev <- qchisq(1 - alpha, 1) # critical value chi-squared distribution
+ ## The end points of the confidence interval are the values
+ ## where the profile deviance for mu is equal to mindev + chidev.
+ ## Now first the solution for the left side of the confidence interval:
+ tmp1 <- unisroot(function(mu)
+ {
+ tmp <- profdev.mu(mu, x, se)
+ tmp$objective - mindev - chidev
+ },
+ c(mi, mlemu))
+ mu1 <- tmp1$root
+ ## and then the solution for the right side of the confidence interval:
+ tmp1 <- unisroot(function(mu)
+ {
+ tmp <- profdev.mu(mu, x, se)
+ tmp$objective - mindev - chidev
+ },
+ c(mlemu, ma), left=FALSE)
+ mu2 <- tmp1$root
+ c(mu1, mu2, 1 - alpha)
+}
+
+##@ confint.sig siena08 confidence interval for sigma
+confint.sig <- function(x, se, alpha=0.05)
+{
+ ## confidence interval for sigma in model
+ ## x ~ normal(expected = mu, variance = sigma^2 + se^2)
+ ## with length(x) = length(se)
+ ## returns list consisting of bounds confidence interval and
+ ## confidence level (1 - alpha). ma <- max(x)
+ mi <- min(x)
+ ra <- max(x) - min(x) # easy upper bound for sigma
+ maxli <- maxlik(x, se) # ML estimators
+ mindev <- maxli$deviance # minimized deviance
+ mlesig <- maxli$sigma # MLE for sigma
+ chidev <- qchisq(1 - alpha, 1) # critical value chi-squared distribution
+ ## The end points of the confidence interval are the values
+ ## where the profile deviance for sigma is equal to mindev + chidev,
+ ## unless the profile deviance in 0 is smaller than this.
+ ## Now first the solution for the left side of the confidence interval;
+ ## this may be 0.
+ if (profdev.sig(0, x, se)$objective <= mindev + chidev)
+ {
+ sig1 <- 0
+ }
+ else
+ {
+ sig1 <- uniroot(function(sig)
+ profdev.sig(sig, x, se)$objective - mindev - chidev,
+ c(0, mlesig))$root
+ }
+ ## and then the solution for the right side of the confidence interval:
+ sig2 <- unisroot(function(sig)
+ profdev.sig(sig,x,se)$objective - mindev - chidev,
+ c(mlesig, ra), left=FALSE)$root
+ return(c(sig1, sig2, 1 - alpha))
+}
+
+
Property changes on: pkg/RSiena/R/observationErrors.r
___________________________________________________________________
Added: svn:eol-style
+ native
Modified: pkg/RSiena/R/siena08.r
===================================================================
--- pkg/RSiena/R/siena08.r 2011-03-13 02:17:56 UTC (rev 143)
+++ pkg/RSiena/R/siena08.r 2011-04-19 15:47:34 UTC (rev 144)
@@ -1,7 +1,7 @@
#/******************************************************************************
# * SIENA: Simulation Investigation for Empirical Network Analysis
# *
-# * Web: http://www.stats.ox.ac.uk/~snidjers/siena
+# * Web: http://www.stats.ox.ac.uk/~snijders/siena
# *
# * File: siena08.r
# *
@@ -9,7 +9,7 @@
# * collection of Siena fits.
# *****************************************************************************/
##@siena08 siena08
-siena08 <- function(..., projname="sienaMeta", bound=5)
+siena08 <- function(..., projname="sienaMeta", bound=5, alpha=0.05)
{
dots <- as.list(substitute(list(...)))[-1] ##first entry is the word 'list'
if (length(dots) == 0)
@@ -92,17 +92,19 @@
{
if (sum((x1$se < bound)) >= 3)
{
- check.correl <- cor.test(x1$theta, x1$se)
+ suppressWarnings(check.correl <- cor.test(x1$theta, x1$se, method="spearman"))
+ ## warnings will be given in case of ties, not important here
}
else
{
- check.correl <- data.frame(estimate=NA, p.value=NA)
+ check.correl <- data.frame(estimate=NA, p.value=NA, method="no correlation test")
}
regfit <- iwlsm(theta ~ 1, psi=psi.iwlsm, data=x1,
ses=x1$se^2)
regfit$terms <- NA
regfit$model <- NULL
regfit$psi <- NULL
+ ## symbols ttilde, Qstat, Tsq as in Snijders & Baerveldt (2003), (18), (17), (15)
Tsq <- sum((x1$theta / x1$se)^2)
regsummary <- summary(regfit)
tratio <- regsummary$coef[1, 3]
@@ -113,8 +115,13 @@
cjminus <- -2 * sum(pnorm(x1$theta / x1$se, log=TRUE))
cjplusp <- 1 - pchisq(cjplus, 2 * nrow(x1))
cjminusp <- 1 - pchisq(cjminus, 2 * nrow(x1))
+ ## ML estimates and confidence intervals
+ maxxlik <- maxlik(x1$theta,x1$se)
+ cmu <- confint.mu(x1$theta,x1$se,alpha)
+ csig <- confint.sig(x1$theta,x1$se,alpha)
ret1 <- list(cor.est=check.correl$estimate,
cor.pval=check.correl$p.value,
+ cor.meth=check.correl$method,
regfit=regfit, regsummary=regsummary,
Tsq=Tsq, pTsq=1 - pchisq(Tsq, nrow(x1) - 1),
tratio=tratio,
@@ -122,7 +129,10 @@
Qstat=Qstat,
pttilde=1 - pchisq(Qstat, nrow(x1) - 1),
cjplus=cjplus, cjminus=cjminus,
- cjplusp=cjplusp, cjminusp=cjminusp, n1=nrow(x1))
+ cjplusp=cjplusp, cjminusp=cjminusp, n1=nrow(x1),
+ mu.ml=maxxlik$mu, sigma.ml=maxxlik$sig,
+ mu.ml.se=maxxlik$se.mu,
+ mu.confint=cmu, sigma.confint=csig)
}
else
{
@@ -212,8 +222,8 @@
" : Estimate ",
format(round(x$theta, 4), width=12),
" (standard error ",
- format(round(x$se, 2), nsmall=2,
- width=11), ")", x$excl, "\n", sep="")
+ format(round(x$se, 4), nsmall=4,
+ width=12), ")", x$excl, "\n", sep="")
Report(c(tmp, "\n"), sep="", outf)
Report(c(" ", y$n1, " datasets used.\n\n"), sep="", outf)
if (y$n1 > 0)
@@ -226,11 +236,15 @@
}
else
{
- Report(c(": \nPearson correlation =", format(round(y$cor.est, 4),
+ Report(c(": \n", y$cor.meth, " =", format(round(y$cor.est, 4),
width=9),
", two-sided ",reportp(y$cor.pval,3), "\n\n"), sep="",
outf)
}
+ Report("Estimates and test based on IWLS modification of Snijders & Baerveldt (2003)\n",
+ outf)
+ Report("----------------------------------------------------------------------------\n",
+ outf)
Report(c("Test that all parameters are 0 : \n"), outf)
Report(c("chi-squared =", format(round(y$Tsq, 4), width=9),
", d.f. = ", y$n1, ", ",
@@ -240,17 +254,35 @@
" (s.e.", format(round(y$regsummary$coefficients[1, 2], 4),
width=9), "), two-sided ",
reportp(2 * pt(-abs(y$regsummary$coefficients[1, 3]),
- y$n1 - 1), 3), "\n"), sep="", outf)
- Report(c("based on IWLS modification of Snijders & Baerveldt (2003). ",
- "\n\n"), sep="", outf)
- Report(c("Residual standard error",
+ y$n1 - 1), 3), "\n\n"), sep="", outf)
+ Report(c("Estimated standard deviation",
format(round(y$regsummary$stddev, 4), width=9)), outf)
Report("\nTest that variance of parameter is 0 :\n", outf)
Report(c("Chi-squared = ", format(round(y$Qstat, 4), width=9),
" (d.f. = ", y$n1-1, "), ", reportp(y$pttilde, 3),
- "\n"), sep="", outf)
- Report(c("based on IWLS modification of Snijders & Baerveldt (2003). ",
"\n\n"), sep="", outf)
+ Report("Estimates and confidence intervals under normality assumptions\n",
+ outf)
+ Report("--------------------------------------------------------------\n", outf)
+ Report(c("Estimated mean parameter",
+ format(round(y$mu.ml, 4), width=9),
+ " (s.e.",format(round(y$mu.ml.se, 4), width=9), "), two-sided ",
+ reportp(2 * pt(-abs(y$mu.ml/y$mu.ml.se),
+ y$n1 - 1), 3), "\n"), sep="", outf)
+ Report(c(format(round(y$mu.confint[3], 2), width=4),
+ "level confidence interval [",
+ format(round(y$mu.confint[1], 4), width=7),
+ ",",
+ format(round(y$mu.confint[2], 4), width=7), "]\n"), outf)
+ Report(c("Estimated standard deviation",
+ ifelse((y$sigma.ml > 0.0001)|(y$sigma.ml < 0.0000001),
+ format(round(y$sigma.ml, 4), width=9), " < 0.0001"),
+ "\n"), outf)
+ Report(c(format(round(y$sigma.confint[3], 2), width=4),
+ "level confidence interval [",
+ format(round(y$sigma.confint[1], 4), width=7),
+ ",",
+ format(round(y$sigma.confint[2], 4), width=7), "]\n\n"), outf)
Report("Fisher's combination of one-sided tests\n", outf)
Report("----------------------------------------\n", outf)
Report("Combination of right one-sided p-values:\n", outf)
@@ -327,17 +359,24 @@
}
##@plot.sienaMeta Methods
-plot.sienaMeta <- function(x, ...)
+plot.sienaMeta <- function(x, ..., layout = c(2,2))
{
library(lattice)
- tmp <- xyplot(theta ~ se|effects, data=x$thetadf, ylab="estimates",
- xlab="standard errors", layout=c(4,4),
+ tmp <- xyplot(theta ~ se|effects,
+ data=x$thetadf[is.na(x$thetadf$scoretests),],
+ ylab="estimates",
+ xlab="standard errors", layout=layout,
panel=function(x, y)
{
panel.xyplot(x, y)
panel.abline(0, qnorm(0.025))
panel.abline(0, qnorm(0.975))
- }, scales="free")
+ },
+ prepanel=function(x,y)
+ { list(xlim=c(min(0,min(x)),max(0,max(x))),
+ ylim=c(min(0,min(y)),max(0,max(y))))
+ },
+ scales="free")
tmp[!sapply(tmp$y.limits, function(x)all(is.na(x)))]
}
@@ -555,7 +594,7 @@
}
else
{
- Report(c(": \nPearson correlation =", format(round(y$cor.est, 4),
+ Report(c(": \n", y$cor.meth, " =", format(round(y$cor.est, 4),
width=9),
", two-sided ",reportp(y$cor.pval,3), "\n\n"),
sep="", outf)
Modified: pkg/RSiena/changeLog
===================================================================
--- pkg/RSiena/changeLog 2011-03-13 02:17:56 UTC (rev 143)
+++ pkg/RSiena/changeLog 2011-04-19 15:47:34 UTC (rev 144)
@@ -1,5 +1,29 @@
-2011-03-13 R-forge revision 143
+2011-04-19 R-forge revision 144
+ * data/allEffects.csv, src/model/effects/AllEffects.h,
+ src/model/effects/EffectFactory.cpp,
+ src/model/effects/OutTruncEffect.h,
+ src/model/effects/OutTruncEffect.spp: new effect OutTruncEffect
+
+ * R/siena08.r, R/observationsErrors.r,
+ man/print.sienaMeta.Rd, man/siena08.Rd: added ML
+ method to siena08, enhanced plots.
+
+ * doc/RSiena.bib, doc/Siena_algorithms4.tex,
+ doc/s_man400.tex, doc/RscriptDataFormat.R,
+ doc/RscriptSienaBehaviour.R, doc/RscriptSienaRunModel.R,
+ doc/RscripSienaVariableFormat.R: major edits, scripts now included
+ in latex.
+
+ * man/includeEffects.Rd: added another example
+
+ * man/s50.Rd, man/s501.Rd, man/s502.Rd, man/s503.Rd, man/s50a.Rd:
+ more helpful information.
+
+ * R/initializeFRAN.r, R/maxlikec.r: added eolstyle property.
+
+2011-03-13 R-forge revision 143 RSienaTest only
+
* data/allEffects.csv: Modified default parm for Gwesp effects
* src/model/effects/GwespEffect.h added as superclass to all Gwesp effects
* src/model/effects/GwespEffect.cpp Now implements GwespAbstract class
Modified: pkg/RSiena/data/allEffects.csv
===================================================================
--- pkg/RSiena/data/allEffects.csv 2011-03-13 02:17:56 UTC (rev 143)
+++ pkg/RSiena/data/allEffects.csv 2011-04-19 15:47:34 UTC (rev 144)
@@ -14,38 +14,37 @@
behaviorOneModeObjective,behavior xxxxxx average alter,beh. xxxxxx average alters,avAlt,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
behaviorOneModeObjective,behavior xxxxxx average rec. alters,beh. xxxxxx average rec. alters,avRecAlt,FALSE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
behaviorOneModeObjective,behavior xxxxxx dense triads <maybe wrong>,beh. xxxxxx dense triads <<<maybe wrong>>>,behDenseTriads,FALSE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,5,objective,NA,NA,0,0,0,0,
-behaviorOneModeObjective,behavior xxxxxx similarity in dense triads <maybe wrong>,beh. xxxxxx homogeneity of dense triads <<<maybe wrong>>>,simDenseTriads,FALSE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,5,objective,NA,NA,0,0,0,0
-behaviorOneModeObjective,behavior xxxxxx reciprocated degree,beh. xxxxxx reciprocated degrees,recipDeg,FALSE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorOneModeObjective,behavior xxxxxx ave. sim. x popularity ego,beh. xxxxxx ave. sim. x indegrees ego,avSimPopEgo,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorOneModeObjective2,behavior xxxxxx: infl. one-sided ? x xxxxxx alter,beh. xxxxxx: infl. interaction? x xxxxxx alter,behInfl1sid,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorBipartiteObjective,behavior xxxxxx average similarity,beh. xxxxxx average similarity,avSim,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorBipartiteObjective,behavior xxxxxx total similarity,beh. xxxxxx total similarity,totSim,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorBipartiteObjective,behavior xxxxxx outdegree,beh. xxxxxx outdegrees,outdeg,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorBipartiteObjective,behavior xxxxxx isolate,beh. xxxxxx isolate,isolate,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorBipartiteObjective,behavior xxxxxx ave. sim. x popularity alter,beh. xxxxxx ave. sim. x indegrees(one-sided),avSimPopAlt,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorBipartiteObjective,behavior xxxxxx tot. sim. x popularity alter,beh. xxxxxx tot. sim. x indegrees(one-sided),totSimPopAlt,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorBipartiteObjective,behavior xxxxxx x popularity alter,beh. xxxxxx x indegrees(one-sided),popAlt,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorBipartiteObjective,behavior xxxxxx average alter,beh. xxxxxx average alters,avAlt,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorBipartiteObjective,behavior xxxxxx dense triads <maybe wrong>,beh. xxxxxx dense triads <<<maybe wrong>>>,behDenseTriads,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorBipartiteObjective,behavior xxxxxx similarity in dense triads <maybe wrong>,beh. xxxxxx homogeneity of dense triads <<<maybe wrong>>>,simDenseTriads,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorBipartiteObjective,behavior xxxxxx ave. sim. x popularity ego,beh. xxxxxx ave. sim. x indegrees ego,avSimPopEgo,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorBipartiteObjective2,behavior xxxxxx: infl. one-sided ? x xxxxxx alter,beh. xxxxxx: infl. interaction? x xxxxxx alter,behInfl1sid,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorObjective,behavior xxxxxx linear shape,beh. xxxxxx cent. sum,linear,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorObjective,behavior xxxxxx quadratic shape,beh. xxxxxx sum of cent. squares,quad,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0
-behaviorRate,rate xxxxxx period 1,Amount of behavioral change,Rate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,1,NA,0,0,0,0
-behaviorRate,rate xxxxxx (period nnnnnn),Amount of behavioral change in period nnnnnn on xxxxxx,Rate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,nnnnnn,NA,0,0,0,0
-behaviorOneModeRate,outdegree effect on rate xxxxxx,Amount of change on xxxxxx x outdegree,outRate,NA,yyyyyy,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0
-behaviorOneModeRate,indegree effect on rate xxxxxx,Amount of change on xxxxxx x indegree,inRate,NA,yyyyyy,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0
-behaviorOneModeRate,reciprocated effect on rate xxxxxx,Amount of change on xxxxxx x reciprocity,recipRate,NA,yyyyyy,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0
-behaviorBipartiteRate,outdegree effect on rate xxxxxx,Amount of change on xxxxxx x outdegree,outRate,NA,yyyyyy,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0
-behaviorBipartiteRate,reciprocated effect on rate xxxxxx,Amount of change on xxxxxx x reciprocity,recipRate,NA,yyyyyy,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0
-nonSymmetricRate,basic rate parameter xxxxxx,Amount of network change,Rate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,1,NA,0,0,0,0
-nonSymmetricRate,constant xxxxxx rate (period nnnnnn),Amount of network change in period nnnnnn,Rate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,nnnnnn,NA,0,0,0,0
-nonSymmetricRate,outdegree effect on rate xxxxxx,Amount of change x outdegrees,outRate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0
-nonSymmetricRate,indegree effect on rate xxxxxx,Amount of change x indegrees,inRate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0
-nonSymmetricRate,reciprocity effect on rate xxxxxx,Amount of change x reciprocity,recipRate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0
-nonSymmetricRate,effect 1/outdegree on rate xxxxxx,Amount of change x (1/outdegrees),outRateInv,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0
-bipartiteRate,basic rate parameter xxxxxx,Amount of network change,Rate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,1,NA,0,0,0,0
+behaviorOneModeObjective,behavior xxxxxx similarity in dense triads <maybe wrong>,beh. xxxxxx homogeneity of dense triads <<<maybe wrong>>>,simDenseTriads,FALSE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,5,objective,NA,NA,0,0,0,0,
+behaviorOneModeObjective,behavior xxxxxx reciprocated degree,beh. xxxxxx reciprocated degrees,recipDeg,FALSE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorOneModeObjective,behavior xxxxxx ave. sim. x popularity ego,beh. xxxxxx ave. sim. x indegrees ego,avSimPopEgo,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorOneModeObjective2,behavior xxxxxx: infl. one-sided ? x xxxxxx alter,beh. xxxxxx: infl. interaction? x xxxxxx alter,behInfl1sid,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorBipartiteObjective,behavior xxxxxx average similarity,beh. xxxxxx average similarity,avSim,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorBipartiteObjective,behavior xxxxxx total similarity,beh. xxxxxx total similarity,totSim,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorBipartiteObjective,behavior xxxxxx outdegree,beh. xxxxxx outdegrees,outdeg,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorBipartiteObjective,behavior xxxxxx isolate,beh. xxxxxx isolate,isolate,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorBipartiteObjective,behavior xxxxxx ave. sim. x popularity alter,beh. xxxxxx ave. sim. x indegrees(one-sided),avSimPopAlt,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorBipartiteObjective,behavior xxxxxx tot. sim. x popularity alter,beh. xxxxxx tot. sim. x indegrees(one-sided),totSimPopAlt,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorBipartiteObjective,behavior xxxxxx x popularity alter,beh. xxxxxx x indegrees(one-sided),popAlt,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorBipartiteObjective,behavior xxxxxx average alter,beh. xxxxxx average alters,avAlt,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorBipartiteObjective,behavior xxxxxx dense triads <maybe wrong>,beh. xxxxxx dense triads <<<maybe wrong>>>,behDenseTriads,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorBipartiteObjective,behavior xxxxxx similarity in dense triads <maybe wrong>,beh. xxxxxx homogeneity of dense triads <<<maybe wrong>>>,simDenseTriads,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorBipartiteObjective,behavior xxxxxx ave. sim. x popularity ego,beh. xxxxxx ave. sim. x indegrees ego,avSimPopEgo,TRUE,yyyyyy,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorObjective,behavior xxxxxx linear shape,beh. xxxxxx cent. sum,linear,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorObjective,behavior xxxxxx quadratic shape,beh. xxxxxx sum of cent. squares,quad,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+behaviorRate,rate xxxxxx period 1,Amount of behavioral change,Rate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,1,NA,0,0,0,0,
+behaviorRate,rate xxxxxx (period nnnnnn),Amount of behavioral change in period nnnnnn on xxxxxx,Rate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,nnnnnn,NA,0,0,0,0,
+behaviorOneModeRate,outdegree effect on rate xxxxxx,Amount of change on xxxxxx x outdegree,outRate,NA,yyyyyy,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0,
+behaviorOneModeRate,indegree effect on rate xxxxxx,Amount of change on xxxxxx x indegree,inRate,NA,yyyyyy,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0,
+behaviorOneModeRate,reciprocated effect on rate xxxxxx,Amount of change on xxxxxx x reciprocity,recipRate,NA,yyyyyy,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0,
+behaviorBipartiteRate,outdegree effect on rate xxxxxx,Amount of change on xxxxxx x outdegree,outRate,NA,yyyyyy,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0,
+behaviorBipartiteRate,reciprocated effect on rate xxxxxx,Amount of change on xxxxxx x reciprocity,recipRate,NA,yyyyyy,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0,
+nonSymmetricRate,basic rate parameter xxxxxx,Amount of network change,Rate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,1,NA,0,0,0,0,
+nonSymmetricRate,constant xxxxxx rate (period nnnnnn),Amount of network change in period nnnnnn,Rate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,nnnnnn,NA,0,0,0,0,
+nonSymmetricRate,outdegree effect on rate xxxxxx,Amount of change x outdegrees,outRate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0,
+nonSymmetricRate,indegree effect on rate xxxxxx,Amount of change x indegrees,inRate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0,
+nonSymmetricRate,reciprocity effect on rate xxxxxx,Amount of change x reciprocity,recipRate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0,
+nonSymmetricRate,effect 1/outdegree on rate xxxxxx,Amount of change x (1/outdegrees),outRateInv,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0,
+bipartiteRate,basic rate parameter xxxxxx,Amount of network change,Rate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,1,NA,0,0,0,0,
bipartiteRate,constant xxxxxx rate (period nnnnnn),Amount of network change in period nnnnnn,Rate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,nnnnnn,NA,0,0,0,0,
bipartiteRate,outdegree effect on rate xxxxxx,Amount of change x outdegrees,outRate,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0,
bipartiteRate,effect 1/outdegree on rate xxxxxx,Amount of change x (1/outdegrees),outRateInv,NA,,,rate,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,rate,NA,structural,0,0,0,0,
@@ -98,6 +97,7 @@
bipartiteObjective,indegree - popularity (sqrt),Sum of indegrees x sqrt(indegree),inPopSqrt,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
bipartiteObjective,outdegree - activity,Sum of squared outdegrees,outAct,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
bipartiteObjective,outdegree - activity (sqrt),Sum of outdegrees^(1.5),outActSqrt,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+bipartiteObjective,outdegree-trunc(#),Sum of outdegrees trunc(#),outTrunc,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,5,objective,NA,NA,0,0,0,0,
bipartiteObjective,1/(outdegree + #),Sum 1/(outdegrees + #),outInv,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,
bipartiteObjective,1/(outdegree+#)(outdegree+1+#),Sum 1/(outdegrees + #)(outdegrees + 1 + #),outSqInv,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,
bipartiteObjective,out-in degree^(1/2) assortativity,Sum of out-in degree^(1/2) products,outInAss,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,
@@ -120,6 +120,7 @@
nonSymmetricObjective,indegree - activity (sqrt),Sum of outdegrees x sqrt(indegree),inActSqrt,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,ego
nonSymmetricObjective,outdegree - activity,Sum of squared outdegrees,outAct,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
nonSymmetricObjective,outdegree - activity (sqrt),Sum of outdegrees^(1.5),outActSqrt,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+nonSymmetricObjective,outdegree-trunc(#),Sum of outdegrees trunc(#),outTrunc,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,5,objective,NA,NA,0,0,0,0,
nonSymmetricObjective,1/(outdegree + #),Sum 1/(outdegrees + #),outInv,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,
nonSymmetricObjective,1/(outdegree+#)(outdegree+1+#),Sum 1/(outdegrees + #)(outdegrees + 1 + #),outSqInv,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,
nonSymmetricObjective,out-out degree^(1/#) assortativity,Sum of out-out degree^(1/#) products,outOutAss,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,2,objective,NA,NA,0,0,0,0,
@@ -137,6 +138,7 @@
symmetricObjective,degree of alter,Sum of squared degrees,inPop,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
symmetricObjective,sqrt degree of alter,Sum of degrees ,inPopSqrt,TRUE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
symmetricObjective,degree^(1.5),Sum of degrees^(1.5),outActSqrt,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,0,objective,NA,NA,0,0,0,0,
+symmetricObjective,outdegree-trunc(#),Sum of outdegrees trunc(#),outTrunc,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,5,objective,NA,NA,0,0,0,0,
symmetricObjective,1/(degree + #),Sum 1/(degrees + #),outInv,FALSE,,,eval,FALSE,FALSE,FALSE,FALSE,FALSE,",",0,1,objective,NA,NA,0,0,0,0,
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rsiena -r 144
More information about the Rsiena-commits
mailing list