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

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

Author: ripleyrm
Date: 2009-11-04 19:29:38 +0100 (Wed, 04 Nov 2009)
New Revision: 19

Modified:
   pkg/RSiena/R/phase1.r
   pkg/RSiena/R/phase2.r
   pkg/RSiena/R/phase3.r
   pkg/RSiena/R/simstatsc.r
Log:
Corrected findiff.method

Modified: pkg/RSiena/R/phase1.r
===================================================================
--- pkg/RSiena/R/phase1.r	2009-10-31 22:56:42 UTC (rev 18)
+++ pkg/RSiena/R/phase1.r	2009-11-04 18:29:38 UTC (rev 19)
@@ -55,7 +55,7 @@
     zsmall$Deriv <- z$Deriv
     zsmall$Phase <- z$Phase
     zsmall$nit <- z$nit
-    zsmall$Findiff.method <- z$Findiff.method
+    zsmall$FinDiff.method <- z$FinDiff.method
     xsmall<- NULL
     zsmall$cconditional <- z$cconditional
     zsmall$condvar <- z$condvar
@@ -276,7 +276,7 @@
     xsmall<- NULL
     zsmall$cconditional <- z$cconditional
     zsmall$condvar <- z$condvar
-    zsmall$FinDiff.method <- z$Findiff.method
+    zsmall$FinDiff.method <- z$FinDiff.method
     int <- z$int
     if (z$n1 > z$phase1Its)
     {

Modified: pkg/RSiena/R/phase2.r
===================================================================
--- pkg/RSiena/R/phase2.r	2009-10-31 22:56:42 UTC (rev 18)
+++ pkg/RSiena/R/phase2.r	2009-11-04 18:29:38 UTC (rev 19)
@@ -187,9 +187,9 @@
     zsmall <- NULL
     zsmall$theta <- z$theta
     zsmall$Deriv <- z$Deriv
-    zsmall$Phase<- z$Phase
-    zsmall$Findiff.method <- z$Findiff.method
-    xsmall<- NULL
+    zsmall$Phase <- z$Phase
+    zsmall$FinDiff.method <- z$FinDiff.method
+    xsmall <- NULL
     zsmall$cconditional <- z$cconditional
     zsmall$condvar <- z$condvar
     repeat

Modified: pkg/RSiena/R/phase3.r
===================================================================
--- pkg/RSiena/R/phase3.r	2009-10-31 22:56:42 UTC (rev 18)
+++ pkg/RSiena/R/phase3.r	2009-11-04 18:29:38 UTC (rev 19)
@@ -61,7 +61,7 @@
     else
         Report('Estimation of derivatives by the LR method (type 1).\n\n', outf)
     zsmall <- NULL
-    zsmall$Findiff.method <- z$Findiff.method
+    zsmall$FinDiff.method <- z$FinDiff.method
     zsmall$theta <- z$theta
     zsmall$Deriv <- z$Deriv
     zsmall$Phase <- z$Phase

Modified: pkg/RSiena/R/simstatsc.r
===================================================================
--- pkg/RSiena/R/simstatsc.r	2009-10-31 22:56:42 UTC (rev 18)
+++ pkg/RSiena/R/simstatsc.r	2009-11-04 18:29:38 UTC (rev 19)
@@ -224,21 +224,51 @@
             myeffects <- ff$myeffects
             returnDeps <- ff$returnDeps
         }
-        ans<- .Call('effects', PACKAGE="RSiena",
-                    pData, myeffects)
+        ## remove interaction effects and save till later
+        basicEffects <- lapply(myeffects, function(x)
+                        {
+                            x[!x$shortName %in% c("inspInt", "behUnspInt"), ]
+                        }
+                            )
+        interactionEffects <- lapply(myeffects, function(x)
+                        {
+                            x[x$shortName %in% c("inspInt", "behUnspInt"), ]
+                        }
+                            )
+        ans <- .Call('effects', PACKAGE="RSiena",
+                    pData, basicEffects)
         pModel <- ans[[1]][[1]]
+       ## browser()
         for (i in 1:length(ans[[2]])) ## ans[[2]] is a list of lists of
             ## pointers to effects. Each list corresponds to one
             ## dependent variable
         {
             effectPtr <- ans[[2]][[i]]
-            myeffects[[i]]$effectPtr <- effectPtr
+            basicEffects[[i]]$effectPtr <- effectPtr
+            interactionEffects[[i]]$effectPtr <-
+                basicEffects[[i]]$effectPtr[match(interactionEffects[[i]]$effect1,
+                                                  basicEffects[[i]]$effectNumber)]
         }
+        ans <- .Call('interactionEffects', PACKAGE="RSiena",
+                    pData, pModel, interactionEffects)
+        ## copy these pointer to the interaction effects and then rejoin
+        for (i in 1:length(ans[[1]])) ## ans is a list of lists of
+            ## pointers to effects. Each list corresponds to one
+            ## dependent variable
+        {
+            if (nrow(interactionEffects[[i]]) > 0)
+            {
+                effectPtr <- ans[[1]][[i]]
+                interactionEffects[[i]]$effectPtr <- effectPtr
+            }
+            myeffects[[i]] <- rbind(basicEffects[[i]], interactionEffects[[i]])
+        }
         if (!initC)
         {
             ans <- .Call('getTargets', PACKAGE="RSiena",
                          pData, pModel, myeffects)
             z$targets <- rowSums(ans)
+            z$targets2 <- ans
         }
         ##store address of model
         f$pModel <- pModel
@@ -343,7 +373,7 @@
     ans <- .Call('model', PACKAGE="RSiena",
                  z$Deriv, f$pData, f$seeds,
                  fromFiniteDiff, f$pModel, f$myeffects, z$theta,
-                 randomseed2, f$returnDeps, z$Findiff.method)
+                 randomseed2, f$returnDeps, z$FinDiff.method)
    #  browser()
    if (!fromFiniteDiff)
     {