added flexibility for intercept notation

R/create_eq.R

@@ -13,13 +13,13 @@ create_eq <- function(lhs,...) {
 #'
 #' @inheritParams extract_eq
 
-create_eq.default <- function(lhs, rhs, ital_vars, use_coefs, coef_digits, fix_signs, model) {
+create_eq.default <- function(lhs, rhs, ital_vars, use_coefs, coef_digits, fix_signs, model, intercept) {
   rhs$final_terms <- create_term(rhs, ital_vars)
 
   if (use_coefs) {
     rhs$final_terms <- add_coefs(rhs, rhs$final_terms, coef_digits)
   } else {
-    rhs$final_terms <- add_greek(rhs, rhs$final_terms)
+    rhs$final_terms <- add_greek(rhs, rhs$final_terms, intercept)
   }
 
   # Add error row
@@ -45,7 +45,7 @@ create_eq.polr <- function(lhs, rhs, ital_vars, use_coefs, coef_digits,
   rhs_final <- lapply(splt$zeta$final_terms, function(x) {
     c(x, splt$coefficient$final_terms, "\\epsilon")
   })
-  attributes(lhs) <- NULL 
+  attributes(lhs) <- NULL
   list(lhs = lhs, rhs = rhs_final)
 }
 
@@ -210,22 +210,22 @@ add_greek <- function(rhs, ...) {
 #'
 #' @keywords internal
 
-add_greek.default <- function(rhs, terms) {
+add_greek.default <- function(rhs, terms, intercept = "alpha") {
   if (any(grepl("(Intercept)", terms))) {
     anno_greek("beta", seq_len(nrow(rhs)), terms)
   } else {
     ifelse(rhs$term == "(Intercept)",
-           "\\alpha",
+           ifelse(intercept == "alpha", "\\alpha", "\\beta_{0}"),
            anno_greek("beta", seq_len(nrow(rhs)) - 1, terms)
            )
   }
 }
 
 add_greek.polr <- function(rhs, terms) {
   ifelse(rhs$coefficient_type == "zeta",
-         anno_greek("alpha", 
+         anno_greek("alpha",
                     rev(seq_along(grep("zeta", rhs$coefficient_type)))),
-         anno_greek("beta", 
+         anno_greek("beta",
                     seq_along(grep("coefficient", rhs$coefficient_type)),
                     terms)
          )
@@ -252,7 +252,6 @@ anno_greek <- function(greek, nums, terms = NULL) {
 #'
 #' @param eq String containing a LaTeX equation
 #'
-#' @inheritParams extract_eq
 #'
 fix_coef_signs <- function(eq) {
   # Side-by-side + -

R/extract_eq.R

@@ -5,6 +5,9 @@
 #' [broom::tidy][broom::tidy].
 #'
 #' @param model A fitted model
+#' @param intercept How should the intercept be displayed? Default is \code{"alpha"},
+#' but can also accept \code{"beta"}, in which case the it will be displayed
+#' as beta zero.
 #' @param ital_vars Logical, defaults to \code{FALSE}. Should the variable names
 #'   not be wrapped in the \code{\\text{}} command?
 #' @param wrap Logical, defaults to \code{FALSE}. Should the terms on the
@@ -79,9 +82,9 @@
 #' mod5 <- glm(out ~ ., data = d, family = binomial(link = "logit"))
 #' extract_eq(mod5, wrap = TRUE)
 
-extract_eq <- function(model, ital_vars = FALSE,
-                       wrap = FALSE, terms_per_line = 4, operator_location = "end",
-                       align_env = "aligned",
+extract_eq <- function(model, intercept = "alpha", ital_vars = FALSE,
+                       wrap = FALSE, terms_per_line = 4,
+                       operator_location = "end", align_env = "aligned",
                        use_coefs = FALSE, coef_digits = 2, fix_signs = TRUE) {
 
   lhs <- extract_lhs(model, ital_vars)
@@ -93,8 +96,9 @@ extract_eq <- function(model, ital_vars = FALSE,
                       use_coefs,
                       coef_digits,
                       fix_signs,
-                      model)
-
+                      model,
+                      intercept)
+
   if (wrap) {
     if (operator_location == "start") {
       line_end <- "\\\\\n&\\quad + "
@@ -123,11 +127,11 @@ extract_eq <- function(model, ital_vars = FALSE,
                          .rhs,
                          sep = " &= "),
                    "\n\\end{", align_env, "}")
-          }, 
-          .lhs = eq_raw$lhs, 
+          },
+          .lhs = eq_raw$lhs,
           .rhs = rhs_combined)
-              
-              
+
+
   } else {
     eq <- Map(function(.lhs, .rhs) {
             paste(.lhs,
@@ -141,7 +145,7 @@ extract_eq <- function(model, ital_vars = FALSE,
   if (use_coefs && fix_signs) {
     eq <- lapply(eq, fix_coef_signs)
   }
-  
+
   if(length(eq) > 1) {
     eq <- paste(eq, collapse = "\\\\")
   } else {

R/extract_rhs.R

@@ -49,7 +49,7 @@
 #' #>  ..$ : Named chr  "virginica:Petal.Length" "Speciesvirginica:"
 #' #>  .. ..- attr(*, "names")= chr  "Species" "Petal.Length"
 #' }
-#' 
+#'
 
 extract_rhs <- function(model) {
   # Extract RHS from formula

R/utils.R

@@ -1,42 +1,34 @@
 #' Strict versions of \code{base::\link[base]{mapply}}
-#' 
+#'
 #' Return a vector of the corresponding type
-#' 
+#'
 #' @keywords internal
-#' 
+#'
 #' @param \dots arguments passed to \code{base::\link[base]{mapply}}
-#' 
-#' @return A vector of the corresponding type, \code{chr} = character, 
+#'
+#' @return A vector of the corresponding type, \code{chr} = character,
 #'   \code{dbl} = double, \code{lgl} = logical, and \code{int} = logical
-#' 
-
-#' @describeIn mapply_chr Return a character vector
+#'
 mapply_chr <- function(...) {
 	out <- mapply(...)
 	stopifnot(is.character(out))
 	out
 }
 
-#' @inheritParams mapply_chr
-#' @describeIn mapply_chr Return a logical vector
 mapply_lgl <- function(...) {
 	out <- mapply(...)
 	stopifnot(is.logical(out))
 	out
 }
 
-#' @inheritParams mapply_chr
-#' @describeIn mapply_chr Return an integer vector
 mapply_int <- function(...) {
 	out <- mapply(...)
 	stopifnot(is.integer(out))
 	out
 }
 
-#' @inheritParams mapply_chr
-#' @describeIn mapply_chr Return a double vector
 mapply_dbl <- function(...) {
 	out <- mapply(...)
 	stopifnot(is.double(out))
 	out
-}
+}