write constants added to Stan's log-posterior in separate lines

Author: paul-buerkner

R/make_stancode.R

@@ -251,9 +251,9 @@ make_stancode <- function(formula, data, family = gaussian(),
       text_disp$modelC1,
       text_model_loop,
       text_families$modelC,
-      "  // prior specifications \n", 
+      "  // priors including all constants \n", 
       text_prior, 
-      "  // likelihood contribution \n",
+      "  // likelihood including all constants \n",
       "  if (!prior_only) { \n  ",
       text_llh, 
       text_lp_pre$modelC,

R/misc.R

@@ -614,17 +614,18 @@ softmax <- function(x) {
   x / rowSums(x)
 }
 
-wsp <- function(x, nsp = 1) {
+wsp <- function(x = "", nsp = 1) {
   # add leading and trailing whitespaces
   # Args:
   #   x: object accepted by paste
   #   nsp: number of whitespaces to add
   sp <- collapse(rep(" ", nsp))
   if (length(x)) {
-    paste0(sp, x, sp)
+    out <- ifelse(nzchar(x), paste0(sp, x, sp), sp)
   } else {
-    NULL
+    out <- NULL
   } 
+  out
 }
 
 limit_chars <- function(x, chars = NULL, lsuffix = 4) {

R/stan-helpers.R

@@ -814,7 +814,7 @@ stan_prior <- function(prior, class, coef = "", group = "",
   #   for a given class of parameters. If a parameter has has 
   #   no corresponding prior in prior, an empty string is returned.
   tp <- tp(wsp)
-  wsp <- collapse(rep(" ", wsp))
+  wsp <- wsp(nsp = wsp)
   prior_only <- identical(attr(prior, "sample_prior"), "only")
   keep <- prior$class == class & 
     prior$coef %in% c(coef, "") & prior$group %in% c(group, "")
@@ -957,19 +957,20 @@ stan_target_prior <- function(prior, par, ncoef = 1, bound = "") {
   trunc_lb <- is.character(par_bound$lb) || par_bound$lb > prior_bound$lb
   trunc_ub <- is.character(par_bound$ub) || par_bound$ub < prior_bound$ub
   if (trunc_lb || trunc_ub) {
+    wsp <- wsp(nsp = 4)
     if (trunc_lb && !trunc_ub) {
       str_add(out) <- paste0(
-        " - ", ncoef, " * ", prior_name, "_lccdf(", 
+        "\n", wsp, "- ", ncoef, " * ", prior_name, "_lccdf(", 
         par_bound$lb, " | ", prior_args
       )
     } else if (!trunc_lb && trunc_ub) {
       str_add(out) <- paste0(
-        " - ", ncoef, " * ", prior_name, "_lcdf(", 
+        "\n", wsp, "- ", ncoef, " * ", prior_name, "_lcdf(", 
         par_bound$ub, " | ", prior_args
       )
     } else if (trunc_lb && trunc_ub) {
       str_add(out) <- paste0(
-        " - \n", collapse(rep(" ", 8)), ncoef, " * log_diff_exp(", 
+        "\n", wsp, "- ", ncoef, " * log_diff_exp(", 
         prior_name, "_lcdf(", par_bound$ub, " | ", prior_args, ", ",
         prior_name, "_lcdf(", par_bound$lb, " | ", prior_args, ")"
       )
@@ -995,11 +996,14 @@ stan_special_prior <- function(class, prior, ncoef, nlpar = "") {
       global_args <- sargs(global_args, global_args)
       c2_args <- paste0("0.5 * hs_df_slab", p)
       c2_args <- sargs(c2_args, c2_args)
+      wsp <- wsp(nsp = 4)
       str_add(out) <- paste0(
         tp, "normal_lpdf(zb", p, " | 0, 1); \n",
-        tp, "normal_lpdf(hs_local", p, "[1] | 0, 1) - ", ncoef, " * log_half; \n",
+        tp, "normal_lpdf(hs_local", p, "[1] | 0, 1)\n", 
+        wsp, "- ", ncoef, " * log(0.5); \n",
         tp, "inv_gamma_lpdf(hs_local", p, "[2] | ", local_args, "); \n",
-        tp, "normal_lpdf(hs_global", p, "[1] | 0, 1) - log_half; \n",
+        tp, "normal_lpdf(hs_global", p, "[1] | 0, 1)\n", 
+        wsp, "- 1 * log(0.5); \n",
         tp, "inv_gamma_lpdf(hs_global", p, "[2] | ", global_args, "); \n",
         tp, "inv_gamma_lpdf(hs_c2", p, " | ", c2_args, "); \n"
       )

R/stan-predictor.R

@@ -285,7 +285,6 @@ stan_fe <- function(fixef, prior, family = gaussian(),
         "  real<lower=0> hs_scale_global", p, "; \n",
         "  real<lower=0> hs_scale_slab", p, "; \n"           
       )
-      str_add(out$tdataD) <- "real log_half = log(0.5); \n"
       str_add(out$par) <- paste0(
         "  // horseshoe shrinkage parameters \n",
         "  vector[K", ct, p, "] zb", p, "; \n",