[Rcpp-commits] r2675 - in pkg/RcppModels: . R src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Dec 2 20:05:58 CET 2010


Author: dmbates
Date: 2010-12-02 20:05:58 +0100 (Thu, 02 Dec 2010)
New Revision: 2675

Modified:
   pkg/RcppModels/ChangeLog
   pkg/RcppModels/DESCRIPTION
   pkg/RcppModels/R/zzz.R
   pkg/RcppModels/src/glmFamily.cpp
   pkg/RcppModels/src/glmFamily.h
Log:
Adapt for Function operator() being const

Modified: pkg/RcppModels/ChangeLog
===================================================================
--- pkg/RcppModels/ChangeLog	2010-12-02 18:59:28 UTC (rev 2674)
+++ pkg/RcppModels/ChangeLog	2010-12-02 19:05:58 UTC (rev 2675)
@@ -1,3 +1,14 @@
+2010-12-02  Douglas Bates  <bates at stat.wisc.edu>
+
+	* src/glmFamily.cpp, src/glmFamily.h: cache the Functions in the
+	list.  Transformation methods are now const (without needing a
+	const_cast).
+
+	* DESCRIPTION (Depends): Change Rcpp dependence to >= 0.8.9.2 to
+	ensure that the Function operator() is const.
+
+	* R/zzz.R (.onLoad): Use a less visible name for the environment.
+
 2010-12-01  Douglas Bates  <bates at stat.wisc.edu>
 
 	* R/fastGlm.R (fastGlm): Perform IRLS iterations before return.

Modified: pkg/RcppModels/DESCRIPTION
===================================================================
--- pkg/RcppModels/DESCRIPTION	2010-12-02 18:59:28 UTC (rev 2674)
+++ pkg/RcppModels/DESCRIPTION	2010-12-02 19:05:58 UTC (rev 2675)
@@ -9,6 +9,6 @@
   linear and nonlinear models that use linear predictor expressions.
 License: GPL (>= 2)
 LazyLoad: yes
-Depends: R(>= 2.12.0), Rcpp(>= 0.8.9), RcppArmadillo, methods
+Depends: R(>= 2.12.0), Rcpp(>= 0.8.9.2), RcppArmadillo, methods
 LinkingTo: RcppArmadillo, Rcpp
 Suggests: RUnit

Modified: pkg/RcppModels/R/zzz.R
===================================================================
--- pkg/RcppModels/R/zzz.R	2010-12-02 18:59:28 UTC (rev 2674)
+++ pkg/RcppModels/R/zzz.R	2010-12-02 19:05:58 UTC (rev 2675)
@@ -1,6 +1,6 @@
-NAMESPACE <- environment()
+.NameSpace <- environment()
 .onLoad <- function(libname, pkgname) {
     ## load the module and store it in our namespace
     mod <- Module("RcppModels")
-    populate(mod, NAMESPACE)
+    populate(mod, .NameSpace)
 }

Modified: pkg/RcppModels/src/glmFamily.cpp
===================================================================
--- pkg/RcppModels/src/glmFamily.cpp	2010-12-02 18:59:28 UTC (rev 2674)
+++ pkg/RcppModels/src/glmFamily.cpp	2010-12-02 19:05:58 UTC (rev 2675)
@@ -62,60 +62,63 @@
 	    varFuncs["poisson"]          = &identf; // x
     }
     
-    // glmFamily::glmFamily() {
-    // 	if (!lnks.count("identity")) initMaps();
-    // }
-	
     glmFamily::glmFamily(List ll) throw (std::runtime_error)
-	: lst(ll) {
+	: lst(ll),
+	  // d_family(as<std::string>(wrap(ll["family"]))),
+	  // d_link(as<std::string>(wrap(ll["link"]))),
+// I haven't been able to work out an expression to initialize the
+// Functions from list components.  This is a placeholder until I can
+// do so.
+	  d_devRes("c"), d_linkfun("c"), d_linkinv("c"),
+	  d_muEta("c"), d_variance("c") {
+	  // d_devRes(wrap(ll["dev.resids"])),
+	  // d_linkfun(wrap(ll["linkfun"])),
+	  // d_linkinv(wrap(ll["linkinv"])),
+	  // d_muEta(wrap(ll["mu.eta"])),
+	  // d_variance(wrap(ll["variance"])) {
 	if (as<string>(lst.attr("class")) != "family")
 	    throw std::runtime_error("glmFamily requires a list of (S3) class \"family\"");
-	CharacterVector ff = lst["family"], lnk = lst["link"];
-	d_family = as<std::string>(ff);
-	d_link = as<std::string>(lnk);
+ 	CharacterVector ff = lst["family"], lnk = lst["link"];
+ 	d_family = as<std::string>(ff);
+ 	d_link = as<std::string>(lnk);
+ 	d_linkinv = ll["linkinv"];
+ 	d_linkfun = ll["linkfun"];
+ 	d_muEta = ll["mu.eta"];
+ 	d_variance = ll["variance"];
+ 	d_devRes = ll["dev.resids"];
 
 	if (!lnks.count("identity")) initMaps();
     }
 
+// The following member functions should be declared const but the
+// Function class call method doesn't yet allow that.
+
     Rcpp::NumericVector
     glmFamily::linkFun(Rcpp::NumericVector const &mu) const {
-	if (lnks.count(d_link)) {	// sapply the known scalar function
+	if (lnks.count(d_link))
 	    return NumericVector::import_transform(mu.begin(), mu.end(), lnks[d_link]);
-	} else {		// use the R function
-	    Function linkfun = ((const_cast<glmFamily*>(this))->lst)["linkfun"];
-	    // The const_cast is needed so that this member function
-	    // can be const and also use the extraction of a list
-	    // component. 
-	    return linkfun(mu);
-	}
+	return d_linkfun(mu);
     }
     
     Rcpp::NumericVector
     glmFamily::linkInv(Rcpp::NumericVector const &eta) const {
-	if (linvs.count(d_link)) {
+	if (linvs.count(d_link))
 	    return NumericVector::import_transform(eta.begin(), eta.end(), linvs[d_link]);
-	} else {
-	    Function linkinv = ((const_cast<glmFamily*>(this))->lst)["linkinv"];
-	    return linkinv(eta);
-	}
+	return d_linkinv(eta);
     }
-    
+
     Rcpp::NumericVector
     glmFamily::muEta(Rcpp::NumericVector const &eta) const {
-	if (muEtas.count(d_link)) {
+	if (muEtas.count(d_link))
 	    return NumericVector::import_transform(eta.begin(), eta.end(), muEtas[d_link]);
-	}
-	Function mu_eta = ((const_cast<glmFamily*>(this))->lst)["mu.eta"];
-	return mu_eta(eta);
+	return d_muEta(eta);
     }
     
     Rcpp::NumericVector
     glmFamily::variance(Rcpp::NumericVector const &mu) const {
-	if (varFuncs.count(d_link)) {
+	if (varFuncs.count(d_link))
 	    return NumericVector::import_transform(mu.begin(), mu.end(), varFuncs[d_link]);
-	}
-	Function vv = ((const_cast<glmFamily*>(this))->lst)["variance"];
-	return vv(mu);
+	return d_variance(mu);
     }
     
     Rcpp::NumericVector
@@ -132,8 +135,6 @@
 		aa[i] = f(yy[i], mm[i], ww[i]);
 	    return ans;
 	}
-	Function devres =
-	    ((const_cast<glmFamily*>(this))->lst)["dev.resids"];
-	return devres(y, mu, weights);
+	return d_devRes(y, mu, weights);
     }
 }

Modified: pkg/RcppModels/src/glmFamily.h
===================================================================
--- pkg/RcppModels/src/glmFamily.h	2010-12-02 18:59:28 UTC (rev 2674)
+++ pkg/RcppModels/src/glmFamily.h	2010-12-02 19:05:58 UTC (rev 2675)
@@ -12,12 +12,11 @@
 		     double(*)(double,double,double)> drmap;
 
     class glmFamily {
-	std::string d_family, d_link; // as in the R glm family
+    protected:
 	Rcpp::List           lst; // original list from R
+	std::string d_family, d_link; // as in the R glm family
+	Rcpp::Function d_devRes, d_linkfun, d_linkinv, d_muEta, d_variance;
     public:
-
-//	glmFamily();
-
 	glmFamily(Rcpp::List) throw (std::runtime_error);
 
 	const std::string& fam() const {return d_family;}



More information about the Rcpp-commits mailing list