[Rcpp-commits] r3695 - in pkg/RcppEigen: . R

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

Author: edd
Date: 2012-07-18 02:53:03 +0200 (Wed, 18 Jul 2012)
New Revision: 3695

Modified:
   pkg/RcppEigen/ChangeLog
   pkg/RcppEigen/R/fastLm.R
Log:
 o corrections in fastLm.R for no-intercept case


Modified: pkg/RcppEigen/ChangeLog
===================================================================
--- pkg/RcppEigen/ChangeLog	2012-07-17 19:27:18 UTC (rev 3694)
+++ pkg/RcppEigen/ChangeLog	2012-07-18 00:53:03 UTC (rev 3695)
@@ -1,3 +1,7 @@
+2012-07-17  Dirk Eddelbuettel  <edd at debian.org>
+
+	* R/fastLm.R: Corrections for R^2 in no-intercept case
+
 2012-06-26  Douglas Bates  <bates at stat.wisc.edu>
 
 	* DESCRIPTION, R/unit.test.R, inst/include/Eigen/*: Massive

Modified: pkg/RcppEigen/R/fastLm.R
===================================================================
--- pkg/RcppEigen/R/fastLm.R	2012-07-17 19:27:18 UTC (rev 3694)
+++ pkg/RcppEigen/R/fastLm.R	2012-07-18 00:53:03 UTC (rev 3695)
@@ -1,6 +1,6 @@
 ## fastLm.R: Rcpp/Eigen implementation of lm()
 ##
-## Copyright (C)  2011 Douglas Bates, Dirk Eddelbuettel and Romain Francois
+## Copyright (C)  2011 - 2012  Douglas Bates, Dirk Eddelbuettel and Romain Francois
 ##
 ## This file is part of RcppEigen.
 ##
@@ -33,6 +33,7 @@
 
     res <- fastLmPure(X, y, as.integer(method[1]))
     res$call <- match.call()
+    res$intercept <- any(apply(X, 2, sd) == 0)
 
     class(res) <- "fastLm"
     res
@@ -58,11 +59,12 @@
     ## cf src/stats/R/lm.R and case with no weights and an intercept
     f <- object$fitted.values
     r <- object$residuals
-    mss <- sum((f - mean(f))^2)
+    #mss <- sum((f - mean(f))^2)
+    mss <- if (object$intercept) sum((f - mean(f))^2) else sum(f^2)
     rss <- sum(r^2)
 
     object$r.squared <- mss/(mss + rss)
-    df.int <- 1 		# case of intercept
+    df.int <- if (object$intercept) 1L else 0L
     n <- length(f)
     rdf <- object$df
     object$adj.r.squared <- 1 - (1 - object$r.squared) * ((n - df.int)/rdf)
@@ -73,10 +75,12 @@
 print.summary.fastLm <- function(x, ...) {
     cat("\nCall:\n")
     print(x$call)
+    cat("\nResiduals:\n")
+    digits <- max(3, getOption("digits") - 3)
+    print(summary(x$residuals, digits=digits)[-4])
     cat("\n")
 
     printCoefmat(x$coefficients, P.values=TRUE, has.Pvalue=TRUE, ...)
-    digits <- max(3, getOption("digits") - 3)
     cat("\nResidual standard error: ", formatC(sqrt(x$s), digits=digits), " on ",
         formatC(x$df), " degrees of freedom\n", sep="")
     cat("Multiple R-squared: ", formatC(x$r.squared, digits=digits),
@@ -92,8 +96,9 @@
 
     res <- fastLm.default(X, y, method=method, ...)
     res$call <- match.call()
-    # I think this is redundant.  The formula is available as res$call$formula
+    ## I think this is redundant.  The formula is available as res$call$formula
     res$formula <- formula
+    res$intercept <- attr(attr(mf, "terms"), "intercept")
     res
 }