[Rsiena-commits] r15 - pkg/RSiena/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Sep 23 18:20:00 CEST 2009
Author: ripleyrm
Date: 2009-09-23 18:19:59 +0200 (Wed, 23 Sep 2009)
New Revision: 15
Modified:
pkg/RSiena/R/phase1.r
pkg/RSiena/R/sienaprint.r
pkg/RSiena/R/simstatsc.r
Log:
Correct finite difference code for multiple processors
Modified: pkg/RSiena/R/phase1.r
===================================================================
--- pkg/RSiena/R/phase1.r 2009-09-23 02:30:16 UTC (rev 14)
+++ pkg/RSiena/R/phase1.r 2009-09-23 16:19:59 UTC (rev 15)
@@ -281,6 +281,14 @@
nits <- seq((z$phase1Its+1), z$n1, int)
for (nit in nits)
{
+ if (is.null(z$ctime))
+ {
+ time1 <- proc.time()['elapsed']
+ if (x$checktime)
+ {
+ z$ctime <- time1
+ }
+ }
z$nit <- nit
z <- doPhase1it(z, x, cl=z$cl, int=int, zsmall=zsmall,
xsmall=xsmall, ...)
@@ -291,7 +299,7 @@
}
}
z$timePhase1 <- (proc.time()['elapsed'] - z$ctime) / (z$nit - 1)
- if (x$checktime)
+ if (x$checktime && !is.na(z$timePhase1))
{
Report(c('Time per iteration in phase 1 =',
format(z$timePhase1, digits = 4, nsmall = 4),'\n'), lf)
@@ -387,6 +395,9 @@
WriteOutTheta(z)
z$nitPhase1 <- z$phase1Its
z$phase1devs <- z$sf
+ z$phase1dfra <- z$frda
+ z$phase1sdf <- z$sdf
+ z$phase1scores <- z$ssc
##browser()
z
}
@@ -524,7 +535,11 @@
z$npos <- z$npos + ifelse(abs(diag(fras[ii, , ])) > 1e-6, 1, 0)
}
}
- sdf <- fras / rep(z$epsilon, z$pp)
+ sdf <- fras
+ for (i in 1:int)
+ {
+ sdf[i, , ] <- fras[i, , ] / rep(z$epsilon, z$pp)
+ }
z$sdf0 <- sdf
# browser()
z
Modified: pkg/RSiena/R/sienaprint.r
===================================================================
--- pkg/RSiena/R/sienaprint.r 2009-09-23 02:30:16 UTC (rev 14)
+++ pkg/RSiena/R/sienaprint.r 2009-09-23 16:19:59 UTC (rev 15)
@@ -64,14 +64,17 @@
addtorow <- tmp$addtorow
for (i in 1:length(tmp1))
{
- for (j in 1:length(addtorow$command))
+ if (length(addtorow$command) > 0)
{
- ii <- grep(i-1, addtorow$pos[[j]])
- if (length(ii))
- if (i == 1 | addtorow$command[j] == 'Network Dynamics')
- cat( addtorow$command[j], '\n')
- else
- cat('\n', addtorow$command[j], '\n', sep='')
+ for (j in 1:length(addtorow$command))
+ {
+ ii <- grep(i-1, addtorow$pos[[j]])
+ if (length(ii))
+ if (i == 1 | addtorow$command[j] == 'Network Dynamics')
+ cat( addtorow$command[j], '\n')
+ else
+ cat('\n', addtorow$command[j], '\n', sep='')
+ }
}
cat(tmp1[i], '\n')
}
Modified: pkg/RSiena/R/simstatsc.r
===================================================================
--- pkg/RSiena/R/simstatsc.r 2009-09-23 02:30:16 UTC (rev 14)
+++ pkg/RSiena/R/simstatsc.r 2009-09-23 16:19:59 UTC (rev 15)
@@ -335,7 +335,16 @@
}
else
{
- randomseed2 <- as.integer(f$randomseed2)
+ if (fromFiniteDiff)
+ {
+ randomseed2 <- as.integer(f$storedseed)
+ }
+ else
+ {
+ randomseed2 <- as.integer(f$randomseed2)
+ f$storedseed <- randomseed2
+ }
+ ## cat(randomseed2, '\n')
}
ans <- .Call('model', PACKAGE="RSiena",
z$Deriv, f$pData, f$seeds,
@@ -355,7 +364,7 @@
}
ntim <- ans[[4]]
fra <- t(ans[[1]])
- f$randomseed2 <- ans[[5]]
+ f$randomseed2 <- ans[[5]][c(1,4,3,2)]
FRANstore(f)
list(sc = sc, fra = fra, ntim0 = ntim, feasible = TRUE, OK = TRUE,
nets=list(ans[[6]]))
More information about the Rsiena-commits
mailing list