move .txt files in exec/ to inst/chunks

and change their extension to .stan so that GitHub recognizes them as Stan code
stan-dev · Jan 31, 2016 · 15f0aac · 15f0aac
1 parent cbddff8
commit 15f0aac
Show file tree

Hide file tree

Showing 25 changed files with 93 additions and 82 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: rstanarm
 Type: Package
 Title: Bayesian Applied Regression Modeling via Stan
-Version: 2.9.0-2
-Date: 2016-01-09
+Version: 2.9.0-3
+Date: 2016-01-31
 Authors@R: c(person("Jonah", "Gabry", email = "jsg2201@columbia.edu", role = "aut"),
              person("Trustees of", "Columbia University", role = "cph"),
              person("R Core", "Deveopment Team", role = "cph", 

diff --git a/R/stanmodels.R b/R/stanmodels.R
@@ -15,18 +15,22 @@
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 
+# This file is only intended to be used during the installation process
 MODELS_HOME <- "exec"
 if (!file.exists(MODELS_HOME)) MODELS_HOME <- sub("R$", "exec", getwd())
 
-make_stanmodel <- function(f) { # nocov start
+stan_files <- dir(MODELS_HOME, pattern = "stan$", full.names = TRUE)
+stanmodels <- sapply(stan_files, function(f) {
   model_cppname <- sub("\\.stan$", "", basename(f))
-  stanfit <- rstan::stanc_builder(f)
+  isystem <- system.file("chunks", package = "rstanarm")
+  if (!file.exists(file.path(isystem, "common_functions.stan")))
+    isystem <- file.path("inst", "chunks")
+  stanfit <- rstan::stanc_builder(f, isystem)
   stanfit$model_cpp <- list(model_cppname = stanfit$model_name, 
                             model_cppcode = stanfit$cppcode)
   return(do.call(methods::new, args = c(stanfit[-(1:3)], Class = "stanmodel", 
                  mk_cppmodule = function(x) get(paste0("model_", model_cppname)))))
-} # nocov end
-
-stan_files <- dir(MODELS_HOME, pattern = "stan$", full.names = TRUE)
-stanmodels <- sapply(stan_files, make_stanmodel)
+  }
+)
 names(stanmodels) <- sub("\\.stan$", "", basename(names(stanmodels)))
+rm(MODELS_HOME)
diff --git a/exec/bernoulli.stan b/exec/bernoulli.stan
@@ -1,8 +1,8 @@
-#include "license.txt"
+#include "license.stan"
 
 // GLM for a Bernoulli outcome
 functions {
-  #include "common_functions.txt"
+  #include "common_functions.stan"
 
   /** 
    * Apply inverse link function to linear predictor
@@ -105,7 +105,7 @@ data {
   vector[K] xbar;     // vector of column-means of rbind(X0, X1)
   matrix[N[1],K] X0;  // centered (by xbar) predictor matrix | y = 0
   matrix[N[2],K] X1;  // centered (by xbar) predictor matrix | y = 1
-  #include "data_glm.txt"
+  #include "data_glm.stan"
 
   // weights
   int<lower=0,upper=1> has_weights;  // 0 = No, 1 = Yes
@@ -117,8 +117,8 @@ data {
   vector[N[1] * has_offset] offset0;
   vector[N[2] * has_offset] offset1;
 
-  #include "hyperparameters.txt"
-  #include "glmer_stuff.txt"
+  #include "hyperparameters.stan"
+  #include "glmer_stuff.stan"
 
   // more glmer stuff
   int<lower=0> num_non_zero[2];     // number of non-zero elements in the Z matrices
@@ -131,23 +131,23 @@ data {
 }
 transformed data {
   int NN;
-  #include "tdata_glm.txt"
+  #include "tdata_glm.stan"
   NN <- N[1] + N[2];
 }
 parameters {
   real<upper=if_else(link == 4, 0, positive_infinity())> gamma[has_intercept];
-  #include "parameters_glm.txt"
+  #include "parameters_glm.stan"
 }
 transformed parameters {
-  #include "tparameters_glm.txt"
+  #include "tparameters_glm.stan"
   if (t > 0) {
     theta_L <- make_theta_L(len_theta_L, p, 
                             1.0, tau, scale, zeta, rho, z_T);
     b <- make_b(z_b, theta_L, p, l);
   }
 }
 model {
-  #include "make_eta_bern.txt"
+  #include "make_eta_bern.stan"
   if (has_intercept == 1) {
     if (link != 4) {
       eta0 <- gamma[1] + eta0;
@@ -170,7 +170,7 @@ model {
     increment_log_prob(dot_product(weights1, pw_bern(1, eta1, link)));
   }
 
-  #include "priors_glm.txt"
+  #include "priors_glm.stan"
   if (t > 0) decov_lp(z_b, z_T, rho, zeta, tau, 
                       regularization, delta, shape, t, p);
 }
@@ -184,7 +184,7 @@ generated quantities {
   {
     vector[N[1]] pi0;
     vector[N[2]] pi1;
-    #include "make_eta_bern.txt"
+    #include "make_eta_bern.stan"
     if (has_intercept == 1) {
       if (link != 4) {
         eta0 <- gamma[1] + eta0;

diff --git a/exec/binomial.stan b/exec/binomial.stan
@@ -1,8 +1,8 @@
-#include "license.txt"
+#include "license.stan"
 
 // GLM for a binomial outcome
 functions {
-  #include "common_functions.txt"
+  #include "common_functions.stan"
 
   /** 
    * Apply inverse link function to linear predictor
@@ -83,39 +83,39 @@ functions {
   }
 }
 data {
-  #include "NKX.txt"
+  #include "NKX.stan"
   int<lower=0> y[N];       // outcome: number of successes
   int<lower=0> trials[N];  // number of trials
-  #include "data_glm.txt"
-  #include "weights_offset.txt"
-  #include "hyperparameters.txt"
-  #include "glmer_stuff.txt"
-  #include "glmer_stuff2.txt"
+  #include "data_glm.stan"
+  #include "weights_offset.stan"
+  #include "hyperparameters.stan"
+  #include "glmer_stuff.stan"
+  #include "glmer_stuff2.stan"
 }
 transformed data {
-  #include "tdata_glm.txt"
+  #include "tdata_glm.stan"
 }
 parameters {
   real<upper=if_else(link == 4, 0, positive_infinity())> gamma[has_intercept];
-  #include "parameters_glm.txt"
+  #include "parameters_glm.stan"
 }
 transformed parameters {
-  #include "tparameters_glm.txt"
+  #include "tparameters_glm.stan"
   if (t > 0) {
     theta_L <- make_theta_L(len_theta_L, p, 
                             1.0, tau, scale, zeta, rho, z_T);
     b <- make_b(z_b, theta_L, p, l);
   }
 }
 model {
-  #include "make_eta.txt"
+  #include "make_eta.stan"
   if (t > 0) eta <- eta + csr_matrix_times_vector(N, q, w, v, u, b);
   if (has_intercept == 1) {
     if (link != 4) eta <- eta + gamma[1];
     else eta <- gamma[1] + eta - max(eta);
   }
   else {
-    #include "eta_no_intercept.txt"
+    #include "eta_no_intercept.stan"
   }
 
   // Log-likelihood 
@@ -126,7 +126,7 @@ model {
   else if (prior_PD == 0) 
     increment_log_prob(dot_product(weights, pw_binom(y, trials, eta, link)));
 
-  #include "priors_glm.txt"
+  #include "priors_glm.stan"
 
   if (t > 0) decov_lp(z_b, z_T, rho, zeta, tau, 
                       regularization, delta, shape, t, p);
@@ -138,7 +138,7 @@ generated quantities {
   mean_PPD <- 0;
   {
     vector[N] pi;
-    #include "make_eta.txt"
+    #include "make_eta.stan"
     if (t > 0) eta <- eta + csr_matrix_times_vector(N, q, w, v, u, b);
     if (has_intercept == 1) {
       if (link != 4) eta <- eta + gamma[1];
@@ -150,7 +150,7 @@ generated quantities {
       }
     }
     else {
-      #include "eta_no_intercept.txt"
+      #include "eta_no_intercept.stan"
     }
 
     pi <- linkinv_binom(eta, link);

diff --git a/exec/continuous.stan b/exec/continuous.stan
@@ -1,8 +1,8 @@
-#include "license.txt"
+#include "license.stan"
 
 # GLM for a Gaussian, Gamma, or inverse Gaussian outcome
 functions {
-  #include "common_functions.txt"
+  #include "common_functions.stan"
 
   /** 
    * Apply inverse link function to linear predictor
@@ -202,19 +202,19 @@ functions {
 
 }
 data {
-  #include "NKX.txt"
+  #include "NKX.stan"
   vector[N] y; // continuous outcome
-  #include "data_glm.txt"
-  #include "weights_offset.txt"
-  #include "hyperparameters.txt"
-  #include "glmer_stuff.txt"
-  #include "glmer_stuff2.txt"
+  #include "data_glm.stan"
+  #include "weights_offset.stan"
+  #include "hyperparameters.stan"
+  #include "glmer_stuff.stan"
+  #include "glmer_stuff2.stan"
 }
 transformed data {
   vector[N * (family == 3)] sqrt_y;
   vector[N * (family == 3)] log_y;
   real sum_log_y;
-  #include "tdata_glm.txt"
+  #include "tdata_glm.stan"
   if      (family == 1) sum_log_y <- not_a_number();
   else if (family == 2) sum_log_y <- sum(log(y));
   else {
@@ -226,12 +226,12 @@ transformed data {
 parameters {
   real<lower=if_else(family == 1 || link == 2, 
                      negative_infinity(), 0)> gamma[has_intercept];
-  #include "parameters_glm.txt"
+  #include "parameters_glm.stan"
   real<lower=0> dispersion_unscaled; # interpretation depends on family!
 }
 transformed parameters {
   real dispersion;
-  #include "tparameters_glm.txt"
+  #include "tparameters_glm.stan"
   if (prior_scale_for_dispersion > 0)
     dispersion <-  prior_scale_for_dispersion * dispersion_unscaled;
   else dispersion <- dispersion_unscaled;
@@ -242,14 +242,14 @@ transformed parameters {
   }
 }
 model {
-  #include "make_eta.txt"
+  #include "make_eta.stan"
   if (t > 0) eta <- eta + csr_matrix_times_vector(N, q, w, v, u, b);
   if (has_intercept == 1) {
     if (family == 1 || link == 2) eta <- eta + gamma[1];
     else eta <- eta - min(eta) + gamma[1];
   }
   else {
-    #include "eta_no_intercept.txt"
+    #include "eta_no_intercept.stan"
   }
 
   // Log-likelihood 
@@ -258,7 +258,7 @@ model {
       if (link == 1)      y ~ normal(eta, dispersion);
       else if (link == 2) y ~ lognormal(eta, dispersion);
       else y ~ normal(divide_real_by_vector(1, eta), dispersion);
-      // divide_real_by_vector() is defined in common_functions.txt
+      // divide_real_by_vector() is defined in common_functions.stan
     }
     else if (family == 2) {
       y ~ GammaReg(eta, dispersion, link, sum_log_y);
@@ -278,7 +278,7 @@ model {
 
   // Log-prior for scale
   if (prior_scale_for_dispersion > 0) dispersion_unscaled ~ cauchy(0, 1);
-  #include "priors_glm.txt"
+  #include "priors_glm.stan"
   if (t > 0) decov_lp(z_b, z_T, rho, zeta, tau, 
                       regularization, delta, shape, t, p);
 }
@@ -289,7 +289,7 @@ generated quantities {
   if (has_intercept == 1)
     alpha[1] <- gamma[1] - dot_product(xbar, beta);
   {
-    #include "make_eta.txt"
+    #include "make_eta.stan"
     if (t > 0) eta <- eta + csr_matrix_times_vector(N, q, w, v, u, b);
     if (has_intercept == 1) {
       if (family == 1 || link == 2) eta <- eta + gamma[1];
@@ -301,7 +301,7 @@ generated quantities {
       }
     }
     else {
-      #include "eta_no_intercept.txt"
+      #include "eta_no_intercept.stan"
     }
 
     if (family == 1) {