version bump - regression - data overview

This commit is contained in:
Andreas Gammelgaard Damsbo 2025-04-02 11:31:04 +02:00
parent f73af16ae1
commit f249aaa9ab
No known key found for this signature in database
29 changed files with 2787 additions and 1138 deletions

BIN
.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 24 KiB

View file

@ -1,6 +1,6 @@
Package: FreesearchR
Title: Browser Based Data Analysis
Version: 25.3.2
Version: 25.4.1
Authors@R:
person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"),
comment = c(ORCID = "0000-0002-7559-1154"))

View file

@ -14,7 +14,6 @@ export(clean_date)
export(clean_sep)
export(columnSelectInput)
export(contrast_text)
export(cor_demo_app)
export(create_baseline)
export(create_log_tics)
export(create_overview_datagrid)
@ -91,6 +90,7 @@ export(remove_na_attr)
export(repeated_instruments)
export(sankey_ready)
export(selectInputIcon)
export(sort_by)
export(specify_qmd_format)
export(subset_types)
export(supported_functions)

10
NEWS.md
View file

@ -1,12 +1,16 @@
# FreesearchR 25.3.2
# FreesearchR 25.4.1
Focus is on polish and improved ui/ux.
Updating name (will be FreesearchR), with renamed repository and some graphics are comng. This may introduce some breaking chances for others calling or installing the package. No future changes are planned. A complete transition is planned before attending and presenting a poster at the European Stroke Organisation Conference 2025 in May.
Updating name (will be FreesearchR), with renamed repository and some graphics are coming. This may introduce some breaking chances for others calling or installing the package. No future changes are planned. A complete transition is planned before attending and presenting a poster at the European Stroke Organisation Conference 2025 in May.
Testing file upload conducted and improved.
Working on improving code export.
Working on improving code export. This is very difficult to get perfect. Initial focus is on extracting enough to be able to learn from it.
Regression calculations, plots, and checks have been improved and moved to standalone module.
Data overview/modifications has been simplified slightly.
# freesearcheR 25.3.1

View file

@ -1 +1 @@
app_version <- function()'250331_1248'
app_version <- function()'250402_1126'

View file

@ -34,21 +34,25 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
#' @export
#'
#' @examples
#' mtcars |> create_baseline(by.var = "gear", add.p="yes"=="yes")
create_baseline <- function(data,...,by.var,add.p=FALSE,add.overall=FALSE){
#' mtcars |> create_baseline(by.var = "gear", add.p = "yes" == "yes")
create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALSE, theme=c("jama", "lancet", "nejm", "qjecon")) {
theme <- match.arg(theme)
if (by.var == "none" | !by.var %in% names(data)) {
by.var <- NULL
}
## These steps are to handle logicals/booleans, that messes up the order of columns
## Has been reported
## Has been reported and should be fixed soon (02042025)
if (!is.null(by.var)) {
if (identical("logical",class(data[[by.var]]))){
if (identical("logical", class(data[[by.var]]))) {
data[by.var] <- as.character(data[[by.var]])
}
}
gtsummary::theme_gtsummary_journal(journal = theme)
out <- data |>
baseline_table(
fun.args =
@ -59,7 +63,7 @@ create_baseline <- function(data,...,by.var,add.p=FALSE,add.overall=FALSE){
)
if (!is.null(by.var)) {
if (isTRUE(add.overall)){
if (isTRUE(add.overall)) {
out <- out |> gtsummary::add_overall()
}
if (isTRUE(add.p)) {
@ -67,7 +71,6 @@ create_baseline <- function(data,...,by.var,add.p=FALSE,add.overall=FALSE){
gtsummary::add_p() |>
gtsummary::bold_p()
}
}
out

View file

@ -133,31 +133,5 @@ sentence_paste <- function(data, and.str = "and") {
}
#' Correlations plot demo app
#'
#' @returns
#' @export
#'
#' @examples
#' \dontrun{
#' cor_demo_app()
#' }
cor_demo_app <- function() {
ui <- shiny::fluidPage(
shiny::sliderInput(
inputId = "cor_cutoff",
label = "Correlation cut-off",
min = 0,
max = 1,
step = .1,
value = .7,
ticks = FALSE
),
data_correlations_ui("data", height = 600)
)
server <- function(input, output, session) {
data_correlations_server("data", data = shiny::reactive(default_parsing(mtcars)), cutoff = shiny::reactive(input$cor_cutoff))
}
shiny::shinyApp(ui, server)
}

View file

@ -350,7 +350,7 @@ data_description <- function(data) {
#' @param na.rm remove NAs
#' @param ... passed to base_sort_by
#'
#' @returns
#' @returns vector
#' @export
#'
#' @examples
@ -363,3 +363,9 @@ sort_by <- function(x,y,na.rm=FALSE,...){
out
}
}
get_ggplot_label <- function(data,label){
assertthat::assert_that(ggplot2::is.ggplot(data))
data$labels[[label]]
}

View file

@ -461,8 +461,7 @@ import_dta <- function(file) {
#'
import_rds <- function(file) {
readr::read_rds(
file = file,
name_repair = "unique_quiet"
file = file
)
}

75
R/plot-download-module.R Normal file
View file

@ -0,0 +1,75 @@
plot_download_ui <- regression_ui <- function(id, ...) {
ns <- shiny::NS(id)
shiny::tagList(
shinyWidgets::noUiSliderInput(
inputId = ns("plot_height"),
label = "Plot height (mm)",
min = 50,
max = 300,
value = 100,
step = 1,
format = shinyWidgets::wNumbFormat(decimals = 0),
color = datamods:::get_primary_color()
),
shinyWidgets::noUiSliderInput(
inputId = ns("plot_width"),
label = "Plot width (mm)",
min = 50,
max = 300,
value = 100,
step = 1,
format = shinyWidgets::wNumbFormat(decimals = 0),
color = datamods:::get_primary_color()
),
shiny::selectInput(
inputId = ns("plot_type"),
label = "File format",
choices = list(
"png",
"tiff",
"eps",
"pdf",
"jpeg",
"svg"
)
),
shiny::br(),
# Button
shiny::downloadButton(
outputId = ns("download_plot"),
label = "Download plot",
icon = shiny::icon("download")
)
)
}
plot_download_server <- function(id,
data,
file_name = "reg_plot",
...) {
shiny::moduleServer(
id = id,
module = function(input, output, session) {
# ns <- session$ns
output$download_plot <- shiny::downloadHandler(
filename = paste0(file_name, ".", input$plot_type),
content = function(file) {
shiny::withProgress(message = "Saving the plot. Hold on for a moment..", {
ggplot2::ggsave(
filename = file,
plot = data,
width = input$plot_width,
height = input$plot_height,
dpi = 300,
units = "mm", scale = 2
)
})
}
)
}
)
}

568
R/regression-module.R Normal file
View file

@ -0,0 +1,568 @@
regression_ui <- function(id, ...) {
ns <- shiny::NS(id)
shiny::tagList(
title = "",
sidebar = bslib::sidebar(
shiny::uiOutput(outputId = ns("data_info"), inline = TRUE),
bslib::accordion(
open = "acc_reg",
multiple = FALSE,
bslib::accordion_panel(
value = "acc_reg",
title = "Regression",
icon = bsicons::bs_icon("calculator"),
shiny::uiOutput(outputId = ns("outcome_var")),
# shiny::selectInput(
# inputId = "design",
# label = "Study design",
# selected = "no",
# inline = TRUE,
# choices = list(
# "Cross-sectional" = "cross-sectional"
# )
# ),
shiny::uiOutput(outputId = ns("regression_type")),
shiny::radioButtons(
inputId = ns("add_regression_p"),
label = "Add p-value",
inline = TRUE,
selected = "yes",
choices = list(
"Yes" = "yes",
"No" = "no"
)
),
shiny::radioButtons(
inputId = ns("all"),
label = "Specify covariables",
inline = TRUE, selected = 2,
choiceNames = c(
"Yes",
"No"
),
choiceValues = c(1, 2)
),
shiny::conditionalPanel(
condition = "input.all==1",
shiny::uiOutput(outputId = ns("regression_vars")),
shiny::helpText("If none are selected, all are included."),
shiny::tags$br(),
ns = ns
),
bslib::input_task_button(
id = ns("load"),
label = "Analyse",
icon = bsicons::bs_icon("pencil"),
label_busy = "Working...",
icon_busy = fontawesome::fa_i("arrows-rotate",
class = "fa-spin",
"aria-hidden" = "true"
),
type = "secondary",
auto_reset = TRUE
),
shiny::helpText("Press 'Analyse' again after changing parameters."),
shiny::tags$br()
),
do.call(
bslib::accordion_panel,
c(
list(
value = "acc_plot",
title = "Coefficient plot",
icon = bsicons::bs_icon("bar-chart-steps"),
shiny::tags$br(),
shiny::uiOutput(outputId = ns("plot_model"))
),
# plot_download_ui(ns("reg_plot_download"))
shiny::tagList(
shinyWidgets::noUiSliderInput(
inputId = ns("plot_height"),
label = "Plot height (mm)",
min = 50,
max = 300,
value = 100,
step = 1,
format = shinyWidgets::wNumbFormat(decimals = 0),
color = datamods:::get_primary_color()
),
shinyWidgets::noUiSliderInput(
inputId = ns("plot_width"),
label = "Plot width (mm)",
min = 50,
max = 300,
value = 100,
step = 1,
format = shinyWidgets::wNumbFormat(decimals = 0),
color = datamods:::get_primary_color()
),
shiny::selectInput(
inputId = ns("plot_type"),
label = "File format",
choices = list(
"png",
"tiff",
"eps",
"pdf",
"jpeg",
"svg"
)
),
shiny::br(),
# Button
shiny::downloadButton(
outputId = ns("download_plot"),
label = "Download plot",
icon = shiny::icon("download")
)
)
)
),
bslib::accordion_panel(
value = "acc_checks",
title = "Checks",
icon = bsicons::bs_icon("clipboard-check"),
shiny::uiOutput(outputId = ns("plot_checks"))
)
)
),
bslib::nav_panel(
title = "Regression table",
gt::gt_output(outputId = ns("table2"))
),
bslib::nav_panel(
title = "Coefficient plot",
shiny::plotOutput(outputId = ns("regression_plot"), height = "80vh")
),
bslib::nav_panel(
title = "Model checks",
shiny::plotOutput(outputId = ns("check"), height = "90vh")
)
)
}
regression_server <- function(id,
data,
...) {
shiny::moduleServer(
id = id,
module = function(input, output, session) {
ns <- session$ns
rv <- shiny::reactiveValues(
data = NULL,
plot = NULL,
check = NULL,
list = list()
)
data_r <- shiny::reactive({
if (shiny::is.reactive(data)) {
data()
} else {
data
}
})
output$data_info <- shiny::renderUI({
shiny::req(regression_vars())
shiny::req(data_r())
data_description(data_r()[regression_vars()])
})
##############################################################################
#########
######### Input fields
#########
##############################################################################
## Keep these "old" selection options as a simple alternative to the modification pane
output$regression_vars <- shiny::renderUI({
columnSelectInput(
inputId = ns("regression_vars"),
selected = NULL,
label = "Covariables to include",
data = data_r(),
multiple = TRUE
)
})
output$outcome_var <- shiny::renderUI({
columnSelectInput(
inputId = ns("outcome_var"),
selected = NULL,
label = "Select outcome variable",
data = data_r(),
multiple = FALSE
)
})
output$regression_type <- shiny::renderUI({
shiny::req(input$outcome_var)
shiny::selectizeInput(
inputId = ns("regression_type"),
label = "Choose regression analysis",
## The below ifelse statement handles the case of loading a new dataset
choices = possible_functions(
data = dplyr::select(
data_r(),
ifelse(input$outcome_var %in% names(data_r()),
input$outcome_var,
names(data_r())[1]
)
), design = "cross-sectional"
),
multiple = FALSE
)
})
output$factor_vars <- shiny::renderUI({
shiny::selectizeInput(
inputId = ns("factor_vars"),
selected = colnames(data_r())[sapply(data_r(), is.factor)],
label = "Covariables to format as categorical",
choices = colnames(data_r()),
multiple = TRUE
)
})
## Collected regression variables
regression_vars <- shiny::reactive({
if (is.null(input$regression_vars)) {
out <- colnames(data_r())
} else {
out <- unique(c(input$regression_vars, input$outcome_var))
}
return(out)
})
output$strat_var <- shiny::renderUI({
columnSelectInput(
inputId = ns("strat_var"),
selected = "none",
label = "Select variable to stratify baseline",
data = data_r(),
col_subset = c(
"none",
names(data_r())[unlist(lapply(data_r(), data_type)) %in% c("dichotomous", "categorical", "ordinal")]
)
)
})
output$plot_model <- shiny::renderUI({
shiny::req(rv$list$regression$tables)
shiny::selectInput(
inputId = ns("plot_model"),
selected = 1,
label = "Select models to plot",
choices = names(rv$list$regression$tables),
multiple = TRUE
)
})
##############################################################################
#########
######### Regression analysis
#########
##############################################################################
shiny::observeEvent(
input$load,
{
shiny::req(input$outcome_var)
rv$list$regression$models <- NULL
tryCatch(
{
## Which models to create should be decided by input
## Could also include
## imputed or
## minimally adjusted
model_lists <- list(
"Univariable" = regression_model_uv_list,
"Multivariable" = regression_model_list
) |>
lapply(\(.fun){
ls <- do.call(
.fun,
c(
list(data = data_r() |>
(\(.x){
.x[regression_vars()]
})()),
list(outcome.str = input$outcome_var),
list(fun.descr = input$regression_type)
)
)
})
rv$list$regression$params <- get_fun_options(input$regression_type) |>
(\(.x){
.x[[1]]
})()
rv$list$regression$models <- model_lists
},
error = function(err) {
showNotification(paste0("Creating regression models failed with the following error: ", err), type = "err")
}
)
}
)
##############################################################################
#########
######### Model checks
#########
##############################################################################
shiny::observeEvent(
list(
rv$list$regression$models
),
{
shiny::req(rv$list$regression$models)
tryCatch(
{
rv$check <- lapply(rv$list$regression$models, \(.x){
.x$model
}) |>
purrr::pluck("Multivariable") |>
performance::check_model()
},
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
# },
error = function(err) {
showNotification(paste0("Running model assumptions checks failed with the following error: ", err), type = "err")
}
)
}
)
rv$check_plot <- shiny::reactive(plot(rv$check))
output$plot_checks <- shiny::renderUI({
shiny::req(rv$list$regression$models)
shiny::req(rv$check_plot)
## Implement correct plotting
names <- sapply(rv$check_plot(), \(.i){
# .i$labels$title
get_ggplot_label(.i, "title")
})
vectorSelectInput(
inputId = ns("plot_checks"),
selected = 1,
label = "Select checks to plot",
choices = names,
multiple = TRUE
)
})
output$check <- shiny::renderPlot(
{
shiny::req(rv$check_plot)
shiny::req(input$plot_checks)
p <- rv$check_plot() +
# patchwork::wrap_plots() +
patchwork::plot_annotation(title = "Multivariable regression model checks")
layout <- sapply(seq_len(length(p)), \(.x){
patchwork::area(.x, 1)
})
out <- p + patchwork::plot_layout(design = Reduce(c, layout))
index <- match(
input$plot_checks,
sapply(rv$check_plot(), \(.i){
get_ggplot_label(.i, "title")
})
)
ls <- list()
for (i in index) {
p <- out[[i]] +
ggplot2::theme(axis.text = ggplot2::element_text(size = 10),
axis.title = ggplot2::element_text(size = 12),
legend.text = ggplot2::element_text(size = 12),
plot.subtitle = ggplot2::element_text(size = 12),
plot.title = ggplot2::element_text(size = 18))
ls <- c(ls, list(p))
}
# browser()
tryCatch(
{
patchwork::wrap_plots(ls, ncol = if (length(ls) == 1) 1 else 2)
},
error = function(err) {
showNotification(err, type = "err")
}
)
},
alt = "Assumptions testing of the multivariable regression model"
)
shiny::observeEvent(
input$load,
{
shiny::req(rv$list$regression$models)
## To avoid plotting old models on fail/error
rv$list$regression$tables <- NULL
tryCatch(
{
out <- lapply(rv$list$regression$models, \(.x){
.x$model
}) |>
purrr::map(regression_table)
if (input$add_regression_p == "no") {
out <- out |>
lapply(\(.x){
.x |>
gtsummary::modify_column_hide(
column = "p.value"
)
})
}
rv$list$regression$tables <- out
rv$list$input <- input
},
warning = function(warn) {
showNotification(paste0(warn), type = "warning")
},
error = function(err) {
showNotification(paste0("Creating a regression table failed with the following error: ", err), type = "err")
}
)
}
)
output$table2 <- gt::render_gt({
shiny::req(rv$list$regression$tables)
rv$list$regression$tables |>
tbl_merge() |>
gtsummary::as_gt() |>
gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
})
##############################################################################
#########
######### Coefficients plot
#########
##############################################################################
shiny::observeEvent(list(
input$plot_model,
rv$list$regression
), {
shiny::req(input$plot_model)
tryCatch(
{
p <- merge_long(
rv$list$regression,
sort_by(
input$plot_model,
c("Univariable", "Minimal", "Multivariable"),
na.rm = TRUE
)
) |>
(\(.x){
if (length(input$plot_model) > 1) {
plot.tbl_regression(
x = .x,
colour = "model",
dodged = TRUE
) +
ggplot2::theme(legend.position = "bottom") +
ggplot2::guides(color = ggplot2::guide_legend(reverse = TRUE))
} else {
plot.tbl_regression(
x = .x,
colour = "variable"
) +
ggplot2::theme(legend.position = "none")
}
})()
rv$plot <- p +
ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) +
gg_theme_shiny()
},
error = function(err) {
showNotification(paste0(err), type = "err")
}
)
})
output$regression_plot <- shiny::renderPlot(
{
shiny::req(input$plot_model)
rv$plot
},
alt = "Regression coefficient plot"
)
# plot_download_server(
# id = ns("reg_plot_download"),
# data = shiny::reactive(rv$plot)
# )
output$download_plot <- shiny::downloadHandler(
filename = paste0("regression_plot.", input$plot_type),
content = function(file) {
shiny::withProgress(message = "Saving the plot. Hold on for a moment..", {
ggplot2::ggsave(
filename = file,
plot = rv$plot,
width = input$plot_width,
height = input$plot_height,
dpi = 300,
units = "mm", scale = 2
)
})
}
)
##############################################################################
#########
######### Output
#########
##############################################################################
return(shiny::reactive({
data <- rv$list
# code <- list()
#
# if (length(code) > 0) {
# attr(data, "code") <- Reduce(
# f = function(x, y) rlang::expr(!!x %>% !!y),
# x = code
# )
# }
return(data)
}))
}
)
}

View file

@ -134,6 +134,8 @@ regression_model <- function(data,
)
)
# out <- REDCapCAST::set_attr(out,label = fun,attr = "fun.call")
# Recreating the call
# out$call <- match.call(definition=eval(parse(text=fun)), call(fun, data = 'data',formula = as.formula(formula.str),args.list))

View file

@ -24,7 +24,8 @@
#' formula.str = "{outcome.str}~.",
#' args.list = NULL
#' ) |>
#' regression_table() |> plot()
#' regression_table() |>
#' plot()
#' gtsummary::trial |>
#' regression_model(
#' outcome.str = "trt",
@ -94,9 +95,8 @@
#' gtsummary::add_glance_source_note() # |>
#' # gtsummary::bold_p()
#' }
regression_table <- function(x, ...) {
if ("list" %in% class(x)){
if ("list" %in% class(x)) {
x |>
purrr::map(\(.m){
regression_table_create(x = .m, ...) |>
@ -104,24 +104,42 @@ regression_table <- function(x, ...) {
}) |>
gtsummary::tbl_stack()
} else {
regression_table_create(x,...)
regression_table_create(x, ...)
}
}
regression_table_create <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
regression_table_create <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression", theme = c("jama", "lancet", "nejm", "qjecon")) {
# Stripping custom class
class(x) <- class(x)[class(x) != "freesearchr_model"]
theme <- match.arg(theme)
if (any(c(length(class(x)) != 1, class(x) != "lm"))) {
if (!"exponentiate" %in% names(args.list)) {
args.list <- c(args.list, list(exponentiate = TRUE, p.values = TRUE))
}
}
gtsummary::theme_gtsummary_journal(journal = theme)
if (inherits(x, "polr")) {
# browser()
out <- do.call(getfun(fun), c(list(x = x), args.list))
out #|>
# gtsummary::add_glance_source_note() # |>
# gtsummary::bold_p()
# out <- do.call(getfun(fun), c(list(x = x, tidy_fun = list(residual_type = "normal")), args.list))
# out <- do.call(what = getfun(fun),
# args = c(
# list(
# x = x,
# tidy_fun = list(
# conf.int = TRUE,
# conf.level = 0.95,
# residual_type = "normal")),
# args.list)
# )
} else {
out <- do.call(getfun(fun), c(list(x = x), args.list))
}
out
}

View file

@ -79,7 +79,7 @@ update_variables_ui <- function(id, title = "") {
shiny::actionButton(
inputId = ns("validate"),
label = htmltools::tagList(
phosphoricons::ph("arrow-circle-right", title = i18n("Apply changes")),
phosphoricons::ph("arrow-circle-right", title = datamods::i18n("Apply changes")),
datamods::i18n("Apply changes")
),
width = "100%"
@ -137,15 +137,9 @@ update_variables_server <- function(id,
output$table <- toastui::renderDatagrid({
shiny::req(variables_r())
# browser()
variables <- variables_r()
# variables <- variables |>
# dplyr::mutate(vals=as.list(dplyr::as_tibble(data_r())))
# variables <- variables |>
# dplyr::mutate(n_id=seq_len(nrow(variables)))
update_variables_datagrid(
variables,
height = height,
@ -165,7 +159,7 @@ update_variables_server <- function(id,
if (length(new_selections) < 1) {
new_selections <- seq_along(data)
}
# browser()
data_inputs <- data.table::as.data.table(input$table_data)
data.table::setorderv(data_inputs, "rowKey")
@ -184,7 +178,6 @@ update_variables_server <- function(id,
new_classes <- data_inputs$class_toset
new_classes[new_classes == "Select"] <- NA
# browser()
data_sv <- variables_r()
vars_to_change <- get_vars_to_convert(data_sv, setNames(as.list(new_classes), old_names))
@ -251,6 +244,8 @@ update_variables_server <- function(id,
ignoreInit = TRUE
)
# shiny::observeEvent(input$close,
# {
return(shiny::reactive({
data <- updated_data$x
code <- list()
@ -277,6 +272,44 @@ update_variables_server <- function(id,
}
return(data)
}))
# })
# shiny::reactive({
# data <- updated_data$x
# code <- list()
# if (!is.null(data) && shiny::isTruthy(updated_data$list_mutate) && length(updated_data$list_mutate) > 0) {
# code <- c(code, list(rlang::call2("mutate", !!!updated_data$list_mutate)))
# }
# if (!is.null(data) && shiny::isTruthy(updated_data$list_rename) && length(updated_data$list_rename) > 0) {
# code <- c(code, list(rlang::call2("rename", !!!updated_data$list_rename)))
# }
# if (!is.null(data) && shiny::isTruthy(updated_data$list_select) && length(updated_data$list_select) > 0) {
# code <- c(code, list(rlang::expr(select(-any_of(c(!!!updated_data$list_select))))))
# }
# if (!is.null(data) && shiny::isTruthy(updated_data$list_relabel) && length(updated_data$list_relabel) > 0) {
# code <- c(code, list(rlang::call2("purrr::map2(list_relabel,
# function(.data,.label){
# REDCapCAST::set_attr(.data,.label,attr = 'label')
# }) |> dplyr::bind_cols(.name_repair = 'unique_quiet')")))
# }
# if (length(code) > 0) {
# attr(data, "code") <- Reduce(
# f = function(x, y) rlang::expr(!!x %>% !!y),
# x = code
# )
# }
# updated_data$return_data <- data
# })
# shiny::observeEvent(input$close,
# {
# shiny::req(input$close)
# return(shiny::reactive({
# data <- updated_data$return_data
# return(data)
# }))
# })
}
)
}
@ -291,10 +324,10 @@ modal_update_variables <- function(id,
showModal(modalDialog(
title = tagList(title, datamods:::button_close_modal()),
update_variables_ui(id),
tags$div(
style = "display: none;",
textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId())
),
# tags$div(
# style = "display: none;",
# textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId())
# ),
easyClose = easyClose,
size = size,
footer = footer
@ -618,7 +651,11 @@ convert_to <- function(data,
setNames(list(expr(as.factor(!!sym(variable)))), variable)
)
} else if (identical(new_class, "numeric")) {
data[[variable]] <- as.numeric(type.convert(data[[variable]], as.is = TRUE, ...))
data[[variable]] <- as.numeric(data[[variable]], ...)
# This is the original, that would convert to character and then to numeric
# resulting in all NAs, setting as.is = FALSE would result in a numeric
# vector in order of appearance. Now it is acting like integer conversion
# data[[variable]] <- as.numeric(type.convert(data[[variable]], as.is = TRUE, ...))
attr(data, "code_03_convert") <- c(
attr(data, "code_03_convert"),
setNames(list(expr(as.numeric(!!sym(variable)))), variable)
@ -633,7 +670,7 @@ convert_to <- function(data,
data[[variable]] <- as.Date(x = clean_date(data[[variable]]), ...)
attr(data, "code_03_convert") <- c(
attr(data, "code_03_convert"),
setNames(list(expr(as.Date(clean_date(!!sym(variable)), origin = !!args$origin, format=clean_sep(!!args$format)))), variable)
setNames(list(expr(as.Date(clean_date(!!sym(variable)), origin = !!args$origin, format = clean_sep(!!args$format)))), variable)
)
} else if (identical(new_class, "datetime")) {
data[[variable]] <- as.POSIXct(x = data[[variable]], ...)
@ -747,8 +784,8 @@ get_vars_to_convert <- function(vars, classes_input) {
#' @returns character vector
#' @export
#'
clean_sep <- function(data,old.sep="[-.,/]",new.sep="-"){
gsub(old.sep,new.sep,data)
clean_sep <- function(data, old.sep = "[-.,/]", new.sep = "-") {
gsub(old.sep, new.sep, data)
}
#' Attempts at applying uniform date format
@ -758,18 +795,19 @@ clean_sep <- function(data,old.sep="[-.,/]",new.sep="-"){
#' @returns character string
#' @export
#'
clean_date <- function(data){
clean_date <- function(data) {
data |>
clean_sep() |>
sapply(\(.x){
if (is.na(.x)){
if (is.na(.x)) {
.x
} else {
strsplit(.x,"-") |>
unlist()|>
strsplit(.x, "-") |>
unlist() |>
lapply(\(.y){
if (nchar(.y)==1) paste0("0",.y) else .y
}) |> paste(collapse="-")
if (nchar(.y) == 1) paste0("0", .y) else .y
}) |>
paste(collapse = "-")
}
}) |>
unname()

View file

@ -0,0 +1,27 @@
#' Correlations plot demo app
#'
#' @returns shiny app
#' @export
#'
#' @examples
#' \dontrun{
#' cor_demo_app()
#' }
cor_demo_app <- function() {
ui <- shiny::fluidPage(
shiny::sliderInput(
inputId = "cor_cutoff",
label = "Correlation cut-off",
min = 0,
max = 1,
step = .1,
value = .7,
ticks = FALSE
),
data_correlations_ui("data", height = 600)
)
server <- function(input, output, session) {
data_correlations_server("data", data = shiny::reactive(default_parsing(mtcars)), cutoff = shiny::reactive(input$cor_cutoff))
}
shiny::shinyApp(ui, server)
}

View file

@ -0,0 +1,44 @@
#' Download demo
#'
#' @returns
#' @export
#'
#' @examples
#' \dontrun{
#' download_demo_app()
#' }
download_demo_app <- function() {
ui <- bslib::page_fixed(
bslib::nav_panel(
title = "test",
bslib::navset_bar(
sidebar = bslib::sidebar(
bslib::accordion(
do.call(
bslib::accordion_panel,
c(
list(
value = "acc_download",
title = "Download",
icon = bsicons::bs_icon("download")
),
plot_download_ui("regression")
)
)
)
)
)
)
)
server <- function(input, output, session) {
plot_download_server(
id = "regression",
data = {
lm(mpg ~ ., default_parsing(mtcars)) |>
gtsummary::tbl_regression() |>
plot(colour = "variable")
}
)
}
shiny::shinyApp(ui, server)
}

View file

@ -0,0 +1,21 @@
#' Regression module
#'
#' @returns
#' @export
#'
#' @examples
#' \dontrun{
#' regression_demo_app()
#' }
regression_demo_app <- function() {
ui <- bslib::page_fixed(
do.call(
bslib::navset_bar,
regression_ui("regression")
)
)
server <- function(input, output, session) {
regression_server("regression", data = default_parsing(mtcars[1:3]))
}
shiny::shinyApp(ui, server)
}

File diff suppressed because it is too large Load diff

View file

@ -75,6 +75,7 @@ server <- function(input, output, session) {
rv <- shiny::reactiveValues(
list = list(),
regression = list(),
ds = NULL,
local_temp = NULL,
ready = NULL,
@ -165,7 +166,7 @@ server <- function(input, output, session) {
),
handlerExpr = {
shiny::req(rv$data_temp)
# browser()
# browser()
rv$data_original <- rv$data_temp |>
dplyr::select(input$import_var) |>
default_parsing()
@ -251,7 +252,12 @@ server <- function(input, output, session) {
shiny::observeEvent(
input$modal_variables,
modal_update_variables("modal_variables", title = "Update and select variables")
modal_update_variables(
id = "modal_variables",
title = "Update and select variables",
footer = tagList(
actionButton("ok", "OK")
))
)
output$data_info <- shiny::renderUI({
@ -259,12 +265,6 @@ server <- function(input, output, session) {
data_description(data_filter())
})
output$data_info_regression <- shiny::renderUI({
shiny::req(regression_vars())
shiny::req(rv$list$data)
data_description(rv$list$data[regression_vars()])
})
######### Create factor
@ -348,7 +348,7 @@ server <- function(input, output, session) {
shiny::reactive(rv$data),
shiny::reactive(rv$data_original),
data_filter(),
regression_vars(),
# regression_vars(),
input$complete_cutoff
),
{
@ -409,28 +409,32 @@ server <- function(input, output, session) {
pagination = 20
)
tryCatch(
{
output$table_mod <- toastui::renderDatagrid({
shiny::req(rv$data)
# data <- rv$data
toastui::datagrid(
# data = rv$data # ,
data = data_filter(),
pagination = 10
# bordered = TRUE,
# compact = TRUE,
# striped = TRUE
)
observeEvent(input$modal_browse, {
datamods::show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal")
})
},
warning = function(warn) {
showNotification(paste0(warn), type = "warning")
},
error = function(err) {
showNotification(paste0(err), type = "err")
}
)
# tryCatch(
# {
# output$table_mod <- toastui::renderDatagrid({
# shiny::req(rv$data)
# # data <- rv$data
# toastui::datagrid(
# # data = rv$data # ,
# data = data_filter(),
# pagination = 10
# # bordered = TRUE,
# # compact = TRUE,
# # striped = TRUE
# )
# })
# },
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
# },
# error = function(err) {
# showNotification(paste0(err), type = "err")
# }
# )
output$original_str <- renderPrint({
str(rv$data_original)
@ -486,65 +490,65 @@ server <- function(input, output, session) {
## Keep these "old" selection options as a simple alternative to the modification pane
output$regression_vars <- shiny::renderUI({
columnSelectInput(
inputId = "regression_vars",
selected = NULL,
label = "Covariables to include",
data = rv$data_filtered,
multiple = TRUE,
)
})
output$outcome_var <- shiny::renderUI({
columnSelectInput(
inputId = "outcome_var",
selected = NULL,
label = "Select outcome variable",
data = rv$data_filtered,
multiple = FALSE
)
})
output$regression_type <- shiny::renderUI({
shiny::req(input$outcome_var)
shiny::selectizeInput(
inputId = "regression_type",
label = "Choose regression analysis",
## The below ifelse statement handles the case of loading a new dataset
choices = possible_functions(
data = dplyr::select(
rv$data_filtered,
ifelse(input$outcome_var %in% names(rv$data_filtered),
input$outcome_var,
names(rv$data_filtered)[1]
)
), design = "cross-sectional"
),
multiple = FALSE
)
})
output$factor_vars <- shiny::renderUI({
shiny::selectizeInput(
inputId = "factor_vars",
selected = colnames(rv$data_filtered)[sapply(rv$data_filtered, is.factor)],
label = "Covariables to format as categorical",
choices = colnames(rv$data_filtered),
multiple = TRUE
)
})
## Collected regression variables
regression_vars <- shiny::reactive({
if (is.null(input$regression_vars)) {
out <- colnames(rv$data_filtered)
} else {
out <- unique(c(input$regression_vars, input$outcome_var))
}
return(out)
})
# output$regression_vars <- shiny::renderUI({
# columnSelectInput(
# inputId = "regression_vars",
# selected = NULL,
# label = "Covariables to include",
# data = rv$data_filtered,
# multiple = TRUE,
# )
# })
#
# output$outcome_var <- shiny::renderUI({
# columnSelectInput(
# inputId = "outcome_var",
# selected = NULL,
# label = "Select outcome variable",
# data = rv$data_filtered,
# multiple = FALSE
# )
# })
#
# output$regression_type <- shiny::renderUI({
# shiny::req(input$outcome_var)
# shiny::selectizeInput(
# inputId = "regression_type",
# label = "Choose regression analysis",
# ## The below ifelse statement handles the case of loading a new dataset
# choices = possible_functions(
# data = dplyr::select(
# rv$data_filtered,
# ifelse(input$outcome_var %in% names(rv$data_filtered),
# input$outcome_var,
# names(rv$data_filtered)[1]
# )
# ), design = "cross-sectional"
# ),
# multiple = FALSE
# )
# })
#
# output$factor_vars <- shiny::renderUI({
# shiny::selectizeInput(
# inputId = "factor_vars",
# selected = colnames(rv$data_filtered)[sapply(rv$data_filtered, is.factor)],
# label = "Covariables to format as categorical",
# choices = colnames(rv$data_filtered),
# multiple = TRUE
# )
# })
#
# ## Collected regression variables
# regression_vars <- shiny::reactive({
# if (is.null(input$regression_vars)) {
# out <- colnames(rv$data_filtered)
# } else {
# out <- unique(c(input$regression_vars, input$outcome_var))
# }
# return(out)
# })
#
output$strat_var <- shiny::renderUI({
columnSelectInput(
inputId = "strat_var",
@ -557,18 +561,18 @@ server <- function(input, output, session) {
)
)
})
output$plot_model <- shiny::renderUI({
shiny::req(rv$list$regression$tables)
shiny::selectInput(
inputId = "plot_model",
selected = "none",
label = "Select models to plot",
choices = names(rv$list$regression$tables),
multiple = TRUE
)
})
#
#
# output$plot_model <- shiny::renderUI({
# shiny::req(rv$list$regression$tables)
# shiny::selectInput(
# inputId = "plot_model",
# selected = "none",
# label = "Select models to plot",
# choices = names(rv$list$regression$tables),
# multiple = TRUE
# )
# })
##############################################################################
@ -656,193 +660,197 @@ server <- function(input, output, session) {
#########
##############################################################################
shiny::observeEvent(
input$load,
{
shiny::req(input$outcome_var)
# browser()
# Assumes all character variables can be formatted as factors
# data <- data_filter$filtered() |>
tryCatch(
{
## Which models to create should be decided by input
## Could also include
## imputed or
## minimally adjusted
model_lists <- list(
"Univariable" = regression_model_uv_list,
"Multivariable" = regression_model_list
) |>
lapply(\(.fun){
ls <- do.call(
.fun,
c(
list(data = rv$list$data |>
(\(.x){
.x[regression_vars()]
})()),
list(outcome.str = input$outcome_var),
list(fun.descr = input$regression_type)
)
)
})
rv$regression <- regression_server("regression", data = shiny::reactive(rv$data_filtered))
# browser()
# rv$list$regression <- regression_server("regression", data = shiny::reactive(rv$data_filtered))
rv$list$regression$params <- get_fun_options(input$regression_type) |>
(\(.x){
.x[[1]]
})()
rv$list$regression$models <- model_lists
# names(rv$list$regression)
# rv$models <- lapply(model_lists, \(.x){
# .x$model
# })
},
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
# },
error = function(err) {
showNotification(paste0("Creating regression models failed with the following error: ", err), type = "err")
}
)
}
)
shiny::observeEvent(
ignoreInit = TRUE,
list(
rv$list$regression$models
),
{
shiny::req(rv$list$regression$models)
tryCatch(
{
rv$check <- lapply(rv$list$regression$models, \(.x){
.x$model
}) |>
purrr::pluck("Multivariable") |>
performance::check_model()
},
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
# },
error = function(err) {
showNotification(paste0("Running model assumptions checks failed with the following error: ", err), type = "err")
}
)
}
)
output$check <- shiny::renderPlot(
{
shiny::req(rv$check)
# browser()
# p <- plot(rv$check) +
# patchwork::plot_annotation(title = "Multivariable regression model checks")
p <- plot(rv$check) +
patchwork::plot_annotation(title = "Multivariable regression model checks")
for (i in seq_len(length(p))) {
p[[i]] <- p[[i]] + gg_theme_shiny()
}
p
# p + patchwork::plot_layout(ncol = 1, design = ggplot2::waiver())
# Generate checks in one column
# layout <- sapply(seq_len(length(p)), \(.x){
# patchwork::area(.x, 1)
# shiny::observeEvent(
# input$load,
# {
# shiny::req(input$outcome_var)
# # browser()
# # Assumes all character variables can be formatted as factors
# # data <- data_filter$filtered() |>
# tryCatch(
# {
# ## Which models to create should be decided by input
# ## Could also include
# ## imputed or
# ## minimally adjusted
# model_lists <- list(
# "Univariable" = regression_model_uv_list,
# "Multivariable" = regression_model_list
# ) |>
# lapply(\(.fun){
# ls <- do.call(
# .fun,
# c(
# list(data = rv$list$data |>
# (\(.x){
# .x[regression_vars()]
# })()),
# list(outcome.str = input$outcome_var),
# list(fun.descr = input$regression_type)
# )
# )
# })
#
# p + patchwork::plot_layout(design = Reduce(c, layout))
# patchwork::wrap_plots(ncol=1) +
# patchwork::plot_annotation(title = 'Multivariable regression model checks')
},
height = 600,
alt = "Assumptions testing of the multivariable regression model"
)
shiny::observeEvent(
input$load,
{
shiny::req(rv$list$regression$models)
tryCatch(
{
out <- lapply(rv$list$regression$models, \(.x){
.x$model
}) |>
purrr::map(regression_table)
if (input$add_regression_p == "no") {
out <- out |>
lapply(\(.x){
.x |>
gtsummary::modify_column_hide(
column = "p.value"
)
})
}
rv$list$regression$tables <- out
# rv$list$regression$table <- out |>
# tbl_merge()
# gtsummary::as_kable(rv$list$regression$table) |>
# readr::write_lines(file="./www/_regression_table.md")
rv$list$input <- input
},
warning = function(warn) {
showNotification(paste0(warn), type = "warning")
},
error = function(err) {
showNotification(paste0("Creating a regression table failed with the following error: ", err), type = "err")
}
)
rv$ready <- "ready"
}
)
output$table2 <- gt::render_gt({
shiny::req(rv$list$regression$tables)
rv$list$regression$tables |>
tbl_merge() |>
gtsummary::as_gt() |>
gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
})
output$regression_plot <- shiny::renderPlot(
{
# shiny::req(rv$list$regression$plot)
shiny::req(input$plot_model)
out <- merge_long(rv$list$regression, input$plot_model) |>
plot.tbl_regression(
colour = "variable",
facet_col = "model"
)
out +
ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) +
gg_theme_shiny()
# rv$list$regression$tables$Multivariable |>
# plot(colour = "variable") +
# # browser()
#
# rv$list$regression$params <- get_fun_options(input$regression_type) |>
# (\(.x){
# .x[[1]]
# })()
#
# rv$list$regression$models <- model_lists
#
# # names(rv$list$regression)
#
# # rv$models <- lapply(model_lists, \(.x){
# # .x$model
# # })
# },
# # warning = function(warn) {
# # showNotification(paste0(warn), type = "warning")
# # },
# error = function(err) {
# showNotification(paste0("Creating regression models failed with the following error: ", err), type = "err")
# }
# )
# }
# )
#
# shiny::observeEvent(
# ignoreInit = TRUE,
# list(
# rv$list$regression$models
# ),
# {
# shiny::req(rv$list$regression$models)
# tryCatch(
# {
# rv$check <- lapply(rv$list$regression$models, \(.x){
# .x$model
# }) |>
# purrr::pluck("Multivariable") |>
# performance::check_model()
# },
# # warning = function(warn) {
# # showNotification(paste0(warn), type = "warning")
# # },
# error = function(err) {
# showNotification(paste0("Running model assumptions checks failed with the following error: ", err), type = "err")
# }
# )
# }
# )
#
# output$check <- shiny::renderPlot(
# {
# shiny::req(rv$check)
# # browser()
# # p <- plot(rv$check) +
# # patchwork::plot_annotation(title = "Multivariable regression model checks")
#
# p <- plot(rv$check) +
# patchwork::plot_annotation(title = "Multivariable regression model checks")
#
# for (i in seq_len(length(p))) {
# p[[i]] <- p[[i]] + gg_theme_shiny()
# }
#
# p
#
# # p + patchwork::plot_layout(ncol = 1, design = ggplot2::waiver())
#
# # Generate checks in one column
# # layout <- sapply(seq_len(length(p)), \(.x){
# # patchwork::area(.x, 1)
# # })
# #
# # p + patchwork::plot_layout(design = Reduce(c, layout))
#
# # patchwork::wrap_plots(ncol=1) +
# # patchwork::plot_annotation(title = 'Multivariable regression model checks')
# },
# height = 600,
# alt = "Assumptions testing of the multivariable regression model"
# )
#
#
# shiny::observeEvent(
# input$load,
# {
# shiny::req(rv$list$regression$models)
# tryCatch(
# {
# out <- lapply(rv$list$regression$models, \(.x){
# .x$model
# }) |>
# purrr::map(regression_table)
#
# if (input$add_regression_p == "no") {
# out <- out |>
# lapply(\(.x){
# .x |>
# gtsummary::modify_column_hide(
# column = "p.value"
# )
# })
# }
#
# rv$list$regression$tables <- out
#
# # rv$list$regression$table <- out |>
# # tbl_merge()
#
# # gtsummary::as_kable(rv$list$regression$table) |>
# # readr::write_lines(file="./www/_regression_table.md")
#
# rv$list$input <- input
# },
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
# },
# error = function(err) {
# showNotification(paste0("Creating a regression table failed with the following error: ", err), type = "err")
# }
# )
# rv$ready <- "ready"
# }
# )
#
# output$table2 <- gt::render_gt({
# shiny::req(rv$list$regression$tables)
# rv$list$regression$tables |>
# tbl_merge() |>
# gtsummary::as_gt() |>
# gt::tab_header(gt::md(glue::glue("**Table 2: {rv$list$regression$params$descr}**")))
# })
#
# output$regression_plot <- shiny::renderPlot(
# {
# # shiny::req(rv$list$regression$plot)
# shiny::req(input$plot_model)
#
# out <- merge_long(rv$list$regression, input$plot_model) |>
# plot.tbl_regression(
# colour = "variable",
# facet_col = "model"
# )
#
# out +
# ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) +
# gg_theme_shiny()
},
height = 500,
alt = "Regression coefficient plot"
)
#
# # rv$list$regression$tables$Multivariable |>
# # plot(colour = "variable") +
# # ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) +
# # gg_theme_shiny()
# },
# height = 500,
# alt = "Regression coefficient plot"
# )
# shiny::conditionalPanel(
# condition = "output.uploaded == 'yes'",
@ -912,21 +920,26 @@ server <- function(input, output, session) {
# shiny::req(rv$list$regression)
## Notification is not progressing
## Presumably due to missing
# browser()
# Simplified for .rmd output attempt
format <- ifelse(type == "docx", "word_document", "odt_document")
# browser()
rv$list$regression <- rv$regression()
shiny::withProgress(message = "Generating the report. Hold on for a moment..", {
tryCatch(
{
rv$list |>
write_rmd(
output_format = format,
input = file.path(getwd(), "www/report.rmd")
)
# write_quarto(
# output_format = type,
# input = file.path(getwd(), "www/report.qmd")
# )
},
error = function(err) {
showNotification(paste0("We encountered the following error creating your report: ", err), type = "err")
}
)
})
file.rename(paste0("www/report.", type), file)
}

View file

@ -146,27 +146,34 @@ ui_elements <- list(
),
shiny::column(
width = 3,
shiny::actionButton(
inputId = "modal_browse",
label = "Browse data",
width = "100%"
),
shiny::tags$br(),
shiny::tags$br(),
IDEAFilter::IDEAFilter_ui("data_filter"),
shiny::tags$br()
)
)
),
bslib::nav_panel(
title = "Browse",
tags$h3("Browse the provided data"),
shiny::tags$p(
"Below is a table with all the modified data provided to browse and understand data."
),
shinyWidgets::html_dependency_winbox(),
fluidRow(
toastui::datagridOutput(outputId = "table_mod")
),
shiny::tags$br(),
shiny::tags$br(),
shiny::tags$br(),
shiny::tags$br(),
shiny::tags$br()
),
# bslib::nav_panel(
# title = "Browse",
# tags$h3("Browse the provided data"),
# shiny::tags$p(
# "Below is a table with all the modified data provided to browse and understand data."
# ),
# shinyWidgets::html_dependency_winbox(),
# fluidRow(
# toastui::datagridOutput(outputId = "table_mod")
# ),
# shiny::tags$br(),
# shiny::tags$br(),
# shiny::tags$br(),
# shiny::tags$br(),
# shiny::tags$br()
# ),
bslib::nav_panel(
title = "Modify",
tags$h3("Subset, rename and convert variables"),
@ -178,26 +185,31 @@ ui_elements <- list(
),
shiny::tags$br(),
shiny::tags$br(),
update_variables_ui("modal_variables"),
shiny::tags$br(),
shiny::tags$br(),
fluidRow(
shiny::column(
width = 2
),
shiny::column(
width = 8,
tags$h4("Advanced data manipulation"),
shiny::tags$br(),
fluidRow(
shiny::column(
width = 6,
tags$h4("Update or modify variables"),
shiny::tags$br(),
shiny::actionButton(
inputId = "modal_variables",
label = "Subset, rename and change class/type",
width = "100%"
),
shiny::tags$br(),
shiny::helpText("Subset variables, rename variables and labels, and apply new class to variables"),
shiny::tags$br(),
shiny::tags$br(),
# tags$h4("Update or modify variables"),
# shiny::tags$br(),
# shiny::actionButton(
# inputId = "modal_variables",
# label = "Subset, rename and change class/type",
# width = "100%"
# ),
# shiny::tags$br(),
# shiny::helpText("Subset variables, rename variables and labels, and apply new class to variables"),
# shiny::tags$br(),
# shiny::tags$br(),
shiny::actionButton(
inputId = "modal_update",
label = "Reorder factor levels",
@ -206,12 +218,21 @@ ui_elements <- list(
shiny::tags$br(),
shiny::helpText("Reorder the levels of factor/categorical variables."),
shiny::tags$br(),
shiny::tags$br(),
shiny::actionButton(
inputId = "data_reset",
label = "Restore original data",
width = "100%"
),
shiny::tags$br(),
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."),
shiny::tags$br(),
shiny::tags$br()
),
shiny::column(
width = 6,
tags$h4("Create new variables"),
shiny::tags$br(),
# tags$h4("Create new variables"),
# shiny::tags$br(),
shiny::actionButton(
inputId = "modal_cut",
label = "New factor",
@ -231,15 +252,15 @@ ui_elements <- list(
shiny::tags$br(),
shiny::tags$br()
)
),
tags$h4("Restore"),
shiny::actionButton(
inputId = "data_reset",
label = "Restore original data",
width = "100%"
),
shiny::tags$br(),
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing.")
) # ,
# tags$h4("Restore"),
# shiny::actionButton(
# inputId = "data_reset",
# label = "Restore original data",
# width = "100%"
# ),
# shiny::tags$br(),
# shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing.")
),
shiny::column(
width = 2
@ -247,10 +268,10 @@ ui_elements <- list(
),
shiny::tags$br(),
shiny::tags$br(),
tags$h4("Restore"),
tags$h4("Compare modified data to original"),
shiny::tags$br(),
shiny::tags$p(
"Below, you'll find a raw overview of the original vs the modified data."
"Here is a overview of the original vs the modified data."
),
shiny::tags$br(),
shiny::tags$br(),
@ -385,110 +406,114 @@ ui_elements <- list(
bslib::nav_panel(
title = "Regression",
id = "navanalyses",
bslib::navset_bar(
title = "",
# bslib::layout_sidebar(
# fillable = TRUE,
sidebar = bslib::sidebar(
shiny::uiOutput(outputId = "data_info_regression", inline = TRUE),
bslib::accordion(
open = "acc_reg",
multiple = FALSE,
bslib::accordion_panel(
value = "acc_reg",
title = "Regression",
icon = bsicons::bs_icon("calculator"),
shiny::uiOutput("outcome_var"),
# shiny::selectInput(
# inputId = "design",
# label = "Study design",
# selected = "no",
# inline = TRUE,
# choices = list(
# "Cross-sectional" = "cross-sectional"
# )
# ),
shiny::uiOutput("regression_type"),
shiny::radioButtons(
inputId = "add_regression_p",
label = "Add p-value",
inline = TRUE,
selected = "yes",
choices = list(
"Yes" = "yes",
"No" = "no"
do.call(
bslib::navset_bar,
regression_ui("regression")
)
),
bslib::input_task_button(
id = "load",
label = "Analyse",
# icon = shiny::icon("pencil", lib = "glyphicon"),
icon = bsicons::bs_icon("pencil"),
label_busy = "Working...",
icon_busy = fontawesome::fa_i("arrows-rotate",
class = "fa-spin",
"aria-hidden" = "true"
),
type = "secondary",
auto_reset = TRUE
),
shiny::helpText("Press 'Analyse' again after changing parameters."),
shiny::tags$br(),
shiny::uiOutput("plot_model")
),
bslib::accordion_panel(
value = "acc_advanced",
title = "Advanced",
icon = bsicons::bs_icon("gear"),
shiny::radioButtons(
inputId = "all",
label = "Specify covariables",
inline = TRUE, selected = 2,
choiceNames = c(
"Yes",
"No"
),
choiceValues = c(1, 2)
),
shiny::conditionalPanel(
condition = "input.all==1",
shiny::uiOutput("regression_vars")
)
)
),
# shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")),
# bslib::navset_bar(
# title = "",
# # bslib::layout_sidebar(
# # fillable = TRUE,
# sidebar = bslib::sidebar(
# shiny::uiOutput(outputId = "data_info_regression", inline = TRUE),
# bslib::accordion(
# open = "acc_reg",
# multiple = FALSE,
# bslib::accordion_panel(
# value = "acc_reg",
# title = "Regression",
# icon = bsicons::bs_icon("calculator"),
# shiny::uiOutput("outcome_var"),
# # shiny::selectInput(
# # inputId = "design",
# # label = "Study design",
# # selected = "no",
# # inline = TRUE,
# # choices = list(
# # "Cross-sectional" = "cross-sectional"
# # )
# # ),
# shiny::uiOutput("regression_type"),
# shiny::radioButtons(
# inputId = "specify_factors",
# label = "Specify categorical variables?",
# selected = "no",
# inputId = "add_regression_p",
# label = "Add p-value",
# inline = TRUE,
# selected = "yes",
# choices = list(
# "Yes" = "yes",
# "No" = "no"
# )
# ),
# shiny::conditionalPanel(
# condition = "input.specify_factors=='yes'",
# shiny::uiOutput("factor_vars")
# bslib::input_task_button(
# id = "load",
# label = "Analyse",
# # icon = shiny::icon("pencil", lib = "glyphicon"),
# icon = bsicons::bs_icon("pencil"),
# label_busy = "Working...",
# icon_busy = fontawesome::fa_i("arrows-rotate",
# class = "fa-spin",
# "aria-hidden" = "true"
# ),
# type = "secondary",
# auto_reset = TRUE
# ),
# shiny::helpText("Press 'Analyse' again after changing parameters."),
# shiny::tags$br(),
# shiny::uiOutput("plot_model")
# ),
# bslib::accordion_panel(
# value = "acc_advanced",
# title = "Advanced",
# icon = bsicons::bs_icon("gear"),
# shiny::radioButtons(
# inputId = "all",
# label = "Specify covariables",
# inline = TRUE, selected = 2,
# choiceNames = c(
# "Yes",
# "No"
# ),
# choiceValues = c(1, 2)
# ),
# shiny::conditionalPanel(
# condition = "output.ready=='yes'",
# shiny::tags$hr(),
),
bslib::nav_panel(
title = "Regression table",
gt::gt_output(outputId = "table2")
),
bslib::nav_panel(
title = "Coefficient plot",
shiny::plotOutput(outputId = "regression_plot")
),
bslib::nav_panel(
title = "Model checks",
shiny::plotOutput(outputId = "check")
# shiny::uiOutput(outputId = "check_1")
)
)
# condition = "input.all==1",
# shiny::uiOutput("regression_vars")
# )
# )
# ),
# # shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")),
# # shiny::radioButtons(
# # inputId = "specify_factors",
# # label = "Specify categorical variables?",
# # selected = "no",
# # inline = TRUE,
# # choices = list(
# # "Yes" = "yes",
# # "No" = "no"
# # )
# # ),
# # shiny::conditionalPanel(
# # condition = "input.specify_factors=='yes'",
# # shiny::uiOutput("factor_vars")
# # ),
# # shiny::conditionalPanel(
# # condition = "output.ready=='yes'",
# # shiny::tags$hr(),
# ),
# bslib::nav_panel(
# title = "Regression table",
# gt::gt_output(outputId = "table2")
# ),
# bslib::nav_panel(
# title = "Coefficient plot",
# shiny::plotOutput(outputId = "regression_plot")
# ),
# bslib::nav_panel(
# title = "Model checks",
# shiny::plotOutput(outputId = "check")
# # shiny::uiOutput(outputId = "check_1")
# )
# )
),
##############################################################################
#########
@ -635,7 +660,7 @@ ui <- bslib::page_fixed(
),
shiny::p(
style = "margin: 1; color: #888;",
"AG Damsbo | v", app_version(), " | ",shiny::tags$a("AGPLv3 license", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer")," | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
"AG Damsbo | v", app_version(), " | ", shiny::tags$a("AGPLv3 license", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer"), " | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
),
)
)

Binary file not shown.

After

Width:  |  Height:  |  Size: 31 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 6.4 KiB

After

Width:  |  Height:  |  Size: 31 KiB

View file

@ -15,6 +15,7 @@ knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```{r}
web_data <- readr::read_rds(file = params$data.file)
# web_data <- readr::read_rds(file = "~/FreesearchR/inst/apps/FreesearchR/www/web_data.rds")
library(gtsummary)
library(gt)
@ -52,21 +53,21 @@ Analyses were conducted in the *FreesearchR* data analysis web-tool based on R v
Below are the baseline characteristics.
```{r, results = 'asis'}
if ("table1" %in% names(web_data)){
tbl <- gtsummary::as_gt(web_data$table1)
knitr::knit_print(tbl)}
if ("table1" %in% names(web_data)) {
tbl <- gtsummary::as_gt(web_data$table1)
knitr::knit_print(tbl)
}
```
`r if ("regression" %in% names(web_data)) glue::glue("Below are the results from the { tolower(vec2sentence(names(web_data$regression$tables)))} {web_data$regression$params$descr}.")`
`r if (length(web_data$regression) > 0) glue::glue("Below are the results from the { tolower(vec2sentence(names(web_data$regression$regression$tables)))} {web_data$regression$regression$params$descr}.")`
```{r, results = 'asis'}
if ("regression" %in% names(web_data)){
reg_tbl <- web_data$regression$tables
knitr::knit_print(tbl_merge(reg_tbl))
if ("regression" %in% names(web_data) && length(web_data$regression) > 0) {
reg_tbl <- web_data$regression$regression$tables
knitr::knit_print(tbl_merge(reg_tbl))
}
```
## Discussion
Good luck on your further work!

View file

@ -1,16 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/correlations-module.R
\name{cor_demo_app}
\alias{cor_demo_app}
\title{Correlations plot demo app}
\usage{
cor_demo_app()
}
\description{
Correlations plot demo app
}
\examples{
\dontrun{
cor_demo_app()
}
}

View file

@ -4,7 +4,14 @@
\alias{create_baseline}
\title{Create a baseline table}
\usage{
create_baseline(data, ..., by.var, add.p = FALSE, add.overall = FALSE)
create_baseline(
data,
...,
by.var,
add.p = FALSE,
add.overall = FALSE,
theme = c("jama", "lancet", "nejm", "qjecon")
)
}
\arguments{
\item{data}{data}
@ -24,5 +31,5 @@ gtsummary table list object
Create a baseline table
}
\examples{
mtcars |> create_baseline(by.var = "gear", add.p="yes"=="yes")
mtcars |> create_baseline(by.var = "gear", add.p = "yes" == "yes")
}

View file

@ -36,7 +36,8 @@ gtsummary::trial |>
formula.str = "{outcome.str}~.",
args.list = NULL
) |>
regression_table() |> plot()
regression_table() |>
plot()
gtsummary::trial |>
regression_model(
outcome.str = "trt",
@ -73,7 +74,7 @@ list(
}) |>
purrr::map(regression_table) |>
tbl_merge()
}
}
regression_table <- function(x, ...) {
UseMethod("regression_table")
}

26
man/sort_by.Rd Normal file
View file

@ -0,0 +1,26 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/helpers.R
\name{sort_by}
\alias{sort_by}
\title{Drop-in replacement for the base::sort_by with option to remove NAs}
\usage{
sort_by(x, y, na.rm = FALSE, ...)
}
\arguments{
\item{x}{x}
\item{y}{y}
\item{na.rm}{remove NAs}
\item{...}{passed to base_sort_by}
}
\value{
vector
}
\description{
Drop-in replacement for the base::sort_by with option to remove NAs
}
\examples{
sort_by(c("Multivariable", "Univariable"),c("Univariable","Minimal","Multivariable"))
}

111
renv.lock
View file

@ -674,11 +674,11 @@
},
"RcppArmadillo": {
"Package": "RcppArmadillo",
"Version": "14.4.0-1",
"Version": "14.4.1-1",
"Source": "Repository",
"Type": "Package",
"Title": "'Rcpp' Integration for the 'Armadillo' Templated Linear Algebra Library",
"Date": "2025-02-17",
"Date": "2025-03-27",
"Authors@R": "c(person(\"Dirk\", \"Eddelbuettel\", role = c(\"aut\", \"cre\"), email = \"edd@debian.org\", comment = c(ORCID = \"0000-0001-6419-907X\")), person(\"Romain\", \"Francois\", role = \"aut\", comment = c(ORCID = \"0000-0002-2444-4226\")), person(\"Doug\", \"Bates\", role = \"aut\", comment = c(ORCID = \"0000-0001-8316-9503\")), person(\"Binxiang\", \"Ni\", role = \"aut\"), person(\"Conrad\", \"Sanderson\", role = \"aut\", comment = c(ORCID = \"0000-0002-0049-4501\")))",
"Description": "'Armadillo' is a templated C++ linear algebra library (by Conrad Sanderson) that aims towards a good balance between speed and ease of use. Integer, floating point and complex numbers are supported, as well as a subset of trigonometric and statistics functions. Various matrix decompositions are provided through optional integration with LAPACK and ATLAS libraries. The 'RcppArmadillo' package includes the header files from the templated 'Armadillo' library. Thus users do not need to install 'Armadillo' itself in order to use 'RcppArmadillo'. From release 7.800.0 on, 'Armadillo' is licensed under Apache License 2; previous releases were under licensed as MPL 2.0 from version 3.800.0 onwards and LGPL-3 prior to that; 'RcppArmadillo' (the 'Rcpp' bindings/bridge to Armadillo) is licensed under the GNU GPL version 2 or later, as is the rest of 'Rcpp'.",
"License": "GPL (>= 2)",
@ -783,7 +783,7 @@
},
"V8": {
"Package": "V8",
"Version": "6.0.2",
"Version": "6.0.3",
"Source": "Repository",
"Type": "Package",
"Title": "Embedded JavaScript and WebAssembly Engine for R",
@ -1231,7 +1231,7 @@
},
"broom": {
"Package": "broom",
"Version": "1.0.7",
"Version": "1.0.8",
"Source": "Repository",
"Type": "Package",
"Title": "Convert Statistical Objects into Tidy Tibbles",
@ -1245,12 +1245,13 @@
],
"Imports": [
"backports",
"cli",
"dplyr (>= 1.0.0)",
"generics (>= 0.0.2)",
"glue",
"lifecycle",
"purrr",
"rlang",
"rlang (>= 1.1.0)",
"stringr",
"tibble (>= 3.0.0)",
"tidyr (>= 1.0.0)"
@ -1315,7 +1316,6 @@
"multcomp",
"network",
"nnet",
"orcutt (>= 2.2)",
"ordinal",
"plm",
"poLCA",
@ -1333,7 +1333,7 @@
"survey",
"survival (>= 3.6-4)",
"systemfit",
"testthat (>= 2.1.0)",
"testthat (>= 3.0.0)",
"tseries",
"vars",
"zoo"
@ -1343,7 +1343,8 @@
"Encoding": "UTF-8",
"RoxygenNote": "7.3.2",
"Language": "en-US",
"Collate": "'aaa-documentation-helper.R' 'null-and-default-tidiers.R' 'aer-tidiers.R' 'auc-tidiers.R' 'base-tidiers.R' 'bbmle-tidiers.R' 'betareg-tidiers.R' 'biglm-tidiers.R' 'bingroup-tidiers.R' 'boot-tidiers.R' 'broom-package.R' 'broom.R' 'btergm-tidiers.R' 'car-tidiers.R' 'caret-tidiers.R' 'cluster-tidiers.R' 'cmprsk-tidiers.R' 'data-frame-tidiers.R' 'deprecated-0-7-0.R' 'drc-tidiers.R' 'emmeans-tidiers.R' 'epiR-tidiers.R' 'ergm-tidiers.R' 'fixest-tidiers.R' 'gam-tidiers.R' 'geepack-tidiers.R' 'glmnet-cv-glmnet-tidiers.R' 'glmnet-glmnet-tidiers.R' 'gmm-tidiers.R' 'hmisc-tidiers.R' 'joinerml-tidiers.R' 'kendall-tidiers.R' 'ks-tidiers.R' 'lavaan-tidiers.R' 'leaps-tidiers.R' 'lfe-tidiers.R' 'list-irlba.R' 'list-optim-tidiers.R' 'list-svd-tidiers.R' 'list-tidiers.R' 'list-xyz-tidiers.R' 'lm-beta-tidiers.R' 'lmodel2-tidiers.R' 'lmtest-tidiers.R' 'maps-tidiers.R' 'margins-tidiers.R' 'mass-fitdistr-tidiers.R' 'mass-negbin-tidiers.R' 'mass-polr-tidiers.R' 'mass-ridgelm-tidiers.R' 'stats-lm-tidiers.R' 'mass-rlm-tidiers.R' 'mclust-tidiers.R' 'mediation-tidiers.R' 'metafor-tidiers.R' 'mfx-tidiers.R' 'mgcv-tidiers.R' 'mlogit-tidiers.R' 'muhaz-tidiers.R' 'multcomp-tidiers.R' 'nnet-tidiers.R' 'nobs.R' 'orcutt-tidiers.R' 'ordinal-clm-tidiers.R' 'ordinal-clmm-tidiers.R' 'plm-tidiers.R' 'polca-tidiers.R' 'psych-tidiers.R' 'stats-nls-tidiers.R' 'quantreg-nlrq-tidiers.R' 'quantreg-rq-tidiers.R' 'quantreg-rqs-tidiers.R' 'robust-glmrob-tidiers.R' 'robust-lmrob-tidiers.R' 'robustbase-glmrob-tidiers.R' 'robustbase-lmrob-tidiers.R' 'sp-tidiers.R' 'spdep-tidiers.R' 'speedglm-speedglm-tidiers.R' 'speedglm-speedlm-tidiers.R' 'stats-anova-tidiers.R' 'stats-arima-tidiers.R' 'stats-decompose-tidiers.R' 'stats-factanal-tidiers.R' 'stats-glm-tidiers.R' 'stats-htest-tidiers.R' 'stats-kmeans-tidiers.R' 'stats-loess-tidiers.R' 'stats-mlm-tidiers.R' 'stats-prcomp-tidiers.R' 'stats-smooth.spline-tidiers.R' 'stats-summary-lm-tidiers.R' 'stats-time-series-tidiers.R' 'survey-tidiers.R' 'survival-aareg-tidiers.R' 'survival-cch-tidiers.R' 'survival-coxph-tidiers.R' 'survival-pyears-tidiers.R' 'survival-survdiff-tidiers.R' 'survival-survexp-tidiers.R' 'survival-survfit-tidiers.R' 'survival-survreg-tidiers.R' 'systemfit-tidiers.R' 'tseries-tidiers.R' 'utilities.R' 'vars-tidiers.R' 'zoo-tidiers.R' 'zzz.R'",
"Collate": "'aaa-documentation-helper.R' 'null-and-default.R' 'aer.R' 'auc.R' 'base.R' 'bbmle.R' 'betareg.R' 'biglm.R' 'bingroup.R' 'boot.R' 'broom-package.R' 'broom.R' 'btergm.R' 'car.R' 'caret.R' 'cluster.R' 'cmprsk.R' 'data-frame.R' 'deprecated-0-7-0.R' 'drc.R' 'emmeans.R' 'epiR.R' 'ergm.R' 'fixest.R' 'gam.R' 'geepack.R' 'glmnet-cv-glmnet.R' 'glmnet-glmnet.R' 'gmm.R' 'hmisc.R' 'import-standalone-obj-type.R' 'import-standalone-types-check.R' 'joinerml.R' 'kendall.R' 'ks.R' 'lavaan.R' 'leaps.R' 'lfe.R' 'list-irlba.R' 'list-optim.R' 'list-svd.R' 'list-xyz.R' 'list.R' 'lm-beta.R' 'lmodel2.R' 'lmtest.R' 'maps.R' 'margins.R' 'mass-fitdistr.R' 'mass-negbin.R' 'mass-polr.R' 'mass-ridgelm.R' 'stats-lm.R' 'mass-rlm.R' 'mclust.R' 'mediation.R' 'metafor.R' 'mfx.R' 'mgcv.R' 'mlogit.R' 'muhaz.R' 'multcomp.R' 'nnet.R' 'nobs.R' 'ordinal-clm.R' 'ordinal-clmm.R' 'plm.R' 'polca.R' 'psych.R' 'stats-nls.R' 'quantreg-nlrq.R' 'quantreg-rq.R' 'quantreg-rqs.R' 'robust-glmrob.R' 'robust-lmrob.R' 'robustbase-glmrob.R' 'robustbase-lmrob.R' 'sp.R' 'spdep.R' 'speedglm-speedglm.R' 'speedglm-speedlm.R' 'stats-anova.R' 'stats-arima.R' 'stats-decompose.R' 'stats-factanal.R' 'stats-glm.R' 'stats-htest.R' 'stats-kmeans.R' 'stats-loess.R' 'stats-mlm.R' 'stats-prcomp.R' 'stats-smooth.spline.R' 'stats-summary-lm.R' 'stats-time-series.R' 'survey.R' 'survival-aareg.R' 'survival-cch.R' 'survival-coxph.R' 'survival-pyears.R' 'survival-survdiff.R' 'survival-survexp.R' 'survival-survfit.R' 'survival-survreg.R' 'systemfit.R' 'tseries.R' 'utilities.R' 'vars.R' 'zoo.R' 'zzz.R'",
"Config/testthat/edition": "3",
"NeedsCompilation": "no",
"Author": "David Robinson [aut], Alex Hayes [aut] (<https://orcid.org/0000-0002-4985-5160>), Simon Couch [aut, cre] (<https://orcid.org/0000-0001-5676-5107>), Posit Software, PBC [cph, fnd], Indrajeet Patil [ctb] (<https://orcid.org/0000-0003-1995-6531>), Derek Chiu [ctb], Matthieu Gomez [ctb], Boris Demeshev [ctb], Dieter Menne [ctb], Benjamin Nutter [ctb], Luke Johnston [ctb], Ben Bolker [ctb], Francois Briatte [ctb], Jeffrey Arnold [ctb], Jonah Gabry [ctb], Luciano Selzer [ctb], Gavin Simpson [ctb], Jens Preussner [ctb], Jay Hesselberth [ctb], Hadley Wickham [ctb], Matthew Lincoln [ctb], Alessandro Gasparini [ctb], Lukasz Komsta [ctb], Frederick Novometsky [ctb], Wilson Freitas [ctb], Michelle Evans [ctb], Jason Cory Brunson [ctb], Simon Jackson [ctb], Ben Whalley [ctb], Karissa Whiting [ctb], Yves Rosseel [ctb], Michael Kuehn [ctb], Jorge Cimentada [ctb], Erle Holgersen [ctb], Karl Dunkle Werner [ctb] (<https://orcid.org/0000-0003-0523-7309>), Ethan Christensen [ctb], Steven Pav [ctb], Paul PJ [ctb], Ben Schneider [ctb], Patrick Kennedy [ctb], Lily Medina [ctb], Brian Fannin [ctb], Jason Muhlenkamp [ctb], Matt Lehman [ctb], Bill Denney [ctb] (<https://orcid.org/0000-0002-5759-428X>), Nic Crane [ctb], Andrew Bates [ctb], Vincent Arel-Bundock [ctb] (<https://orcid.org/0000-0003-2042-7063>), Hideaki Hayashi [ctb], Luis Tobalina [ctb], Annie Wang [ctb], Wei Yang Tham [ctb], Clara Wang [ctb], Abby Smith [ctb] (<https://orcid.org/0000-0002-3207-0375>), Jasper Cooper [ctb] (<https://orcid.org/0000-0002-8639-3188>), E Auden Krauska [ctb] (<https://orcid.org/0000-0002-1466-5850>), Alex Wang [ctb], Malcolm Barrett [ctb] (<https://orcid.org/0000-0003-0299-5825>), Charles Gray [ctb] (<https://orcid.org/0000-0002-9978-011X>), Jared Wilber [ctb], Vilmantas Gegzna [ctb] (<https://orcid.org/0000-0002-9500-5167>), Eduard Szoecs [ctb], Frederik Aust [ctb] (<https://orcid.org/0000-0003-4900-788X>), Angus Moore [ctb], Nick Williams [ctb], Marius Barth [ctb] (<https://orcid.org/0000-0002-3421-6665>), Bruna Wundervald [ctb] (<https://orcid.org/0000-0001-8163-220X>), Joyce Cahoon [ctb] (<https://orcid.org/0000-0001-7217-4702>), Grant McDermott [ctb] (<https://orcid.org/0000-0001-7883-8573>), Kevin Zarca [ctb], Shiro Kuriwaki [ctb] (<https://orcid.org/0000-0002-5687-2647>), Lukas Wallrich [ctb] (<https://orcid.org/0000-0003-2121-5177>), James Martherus [ctb] (<https://orcid.org/0000-0002-8285-3300>), Chuliang Xiao [ctb] (<https://orcid.org/0000-0002-8466-9398>), Joseph Larmarange [ctb], Max Kuhn [ctb], Michal Bojanowski [ctb], Hakon Malmedal [ctb], Clara Wang [ctb], Sergio Oller [ctb], Luke Sonnet [ctb], Jim Hester [ctb], Ben Schneider [ctb], Bernie Gray [ctb] (<https://orcid.org/0000-0001-9190-6032>), Mara Averick [ctb], Aaron Jacobs [ctb], Andreas Bender [ctb], Sven Templer [ctb], Paul-Christian Buerkner [ctb], Matthew Kay [ctb], Erwan Le Pennec [ctb], Johan Junkka [ctb], Hao Zhu [ctb], Benjamin Soltoff [ctb], Zoe Wilkinson Saldana [ctb], Tyler Littlefield [ctb], Charles T. Gray [ctb], Shabbh E. Banks [ctb], Serina Robinson [ctb], Roger Bivand [ctb], Riinu Ots [ctb], Nicholas Williams [ctb], Nina Jakobsen [ctb], Michael Weylandt [ctb], Lisa Lendway [ctb], Karl Hailperin [ctb], Josue Rodriguez [ctb], Jenny Bryan [ctb], Chris Jarvis [ctb], Greg Macfarlane [ctb], Brian Mannakee [ctb], Drew Tyre [ctb], Shreyas Singh [ctb], Laurens Geffert [ctb], Hong Ooi [ctb], Henrik Bengtsson [ctb], Eduard Szocs [ctb], David Hugh-Jones [ctb], Matthieu Stigler [ctb], Hugo Tavares [ctb] (<https://orcid.org/0000-0001-9373-2726>), R. Willem Vervoort [ctb], Brenton M. Wiernik [ctb], Josh Yamamoto [ctb], Jasme Lee [ctb], Taren Sanders [ctb] (<https://orcid.org/0000-0002-4504-6008>), Ilaria Prosdocimi [ctb] (<https://orcid.org/0000-0001-8565-094X>), Daniel D. Sjoberg [ctb] (<https://orcid.org/0000-0003-0862-2018>), Alex Reinhart [ctb] (<https://orcid.org/0000-0002-6658-514X>)",
"Maintainer": "Simon Couch <simon.couch@posit.co>",
@ -2313,7 +2314,7 @@
},
"curl": {
"Package": "curl",
"Version": "6.2.1",
"Version": "6.2.2",
"Source": "Repository",
"Type": "Package",
"Title": "A Modern and Flexible Web Client for R",
@ -2430,7 +2431,7 @@
},
"datawizard": {
"Package": "datawizard",
"Version": "1.0.1",
"Version": "1.0.2",
"Source": "Repository",
"Type": "Package",
"Title": "Easy Data Wrangling and Statistical Transformations",
@ -3324,10 +3325,10 @@
},
"foreign": {
"Package": "foreign",
"Version": "0.8-88",
"Version": "0.8-90",
"Source": "Repository",
"Priority": "recommended",
"Date": "2025-01-10",
"Date": "2025-03-31",
"Title": "Read Data Stored by 'Minitab', 'S', 'SAS', 'SPSS', 'Stata', 'Systat', 'Weka', 'dBase', ...",
"Depends": [
"R (>= 4.0.0)"
@ -3569,7 +3570,7 @@
},
"gdtools": {
"Package": "gdtools",
"Version": "0.4.1",
"Version": "0.4.2",
"Source": "Repository",
"Title": "Utilities for Graphical Rendering and Fonts Management",
"Authors@R": "c( person(\"David\", \"Gohel\", , \"david.gohel@ardata.fr\", role = c(\"aut\", \"cre\")), person(\"Hadley\", \"Wickham\", , \"hadley@rstudio.com\", role = \"aut\"), person(\"Lionel\", \"Henry\", , \"lionel@rstudio.com\", role = \"aut\"), person(\"Jeroen\", \"Ooms\", , \"jeroen@berkeley.edu\", role = \"aut\", comment = c(ORCID = \"0000-0002-4035-0289\")), person(\"Yixuan\", \"Qiu\", role = \"ctb\"), person(\"R Core Team\", role = \"cph\", comment = \"Cairo code from X11 device\"), person(\"ArData\", role = \"cph\"), person(\"RStudio\", role = \"cph\") )",
@ -3882,7 +3883,7 @@
},
"ggiraph": {
"Package": "ggiraph",
"Version": "0.8.12",
"Version": "0.8.13",
"Source": "Repository",
"Type": "Package",
"Title": "Make 'ggplot2' Graphics Interactive",
@ -5041,7 +5042,7 @@
},
"jsonlite": {
"Package": "jsonlite",
"Version": "1.9.1",
"Version": "2.0.0",
"Source": "Repository",
"Title": "A Simple and Robust JSON Parser and Generator for R",
"License": "MIT + file LICENSE",
@ -5063,7 +5064,7 @@
"R.rsp",
"sf"
],
"RoxygenNote": "7.2.3",
"RoxygenNote": "7.3.2",
"Encoding": "UTF-8",
"NeedsCompilation": "yes",
"Author": "Jeroen Ooms [aut, cre] (<https://orcid.org/0000-0002-4035-0289>), Duncan Temple Lang [ctb], Lloyd Hilaiel [cph] (author of bundled libyajl)",
@ -5539,12 +5540,44 @@
"Maintainer": "Henrik Bengtsson <henrikb@braju.com>",
"Repository": "CRAN"
},
"litedown": {
"Package": "litedown",
"Version": "0.6",
"Source": "Repository",
"Type": "Package",
"Title": "A Lightweight Version of R Markdown",
"Authors@R": "c( person(\"Yihui\", \"Xie\", role = c(\"aut\", \"cre\"), email = \"xie@yihui.name\", comment = c(ORCID = \"0000-0003-0645-5666\", URL = \"https://yihui.org\")), person(\"Tim\", \"Taylor\", role = \"ctb\", comment = c(ORCID = \"0000-0002-8587-7113\")), person() )",
"Description": "Render R Markdown to Markdown (without using 'knitr'), and Markdown to lightweight HTML or 'LaTeX' documents with the 'commonmark' package (instead of 'Pandoc'). Some missing Markdown features in 'commonmark' are also supported, such as raw HTML or 'LaTeX' blocks, 'LaTeX' math, superscripts, subscripts, footnotes, element attributes, and appendices, but not all 'Pandoc' Markdown features are (or will be) supported. With additional JavaScript and CSS, you can also create HTML slides and articles. This package can be viewed as a trimmed-down version of R Markdown and 'knitr'. It does not aim at rich Markdown features or a large variety of output formats (the primary formats are HTML and 'LaTeX'). Book and website projects of multiple input documents are also supported.",
"Depends": [
"R (>= 3.2.0)"
],
"Imports": [
"utils",
"commonmark (>= 1.9.1)",
"xfun (>= 0.51)"
],
"Suggests": [
"rbibutils",
"rstudioapi",
"tinytex"
],
"License": "MIT + file LICENSE",
"URL": "https://github.com/yihui/litedown",
"BugReports": "https://github.com/yihui/litedown/issues",
"VignetteBuilder": "litedown",
"RoxygenNote": "7.3.2",
"Encoding": "UTF-8",
"NeedsCompilation": "no",
"Author": "Yihui Xie [aut, cre] (<https://orcid.org/0000-0003-0645-5666>, https://yihui.org), Tim Taylor [ctb] (<https://orcid.org/0000-0002-8587-7113>)",
"Maintainer": "Yihui Xie <xie@yihui.name>",
"Repository": "CRAN"
},
"lme4": {
"Package": "lme4",
"Version": "1.1-36",
"Version": "1.1-37",
"Source": "Repository",
"Title": "Linear Mixed-Effects Models using 'Eigen' and S4",
"Authors@R": "c( person(\"Douglas\",\"Bates\", role=\"aut\", comment=c(ORCID=\"0000-0001-8316-9503\")), person(\"Martin\",\"Maechler\", role=\"aut\", comment=c(ORCID=\"0000-0002-8685-9910\")), person(\"Ben\",\"Bolker\",email=\"bbolker+lme4@gmail.com\", role=c(\"aut\",\"cre\"), comment=c(ORCID=\"0000-0002-2127-0443\")), person(\"Steven\",\"Walker\",role=\"aut\", comment=c(ORCID=\"0000-0002-4394-9078\")), person(\"Rune Haubo Bojesen\",\"Christensen\", role=\"ctb\", comment=c(ORCID=\"0000-0002-4494-3399\")), person(\"Henrik\",\"Singmann\", role=\"ctb\", comment=c(ORCID=\"0000-0002-4842-3657\")), person(\"Bin\", \"Dai\", role=\"ctb\"), person(\"Fabian\", \"Scheipl\", role=\"ctb\", comment=c(ORCID=\"0000-0001-8172-3603\")), person(\"Gabor\", \"Grothendieck\", role=\"ctb\"), person(\"Peter\", \"Green\", role=\"ctb\", comment=c(ORCID=\"0000-0002-0238-9852\")), person(\"John\", \"Fox\", role=\"ctb\"), person(\"Alexander\", \"Bauer\", role=\"ctb\"), person(\"Pavel N.\", \"Krivitsky\", role=c(\"ctb\",\"cph\"), comment=c(ORCID=\"0000-0002-9101-3362\", \"shared copyright on simulate.formula\")), person(\"Emi\", \"Tanaka\", role = \"ctb\", comment = c(ORCID=\"0000-0002-1455-259X\")), person(\"Mikael\", \"Jagan\", role = \"ctb\", comment = c(ORCID=\"0000-0002-3542-2938\")) )",
"Authors@R": "c( person(\"Douglas\",\"Bates\", role=\"aut\", comment=c(ORCID=\"0000-0001-8316-9503\")), person(\"Martin\",\"Maechler\", role=\"aut\", comment=c(ORCID=\"0000-0002-8685-9910\")), person(\"Ben\",\"Bolker\",email=\"bbolker+lme4@gmail.com\", role=c(\"aut\",\"cre\"), comment=c(ORCID=\"0000-0002-2127-0443\")), person(\"Steven\",\"Walker\",role=\"aut\", comment=c(ORCID=\"0000-0002-4394-9078\")), person(\"Rune Haubo Bojesen\",\"Christensen\", role=\"ctb\", comment=c(ORCID=\"0000-0002-4494-3399\")), person(\"Henrik\",\"Singmann\", role=\"ctb\", comment=c(ORCID=\"0000-0002-4842-3657\")), person(\"Bin\", \"Dai\", role=\"ctb\"), person(\"Fabian\", \"Scheipl\", role=\"ctb\", comment=c(ORCID=\"0000-0001-8172-3603\")), person(\"Gabor\", \"Grothendieck\", role=\"ctb\"), person(\"Peter\", \"Green\", role=\"ctb\", comment=c(ORCID=\"0000-0002-0238-9852\")), person(\"John\", \"Fox\", role=\"ctb\"), person(\"Alexander\", \"Bauer\", role=\"ctb\"), person(\"Pavel N.\", \"Krivitsky\", role=c(\"ctb\",\"cph\"), comment=c(ORCID=\"0000-0002-9101-3362\", \"shared copyright on simulate.formula\")), person(\"Emi\", \"Tanaka\", role = \"ctb\", comment = c(ORCID=\"0000-0002-1455-259X\")), person(\"Mikael\", \"Jagan\", role = \"ctb\", comment = c(ORCID=\"0000-0002-3542-2938\")), person(\"Ross D.\", \"Boylan\", email=\"ross.boylan@ucsf.edu\", role=(\"ctb\"), comment = c(ORCID=\"0009-0003-4123-8090\")) )",
"Description": "Fit linear and generalized linear mixed-effects models. The models and their components are represented using S4 classes and methods. The core computational algorithms are implemented using the 'Eigen' C++ library for numerical linear algebra and 'RcppEigen' \"glue\".",
"Depends": [
"R (>= 3.6.0)",
@ -5599,7 +5632,7 @@
"BugReports": "https://github.com/lme4/lme4/issues",
"Encoding": "UTF-8",
"NeedsCompilation": "yes",
"Author": "Douglas Bates [aut] (<https://orcid.org/0000-0001-8316-9503>), Martin Maechler [aut] (<https://orcid.org/0000-0002-8685-9910>), Ben Bolker [aut, cre] (<https://orcid.org/0000-0002-2127-0443>), Steven Walker [aut] (<https://orcid.org/0000-0002-4394-9078>), Rune Haubo Bojesen Christensen [ctb] (<https://orcid.org/0000-0002-4494-3399>), Henrik Singmann [ctb] (<https://orcid.org/0000-0002-4842-3657>), Bin Dai [ctb], Fabian Scheipl [ctb] (<https://orcid.org/0000-0001-8172-3603>), Gabor Grothendieck [ctb], Peter Green [ctb] (<https://orcid.org/0000-0002-0238-9852>), John Fox [ctb], Alexander Bauer [ctb], Pavel N. Krivitsky [ctb, cph] (<https://orcid.org/0000-0002-9101-3362>, shared copyright on simulate.formula), Emi Tanaka [ctb] (<https://orcid.org/0000-0002-1455-259X>), Mikael Jagan [ctb] (<https://orcid.org/0000-0002-3542-2938>)",
"Author": "Douglas Bates [aut] (<https://orcid.org/0000-0001-8316-9503>), Martin Maechler [aut] (<https://orcid.org/0000-0002-8685-9910>), Ben Bolker [aut, cre] (<https://orcid.org/0000-0002-2127-0443>), Steven Walker [aut] (<https://orcid.org/0000-0002-4394-9078>), Rune Haubo Bojesen Christensen [ctb] (<https://orcid.org/0000-0002-4494-3399>), Henrik Singmann [ctb] (<https://orcid.org/0000-0002-4842-3657>), Bin Dai [ctb], Fabian Scheipl [ctb] (<https://orcid.org/0000-0001-8172-3603>), Gabor Grothendieck [ctb], Peter Green [ctb] (<https://orcid.org/0000-0002-0238-9852>), John Fox [ctb], Alexander Bauer [ctb], Pavel N. Krivitsky [ctb, cph] (<https://orcid.org/0000-0002-9101-3362>, shared copyright on simulate.formula), Emi Tanaka [ctb] (<https://orcid.org/0000-0002-1455-259X>), Mikael Jagan [ctb] (<https://orcid.org/0000-0002-3542-2938>), Ross D. Boylan [ctb] (<https://orcid.org/0009-0003-4123-8090>)",
"Maintainer": "Ben Bolker <bbolker+lme4@gmail.com>",
"Repository": "CRAN"
},
@ -5714,7 +5747,7 @@
},
"markdown": {
"Package": "markdown",
"Version": "1.13",
"Version": "2.0",
"Source": "Repository",
"Type": "Package",
"Title": "Render Markdown with 'commonmark'",
@ -5725,8 +5758,8 @@
],
"Imports": [
"utils",
"commonmark (>= 1.9.0)",
"xfun (>= 0.38)"
"xfun",
"litedown (>= 0.6)"
],
"Suggests": [
"knitr",
@ -5737,7 +5770,7 @@
"License": "MIT + file LICENSE",
"URL": "https://github.com/rstudio/markdown",
"BugReports": "https://github.com/rstudio/markdown/issues",
"RoxygenNote": "7.3.1",
"RoxygenNote": "7.3.2",
"Encoding": "UTF-8",
"NeedsCompilation": "no",
"Author": "Yihui Xie [aut, cre] (<https://orcid.org/0000-0003-0645-5666>), JJ Allaire [aut], Jeffrey Horner [aut], Henrik Bengtsson [ctb], Jim Hester [ctb], Yixuan Qiu [ctb], Kohske Takahashi [ctb], Adam November [ctb], Nacho Caballero [ctb], Jeroen Ooms [ctb], Thomas Leeper [ctb], Joe Cheng [ctb], Andrzej Oles [ctb], Posit Software, PBC [cph, fnd]",
@ -6016,9 +6049,9 @@
},
"nlme": {
"Package": "nlme",
"Version": "3.1-167",
"Version": "3.1-168",
"Source": "Repository",
"Date": "2025-01-27",
"Date": "2025-03-31",
"Priority": "recommended",
"Title": "Linear and Nonlinear Mixed Effects Models",
"Authors@R": "c(person(\"José\", \"Pinheiro\", role = \"aut\", comment = \"S version\"), person(\"Douglas\", \"Bates\", role = \"aut\", comment = \"up to 2007\"), person(\"Saikat\", \"DebRoy\", role = \"ctb\", comment = \"up to 2002\"), person(\"Deepayan\", \"Sarkar\", role = \"ctb\", comment = \"up to 2005\"), person(\"EISPACK authors\", role = \"ctb\", comment = \"src/rs.f\"), person(\"Siem\", \"Heisterkamp\", role = \"ctb\", comment = \"Author fixed sigma\"), person(\"Bert\", \"Van Willigen\",role = \"ctb\", comment = \"Programmer fixed sigma\"), person(\"Johannes\", \"Ranke\", role = \"ctb\", comment = \"varConstProp()\"), person(\"R Core Team\", email = \"R-core@R-project.org\", role = c(\"aut\", \"cre\"), comment = c(ROR = \"02zz1nj61\")))",
@ -6102,7 +6135,7 @@
},
"officer": {
"Package": "officer",
"Version": "0.6.7",
"Version": "0.6.8",
"Source": "Repository",
"Type": "Package",
"Title": "Manipulation of Microsoft Word and PowerPoint Documents",
@ -6127,15 +6160,18 @@
"Suggests": [
"devEMF",
"doconv (>= 0.3.0)",
"gdtools",
"ggplot2",
"knitr",
"magick",
"rmarkdown",
"rsvg",
"testthat"
"testthat",
"withr"
],
"Encoding": "UTF-8",
"RoxygenNote": "7.3.2",
"Collate": "'core_properties.R' 'custom_properties.R' 'defunct.R' 'dev-utils.R' 'docx_add.R' 'docx_comments.R' 'docx_cursor.R' 'docx_part.R' 'docx_replace.R' 'docx_section.R' 'docx_settings.R' 'empty_content.R' 'formatting_properties.R' 'fortify_docx.R' 'fortify_pptx.R' 'knitr_utils.R' 'officer.R' 'ooxml.R' 'ooxml_block_objects.R' 'ooxml_run_objects.R' 'openxml_content_type.R' 'openxml_document.R' 'pack_folder.R' 'ph_location.R' 'post-proc.R' 'ppt_class_dir_collection.R' 'ppt_classes.R' 'ppt_notes.R' 'ppt_ph_dedupe_layout.R' 'ppt_ph_manipulate.R' 'ppt_ph_rename_layout.R' 'ppt_ph_with_methods.R' 'pptx_informations.R' 'pptx_layout_helper.R' 'pptx_matrix.R' 'utils.R' 'pptx_slide_manip.R' 'read_docx.R' 'read_docx_styles.R' 'read_pptx.R' 'read_xlsx.R' 'relationship.R' 'rtf.R' 'shape_properties.R' 'shorcuts.R'",
"NeedsCompilation": "no",
"Author": "David Gohel [aut, cre], Stefan Moog [aut], Mark Heckmann [aut] (<https://orcid.org/0000-0002-0736-7417>), ArData [cph], Frank Hangler [ctb] (function body_replace_all_text), Liz Sander [ctb] (several documentation fixes), Anton Victorson [ctb] (fixes xml structures), Jon Calder [ctb] (update vignettes), John Harrold [ctb] (function annotate_base), John Muschelli [ctb] (google doc compatibility), Bill Denney [ctb] (<https://orcid.org/0000-0002-5759-428X>, function as.matrix.rpptx), Nikolai Beck [ctb] (set speaker notes for .pptx documents), Greg Leleu [ctb] (fields functionality in ppt), Majid Eismann [ctb], Hongyuan Jia [ctb] (<https://orcid.org/0000-0002-0075-8183>)",
"Maintainer": "David Gohel <david.gohel@ardata.fr>",
@ -6210,7 +6246,7 @@
},
"openxlsx2": {
"Package": "openxlsx2",
"Version": "1.13",
"Version": "1.14",
"Source": "Repository",
"Type": "Package",
"Title": "Read, Write and Edit 'xlsx' Files",
@ -6319,7 +6355,7 @@
},
"parallelly": {
"Package": "parallelly",
"Version": "1.42.0",
"Version": "1.43.0",
"Source": "Repository",
"Title": "Enhancing the 'parallel' Package",
"Imports": [
@ -7198,9 +7234,9 @@
},
"psych": {
"Package": "psych",
"Version": "2.4.12",
"Version": "2.5.3",
"Source": "Repository",
"Date": "2024-12-05",
"Date": "2025-03-18",
"Title": "Procedures for Psychological, Psychometric, and Personality Research",
"Authors@R": "person(\"William\", \"Revelle\", role =c(\"aut\",\"cre\"), email=\"revelle@northwestern.edu\", comment=c(ORCID = \"0000-0003-4880-9610\") )",
"Description": "A general purpose toolbox developed originally for personality, psychometric theory and experimental psychology. Functions are primarily for multivariate analysis and scale construction using factor analysis, principal component analysis, cluster analysis and reliability analysis, although others provide basic descriptive statistics. Item Response Theory is done using factor analysis of tetrachoric and polychoric correlations. Functions for analyzing data at multiple levels include within and between group statistics, including correlations and factor analysis. Validation and cross validation of scales developed using basic machine learning algorithms are provided, as are functions for simulating and testing particular item and test structures. Several functions serve as a useful front end for structural equation modeling. Graphical displays of path diagrams, including mediation models, factor analysis and structural equation models are created using basic graphics. Some of the functions are written to support a book on psychometric theory as well as publications in personality research. For more information, see the <https://personality-project.org/r/> web page.",
@ -7881,7 +7917,7 @@
},
"renv": {
"Package": "renv",
"Version": "1.1.3",
"Version": "1.1.4",
"Source": "Repository",
"Type": "Package",
"Title": "Project Environments",
@ -9015,9 +9051,9 @@
},
"stringi": {
"Package": "stringi",
"Version": "1.8.4",
"Version": "1.8.7",
"Source": "Repository",
"Date": "2024-05-06",
"Date": "2025-03-27",
"Title": "Fast and Portable Character String Processing Facilities",
"Description": "A collection of character string/text/natural language processing tools for pattern searching (e.g., with 'Java'-like regular expressions or the 'Unicode' collation algorithm), random string generation, case mapping, string transliteration, concatenation, sorting, padding, wrapping, Unicode normalisation, date-time formatting and parsing, and many more. They are fast, consistent, convenient, and - thanks to 'ICU' (International Components for Unicode) - portable across all locales and platforms. Documentation about 'stringi' is provided via its website at <https://stringi.gagolewski.com/> and the paper by Gagolewski (2022, <doi:10.18637/jss.v103.i02>).",
"URL": "https://stringi.gagolewski.com/, https://github.com/gagolews/stringi, https://icu.unicode.org/",
@ -9034,11 +9070,12 @@
],
"Biarch": "TRUE",
"License": "file LICENSE",
"Author": "Marek Gagolewski [aut, cre, cph] (<https://orcid.org/0000-0003-0637-6028>), Bartek Tartanus [ctb], and others (stringi source code); Unicode, Inc. and others (ICU4C source code, Unicode Character Database)",
"Maintainer": "Marek Gagolewski <marek@gagolewski.com>",
"RoxygenNote": "7.2.3",
"Authors@R": "c(person(given = \"Marek\", family = \"Gagolewski\", role = c(\"aut\", \"cre\", \"cph\"), email = \"marek@gagolewski.com\", comment = c(ORCID = \"0000-0003-0637-6028\")), person(given = \"Bartek\", family = \"Tartanus\", role = \"ctb\"), person(\"Unicode, Inc. and others\", role=\"ctb\", comment = \"ICU4C source code, Unicode Character Database\") )",
"RoxygenNote": "7.3.2",
"Encoding": "UTF-8",
"NeedsCompilation": "yes",
"Author": "Marek Gagolewski [aut, cre, cph] (<https://orcid.org/0000-0003-0637-6028>), Bartek Tartanus [ctb], Unicode, Inc. and others [ctb] (ICU4C source code, Unicode Character Database)",
"Maintainer": "Marek Gagolewski <marek@gagolewski.com>",
"License_is_FOSS": "yes",
"Repository": "CRAN"
},

View file

@ -2,7 +2,7 @@
local({
# the requested version of renv
version <- "1.1.3"
version <- "1.1.4"
attr(version, "sha") <- NULL
# the project directory