[Rsiena-commits] r78 - in pkg: RSiena/R RSiena/man RSienaTest/R RSienaTest/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Apr 12 21:48:16 CEST 2010
Author: ripleyrm
Date: 2010-04-12 21:48:16 +0200 (Mon, 12 Apr 2010)
New Revision: 78
Modified:
pkg/RSiena/R/print01Report.r
pkg/RSiena/R/siena01.r
pkg/RSiena/R/sienaeffects.r
pkg/RSiena/man/includeEffects.Rd
pkg/RSiena/man/includeInteraction.Rd
pkg/RSiena/man/setEffect.Rd
pkg/RSienaTest/R/print01Report.r
pkg/RSienaTest/R/siena01.r
pkg/RSienaTest/R/sienaeffects.r
pkg/RSienaTest/man/includeEffects.Rd
pkg/RSienaTest/man/includeInteraction.Rd
pkg/RSienaTest/man/setEffect.Rd
Log:
fixes to includeEffects etc, report of missing values, display of effect1 to effect3.
Modified: pkg/RSiena/R/print01Report.r
===================================================================
--- pkg/RSiena/R/print01Report.r 2010-04-12 16:38:28 UTC (rev 77)
+++ pkg/RSiena/R/print01Report.r 2010-04-12 19:48:16 UTC (rev 78)
@@ -184,11 +184,12 @@
}
if (attr(depvar, "type") == "bipartite")
{
- tmp <- format(cbind(1:atts$netdims[1], outdeg))
- }
+ tmp <- format(cbind(1:atts$netdims[1], outdeg))
+ }
else
{
- tmp <- format(cbind(1:atts$netdims[1], outdeg, indeg))
+ tmp <- format(cbind(1:atts$netdims[1], outdeg,
+ indeg))
}
Report(tmp[, 1], fill=60, outf)
@@ -251,7 +252,8 @@
nnonactive <-
rowSums(depvar[, , k] == 10 |
depvar[, , k] == 11, na.rm=TRUE)
- nnonactive <- nnonactive >= nrow(depvar[, , k])
+ nnonactive <- nnonactive >=
+ nrow(depvar[, , k])
}
if (sum(nnonactive) == 1)
{
@@ -269,11 +271,15 @@
}
if (attr(depvar, "sparse"))
{
- anymissings <- any(is.na(depvar[[k]]))
+ depvark <- depvar[[k]]
+ diag(depvark) <- 0
+ anymissings <- any(is.na(depvark))
}
else
{
- anymissings <- any(is.na(depvar[, , k]))
+ depvark <- depvar[, , k]
+ diag(depvark) <- 0
+ anymissings <- any(is.na(depvark))
}
if (anymissings)
{
@@ -656,7 +662,8 @@
Report(c("Exogenous dyadic covariate named ", covars[i], '.\n'),
sep="", outf)
}
- Report("Number of tie variables with missing data per period:\n", outf)
+ Report("Number of tie variables with missing data per period:\n",
+ outf)
Report(c(" period ", format(1:(x$observations - 1) +
periodFromStart, width=9),
" overall\n"), sep="", outf)
@@ -924,7 +931,8 @@
upOnly <- atts$anyUpOnly[!nets]
for (i in seq(along=netnames[upOnly]))
{
- Report(c("\nBehavior variable ", netnames[i], ":\n"), sep = "", outf)
+ Report(c("\nBehavior variable ", netnames[i], ":\n"), sep = "",
+ outf)
if (atts$observations == 1)
{
Report("All behavior changes are upward.\n", outf)
@@ -1067,15 +1075,13 @@
{
Report(c("for network ", format(netnames[i], width=12),
format(round(balmean[i], 4),
- nsmall=4, width=14),
- '.\n'),
+ nsmall=4, width=14), '.\n'),
sep="", outf)
}
else
{
- Report(c(format(round(balmean[i], 4), nsmall=4, width=14),
- '.\n'),
- sep="", outf)
+ Report(c(format(round(balmean[i], 4), nsmall=4,
+ width=14), '.\n'), sep="", outf)
}
}
}
@@ -1111,8 +1117,7 @@
{
Report(c("Similarity", format(atts$cCovars[i], width=12),
':', format(round(atts$cCovarSim[i], 4), width=12,
- nsmall=4),
- '\n'), outf)
+ nsmall=4), '\n'), outf)
}
}
}
@@ -1139,8 +1144,7 @@
{
Report(c("Similarity", format(atts$netnames[i], width=12),
':', format(round(atts$bSim[i], 4), nsmall=4,
- width=12),
- '\n'), outf)
+ width=12), '\n'), outf)
}
}
}
@@ -1168,8 +1172,7 @@
{
Report(c("Similarity", format(atts$vCovars[i], width=12),
':', format(round(atts$vCovarSim[i], 4), width=12,
- nsmall=4),
- '\n'), outf)
+ nsmall=4), '\n'), outf)
}
}
}
Modified: pkg/RSiena/R/siena01.r
===================================================================
--- pkg/RSiena/R/siena01.r 2010-04-12 16:38:28 UTC (rev 77)
+++ pkg/RSiena/R/siena01.r 2010-04-12 19:48:16 UTC (rev 78)
@@ -666,7 +666,8 @@
showFn <- function()
{
editCols <- c("name", "effectName", "type", "include", "fix",
- "test", "initialValue", "parm")
+ "test", "initialValue", "parm", "effectNumber",
+ "effect1", "effect2", "effect3")
effEdit <- myeff[myeff$include, editCols]
for (i in c("include", "fix", "test"))
{
Modified: pkg/RSiena/R/sienaeffects.r
===================================================================
--- pkg/RSiena/R/sienaeffects.r 2010-04-12 16:38:28 UTC (rev 77)
+++ pkg/RSiena/R/sienaeffects.r 2010-04-12 19:48:16 UTC (rev 78)
@@ -10,14 +10,30 @@
##@includeEffect DataCreate
includeEffects <- function(myeff, ..., include=TRUE, name=myeff$name[1],
- type="eval", interaction1="", interaction2="")
+ type="eval", interaction1="", interaction2="",
+ character=FALSE)
{
- dots <- substitute(list(...))[-1] ##first entry is the word 'list'
+
+ if (character)
+ {
+ dots <- sapply(list(...), function(x)x)
+ }
+ else
+ {
+ dots <- substitute(list(...))[-1] ##first entry is the word 'list'
+ }
if (length(dots) == 0)
{
stop("need some effect short names")
}
- effectNames <- sapply(dots, function(x)deparse(x))
+ if (!character)
+ {
+ effectNames <- sapply(dots, function(x)deparse(x))
+ }
+ else
+ {
+ effectNames <- dots
+ }
use <- myeff$shortName %in% effectNames &
myeff$type==type &
myeff$name==name &
@@ -25,17 +41,24 @@
myeff$interaction2 == interaction2
myeff[use, "include"] <- include
print(myeff[use, c("name", "shortName", "type", "interaction1",
- "interaction2", "include")])
+ "interaction2", "include")])
myeff
}
##@includeInteraction DataCreate
includeInteraction <- function(myeff, ...,
include=TRUE, name=myeff$name[1],
type="eval", interaction1=rep("", 3),
- interaction2=rep("", 3))
+ interaction2=rep("", 3), character=FALSE)
{
- ## check we have 2 or 3 short names
- dots <- substitute(list(...))[-1] ##first entry is the word 'list'
+ if (character)
+ {
+ dots <- sapply(list(...), function(x)x)
+ }
+ else
+ {
+ ## check we have 2 or 3 short names
+ dots <- substitute(list(...))[-1] ##first entry is the word 'list'
+ }
if (length(dots) == 0)
{
stop("need some effect short names")
@@ -44,7 +67,14 @@
{
stop("need exactly two or three effect short names")
}
- shortNames <- sapply(dots, function(x)deparse(x))
+ if (!character)
+ {
+ shortNames <- sapply(dots, function(x)deparse(x))
+ }
+ else
+ {
+ shortNames <- dots
+ }
## check that we have a spare row
ints <- myeff[myeff$name == name & myeff$shortName %in%
c("unspInt", "behUnspInt") &
@@ -132,10 +162,14 @@
##@setEffect DataCreate
setEffect <- function(myeff, shortName, parameter=0,
fix=FALSE, test=FALSE, initialValue=0,
- include=TRUE, name=myeff$name[1],
- type="eval", interaction1="", interaction2="")
+ include=TRUE, name=myeff$name[1],
+ type="eval", interaction1="", interaction2="",
+ character=FALSE)
{
- shortName <- deparse(substitute(shortName))
+ if (!character)
+ {
+ shortName <- deparse(substitute(shortName))
+ }
use <- myeff$shortName == shortName &
myeff$name == name &
myeff$type == type &
Modified: pkg/RSiena/man/includeEffects.Rd
===================================================================
--- pkg/RSiena/man/includeEffects.Rd 2010-04-12 16:38:28 UTC (rev 77)
+++ pkg/RSiena/man/includeEffects.Rd 2010-04-12 19:48:16 UTC (rev 78)
@@ -9,7 +9,7 @@
}
\usage{
includeEffects(myeff, ..., include = TRUE, name = myeff$name[1],
- type = "eval", interaction1 = "", interaction2 = "")
+ type = "eval", interaction1 = "", interaction2 = "", character=FALSE)
}
\arguments{
\item{myeff}{a Siena effects object as created by \code{\link{getEffects}}
@@ -34,6 +34,7 @@
Name of siena object where needed to completely identify the
effects e.g. covariate name or behavior variable name.
}
+\item{character}{Boolean: are the effect names character strings or not}
}
\details{The arguments should identify the effects completely. The
include column will be set to the value requested (TRUE or FALSE).
Modified: pkg/RSiena/man/includeInteraction.Rd
===================================================================
--- pkg/RSiena/man/includeInteraction.Rd 2010-04-12 16:38:28 UTC (rev 77)
+++ pkg/RSiena/man/includeInteraction.Rd 2010-04-12 19:48:16 UTC (rev 78)
@@ -9,7 +9,8 @@
\usage{
includeInteraction(myeff, ..., include = TRUE,
name = myeff$name[1], type = "eval",
-interaction1 = rep("", 3), interaction2 = rep("", 3))
+interaction1 = rep("", 3), interaction2 = rep("", 3),
+character=FALSE)
}
\arguments{
\item{myeff}{a Siena effects object as created by \code{\link{getEffects}}}
@@ -35,6 +36,7 @@
effect e.g. covariate name or behavior variable name.
Trailing blanks may be omitted.
}
+\item{character}{Boolean: are the effect names character strings or not}
}
\details{The details provided should uniquely identify up to three
effects. If so, an interaction effect will be created and included or
Modified: pkg/RSiena/man/setEffect.Rd
===================================================================
--- pkg/RSiena/man/setEffect.Rd 2010-04-12 16:38:28 UTC (rev 77)
+++ pkg/RSiena/man/setEffect.Rd 2010-04-12 19:48:16 UTC (rev 78)
@@ -11,7 +11,7 @@
setEffect(myeff, shortName, parameter = 0, fix = FALSE,
test = FALSE, initialValue = 0, include = TRUE,
name = myeff$name[1], type = "eval", interaction1 = "",
-interaction2 = "")
+interaction2 = "", character=FALSE)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
@@ -44,6 +44,7 @@
Name of siena object where needed to completely identify the
effect e.g. covariate name or behavior variable name.
}
+\item{character}{Boolean: is the short name a character string or not}
}
\details{
The arguments should identify the effects completely. The parm column
Modified: pkg/RSienaTest/R/print01Report.r
===================================================================
--- pkg/RSienaTest/R/print01Report.r 2010-04-12 16:38:28 UTC (rev 77)
+++ pkg/RSienaTest/R/print01Report.r 2010-04-12 19:48:16 UTC (rev 78)
@@ -184,11 +184,12 @@
}
if (attr(depvar, "type") == "bipartite")
{
- tmp <- format(cbind(1:atts$netdims[1], outdeg))
- }
+ tmp <- format(cbind(1:atts$netdims[1], outdeg))
+ }
else
{
- tmp <- format(cbind(1:atts$netdims[1], outdeg, indeg))
+ tmp <- format(cbind(1:atts$netdims[1], outdeg,
+ indeg))
}
Report(tmp[, 1], fill=60, outf)
@@ -251,7 +252,8 @@
nnonactive <-
rowSums(depvar[, , k] == 10 |
depvar[, , k] == 11, na.rm=TRUE)
- nnonactive <- nnonactive >= nrow(depvar[, , k])
+ nnonactive <- nnonactive >=
+ nrow(depvar[, , k])
}
if (sum(nnonactive) == 1)
{
@@ -269,11 +271,15 @@
}
if (attr(depvar, "sparse"))
{
- anymissings <- any(is.na(depvar[[k]]))
+ depvark <- depvar[[k]]
+ diag(depvark) <- 0
+ anymissings <- any(is.na(depvark))
}
else
{
- anymissings <- any(is.na(depvar[, , k]))
+ depvark <- depvar[, , k]
+ diag(depvark) <- 0
+ anymissings <- any(is.na(depvark))
}
if (anymissings)
{
@@ -656,7 +662,8 @@
Report(c("Exogenous dyadic covariate named ", covars[i], '.\n'),
sep="", outf)
}
- Report("Number of tie variables with missing data per period:\n", outf)
+ Report("Number of tie variables with missing data per period:\n",
+ outf)
Report(c(" period ", format(1:(x$observations - 1) +
periodFromStart, width=9),
" overall\n"), sep="", outf)
@@ -924,7 +931,8 @@
upOnly <- atts$anyUpOnly[!nets]
for (i in seq(along=netnames[upOnly]))
{
- Report(c("\nBehavior variable ", netnames[i], ":\n"), sep = "", outf)
+ Report(c("\nBehavior variable ", netnames[i], ":\n"), sep = "",
+ outf)
if (atts$observations == 1)
{
Report("All behavior changes are upward.\n", outf)
@@ -1067,15 +1075,13 @@
{
Report(c("for network ", format(netnames[i], width=12),
format(round(balmean[i], 4),
- nsmall=4, width=14),
- '.\n'),
+ nsmall=4, width=14), '.\n'),
sep="", outf)
}
else
{
- Report(c(format(round(balmean[i], 4), nsmall=4, width=14),
- '.\n'),
- sep="", outf)
+ Report(c(format(round(balmean[i], 4), nsmall=4,
+ width=14), '.\n'), sep="", outf)
}
}
}
@@ -1111,8 +1117,7 @@
{
Report(c("Similarity", format(atts$cCovars[i], width=12),
':', format(round(atts$cCovarSim[i], 4), width=12,
- nsmall=4),
- '\n'), outf)
+ nsmall=4), '\n'), outf)
}
}
}
@@ -1139,8 +1144,7 @@
{
Report(c("Similarity", format(atts$netnames[i], width=12),
':', format(round(atts$bSim[i], 4), nsmall=4,
- width=12),
- '\n'), outf)
+ width=12), '\n'), outf)
}
}
}
@@ -1168,8 +1172,7 @@
{
Report(c("Similarity", format(atts$vCovars[i], width=12),
':', format(round(atts$vCovarSim[i], 4), width=12,
- nsmall=4),
- '\n'), outf)
+ nsmall=4), '\n'), outf)
}
}
}
Modified: pkg/RSienaTest/R/siena01.r
===================================================================
--- pkg/RSienaTest/R/siena01.r 2010-04-12 16:38:28 UTC (rev 77)
+++ pkg/RSienaTest/R/siena01.r 2010-04-12 19:48:16 UTC (rev 78)
@@ -666,7 +666,8 @@
showFn <- function()
{
editCols <- c("name", "effectName", "type", "include", "fix",
- "test", "initialValue", "parm")
+ "test", "initialValue", "parm", "effectNumber",
+ "effect1", "effect2", "effect3")
effEdit <- myeff[myeff$include, editCols]
for (i in c("include", "fix", "test"))
{
Modified: pkg/RSienaTest/R/sienaeffects.r
===================================================================
--- pkg/RSienaTest/R/sienaeffects.r 2010-04-12 16:38:28 UTC (rev 77)
+++ pkg/RSienaTest/R/sienaeffects.r 2010-04-12 19:48:16 UTC (rev 78)
@@ -10,14 +10,30 @@
##@includeEffect DataCreate
includeEffects <- function(myeff, ..., include=TRUE, name=myeff$name[1],
- type="eval", interaction1="", interaction2="")
+ type="eval", interaction1="", interaction2="",
+ character=FALSE)
{
- dots <- substitute(list(...))[-1] ##first entry is the word 'list'
+
+ if (character)
+ {
+ dots <- sapply(list(...), function(x)x)
+ }
+ else
+ {
+ dots <- substitute(list(...))[-1] ##first entry is the word 'list'
+ }
if (length(dots) == 0)
{
stop("need some effect short names")
}
- effectNames <- sapply(dots, function(x)deparse(x))
+ if (!character)
+ {
+ effectNames <- sapply(dots, function(x)deparse(x))
+ }
+ else
+ {
+ effectNames <- dots
+ }
use <- myeff$shortName %in% effectNames &
myeff$type==type &
myeff$name==name &
@@ -25,17 +41,24 @@
myeff$interaction2 == interaction2
myeff[use, "include"] <- include
print(myeff[use, c("name", "shortName", "type", "interaction1",
- "interaction2", "include")])
+ "interaction2", "include")])
myeff
}
##@includeInteraction DataCreate
includeInteraction <- function(myeff, ...,
include=TRUE, name=myeff$name[1],
type="eval", interaction1=rep("", 3),
- interaction2=rep("", 3))
+ interaction2=rep("", 3), character=FALSE)
{
- ## check we have 2 or 3 short names
- dots <- substitute(list(...))[-1] ##first entry is the word 'list'
+ if (character)
+ {
+ dots <- sapply(list(...), function(x)x)
+ }
+ else
+ {
+ ## check we have 2 or 3 short names
+ dots <- substitute(list(...))[-1] ##first entry is the word 'list'
+ }
if (length(dots) == 0)
{
stop("need some effect short names")
@@ -44,7 +67,14 @@
{
stop("need exactly two or three effect short names")
}
- shortNames <- sapply(dots, function(x)deparse(x))
+ if (!character)
+ {
+ shortNames <- sapply(dots, function(x)deparse(x))
+ }
+ else
+ {
+ shortNames <- dots
+ }
## check that we have a spare row
ints <- myeff[myeff$name == name & myeff$shortName %in%
c("unspInt", "behUnspInt") &
@@ -132,10 +162,14 @@
##@setEffect DataCreate
setEffect <- function(myeff, shortName, parameter=0,
fix=FALSE, test=FALSE, initialValue=0,
- include=TRUE, name=myeff$name[1],
- type="eval", interaction1="", interaction2="")
+ include=TRUE, name=myeff$name[1],
+ type="eval", interaction1="", interaction2="",
+ character=FALSE)
{
- shortName <- deparse(substitute(shortName))
+ if (!character)
+ {
+ shortName <- deparse(substitute(shortName))
+ }
use <- myeff$shortName == shortName &
myeff$name == name &
myeff$type == type &
Modified: pkg/RSienaTest/man/includeEffects.Rd
===================================================================
--- pkg/RSienaTest/man/includeEffects.Rd 2010-04-12 16:38:28 UTC (rev 77)
+++ pkg/RSienaTest/man/includeEffects.Rd 2010-04-12 19:48:16 UTC (rev 78)
@@ -9,7 +9,7 @@
}
\usage{
includeEffects(myeff, ..., include = TRUE, name = myeff$name[1],
- type = "eval", interaction1 = "", interaction2 = "")
+ type = "eval", interaction1 = "", interaction2 = "", character=FALSE)
}
\arguments{
\item{myeff}{a Siena effects object as created by \code{\link{getEffects}}
@@ -34,6 +34,7 @@
Name of siena object where needed to completely identify the
effects e.g. covariate name or behavior variable name.
}
+\item{character}{Boolean: are the effect names character strings or not}
}
\details{The arguments should identify the effects completely. The
include column will be set to the value requested (TRUE or FALSE).
Modified: pkg/RSienaTest/man/includeInteraction.Rd
===================================================================
--- pkg/RSienaTest/man/includeInteraction.Rd 2010-04-12 16:38:28 UTC (rev 77)
+++ pkg/RSienaTest/man/includeInteraction.Rd 2010-04-12 19:48:16 UTC (rev 78)
@@ -9,7 +9,8 @@
\usage{
includeInteraction(myeff, ..., include = TRUE,
name = myeff$name[1], type = "eval",
-interaction1 = rep("", 3), interaction2 = rep("", 3))
+interaction1 = rep("", 3), interaction2 = rep("", 3),
+character=FALSE)
}
\arguments{
\item{myeff}{a Siena effects object as created by \code{\link{getEffects}}}
@@ -35,6 +36,7 @@
effect e.g. covariate name or behavior variable name.
Trailing blanks may be omitted.
}
+\item{character}{Boolean: are the effect names character strings or not}
}
\details{The details provided should uniquely identify up to three
effects. If so, an interaction effect will be created and included or
Modified: pkg/RSienaTest/man/setEffect.Rd
===================================================================
--- pkg/RSienaTest/man/setEffect.Rd 2010-04-12 16:38:28 UTC (rev 77)
+++ pkg/RSienaTest/man/setEffect.Rd 2010-04-12 19:48:16 UTC (rev 78)
@@ -11,7 +11,7 @@
setEffect(myeff, shortName, parameter = 0, fix = FALSE,
test = FALSE, initialValue = 0, include = TRUE,
name = myeff$name[1], type = "eval", interaction1 = "",
-interaction2 = "")
+interaction2 = "", character=FALSE)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
@@ -44,6 +44,7 @@
Name of siena object where needed to completely identify the
effect e.g. covariate name or behavior variable name.
}
+\item{character}{Boolean: is the short name a character string or not}
}
\details{
The arguments should identify the effects completely. The parm column
More information about the Rsiena-commits
mailing list