[Gmpm-commits] r14 - pkg/R

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

Author: dalebarr
Date: 2009-09-16 16:48:56 +0200 (Wed, 16 Sep 2009)
New Revision: 14

Modified:
   pkg/R/generics.R
   pkg/R/gmp.R
   pkg/R/helpers.R
Log:
minor bug fixes

Modified: pkg/R/generics.R
===================================================================
--- pkg/R/generics.R	2009-09-16 11:50:48 UTC (rev 13)
+++ pkg/R/generics.R	2009-09-16 14:48:56 UTC (rev 14)
@@ -1,3 +1,7 @@
+setGeneric(name=".initFinal",
+           def=function(object) {
+             standardGeneric(".initFinal")})
+
 setGeneric(name="getModelFrame",
            def=function(object) {
              standardGeneric("getModelFrame")})

Modified: pkg/R/gmp.R
===================================================================
--- pkg/R/gmp.R	2009-09-16 11:50:48 UTC (rev 13)
+++ pkg/R/gmp.R	2009-09-16 14:48:56 UTC (rev 14)
@@ -1,3 +1,26 @@
+setMethod(".initFinal",
+          signature(object="Gmp"),
+          function(object) {            
+            return(object)
+          })
+
+setMethod(".initFinal",
+          signature(object="Gmp.mul"),
+          function(object) {
+
+          # make sure that if it is a single variable, it is coded as a factor
+            if (length(grep("cbind", object at DVname))==0) {
+              if (!is.matrix(object at df1[,object at DVname])) {
+                if (!is.factor(object at df1[,object at DVname])) {
+                  object at df1[,object at DVname] <- factor(object at df1[,object at DVname])
+                  warning("Converting '", object at DVname, "' to a factor")
+                } else {}
+              } else {}
+            } else {}
+            
+            return(object)
+          })
+
 setMethod("getModelFrame",
           signature(object="Gmp"),
           function(object) {
@@ -28,8 +51,7 @@
               nform <- paste(lhs, "~", object at ivars[i], sep="")
               fcall$formula <- nform
               if (object at famtype == "multinomial") {
-                tryCatch({sink(".multinom.txt"); nn1 <- colnames(coef(eval(as.call(fcall))))},
-                         finally=sink(NULL))
+                capture.output(nn1 <- colnames(coef(eval(as.call(fcall)))))
               } else {
                 nn1 <- names(coef(eval(as.call(fcall))))
               }
@@ -570,8 +592,7 @@
             nameObject <- deparse(substitute(x))
             
             x at pmx <- array(dim=c(maxruns+1, dim(x at coef0)[1], dim(x at coef0)[2]))
-            tryCatch({sink(".multinom.txt");
-                      f0 <- origFit(x)}, finally=sink(NULL))
+            capture.output(f0 <- origFit(x))
             x at pmx[1,,] <-coef(f0)
               
             dimnames(x at pmx) <- list(run=1:(maxruns+1),
@@ -968,9 +989,7 @@
           function(object)
           {
                                         ##print("~~~ in fitOnce (Gmp) ~~~")
-            sink(".multinom.txt")
-            fit1 <- eval(as.call(object at fitcall))
-            sink(NULL)
+            capture.output(fit1 <- eval(as.call(object at fitcall)))
             if (!is.null(fit1$convergence)) {
               if (fit1$convergence == 1) {
                 cat("Warning: multinom function did not converge.\n",

Modified: pkg/R/helpers.R
===================================================================
--- pkg/R/helpers.R	2009-09-16 11:50:48 UTC (rev 13)
+++ pkg/R/helpers.R	2009-09-16 14:48:56 UTC (rev 14)
@@ -84,6 +84,7 @@
   .checkMultilevel(x)
   .getDesign(x)
   x at fitcall <- .buildFitCall(x, ocall=match.call(expand.dots=TRUE))
+  x <- .initFinal(x)  
   x at IVcoef <- .getFactorLabelsFromFit(x)
   
   .preparePermScheme(x)