tests/testthat/test-apply_frmt.R
In GSK-Biostatistics/tlang: Applies Display Metadata to Analysis Results Datasets
test_that("applying frmt", {
sample_df <- data.frame(
x = c(1234.5678, 345.6789, 56.7891, 4567.8910, 8.9101)
)
sample_frmt_no_dec <- frmt("xxx")
sample_frmt_single_dec <- frmt("xxx.x")
sample_frmt_double_dec <- frmt("xxx.xx")
sample_df_no_dec_frmted <- apply_frmt.frmt(
frmt_def = sample_frmt_no_dec,
.data = sample_df,
value = quo(x)
)
sample_df_single_dec_frmted <- apply_frmt.frmt(
frmt_def = sample_frmt_single_dec,
.data = sample_df,
value = quo(x)
)
sample_df_double_dec_frmted <- apply_frmt.frmt(
frmt_def = sample_frmt_double_dec,
.data = sample_df,
value = quo(x)
)
expect_equal(
sample_df_no_dec_frmted$x,
c("1235", "346", " 57", "4568", " 9")
)
expect_equal(
sample_df_single_dec_frmted$x,
c("1234.6", "345.7", " 56.8", "4567.9", " 8.9")
)
expect_equal(
sample_df_double_dec_frmted$x,
c("1234.57", "345.68", " 56.79", "4567.89", " 8.91")
)
})
test_that("applying frmt - scientific", {
sample_df <- data.frame(
x = c(1234.5678, 345.6789, 56.7891, 4567.8910, 8.9101, 0.0678)
)
sample_frmt_10x <- frmt(expression = "xxx.x", scientific = " x10^x")
sample_frmt_10xx <- frmt(expression = "xxx.x", scientific = " x10^xx")
sample_frmt_ex <- frmt(expression = "xxx.x", scientific = "e^x")
sample_frmt_exxxx <- frmt(expression = "xxx.x", scientific = "e^xxxx")
sample_df_frmted_10x <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_10x
)
sample_df_frmted_10xx <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_10xx
)
sample_df_frmted_ex <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_ex
)
sample_df_frmted_exxxx <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_exxxx
)
expect_equal(
sample_df_frmted_10x$x,
c(" 1.2 x10^3",
" 3.5 x10^2",
" 5.7 x10^1",
" 4.6 x10^3",
" 8.9 x10^0",
" 6.8 x10^-2")
)
expect_equal(
sample_df_frmted_10xx$x,
c(" 1.2 x10^ 3",
" 3.5 x10^ 2",
" 5.7 x10^ 1",
" 4.6 x10^ 3",
" 8.9 x10^ 0",
" 6.8 x10^-2")
)
expect_equal(
sample_df_frmted_ex$x,
c(" 1.2e^3",
" 3.5e^2",
" 5.7e^1",
" 4.6e^3",
" 8.9e^0",
" 6.8e^-2")
)
expect_equal(
sample_df_frmted_exxxx$x,
c(" 1.2e^ 3",
" 3.5e^ 2",
" 5.7e^ 1",
" 4.6e^ 3",
" 8.9e^ 0",
" 6.8e^ -2")
)
})
test_that("applying frmt - transform", {
sample_df <- data.frame(
x = c(1234.5678, 345.6789, 56.7891, 4567.8910, 8.9101)
)
formula_transform <- frmt("xxx", transform = ~.*100)
fx_transform <- frmt("xxx.x", transform = function(x){x^2})
formula_result<- apply_frmt.frmt(
frmt_def = formula_transform,
.data = sample_df,
value = quo(x)
) %>%
pull(x)
expect_equal(formula_result,
c("123457", "34568", "5679" , "456789", "891"))
fx_result <- apply_frmt.frmt(
frmt_def = fx_transform,
.data = sample_df,
value = quo(x)
) %>%
pull(x)
expect_equal(fx_result,
c("1524157.7", "119493.9", "3225.0", "20865628.2", " 79.4" ))
})
test_that("applying frmt - preserves decimal places after rounding", {
sample_df <- data.frame(
x = c(10, 12.3647, 3, 100, 167.299)
)
sample_frmt_1dec <- frmt(expression = "xxx.x")
sample_frmt_2dec <- frmt(expression = "xxx.xx")
sample_frmt_10x <- frmt(expression = "xxx.x", scientific = " x10^x")
sample_df_frmted_1dec <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_1dec
)
sample_df_frmted_2dec <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_2dec
)
sample_df_frmted_10x <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_10x
)
expect_equal(
sample_df_frmted_1dec$x,
c(" 10.0",
" 12.4",
" 3.0",
"100.0",
"167.3")
)
expect_equal(
sample_df_frmted_2dec$x,
c(" 10.00",
" 12.36",
" 3.00",
"100.00",
"167.30")
)
expect_equal(
sample_df_frmted_10x$x,
c(" 1.0 x10^1",
" 1.2 x10^1",
" 3.0 x10^0",
" 1.0 x10^2",
" 1.7 x10^2")
)
})
test_that("applying frmt_combine - 2x", {
sample_df <- tibble(
group = "group",
lab = rep(paste("lab",1:5),2),
col = "col",
y = rep(c("A","B"),each = 5),
x = c(1234.5678, 2345.6789, 3456.7891, 4567.8910, 5678.9101,
1.2345678, 2.3456789, 3.4567891, 4.5678910, 5.6789101)
)
sample_frmt <- frmt_combine(
"{A} {B}",
A = frmt("xxx.x"),
B = frmt("(X.X%)")
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group)
)
expect_equal(
sample_df_frmted,
tibble(
group = "group",
lab = paste("lab",1:5),
col = "col",
y = "A",
x = c("1234.6 (1.2%)", "2345.7 (2.3%)", "3456.8 (3.5%)", "4567.9 (4.6%)", "5678.9 (5.7%)")
)
)
})
test_that("applying frmt_combine missing",{
#Both missing
sample_df <- tibble(
group = "group",
lab = rep(paste("lab",1:5),2),
col = "col",
y = rep(c("A","B"),each = 5),
x = c(1234.5678, 2345.6789, 3456.7891, 4567.8910, NA,
1.2345678, 2.3456789, 3.4567891, 4.5678910, NA)
)
sample_frmt <- frmt_combine(
"{A} {B}",
A = frmt("xxx.x"),
B = frmt("(X.X%)"),
missing = "Missing"
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group)
)
expect_equal(
sample_df_frmted,
tibble(
group = "group",
lab = paste("lab",1:5),
col = "col",
y = "A",
x = c("1234.6 (1.2%)", "2345.7 (2.3%)", "3456.8 (3.5%)", "4567.9 (4.6%)", "Missing")
)
)
#One Missing
sample_df <- tibble(
group = "group",
lab = rep(paste("lab",1:5),2),
col = "col",
y = rep(c("A","B"),each = 5),
x = c(1234.5678, 2345.6789, 3456.7891, 4567.8910, NA,
1.2345678, 2.3456789, 3.4567891, 4.5678910, 5.6789101)
)
sample_frmt <- frmt_combine(
"{A} {B}",
A = frmt("xxx.x"),
B = frmt("(X.X%)"),
missing = "Missing"
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group)
)
expect_equal(
sample_df_frmted,
tibble(
group = "group",
lab = paste("lab",1:5),
col = "col",
y = "A",
x = c("1234.6 (1.2%)", "2345.7 (2.3%)", "3456.8 (3.5%)", "4567.9 (4.6%)", "NA (5.7%)")
)
)
})
test_that("applying frmt_combine - 3x", {
sample_df <- tibble(
group = "group",
lab = rep(paste("lab",1:5),3),
col = "col",
y = rep(c("A","B","C"),each = 5),
x = c(1234.5678, 2345.6789, 3456.7891, 4567.8910, 5678.9101,
1.2345678, 2.3456789, 3.4567891, 4.5678910, 5.6789101,
10,111,1112,13,114)
)
sample_frmt <- frmt_combine(
"{A} {B} - {C}",
A = frmt("xxx.x"),
B = frmt("(X.X%)"),
C = frmt("*XXXX.X")
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group)
)
expect_equal(
sample_df_frmted,
tibble(
group = "group",
lab = paste("lab",1:5),
col = "col",
y = "A",
x = c("1234.6 (1.2%) - * 10.0", "2345.7 (2.3%) - * 111.0", "3456.8 (3.5%) - *1112.0", "4567.9 (4.6%) - * 13.0", "5678.9 (5.7%) - * 114.0")
)
)
})
test_that("applying frmt_combine - no unique labels, so unable to frmt_combine", {
sample_df <- tibble(
group = "group",
lab = paste("lab",1:15),
col = "col",
y = rep(c("A","B","C"),each = 5),
x = c(1234.5678, 2345.6789, 3456.7891, 4567.8910, 5678.9101,
1.2345678, 2.3456789, 3.4567891, 4.5678910, 5.6789101,
10,111,1112,13,114)
)
sample_frmt <- frmt_combine(
"{A} {B} - {C}",
A = frmt("xxx.x"),
B = frmt("(X.X%)"),
C = frmt("*XXXX.X")
)
expect_warning(
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group)
),
"Unable to apply `frmt_combine` due to uniqueness of column/row identifiers. Params that are to be combined need to have matching values across: "
)
expect_equal(
sample_df_frmted,
tibble(
group = "group",
lab = c("lab 1", "lab 10",
"lab 11", "lab 12", "lab 13", "lab 14", "lab 15", "lab 2", "lab 3",
"lab 4", "lab 5", "lab 6", "lab 7", "lab 8", "lab 9"),
col = "col",
y = c("A", "B", "C", "C",
"C", "C", "C", "A", "A", "A", "A", "B", "B", "B", "B"),
x = c("1234.6 NA - NA", "NA (5.7%) - NA", "NA NA - * 10.0", "NA NA - * 111.0",
"NA NA - *1112.0", "NA NA - * 13.0", "NA NA - * 114.0", "2345.7 NA - NA",
"3456.8 NA - NA", "4567.9 NA - NA", "5678.9 NA - NA", "NA (1.2%) - NA",
"NA (2.3%) - NA", "NA (3.5%) - NA", "NA (4.6%) - NA")
)
)
})
test_that("applying frmt_when", {
#Test frmt_when alone
sample_df <- tibble(
group = "group",
lab = rep(paste("lab",1:5), 2),
col = "col",
y = rep(c("A","B"),each = 5),
x = c(1234.5678, 2345.6789, 3456.7891, 4567.8910, 5678.9101,
1.2345678, 2.3456789, 3.4567891, 4.5678910, 5.6789101)
)
sample_frmt <- frmt_when(
">1000" ~ frmt("XXX.X"),
"TRUE" ~ "Undectable"
)
sample_df_frmted <- apply_frmt(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = "y",
column = vars(col),
label = quo(lab),
group = vars(group)
)
man_df <- tibble::tribble(
~group, ~lab, ~col, ~y, ~x,
"group", "lab 1", "col", "A", "1234.6",
"group", "lab 2", "col", "A", "2345.7",
"group", "lab 3", "col", "A", "3456.8",
"group", "lab 4", "col", "A", "4567.9",
"group", "lab 5", "col", "A", "5678.9",
"group", "lab 1", "col", "B", "Undectable",
"group", "lab 2", "col", "B", "Undectable",
"group", "lab 3", "col", "B", "Undectable",
"group", "lab 4", "col", "B", "Undectable",
"group", "lab 5", "col", "B", "Undectable",
)
expect_equal(sample_df_frmted, man_df)
#Test in combination
sample_frmt_combo <- frmt_combine(
"{A} {B}",
A = frmt("xxx.x"),
B = frmt_when(">3" ~ frmt("(X.X%)"),
"<=3" ~ frmt("Undetectable")
)
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt_combo,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group)
)
man_df_combo <- tibble::tribble(
~group, ~lab, ~col, ~y, ~x,
"group", "lab 1", "col", "A", "1234.6 Undetectable",
"group", "lab 2", "col", "A", "2345.7 Undetectable",
"group", "lab 3", "col", "A", "3456.8 (3.5%)",
"group", "lab 4", "col", "A", "4567.9 (4.6%)",
"group", "lab 5", "col", "A", "5678.9 (5.7%)",
)
expect_equal(sample_df_frmted, man_df_combo)
})
test_that("mocks return correctly", {
#frmt
frmt_mock <- apply_frmt.frmt(
frmt_def = frmt("xxx.x"),
.data = iris,
value = quo(mock),
mock = TRUE
)%>%
pull(mock)
expect_equal(frmt_mock, rep("xxx.x", nrow(iris)))
# frmt_when
frmt_when_true <- apply_frmt.frmt_when(frmt_when("==100"~ frmt(""),
"==0"~ "",
"TRUE" ~ frmt("(XXX.X%)")),
.data = iris, sym("value"),mock = TRUE) %>%
pull(value)
expect_equal(frmt_when_true, rep("(XXX.X%)", nrow(iris)))
frmt_when_no_true <-apply_frmt.frmt_when(frmt_when("==100"~ frmt("Hello"),
"==0"~ ""),
.data = iris, sym("value"),mock = TRUE) %>%
pull(value)
expect_equal(frmt_when_no_true, rep("Hello", nrow(iris)))
#frmt_combine
sample_df <- tibble(
group = "group",
lab = rep(paste("lab",1:5),2),
col = "col",
y = rep(c("A","B"),each = 5)
)
sample_frmt <- frmt_combine(
"{A} {B}",
A = frmt("xxx.x"),
B = frmt("(X.X%)"),
missing = "Missing"
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group),
mock = TRUE
) %>%
pull(x)
expect_equal(sample_df_frmted, rep("xxx.x (X.X%)", 5))
})
test_that("Space in Param", {
no_ten <- frmt_combine("{LM mean} ({LM stderr})",
`LM mean` = frmt("xx.x"),
`LM stderr` = frmt("xx.xx")
)
expect_equal(no_ten$expression, "{`LM mean`} ({`LM stderr`})")
mixed <- frmt_combine("{mean} ({CV %})",
mean = frmt("xx.x"),
`CV %` = frmt("xx.xx")
)
expect_equal(mixed$expression, "{mean} ({`CV %`})")
data <- tibble::tribble(
~group, ~type, ~label, ~column, ~param, ~value,
"baseline", "description", "Week 12 analysis", "Placebo", "LM mean", 79.0,
"baseline", "description", "Week 12 analysis", "Placebo", "LM stderr", 5.0,
"Primary analysis", "trt comparison", "Week 12 analysis", "TRT - PBO", "LM mean", -0.3,
"Primary analysis", "trt comparison", "Week 12 analysis", "TRT - PBO", "LM stderr", 0.4
)
space_combo <- frmt_combine("{`LM mean`} ({`LM stderr`})",
`LM mean` = frmt("xx.x"),
`LM stderr` = frmt("xx.xx")
)
expect_equal(space_combo$expression, "{`LM mean`} ({`LM stderr`})")
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = space_combo,
.data = data,
value = quo(value),
param = quo(param),
column = vars(column),
label = quo(label),
group = vars(group, type),
mock = FALSE
) %>%
pull(value)
expect_equal(sample_df_frmted, c("79.0 ( 5.00)", "-0.3 ( 0.40)"))
})
test_that("frmt_combine only applies when all parameters are in the data", {
data <- tibble(Group = rep(c("Age (y)", "Sex", "Age (y)", "Sex"), c(3, 3, 6,12)),
Label = rep(c("n", "Mean (SD)", "Male","Female"), c(6, 6,6,6)),
Column = rep(c("Placebo", "Treatment", "Total"), times = 8),
Param = rep(c("n", "mean", "sd", "n", "pct", "n", "pct"), c(6, 3, 3, 3,3,3,3)),
Value = c(15,13,28,14,13,27,73.56, 74.231,71.84,9.347,7.234,8.293,8,7,15,8/14,7/13,15/27,6,6,12,6/14,6/13,12/27
)
) %>%
# Note because tfrmt only does rounding we will need to have the percents multiplied by 100
mutate(Value = case_when(Param == "pct" ~ Value * 100,
TRUE ~ Value),
ord1 = if_else(Group == "Age (y)", 1, 2),
ord2 = if_else(Label == "n", 1, 2),
TEMP_row = row_number())
test_combo <- frmt_structure(group_val = ".default", label_val = ".default",
frmt_combine("{n} ({pct}%)",
n = frmt("XX"),
pct = frmt("x.x"))
)
rows_to_use <- fmt_test_data(test_combo, data, group= vars(Group),
label = quo(Label), param = quo(Param) )
expected <- data %>%
filter(Label %in% c("Male","Female")) %>%
pull(TEMP_row)
expect_equal(rows_to_use, expected)
})
test_that("frmt_combine fills with partially missing values where a column is missing the value", {
data <- tibble(
Group = rep(c("Age (y)"), c(6)),
Label = rep(c("Mean (SD)"), c(6)),
Column = rep(c("Placebo", "Treatment", "Total"), each = c(2)),
Param = rep(c("mean", "sd"), times = c(3)),
Value = c(1, 2, 3, 4, 5, 6)
) %>%
.[-1,] # remove first row - where a "mean" is, but is otherwise complete
test_combo <- frmt_combine(
"{mean} {sd}",
mean = frmt("XX", missing = " -"),
sd = frmt("(xx)")
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = test_combo,
.data = data,
value = quo(Value),
param = quo(Param),
column = vars(Column),
label = quo(Label),
group = vars(Group),
mock = FALSE
)
expect_equal(sample_df_frmted,
tibble(
Group = rep(c("Age (y)"), c(3)),
Label = rep(c("Mean (SD)"), c(3)),
Column = c("Placebo", "Total", "Treatment"),
Param = c("sd","mean","mean"),
Value = c(" - ( 2)", " 5 ( 6)", " 3 ( 4)")
))
# Test the NA still comes through when missing isn't provided
test_combo_na <- frmt_combine(
"{mean} {sd}",
mean = frmt("XX"),
sd = frmt("(xx)")
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = test_combo_na,
.data = data,
value = quo(Value),
param = quo(Param),
column = vars(Column),
label = quo(Label),
group = vars(Group),
mock = FALSE
)
expect_equal(sample_df_frmted,
tibble(
Group = rep(c("Age (y)"), c(3)),
Label = rep(c("Mean (SD)"), c(3)),
Column = c("Placebo", "Total", "Treatment"),
Param = c("sd","mean","mean"),
Value = c("NA ( 2)", " 5 ( 6)", " 3 ( 4)")
))
})
GSK-Biostatistics/tlang documentation built on Dec. 11, 2024, 11:16 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
test_that("applying frmt", {
sample_df <- data.frame(
x = c(1234.5678, 345.6789, 56.7891, 4567.8910, 8.9101)
)
sample_frmt_no_dec <- frmt("xxx")
sample_frmt_single_dec <- frmt("xxx.x")
sample_frmt_double_dec <- frmt("xxx.xx")
sample_df_no_dec_frmted <- apply_frmt.frmt(
frmt_def = sample_frmt_no_dec,
.data = sample_df,
value = quo(x)
)
sample_df_single_dec_frmted <- apply_frmt.frmt(
frmt_def = sample_frmt_single_dec,
.data = sample_df,
value = quo(x)
)
sample_df_double_dec_frmted <- apply_frmt.frmt(
frmt_def = sample_frmt_double_dec,
.data = sample_df,
value = quo(x)
)
expect_equal(
sample_df_no_dec_frmted$x,
c("1235", "346", " 57", "4568", " 9")
)
expect_equal(
sample_df_single_dec_frmted$x,
c("1234.6", "345.7", " 56.8", "4567.9", " 8.9")
)
expect_equal(
sample_df_double_dec_frmted$x,
c("1234.57", "345.68", " 56.79", "4567.89", " 8.91")
)
})
test_that("applying frmt - scientific", {
sample_df <- data.frame(
x = c(1234.5678, 345.6789, 56.7891, 4567.8910, 8.9101, 0.0678)
)
sample_frmt_10x <- frmt(expression = "xxx.x", scientific = " x10^x")
sample_frmt_10xx <- frmt(expression = "xxx.x", scientific = " x10^xx")
sample_frmt_ex <- frmt(expression = "xxx.x", scientific = "e^x")
sample_frmt_exxxx <- frmt(expression = "xxx.x", scientific = "e^xxxx")
sample_df_frmted_10x <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_10x
)
sample_df_frmted_10xx <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_10xx
)
sample_df_frmted_ex <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_ex
)
sample_df_frmted_exxxx <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_exxxx
)
expect_equal(
sample_df_frmted_10x$x,
c(" 1.2 x10^3",
" 3.5 x10^2",
" 5.7 x10^1",
" 4.6 x10^3",
" 8.9 x10^0",
" 6.8 x10^-2")
)
expect_equal(
sample_df_frmted_10xx$x,
c(" 1.2 x10^ 3",
" 3.5 x10^ 2",
" 5.7 x10^ 1",
" 4.6 x10^ 3",
" 8.9 x10^ 0",
" 6.8 x10^-2")
)
expect_equal(
sample_df_frmted_ex$x,
c(" 1.2e^3",
" 3.5e^2",
" 5.7e^1",
" 4.6e^3",
" 8.9e^0",
" 6.8e^-2")
)
expect_equal(
sample_df_frmted_exxxx$x,
c(" 1.2e^ 3",
" 3.5e^ 2",
" 5.7e^ 1",
" 4.6e^ 3",
" 8.9e^ 0",
" 6.8e^ -2")
)
})
test_that("applying frmt - transform", {
sample_df <- data.frame(
x = c(1234.5678, 345.6789, 56.7891, 4567.8910, 8.9101)
)
formula_transform <- frmt("xxx", transform = ~.*100)
fx_transform <- frmt("xxx.x", transform = function(x){x^2})
formula_result<- apply_frmt.frmt(
frmt_def = formula_transform,
.data = sample_df,
value = quo(x)
) %>%
pull(x)
expect_equal(formula_result,
c("123457", "34568", "5679" , "456789", "891"))
fx_result <- apply_frmt.frmt(
frmt_def = fx_transform,
.data = sample_df,
value = quo(x)
) %>%
pull(x)
expect_equal(fx_result,
c("1524157.7", "119493.9", "3225.0", "20865628.2", " 79.4" ))
})
test_that("applying frmt - preserves decimal places after rounding", {
sample_df <- data.frame(
x = c(10, 12.3647, 3, 100, 167.299)
)
sample_frmt_1dec <- frmt(expression = "xxx.x")
sample_frmt_2dec <- frmt(expression = "xxx.xx")
sample_frmt_10x <- frmt(expression = "xxx.x", scientific = " x10^x")
sample_df_frmted_1dec <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_1dec
)
sample_df_frmted_2dec <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_2dec
)
sample_df_frmted_10x <- apply_frmt.frmt(
.data = sample_df,
value = sym("x"),
frmt_def = sample_frmt_10x
)
expect_equal(
sample_df_frmted_1dec$x,
c(" 10.0",
" 12.4",
" 3.0",
"100.0",
"167.3")
)
expect_equal(
sample_df_frmted_2dec$x,
c(" 10.00",
" 12.36",
" 3.00",
"100.00",
"167.30")
)
expect_equal(
sample_df_frmted_10x$x,
c(" 1.0 x10^1",
" 1.2 x10^1",
" 3.0 x10^0",
" 1.0 x10^2",
" 1.7 x10^2")
)
})
test_that("applying frmt_combine - 2x", {
sample_df <- tibble(
group = "group",
lab = rep(paste("lab",1:5),2),
col = "col",
y = rep(c("A","B"),each = 5),
x = c(1234.5678, 2345.6789, 3456.7891, 4567.8910, 5678.9101,
1.2345678, 2.3456789, 3.4567891, 4.5678910, 5.6789101)
)
sample_frmt <- frmt_combine(
"{A} {B}",
A = frmt("xxx.x"),
B = frmt("(X.X%)")
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group)
)
expect_equal(
sample_df_frmted,
tibble(
group = "group",
lab = paste("lab",1:5),
col = "col",
y = "A",
x = c("1234.6 (1.2%)", "2345.7 (2.3%)", "3456.8 (3.5%)", "4567.9 (4.6%)", "5678.9 (5.7%)")
)
)
})
test_that("applying frmt_combine missing",{
#Both missing
sample_df <- tibble(
group = "group",
lab = rep(paste("lab",1:5),2),
col = "col",
y = rep(c("A","B"),each = 5),
x = c(1234.5678, 2345.6789, 3456.7891, 4567.8910, NA,
1.2345678, 2.3456789, 3.4567891, 4.5678910, NA)
)
sample_frmt <- frmt_combine(
"{A} {B}",
A = frmt("xxx.x"),
B = frmt("(X.X%)"),
missing = "Missing"
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group)
)
expect_equal(
sample_df_frmted,
tibble(
group = "group",
lab = paste("lab",1:5),
col = "col",
y = "A",
x = c("1234.6 (1.2%)", "2345.7 (2.3%)", "3456.8 (3.5%)", "4567.9 (4.6%)", "Missing")
)
)
#One Missing
sample_df <- tibble(
group = "group",
lab = rep(paste("lab",1:5),2),
col = "col",
y = rep(c("A","B"),each = 5),
x = c(1234.5678, 2345.6789, 3456.7891, 4567.8910, NA,
1.2345678, 2.3456789, 3.4567891, 4.5678910, 5.6789101)
)
sample_frmt <- frmt_combine(
"{A} {B}",
A = frmt("xxx.x"),
B = frmt("(X.X%)"),
missing = "Missing"
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group)
)
expect_equal(
sample_df_frmted,
tibble(
group = "group",
lab = paste("lab",1:5),
col = "col",
y = "A",
x = c("1234.6 (1.2%)", "2345.7 (2.3%)", "3456.8 (3.5%)", "4567.9 (4.6%)", "NA (5.7%)")
)
)
})
test_that("applying frmt_combine - 3x", {
sample_df <- tibble(
group = "group",
lab = rep(paste("lab",1:5),3),
col = "col",
y = rep(c("A","B","C"),each = 5),
x = c(1234.5678, 2345.6789, 3456.7891, 4567.8910, 5678.9101,
1.2345678, 2.3456789, 3.4567891, 4.5678910, 5.6789101,
10,111,1112,13,114)
)
sample_frmt <- frmt_combine(
"{A} {B} - {C}",
A = frmt("xxx.x"),
B = frmt("(X.X%)"),
C = frmt("*XXXX.X")
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group)
)
expect_equal(
sample_df_frmted,
tibble(
group = "group",
lab = paste("lab",1:5),
col = "col",
y = "A",
x = c("1234.6 (1.2%) - * 10.0", "2345.7 (2.3%) - * 111.0", "3456.8 (3.5%) - *1112.0", "4567.9 (4.6%) - * 13.0", "5678.9 (5.7%) - * 114.0")
)
)
})
test_that("applying frmt_combine - no unique labels, so unable to frmt_combine", {
sample_df <- tibble(
group = "group",
lab = paste("lab",1:15),
col = "col",
y = rep(c("A","B","C"),each = 5),
x = c(1234.5678, 2345.6789, 3456.7891, 4567.8910, 5678.9101,
1.2345678, 2.3456789, 3.4567891, 4.5678910, 5.6789101,
10,111,1112,13,114)
)
sample_frmt <- frmt_combine(
"{A} {B} - {C}",
A = frmt("xxx.x"),
B = frmt("(X.X%)"),
C = frmt("*XXXX.X")
)
expect_warning(
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group)
),
"Unable to apply `frmt_combine` due to uniqueness of column/row identifiers. Params that are to be combined need to have matching values across: "
)
expect_equal(
sample_df_frmted,
tibble(
group = "group",
lab = c("lab 1", "lab 10",
"lab 11", "lab 12", "lab 13", "lab 14", "lab 15", "lab 2", "lab 3",
"lab 4", "lab 5", "lab 6", "lab 7", "lab 8", "lab 9"),
col = "col",
y = c("A", "B", "C", "C",
"C", "C", "C", "A", "A", "A", "A", "B", "B", "B", "B"),
x = c("1234.6 NA - NA", "NA (5.7%) - NA", "NA NA - * 10.0", "NA NA - * 111.0",
"NA NA - *1112.0", "NA NA - * 13.0", "NA NA - * 114.0", "2345.7 NA - NA",
"3456.8 NA - NA", "4567.9 NA - NA", "5678.9 NA - NA", "NA (1.2%) - NA",
"NA (2.3%) - NA", "NA (3.5%) - NA", "NA (4.6%) - NA")
)
)
})
test_that("applying frmt_when", {
#Test frmt_when alone
sample_df <- tibble(
group = "group",
lab = rep(paste("lab",1:5), 2),
col = "col",
y = rep(c("A","B"),each = 5),
x = c(1234.5678, 2345.6789, 3456.7891, 4567.8910, 5678.9101,
1.2345678, 2.3456789, 3.4567891, 4.5678910, 5.6789101)
)
sample_frmt <- frmt_when(
">1000" ~ frmt("XXX.X"),
"TRUE" ~ "Undectable"
)
sample_df_frmted <- apply_frmt(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = "y",
column = vars(col),
label = quo(lab),
group = vars(group)
)
man_df <- tibble::tribble(
~group, ~lab, ~col, ~y, ~x,
"group", "lab 1", "col", "A", "1234.6",
"group", "lab 2", "col", "A", "2345.7",
"group", "lab 3", "col", "A", "3456.8",
"group", "lab 4", "col", "A", "4567.9",
"group", "lab 5", "col", "A", "5678.9",
"group", "lab 1", "col", "B", "Undectable",
"group", "lab 2", "col", "B", "Undectable",
"group", "lab 3", "col", "B", "Undectable",
"group", "lab 4", "col", "B", "Undectable",
"group", "lab 5", "col", "B", "Undectable",
)
expect_equal(sample_df_frmted, man_df)
#Test in combination
sample_frmt_combo <- frmt_combine(
"{A} {B}",
A = frmt("xxx.x"),
B = frmt_when(">3" ~ frmt("(X.X%)"),
"<=3" ~ frmt("Undetectable")
)
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt_combo,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group)
)
man_df_combo <- tibble::tribble(
~group, ~lab, ~col, ~y, ~x,
"group", "lab 1", "col", "A", "1234.6 Undetectable",
"group", "lab 2", "col", "A", "2345.7 Undetectable",
"group", "lab 3", "col", "A", "3456.8 (3.5%)",
"group", "lab 4", "col", "A", "4567.9 (4.6%)",
"group", "lab 5", "col", "A", "5678.9 (5.7%)",
)
expect_equal(sample_df_frmted, man_df_combo)
})
test_that("mocks return correctly", {
#frmt
frmt_mock <- apply_frmt.frmt(
frmt_def = frmt("xxx.x"),
.data = iris,
value = quo(mock),
mock = TRUE
)%>%
pull(mock)
expect_equal(frmt_mock, rep("xxx.x", nrow(iris)))
# frmt_when
frmt_when_true <- apply_frmt.frmt_when(frmt_when("==100"~ frmt(""),
"==0"~ "",
"TRUE" ~ frmt("(XXX.X%)")),
.data = iris, sym("value"),mock = TRUE) %>%
pull(value)
expect_equal(frmt_when_true, rep("(XXX.X%)", nrow(iris)))
frmt_when_no_true <-apply_frmt.frmt_when(frmt_when("==100"~ frmt("Hello"),
"==0"~ ""),
.data = iris, sym("value"),mock = TRUE) %>%
pull(value)
expect_equal(frmt_when_no_true, rep("Hello", nrow(iris)))
#frmt_combine
sample_df <- tibble(
group = "group",
lab = rep(paste("lab",1:5),2),
col = "col",
y = rep(c("A","B"),each = 5)
)
sample_frmt <- frmt_combine(
"{A} {B}",
A = frmt("xxx.x"),
B = frmt("(X.X%)"),
missing = "Missing"
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = sample_frmt,
.data = sample_df,
value = quo(x),
param = quo(y),
column = vars(col),
label = quo(lab),
group = vars(group),
mock = TRUE
) %>%
pull(x)
expect_equal(sample_df_frmted, rep("xxx.x (X.X%)", 5))
})
test_that("Space in Param", {
no_ten <- frmt_combine("{LM mean} ({LM stderr})",
`LM mean` = frmt("xx.x"),
`LM stderr` = frmt("xx.xx")
)
expect_equal(no_ten$expression, "{`LM mean`} ({`LM stderr`})")
mixed <- frmt_combine("{mean} ({CV %})",
mean = frmt("xx.x"),
`CV %` = frmt("xx.xx")
)
expect_equal(mixed$expression, "{mean} ({`CV %`})")
data <- tibble::tribble(
~group, ~type, ~label, ~column, ~param, ~value,
"baseline", "description", "Week 12 analysis", "Placebo", "LM mean", 79.0,
"baseline", "description", "Week 12 analysis", "Placebo", "LM stderr", 5.0,
"Primary analysis", "trt comparison", "Week 12 analysis", "TRT - PBO", "LM mean", -0.3,
"Primary analysis", "trt comparison", "Week 12 analysis", "TRT - PBO", "LM stderr", 0.4
)
space_combo <- frmt_combine("{`LM mean`} ({`LM stderr`})",
`LM mean` = frmt("xx.x"),
`LM stderr` = frmt("xx.xx")
)
expect_equal(space_combo$expression, "{`LM mean`} ({`LM stderr`})")
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = space_combo,
.data = data,
value = quo(value),
param = quo(param),
column = vars(column),
label = quo(label),
group = vars(group, type),
mock = FALSE
) %>%
pull(value)
expect_equal(sample_df_frmted, c("79.0 ( 5.00)", "-0.3 ( 0.40)"))
})
test_that("frmt_combine only applies when all parameters are in the data", {
data <- tibble(Group = rep(c("Age (y)", "Sex", "Age (y)", "Sex"), c(3, 3, 6,12)),
Label = rep(c("n", "Mean (SD)", "Male","Female"), c(6, 6,6,6)),
Column = rep(c("Placebo", "Treatment", "Total"), times = 8),
Param = rep(c("n", "mean", "sd", "n", "pct", "n", "pct"), c(6, 3, 3, 3,3,3,3)),
Value = c(15,13,28,14,13,27,73.56, 74.231,71.84,9.347,7.234,8.293,8,7,15,8/14,7/13,15/27,6,6,12,6/14,6/13,12/27
)
) %>%
# Note because tfrmt only does rounding we will need to have the percents multiplied by 100
mutate(Value = case_when(Param == "pct" ~ Value * 100,
TRUE ~ Value),
ord1 = if_else(Group == "Age (y)", 1, 2),
ord2 = if_else(Label == "n", 1, 2),
TEMP_row = row_number())
test_combo <- frmt_structure(group_val = ".default", label_val = ".default",
frmt_combine("{n} ({pct}%)",
n = frmt("XX"),
pct = frmt("x.x"))
)
rows_to_use <- fmt_test_data(test_combo, data, group= vars(Group),
label = quo(Label), param = quo(Param) )
expected <- data %>%
filter(Label %in% c("Male","Female")) %>%
pull(TEMP_row)
expect_equal(rows_to_use, expected)
})
test_that("frmt_combine fills with partially missing values where a column is missing the value", {
data <- tibble(
Group = rep(c("Age (y)"), c(6)),
Label = rep(c("Mean (SD)"), c(6)),
Column = rep(c("Placebo", "Treatment", "Total"), each = c(2)),
Param = rep(c("mean", "sd"), times = c(3)),
Value = c(1, 2, 3, 4, 5, 6)
) %>%
.[-1,] # remove first row - where a "mean" is, but is otherwise complete
test_combo <- frmt_combine(
"{mean} {sd}",
mean = frmt("XX", missing = " -"),
sd = frmt("(xx)")
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = test_combo,
.data = data,
value = quo(Value),
param = quo(Param),
column = vars(Column),
label = quo(Label),
group = vars(Group),
mock = FALSE
)
expect_equal(sample_df_frmted,
tibble(
Group = rep(c("Age (y)"), c(3)),
Label = rep(c("Mean (SD)"), c(3)),
Column = c("Placebo", "Total", "Treatment"),
Param = c("sd","mean","mean"),
Value = c(" - ( 2)", " 5 ( 6)", " 3 ( 4)")
))
# Test the NA still comes through when missing isn't provided
test_combo_na <- frmt_combine(
"{mean} {sd}",
mean = frmt("XX"),
sd = frmt("(xx)")
)
sample_df_frmted <- apply_frmt.frmt_combine(
frmt_def = test_combo_na,
.data = data,
value = quo(Value),
param = quo(Param),
column = vars(Column),
label = quo(Label),
group = vars(Group),
mock = FALSE
)
expect_equal(sample_df_frmted,
tibble(
Group = rep(c("Age (y)"), c(3)),
Label = rep(c("Mean (SD)"), c(3)),
Column = c("Placebo", "Total", "Treatment"),
Param = c("sd","mean","mean"),
Value = c("NA ( 2)", " 5 ( 6)", " 3 ( 4)")
))
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.