testthat::context("[OLS] light_table produces the expected table")
# SINGLE OLS MODEL (RCPPEIGEN) ----------------------------
ols <- RcppArmadillo::fastLm(
Sepal.Length ~ Sepal.Width,
=
)
latex_table <- ::(ols,
= "My table title",
label = "My table label",
dep.var.labels = "My depvar",
column.labels = "My label column",
stats.list = ("n","ll","lln","bic"))
html_table <- ::(ols,
= "html",
= "My table title",
dep.var.labels = "My depvar",
column.labels = "My label column",
stats.list = ("n","ll","lln","bic"))
# HEADER =========================
testthat::test_that("Table header is correct [latex]",{
testthat::expect_true((prefix = "\\begin{table}[!htbp]", latex_table[1])
)
testthat::expect_true((("\\\\caption{My table title}", perl = ,
x = latex_table))>0)
testthat::expect_true((("\\\\label{My table label}", perl = ,
x = latex_table))>0)
testthat::expect_true((("My depvar", perl = ,
x = latex_table))>0)
testthat::expect_true((("& My label column", perl = ,
x = latex_table))>0)
}
)
testthat::test_that("Table header is correct [html]",{
testthat::expect_true((prefix = "<table style=\"text-align:center\"><tr>", html_table[1])
)
testthat::expect_true((("<td colspan=\"%s\"style=\"border-bottom: 1px solid black\"></td>",2L),
html_table[1]))
testthat::expect_true((("<caption>%s</caption>","My table title"),
html_table[1]))
}
)
testthat::test_that("Label is ignored in HTML tables",{
testthat::expect_equal(
::(ols,
= "html",
= "My table title",
label = "My table label",
dep.var.labels = "My depvar",
column.labels = "My label column"),
::(ols,
= "html",
= "My table title",
label = "Label ignored",
dep.var.labels = "My depvar",
column.labels = "My label column")
)
}
)
# BODY ===================================
testthat::test_that("Body (coefficients) correct [latex]",{
rows_coeff <- latex_table
(
((("(Intercept)", "Sepal.Width"), collapse = "|"), latex_table)
)
]
rows_sd <- latex_table
(
((("(Intercept)", "Sepal.Width"), collapse = "|"), latex_table)
)+1
]
# Coefficient names are ok [intercept]
testthat::expect_equal(
(
(
(stringr::str_split(rows_coeff[1], "&"))
)[1]
),
"(Intercept)"
)
# Coefficient names are ok [x covariate]
testthat::expect_equal(
(
(
(stringr::str_split(rows_coeff[2], "&"))
)[1]
),
"Sepal.Width"
)
<- (ols)$,"p.value"]
# Coefficient s.e. are ok [intercept]
testthat::expect_equal(
(
(
(stringr::str_split(rows_coeff[1], "&"))
)[2]),
(
(ols$'(Intercept)'],digits = 3L, nsmall = 3L),
:::('(Intercept)']),
"\\\\")
)
# Coefficient names are ok [x covariates]
testthat::expect_equal(
(
(
(stringr::str_split(rows_coeff[2], "&"))
)[2]),
(x = (
(ols$'Sepal.Width'],digits = 3L, nsmall = 3L),
:::('Sepal.Width']),
"\\\\"), = "-", replacement = "$-$"
)
)
})
testthat::test_that("Body (coefficients) correct [html]",{
coeff_part <- html_table
((("(Intercept)", "Sepal.Width"), collapse = "|"), html_table)
]
coeff_part <- ((
stringr::str_split(coeff_part, = "</td>", simplify = )
), "</td>")
rows_coeff <- coeff_part
(((("(Intercept)", "Sepal.Width"), collapse = "|"), coeff_part),
((("(Intercept)", "Sepal.Width"), collapse = "|"), coeff_part) + 1)
]
rows_sd <- coeff_part
((("(Intercept)", "Sepal.Width"), collapse = "|"), coeff_part) + 3
]
# Coefficient names are ok [intercept]
testthat::expect_equal(
("(Intercept)", rows_coeff),
1L
)
# Coefficient names are ok [x covariate]
testthat::expect_equal(
("Sepal.Width", rows_coeff),
2L
)
<- (ols)$,"StdErr"]
pvalues <- (ols)$,"p.value"]
# Coefficients are ok
testthat::expect_equal(
rows_coeff[grep("Sepal.Width", rows_coeff)+2],
(
"<td>",
(ols$'Sepal.Width'],digits = 3L, nsmall = 3L),
:::(pvalues'Sepal.Width'], = "html"),
"</td>")
)
testthat::expect_equal(
rows_coeff[grep("(Intercept)", rows_coeff)+2],
(
"<td>",
(ols$'(Intercept)'],digits = 3L, nsmall = 3L),
:::(pvalues'(Intercept)'], = "html"),
"</td>")
)
# standard errors are ok
testthat::expect_equal(
("<td>(", (, digits = 3L, nsmall = 3L), ")</td>"),
rows_sd
)
})
## 1.2. SEVERAL MODELS (RCPPEIGEN) =================
ols <- RcppArmadillo::fastLm(
Sepal.Length ~ Sepal.Width,
=
)
latex_table <- ::((ols, ols, ols),
= "My table title",
label = "My table label",
dep.var.labels = ("My depvar1", "My depvar2"),
dep.var.separate = (2,1),
column.labels = ("Label1","Label2"),
stats.list = ("n","ll","lln","bic"))
html_table <- ::((ols, ols, ols),
= "html",
= "My table title",
dep.var.labels = ("My depvar1", "My depvar2","toomanyvar"),
dep.var.separate = (2,1),
column.labels = ("Label1","Label2"),
stats.list = ("n","ll","lln","bic"))
# HEADER
testthat::test_that("[latex] Number of columns: number of models + 1", {
tabular_row = stringr::str_split( = "\n",
latex_table[grepl("\\\\begin{tabular}", latex_table, perl = )], simplify = )[1,1]
testthat::expect_equal(tabular_row, ("\\begin{tabular}{@{\\extracolsep{5pt}}l%s}",
(("c",3L), collapse = "")))
})
testthat::test_that("[html] Number of columns: number of models + 1", {
testthat::expect_true(
(("<td colspan=\"%s\"style=\"border-bottom: 1px solid black\"></td></tr>", 3L + 1L),
html_table[1]
)
)
})
testthat::test_that("[html] Number of columns: number of models + 1", {
dep_var_row <- html_table[grepl("<td></td><td colspan=\"2\">My depvar1</td><td colspan=\"1\">My depvar2</td>",
html_table)]
dep_var_row <- ((
stringr::str_split(dep_var_row, "</td>", simplify = )
), "</td>")
# 1 - First model supposed to be on two columns
testthat::expect_equal(
(("<td colspan=\"2\">My depvar1</td>", dep_var_row)),
1L
)
# 2 - Second model supposed to be on two columns
testthat::expect_equal(
(("<td colspan=\"1\">My depvar2</td>", dep_var_row)),
1L
)
# 3 - Last dep.var name does not appear (because of col.var.separate)
testthat::expect_equal((("toomanyvar", dep_var_row)), 0L)
# 4 - Column names Label1, Label2 and empty field (no column label!)
testthat::expect_equal((("<td>Label1</td>", dep_var_row)), 1L)
testthat::expect_equal((("<td>Label2</td>", dep_var_row)), 1L)
testthat::expect_true(('</tr>',
dep_var_row[grep("<td>Label2</td>", dep_var_row)+1])
)
})
# OGLMX ---------
("oglmx", quietly = )
# iris$y_r <- as.numeric(iris$Species)
#
# oglm <- oglmx::oglmx(
# y_r ~ Sepal.Length ,
# data = iris
# )
#
# PART 2: TEST OPTIONS -------------------
# covariate.labels =================
ols <- (
Sepal.Length ~ Sepal.Width + Petal.Length,
=
)
latex_table1 <- ::(ols,
= "My table title",
label = "My table label",
dep.var.labels = "My depvar",
column.labels = "My label column")
latex_table2 <- ::(ols,
= "My table title",
label = "My table label",
dep.var.labels = "My depvar",
column.labels = "My label column",
covariate.labels = ("Sepal Width", "Length Petal"))
testthat::test_that("Same table except for the covariate names", {
latex_table1b <- ( = "Sepal.Width", replacement = "Sepal Width", latex_table1)
latex_table1b <- ( = "Petal.Length", replacement = "Length Petal", latex_table1b)
testthat::expect_equal((latex_table1b),(latex_table2))
})
html_table1 <- ::(ols,
= "html",
= "My table title",
label = "My table label",
dep.var.labels = "My depvar",
column.labels = "My label column")
html_table2 <- ::(ols,
= "html",
= "My table title",
label = "My table label",
dep.var.labels = "My depvar",
column.labels = "My label column",
covariate.labels = ("Sepal Width", "Length Petal"))
testthat::test_that("Same table except for the covariate names", {
html_table1b <- ( = "Sepal.Width", replacement = "Sepal Width", html_table1)
html_table1b <- ( = "Petal.Length", replacement = "Length Petal", html_table1b)
testthat::expect_equal((html_table1b),(html_table2))
})
# adjustbox ==================
latex_table <- ::(ols,
= "My table title",
label = "My table label",
dep.var.labels = "My depvar",
column.labels = "My label column",
adjustbox_width = 1.1)
testthat::test_that("Table header and foot are correct",{
testthat::expect_true((prefix = "\\begin{table}[!htbp]", latex_table[1])
)
testthat::expect_true((("\\\\caption{My table title}", perl = ,
x = latex_table))>0)
testthat::expect_true((("\\\\begin{adjustbox}{width=1.1\\\\linewidth, center}", perl = ,
x = latex_table))>0)
testthat::expect_true((("\\\\label{My table label}", perl = ,
x = latex_table))>0)
testthat::expect_true((("My depvar", perl = ,
x = latex_table))>0)
testthat::expect_true((("& My label column", perl = ,
x = latex_table))>0)
testthat::expect_true((("\\\\end{adjustbox} ", perl = ,
x = latex_table))>0)
}
)
# R2 and Adjusted R2 ====================
ols <- (
Sepal.Length ~ Sepal.Width + Petal.Length,
=
)
# 2. light objects
latex_table <- ::(::(ols),
= "My table title",
label = "My table label",
dep.var.labels = "My depvar",
column.labels = "My label column",
stats.list = ("rsq","adj.rsq"))
html_table <- ::(::(ols),
= "html",
= "My table title",
label = "My table label",
dep.var.labels = "My depvar",
column.labels = "My label column",
stats.list = ("rsq","adj.rsq"))
testthat::test_that("R2 correctly reported", {
testthat::expect_equal(
latex_table[grepl("^\\$R\\^2\\$", latex_table, perl = )],
(
"$R^2$ & %s \\\\", ((ols)$r.squared, digits = 3L, nsmall = 3L)
)
)
}
)
testthat::test_that("Adjusted R2 correctly reported", {
testthat::expect_equal(
latex_table[grepl("Adjusted \\$R\\^2\\$", latex_table, perl = )],
(
"Adjusted $R^2$ & %s \\\\", ((ols)$adj.r.squared, digits = 3L, nsmall = 3L)
)
)
})
testthat::test_that("R2 correctly reported", {
testthat::expect_equal(
html_table[grepl(">R<sup>2</sup>", html_table)],
("<tr><td style=\"text-align:left\">R<sup>2</sup></td><td>%s</td></tr>",
((ols)$r.squared, digits = 3L, nsmall = 3L))
)
}
)
testthat::test_that("R2 correctly reported", {
testthat::expect_equal(
html_table[grepl("Adjusted R<sup>2</sup>", html_table)],
("<tr><td style=\"text-align:left\">Adjusted R<sup>2</sup></td><td>%s</td></tr>",
((ols)$adj.r.squared, digits = 3L, nsmall = 3L))
)
}
)
