Skip to content

Commit

Permalink
Put multiple equations in aligned environment (fixes datalorax#67)
Browse files Browse the repository at this point in the history
  • Loading branch information
@andrewheiss
andrewheiss committed Jul 31, 2020
1 parent 5f32ffe commit 8eb90c9
Show file tree
Hide file tree
Showing 3 changed files with 43 additions and 32 deletions.
39 changes: 19 additions & 20 deletions R/extract_eq.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -130,28 +130,27 @@ extract_eq <- function(model, intercept = "alpha", greek = "beta",
rhs_combined <- lapply(rhs_groups_collapsed, function(x) {
paste(x, collapse = line_end)
})
} else {
rhs_combined <- lapply(eq_raw$rhs, function(x) {
paste(x, collapse = " + ")
})
}

# Combine RHS and LHS using anchors (&=)
# This is a list of equations, typically of length 1 unless there are
# multiple equations like ordered logistic regression from polr() and clm()
eq <- Map(function(.lhs, .rhs) {
paste(.lhs,
paste(.rhs, collapse = " + "),
sep = " &= ")
},
.lhs = eq_raw$lhs,
.rhs = wrap_rhs(model, rhs_combined))

# If wrapping is enabled or if there are multiple equations, use anchored &=,
# otherwise use just regular =
if (wrap | length(rhs_combined) > 1) {
equal_sign <- " &= "
} else {
eq <- Map(function(.lhs, .rhs) {
paste(.lhs,
wrap_rhs(model, paste(.rhs, collapse = " + ")),
sep = " = ")
},
.lhs = eq_raw$lhs,
.rhs = eq_raw$rhs)
equal_sign <- " = "
}

# Combine RHS and LHS
eq <- Map(function(.lhs, .rhs) {
paste(.lhs, .rhs, sep = equal_sign)
},
.lhs = eq_raw$lhs,
.rhs = wrap_rhs(model, rhs_combined))

if (use_coefs && fix_signs) {
eq <- lapply(eq, fix_coef_signs)
}
Expand All @@ -162,9 +161,9 @@ extract_eq <- function(model, intercept = "alpha", greek = "beta",
eq <- eq[[1]]
}

# Add environment finally, if wrapping
# Add environment finally, if wrapping or if there are multiple equations
# This comes later so that multiple equations don't get their own environments
if (wrap) {
if (wrap | length(rhs_combined) > 1) {
eq <- paste0("\\begin{", align_env, "}\n",
eq,
"\n\\end{", align_env, "}")
Expand Down
18 changes: 12 additions & 6 deletions tests/testthat/test-clm.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,16 +19,20 @@ test_that("Ordered models with clm work", {
tex_nowrap_probit <- extract_eq(model_probit, wrap = FALSE)
tex_wrap_probit <- extract_eq(model_probit, wrap = TRUE)

actual_nowrap_logit <- "\\log\\left[ \\frac { P( \\operatorname{A} \\geq \\operatorname{B} ) }{ 1 - P( \\operatorname{A} \\geq \\operatorname{B} ) } \\right] = \\alpha_{1} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon \\\\
\\log\\left[ \\frac { P( \\operatorname{B} \\geq \\operatorname{C} ) }{ 1 - P( \\operatorname{B} \\geq \\operatorname{C} ) } \\right] = \\alpha_{2} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon"
actual_nowrap_logit <- "\\begin{aligned}
\\log\\left[ \\frac { P( \\operatorname{A} \\geq \\operatorname{B} ) }{ 1 - P( \\operatorname{A} \\geq \\operatorname{B} ) } \\right] &= \\alpha_{1} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon \\\\
\\log\\left[ \\frac { P( \\operatorname{B} \\geq \\operatorname{C} ) }{ 1 - P( \\operatorname{B} \\geq \\operatorname{C} ) } \\right] &= \\alpha_{2} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon
\\end{aligned}"

actual_wrap_logit <- "\\begin{aligned}
\\log\\left[ \\frac { P( \\operatorname{A} \\geq \\operatorname{B} ) }{ 1 - P( \\operatorname{A} \\geq \\operatorname{B} ) } \\right] &= \\alpha_{1} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon \\\\
\\log\\left[ \\frac { P( \\operatorname{B} \\geq \\operatorname{C} ) }{ 1 - P( \\operatorname{B} \\geq \\operatorname{C} ) } \\right] &= \\alpha_{2} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon
\\end{aligned}"

actual_nowrap_probit <- "P(\\operatorname{A} \\geq \\operatorname{B}) = \\Phi[\\alpha_{1} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon] \\\\
P(\\operatorname{B} \\geq \\operatorname{C}) = \\Phi[\\alpha_{2} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon]"
actual_nowrap_probit <- "\\begin{aligned}
P(\\operatorname{A} \\geq \\operatorname{B}) &= \\Phi[\\alpha_{1} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon] \\\\
P(\\operatorname{B} \\geq \\operatorname{C}) &= \\Phi[\\alpha_{2} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon]
\\end{aligned}"

actual_wrap_probit <- "\\begin{aligned}
P(\\operatorname{A} \\geq \\operatorname{B}) &= \\Phi[\\alpha_{1} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon] \\\\
Expand All @@ -49,8 +53,10 @@ P(\\operatorname{B} \\geq \\operatorname{C}) &= \\Phi[\\alpha_{2} + \\beta_{1}(\

# Coefficients instead of letters
tex <- extract_eq(model_logit, use_coefs = TRUE)
actual <- "\\log\\left[ \\frac { P( \\operatorname{A} \\geq \\operatorname{B} ) }{ 1 - P( \\operatorname{A} \\geq \\operatorname{B} ) } \\right] = -0.81 + 0.03(\\operatorname{continuous\\_1}) - 0.03(\\operatorname{continuous\\_2}) + \\epsilon \\\\
\\log\\left[ \\frac { P( \\operatorname{B} \\geq \\operatorname{C} ) }{ 1 - P( \\operatorname{B} \\geq \\operatorname{C} ) } \\right] = 0.59 + 0.03(\\operatorname{continuous\\_1}) - 0.03(\\operatorname{continuous\\_2}) + \\epsilon"
actual <- "\\begin{aligned}
\\log\\left[ \\frac { P( \\operatorname{A} \\geq \\operatorname{B} ) }{ 1 - P( \\operatorname{A} \\geq \\operatorname{B} ) } \\right] &= -0.81 + 0.03(\\operatorname{continuous\\_1}) - 0.03(\\operatorname{continuous\\_2}) + \\epsilon \\\\
\\log\\left[ \\frac { P( \\operatorname{B} \\geq \\operatorname{C} ) }{ 1 - P( \\operatorname{B} \\geq \\operatorname{C} ) } \\right] &= 0.59 + 0.03(\\operatorname{continuous\\_1}) - 0.03(\\operatorname{continuous\\_2}) + \\epsilon
\\end{aligned}"
expect_equal(tex, equation_class(actual),
label = "ordered logit + coefs builds correctly")
})
Expand Down
18 changes: 12 additions & 6 deletions tests/testthat/test-polr.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,16 +17,20 @@ test_that("Ordered logistic regression works", {
tex_nowrap_probit <- extract_eq(model_polr_probit, wrap = FALSE)
tex_wrap_probit <- extract_eq(model_polr_probit, wrap = TRUE)

actual_nowrap <- "\\log\\left[ \\frac { P( \\operatorname{A} \\geq \\operatorname{B} ) }{ 1 - P( \\operatorname{A} \\geq \\operatorname{B} ) } \\right] = \\alpha_{1} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon \\\\
\\log\\left[ \\frac { P( \\operatorname{B} \\geq \\operatorname{C} ) }{ 1 - P( \\operatorname{B} \\geq \\operatorname{C} ) } \\right] = \\alpha_{2} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon"
actual_nowrap <- "\\begin{aligned}
\\log\\left[ \\frac { P( \\operatorname{A} \\geq \\operatorname{B} ) }{ 1 - P( \\operatorname{A} \\geq \\operatorname{B} ) } \\right] &= \\alpha_{1} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon \\\\
\\log\\left[ \\frac { P( \\operatorname{B} \\geq \\operatorname{C} ) }{ 1 - P( \\operatorname{B} \\geq \\operatorname{C} ) } \\right] &= \\alpha_{2} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon
\\end{aligned}"

actual_wrap <- "\\begin{aligned}
\\log\\left[ \\frac { P( \\operatorname{A} \\geq \\operatorname{B} ) }{ 1 - P( \\operatorname{A} \\geq \\operatorname{B} ) } \\right] &= \\alpha_{1} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon \\\\
\\log\\left[ \\frac { P( \\operatorname{B} \\geq \\operatorname{C} ) }{ 1 - P( \\operatorname{B} \\geq \\operatorname{C} ) } \\right] &= \\alpha_{2} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon
\\end{aligned}"

actual_nowrap_probit <- "P(\\operatorname{A} \\geq \\operatorname{B}) = \\Phi[\\alpha_{1} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon] \\\\
P(\\operatorname{B} \\geq \\operatorname{C}) = \\Phi[\\alpha_{2} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon]"
actual_nowrap_probit <- "\\begin{aligned}
P(\\operatorname{A} \\geq \\operatorname{B}) &= \\Phi[\\alpha_{1} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon] \\\\
P(\\operatorname{B} \\geq \\operatorname{C}) &= \\Phi[\\alpha_{2} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon]
\\end{aligned}"

actual_wrap_probit <- "\\begin{aligned}
P(\\operatorname{A} \\geq \\operatorname{B}) &= \\Phi[\\alpha_{1} + \\beta_{1}(\\operatorname{continuous\\_1}) + \\beta_{2}(\\operatorname{continuous\\_2}) + \\epsilon] \\\\
Expand All @@ -47,8 +51,10 @@ P(\\operatorname{B} \\geq \\operatorname{C}) &= \\Phi[\\alpha_{2} + \\beta_{1}(\

# Coefficients instead of letters
tex <- extract_eq(model_polr, use_coefs = TRUE)
actual <- "\\log\\left[ \\frac { P( \\operatorname{A} \\geq \\operatorname{B} ) }{ 1 - P( \\operatorname{A} \\geq \\operatorname{B} ) } \\right] = 1.09 + 0.03(\\operatorname{continuous\\_1}) - 0.03(\\operatorname{continuous\\_2}) + \\epsilon \\\\
\\log\\left[ \\frac { P( \\operatorname{B} \\geq \\operatorname{C} ) }{ 1 - P( \\operatorname{B} \\geq \\operatorname{C} ) } \\right] = 2.48 + 0.03(\\operatorname{continuous\\_1}) - 0.03(\\operatorname{continuous\\_2}) + \\epsilon"
actual <- "\\begin{aligned}
\\log\\left[ \\frac { P( \\operatorname{A} \\geq \\operatorname{B} ) }{ 1 - P( \\operatorname{A} \\geq \\operatorname{B} ) } \\right] &= 1.09 + 0.03(\\operatorname{continuous\\_1}) - 0.03(\\operatorname{continuous\\_2}) + \\epsilon \\\\
\\log\\left[ \\frac { P( \\operatorname{B} \\geq \\operatorname{C} ) }{ 1 - P( \\operatorname{B} \\geq \\operatorname{C} ) } \\right] &= 2.48 + 0.03(\\operatorname{continuous\\_1}) - 0.03(\\operatorname{continuous\\_2}) + \\epsilon
\\end{aligned}"
expect_equal(tex, equation_class(actual),
label = "ordered logit + coefs builds correctly")
})

0 comments on commit 8eb90c9

Please sign in to comment.