[Rsiena-commits] r15 - pkg/RSiena/R

[noreply at r-forge.r-project.org]

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]]))