Skip to content

Commit b661193

Browse files
matthewphamiltonmatthewphamilton
committed
minor updates
1 parent 919b904 commit b661193

7 files changed

Lines changed: 154 additions & 86 deletions

File tree

‎CITATION.cff‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,12 @@
11
cff-version: 1.2.0
2-
message: "Matthew Hamilton and Caroline Gao (2022). specific: Specify Candidate Models for Representing Mental Health Systems. Version 0.0.0.9078. Zenodo. https://doi.org/10.5281/zenodo.5768689"
2+
message: "Matthew Hamilton and Caroline Gao (2022). specific: Specify Candidate Models for Representing Mental Health Systems. Version 0.0.0.9079. Zenodo. https://doi.org/10.5281/zenodo.5768689"
33
authors:
44
- family-names: "Hamilton"
55
given-names: "Matthew"
66
- family-names: "Gao"
77
given-names: "Caroline"
88
title: "specific: Specify Candidate Models for Representing Mental Health Systems"
9-
version: 0.0.0.9078
9+
version: 0.0.0.9079
1010
doi: 10.5281/zenodo.5768689
11-
date-released: 2022-02-17
11+
date-released: 2022-02-22
1212
url: "https://ready4-dev.github.io/specific/"

‎DESCRIPTION‎

Lines changed: 9 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,7 @@ Imports:
5252
ready4show (>= 0.0.0.9095),
5353
ready4use (>= 0.0.0.9220),
5454
rlang,
55+
scorz (>= 0.0.0.9048),
5556
stats,
5657
stringi,
5758
stringr,
@@ -119,10 +120,14 @@ Collate:
119120
'pkg_specific.R'
120121
'specific-package.R'
121122
Suggests:
122-
scorz,
123-
rmarkdown
124-
Remotes:
123+
rmarkdown,
124+
betareg,
125+
cmdstanr (>= 0.4.0.9000),
126+
rstan
127+
Remotes:
125128
ready4-dev/ready4,
126129
ready4-dev/ready4show,
127130
ready4-dev/ready4use,
128-
ready4-dev/youthvars
131+
ready4-dev/youthvars,
132+
stan-dev/cmdstanr,
133+
ready4-dev/scorz

‎R/fn_print.R‎

Lines changed: 48 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -147,16 +147,6 @@ print_indpnt_predrs_coefs_tbl <- function (params_ls, caption_1L_chr, mkdn_tbl_r
147147
results_ls <- params_ls$results_ls
148148
tb <- results_ls$tables_ls$ind_preds_coefs_tbl %>% transform_nms_in_mdl_tbl(col_nm_1L_chr = "Parameter",
149149
var_nm_change_lup = results_ls$var_nm_change_lup)
150-
add_to_row_ls <- list()
151-
add_to_row_ls$pos <- list(-1, 0, nrow(tb))
152-
add_to_row_ls$command <- c(paste0("\\toprule \n", "&\\multicolumn{5}{c}{",
153-
paste0(results_ls$ttu_lngl_ls$best_mdls_tb[[1, "model_type"]],
154-
" - ", results_ls$ttu_lngl_ls$best_mdls_tb[[1, "link_and_tfmn_chr"]]),
155-
"}&\\multicolumn{5}{c}{", paste0(results_ls$ttu_lngl_ls$best_mdls_tb[[2,
156-
"model_type"]], " - ", results_ls$ttu_lngl_ls$best_mdls_tb[[2,
157-
"link_and_tfmn_chr"]]), "}\\\\\n"), paste0("Parameter & Estimate\t& SE\t& 95CI & R2\t& Sigma & Estimate & SE\t& 95CI & R2 & Sigma \\\\\n",
158-
"\\midrule \n"), paste0("\\hline\n", "{\\footnotesize ",
159-
make_scaling_text(results_ls), "}\n"))
160150
if (params_ls$output_type_1L_chr == "Word") {
161151
tb$Parameter <- stringr::str_replace_all(stringr::str_replace_all(stringr::str_replace_all(tb$Parameter,
162152
"\\\\textbf", ""), "\\{", ""), "\\}", "")
@@ -181,6 +171,7 @@ print_indpnt_predrs_coefs_tbl <- function (params_ls, caption_1L_chr, mkdn_tbl_r
181171
general_title = " ")
182172
}
183173
else {
174+
add_to_row_ls <- NULL
184175
ready4show::print_table(output_type_1L_chr = params_ls$output_type_1L_chr,
185176
caption_1L_chr = caption_1L_chr, mkdn_tbl_ref_1L_chr = mkdn_tbl_ref_1L_chr,
186177
use_rdocx_1L_lgl = ifelse(params_ls$output_type_1L_chr ==
@@ -220,16 +211,19 @@ print_indpnt_predrs_lngl_mdl_coefs <- function (params_ls, caption_1L_chr, ref_1
220211
#' @param params_ls Parameters (a list)
221212
#' @param caption_1L_chr Caption (a character vector of length one)
222213
#' @param table_1L_chr Table (a character vector of length one)
214+
#' @param column_1_width_1L_chr Column 1 width (a character vector of length one), Default: '25em'
223215
#' @param ref_1L_int Reference (an integer vector of length one), Default: 1
224216
#' @return NULL
225217
#' @rdname print_lngl_ttu_tbls
226218
#' @export
227219
#' @importFrom knitr opts_current
228220
#' @importFrom purrr map_chr
221+
#' @importFrom dplyr mutate across case_when
222+
#' @importFrom kableExtra kbl kable_styling column_spec row_spec collapse_rows footnote
229223
#' @importFrom ready4show print_table
230224
#' @keywords internal
231225
print_lngl_ttu_tbls <- function (table_df, params_ls, caption_1L_chr, table_1L_chr,
232-
ref_1L_int = 1)
226+
column_1_width_1L_chr = "25em", ref_1L_int = 1)
233227
{
234228
results_ls <- params_ls$results_ls
235229
if (params_ls$output_type_1L_chr == "PDF") {
@@ -245,28 +239,46 @@ print_lngl_ttu_tbls <- function (table_df, params_ls, caption_1L_chr, table_1L_c
245239
else {
246240
add_to_row_ls <- NULL
247241
}
248-
table_df %>% ready4show::print_table(output_type_1L_chr = params_ls$output_type_1L_chr,
249-
caption_1L_chr = caption_1L_chr, mkdn_tbl_ref_1L_chr = paste0("tab:",
250-
table_1L_chr), use_rdocx_1L_lgl = ifelse(params_ls$output_type_1L_chr ==
251-
"Word", T, F), add_to_row_ls = add_to_row_ls, footnotes_chr = make_scaling_text(results_ls,
252-
table_1L_chr = table_1L_chr), hline_after_ls = c(-1,
253-
0), sanitize_fn = force)
242+
if (params_ls$output_type_1L_chr == "PDF") {
243+
table_df %>% dplyr::mutate(dplyr::across(.cols = everything(),
244+
~dplyr::case_when(is.na(.x) ~ "", T ~ .x))) %>% kableExtra::kbl(booktabs = T,
245+
caption = knitr::opts_current$get("tab.cap"), escape = F,
246+
longtable = T, col.names = c("Parameter", "Estimate",
247+
"SE", "CI (95\\%)", "R2", "Sigma")) %>% kableExtra::kable_styling(latex_options = c("repeat_header"),
248+
full_width = F) %>% kableExtra::column_spec(1, width = column_1_width_1L_chr) %>%
249+
kableExtra::row_spec(which(!is.na(table_df[, 5])),
250+
bold = T) %>% kableExtra::collapse_rows(columns = 1) %>%
251+
kableExtra::footnote(general = make_scaling_text(results_ls,
252+
table_1L_chr = table_1L_chr), general_title = " ")
253+
}
254+
else {
255+
table_df %>% ready4show::print_table(output_type_1L_chr = params_ls$output_type_1L_chr,
256+
caption_1L_chr = caption_1L_chr, mkdn_tbl_ref_1L_chr = paste0("tab:",
257+
table_1L_chr), use_rdocx_1L_lgl = ifelse(params_ls$output_type_1L_chr ==
258+
"Word", T, F), add_to_row_ls = add_to_row_ls,
259+
footnotes_chr = make_scaling_text(results_ls, table_1L_chr = table_1L_chr),
260+
hline_after_ls = c(-1, 0), sanitize_fn = force)
261+
}
254262
}
255263
#' Print ten folds table
256264
#' @description print_ten_folds_tbl() is a Print function that prints output to console Specifically, this function implements an algorithm to print ten folds table. The function is called for its side effects and does not return a value.
257265
#' @param params_ls Parameters (a list)
258266
#' @param caption_1L_chr Caption (a character vector of length one)
259267
#' @param mkdn_tbl_ref_1L_chr Markdown table reference (a character vector of length one)
268+
#' @param column_1_width_1L_chr Column 1 width (a character vector of length one), Default: '20em'
260269
#' @param ref_1L_int Reference (an integer vector of length one), Default: 1
261270
#' @return NULL
262271
#' @rdname print_ten_folds_tbl
263272
#' @export
264-
#' @importFrom dplyr mutate across everything
273+
#' @importFrom dplyr mutate across everything case_when
265274
#' @importFrom stringr str_replace_all
266275
#' @importFrom purrr map_chr
267276
#' @importFrom Hmisc capitalize
277+
#' @importFrom kableExtra kbl kable_styling column_spec add_header_above collapse_rows footnote
278+
#' @importFrom knitr opts_current
268279
#' @importFrom ready4show print_table
269-
print_ten_folds_tbl <- function (params_ls, caption_1L_chr, mkdn_tbl_ref_1L_chr, ref_1L_int = 1)
280+
print_ten_folds_tbl <- function (params_ls, caption_1L_chr, mkdn_tbl_ref_1L_chr, column_1_width_1L_chr = "20em",
281+
ref_1L_int = 1)
270282
{
271283
results_ls <- params_ls$results_ls
272284
if (ref_1L_int == 1) {
@@ -280,12 +292,6 @@ print_ten_folds_tbl <- function (params_ls, caption_1L_chr, mkdn_tbl_ref_1L_chr,
280292
df$Predictor <- df$Predictor %>% transform_names(rename_lup = results_ls$var_nm_change_lup)
281293
}
282294
if (params_ls$output_type_1L_chr == "PDF") {
283-
add_to_row_ls <- list()
284-
add_to_row_ls$pos <- list(0, 0, 0, nrow(df))
285-
add_to_row_ls$command <- c("&\\multicolumn{3}{c}{Training model fit}&\\multicolumn{3}{c}{Testing model fit}\\\\\n",
286-
"&\\multicolumn{3}{c}{(averaged over 10 folds)}&\\multicolumn{3}{c}{(averaged over 10 folds)}\\\\\n",
287-
"Model & R2\t& RMSE & MAE & R2\t& RMSE & MAE \\\\\n",
288-
paste0("\\hline\n", "{\\footnotesize RMSE: Root Mean Squared Error; MAE: Mean Absolute Error}\n"))
289295
if (ref_1L_int == 1) {
290296
df$Model <- df$Model %>% purrr::map_chr(~ifelse(.x %in%
291297
c("GLM", "OLS"), paste0("\\textbf{", .x, "}"),
@@ -295,15 +301,27 @@ print_ten_folds_tbl <- function (params_ls, caption_1L_chr, mkdn_tbl_ref_1L_chr,
295301
df$Predictor <- df$Predictor %>% purrr::map_chr(~paste0("\\textbf{",
296302
.x, "}"))
297303
}
304+
df %>% dplyr::mutate(dplyr::across(.cols = everything(),
305+
~dplyr::case_when(is.na(.x) ~ "", T ~ .x))) %>% kableExtra::kbl(booktabs = T,
306+
caption = knitr::opts_current$get("tab.cap"), escape = F,
307+
longtable = T, col.names = c("Model", "R2", "RMSE",
308+
"MAE", "R2", "RMSE", "MAE")) %>% kableExtra::kable_styling(latex_options = c("repeat_header"),
309+
full_width = F) %>% kableExtra::column_spec(1, bold = T,
310+
width = column_1_width_1L_chr) %>% kableExtra::add_header_above(parse(text = paste0("c(",
311+
"\" \"", ", ", paste0("\"", "Training model fit",
312+
"\" = 3"), ", ", paste0("\"", "Testing model fit",
313+
"\" = 3"), ")")) %>% eval()) %>% kableExtra::collapse_rows(columns = 1) %>%
314+
kableExtra::footnote(general = "Results are averaged over ten folds. RMSE: Root Mean Squared Error; MAE: Mean Absolute Error",
315+
general_title = " ")
298316
}
299317
else {
300318
add_to_row_ls <- NULL
319+
df %>% ready4show::print_table(output_type_1L_chr = params_ls$output_type_1L_chr,
320+
caption_1L_chr = caption_1L_chr, mkdn_tbl_ref_1L_chr = mkdn_tbl_ref_1L_chr,
321+
use_rdocx_1L_lgl = ifelse(params_ls$output_type_1L_chr ==
322+
"Word", T, F), add_to_row_ls = add_to_row_ls,
323+
hline_after_ls = c(-1, 0), sanitize_fn = force)
301324
}
302-
df %>% ready4show::print_table(output_type_1L_chr = params_ls$output_type_1L_chr,
303-
caption_1L_chr = caption_1L_chr, mkdn_tbl_ref_1L_chr = mkdn_tbl_ref_1L_chr,
304-
use_rdocx_1L_lgl = ifelse(params_ls$output_type_1L_chr ==
305-
"Word", T, F), add_to_row_ls = add_to_row_ls, hline_after_ls = c(-1,
306-
0), sanitize_fn = force)
307325
}
308326
#' Print time series model plots
309327
#' @description print_ts_mdl_plts() is a Print function that prints output to console Specifically, this function implements an algorithm to print time series model plots. The function is called for its side effects and does not return a value.

‎data-raw/DATASET.R‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -432,8 +432,7 @@ datasets_ls <- list(tibble::tibble(short_name_chr = c("OLS_NTF",
432432
desc_1L_chr = "A lookup table of different report types"))
433433
z <- ready4pack::make_pt_ready4pack_manifest(x,
434434
constructor_r3 = y,
435-
pkg_ds_ls_ls = datasets_ls
436-
) %>%
435+
pkg_ds_ls_ls = datasets_ls) %>%
437436
ready4pack::ready4pack_manifest()
438437
z <- ready4::author(z)
439438
ready4::write_citation_cff(packageDescription("specific"),

0 commit comments

Comments
 (0)