[Rsiena-commits] r70 - in pkg/RSiena: . R

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

Author: ripleyrm
Date: 2010-03-27 22:47:56 +0100 (Sat, 27 Mar 2010)
New Revision: 70

Modified:
   pkg/RSiena/R/phase1.r
   pkg/RSiena/R/phase3.r
   pkg/RSiena/R/siena07.r
   pkg/RSiena/R/simstatsc.r
   pkg/RSiena/changeLog
Log:
Bug fixes: 1. carry forward/back for behavior variables.
2. remove tkvars from sienaFit object.
3. ensure ntim has correct dimensions.
4. FiniteDifferences had problems with only one parameter

Modified: pkg/RSiena/R/phase1.r
===================================================================
--- pkg/RSiena/R/phase1.r	2010-03-24 18:12:18 UTC (rev 69)
+++ pkg/RSiena/R/phase1.r	2010-03-27 21:47:56 UTC (rev 70)
@@ -527,7 +527,8 @@
     {
         for (ii in 1: min(10 - z$nit + 1, int))
         {
-            z$npos <- z$npos + ifelse(abs(diag(fras[ii, , ])) > 1e-6, 1, 0)
+            z$npos <- z$npos +
+                ifelse(abs(diag(matrix(fras[ii, , ], nrow=z$pp))) > 1e-6, 1, 0)
         }
     }
     sdf <- fras

Modified: pkg/RSiena/R/phase3.r
===================================================================
--- pkg/RSiena/R/phase3.r	2010-03-24 18:12:18 UTC (rev 69)
+++ pkg/RSiena/R/phase3.r	2010-03-27 21:47:56 UTC (rev 70)
@@ -43,6 +43,10 @@
     z$sf2 <- array(0, dim = c(z$n3, f$observations - 1, z$pp))
     z$ssc <- array(0, dim = c(z$n3, f$observations - 1, z$pp))
     z$sdf <- array(0, dim = c(z$n3, z$pp, z$pp))
+    if (z$cconditional)
+    {
+        z$ntim <- matrix(NA, nrow=z$n3, ncol=f$observations - 1)
+    }
     z$sims <- vector("list", z$n3)
     ## revert to original requested method for phase 3 unless symmetric
     if (z$FinDiff.method && !x$FinDiff.method &&

Modified: pkg/RSiena/R/siena07.r
===================================================================
--- pkg/RSiena/R/siena07.r	2010-03-24 18:12:18 UTC (rev 69)
+++ pkg/RSiena/R/siena07.r	2010-03-27 21:47:56 UTC (rev 70)
@@ -125,6 +125,8 @@
         stopCluster(z$cl)
 
     class(z) <- "sienaFit"
+    z$tkvars <- NULL
+    z$pb <- NULL
     z
 }
 ##@InitReports siena07 Print report

Modified: pkg/RSiena/R/simstatsc.r
===================================================================
--- pkg/RSiena/R/simstatsc.r	2010-03-24 18:12:18 UTC (rev 69)
+++ pkg/RSiena/R/simstatsc.r	2010-03-27 21:47:56 UTC (rev 70)
@@ -804,15 +804,31 @@
 {
     beh <- depvar[, 1, ]
     behmiss <- is.na(beh)
+    origbeh <- beh
+    allna <- apply(beh, 1, function(x)all(is.na(x)))
+    modes <- attr(depvar, "modes")
     ## carry forward missings ### nb otherwise use the mode
-    for (i in 1:observations)
+    ## allNAs: use modes
+    beh[allna, ] <- rep(modes, each=sum(allna))
+    for (i in 2:observations)
     {
-        if (i == 1)
-            beh[is.na(beh[, i]), i] <- 0
-        else ##carry missing forward!
-            beh[is.na(beh[, i]), i] <-
-                beh[is.na(beh[, i]), i - 1]
+            beh[is.na(beh[, i]), i] <-  beh[is.na(beh[, i]), i - 1]
     }
+    for (i in (observations-1):1)
+    {
+            beh[is.na(beh[, i]), i] <-  beh[is.na(beh[, i]), i +1]
+    }
+   #browser()
+   # for (i in seq(2:observations)
+   # {
+   #     if (i == 1)
+   #     {
+   #         beh[is.na(beh[, i]), i] <- modes[1]
+   #     else ##carry missing forward if there
+   #     {
+   #         beh[is.na(beh[, i]), i] <- ifelse(beh[is.na(beh[, i] , i - 1]
+   #             beh[is.na(beh[, i]), i - 1]
+   # }
     struct <- beh[beh %in% c(10,11)]
     beh[struct] <- beh[struct] - 10
     behstruct <- beh
@@ -1277,7 +1293,6 @@
             z$posj <- z$posj[-z$condvar]
             z$theta[z$posj] <-
                 z$theta[z$posj] / requestedEffects$initialValue[z$condvar]
-            z$ntim <- matrix(NA, nrow=x$n3, ncol=observations)
         }
 
         ## unpack data and put onto f anything we may need next time round.

Modified: pkg/RSiena/changeLog
===================================================================
--- pkg/RSiena/changeLog	2010-03-24 18:12:18 UTC (rev 69)
+++ pkg/RSiena/changeLog	2010-03-27 21:47:56 UTC (rev 70)
@@ -1,3 +1,12 @@
+2010-03-27 R-forge revision 70 (RSiena only)
+
+	* R/simstatsc.r, R/phase3.r: move definition of ntim to phase3
+	* R/simstatsc.r (unpackBehavior) carry forward and back or use
+	mode for missings
+	* R/siena07.r: remove tk variables from return object
+	* R/phase1.r (FiniteDifferences) ensure z$npos update is always a
+	vector (a dimension could be lost).
+
 2010-03-24 R-forge revision 69 (RSiena only) (cf revision 63, 67 for RSienaTest)
 
 	* src/many: mostly incomplete, changes for ML.