andreas/FreesearchR
1
0
Fork 0
mirror of https://github.com/agdamsbo/FreesearchR.git synced 2025-09-12 01:49:39 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

code export works!
Some checks are pending
pkgdown.yaml / pkgdown (push) Waiting to run
Details

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2025-04-09 12:31:08 +02:00
parent b3434d9dfb
commit 347490605f
No known key found for this signature in database
20 changed files with 584 additions and 549 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
NAMESPACE
View file

@ -32,6 +32,7 @@ export(data_visuals_ui)
export(default_format_arguments)
export(default_parsing)
export(drop_empty_event)
export(expression_string)
export(factorize)
export(file_export)
export(format_writer)
@ -62,6 +63,7 @@ export(line_break)
export(m_datafileUI)
export(m_redcap_readServer)
export(m_redcap_readUI)
export(merge_expression)
export(merge_long)
export(missing_fraction)
export(modal_cut_variable)

2
NEWS.md
View file

@ -4,6 +4,8 @@ Polished and simplified data import module including a much improved REDCap impo
- *CHANGE* `default_parsing()` now ensure unique variable names.
- *NEW* Working code output for all major modules including import, modifications, filter, evaluation, plotting and regression.
# FreesearchR 25.4.1
Focus is on polish and improved ui/ux.

2
R/app_version.R
View file

@ -1 +1 @@
app_version <- function()'Version: 25.4.1.250408_1343'
app_version <- function()'Version: 25.4.1.250409_1216'

9
R/data-summary.R
View file

@ -16,7 +16,7 @@ data_summary_ui <- function(id) {
#' @param data data
#' @param color.main main color
#' @param color.sec secondary color
#' @param ... arguments passed to toastui::datagrid
#' @param ... arguments passed to create_overview_datagrid
#'
#' @name data-summary
#' @returns shiny server module
@ -37,7 +37,7 @@ data_summary_server <- function(id,
shiny::req(data())
data() |>
overview_vars() |>
create_overview_datagrid() |>
create_overview_datagrid(...) |>
add_sparkline(
column = "vals",
color.main = color.main,
@ -176,7 +176,7 @@ overview_vars <- function(data) {
#' mtcars |>
#' overview_vars() |>
#' create_overview_datagrid()
create_overview_datagrid <- function(data) {
create_overview_datagrid <- function(data,...) {
# browser()
gridTheme <- getOption("datagrid.theme")
if (length(gridTheme) < 1) {
@ -207,7 +207,8 @@ create_overview_datagrid <- function(data) {
grid <- toastui::datagrid(
data = data,
theme = "default",
colwidths = "fit"
colwidths = "fit",
...
)
grid <- toastui::grid_columns(

29
R/data_plots.R
View file

@ -86,7 +86,10 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
),
bslib::nav_panel(
title = tab_title,
shiny::plotOutput(ns("plot"))
shiny::plotOutput(ns("plot"),height = "70vh"),
shiny::tags$br(),
shiny::h4("Plot code:"),
shiny::verbatimTextOutput(outputId = ns("code_plot"))
)
)
}
@ -109,7 +112,8 @@ data_visuals_server <- function(id,
rv <- shiny::reactiveValues(
plot.params = NULL,
plot = NULL
plot = NULL,
code=NULL
)
# ## --- New attempt
@ -302,15 +306,26 @@ data_visuals_server <- function(id,
{
tryCatch(
{
shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
rv$plot <- create_plot(
data = data(),
parameters <- list(
type = rv$plot.params()[["fun"]],
x = input$primary,
y = input$secondary,
z = input$tertiary
)
shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
rv$plot <- rlang::exec(create_plot, !!!append_list(data(),parameters,"data"))
# rv$plot <- create_plot(
# data = data(),
# type = rv$plot.params()[["fun"]],
# x = input$primary,
# y = input$secondary,
# z = input$tertiary
# )
})
rv$code <- glue::glue("FreesearchR::create_plot(data,{list2str(parameters)})")
},
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
@ -323,6 +338,10 @@ data_visuals_server <- function(id,
ignoreInit = TRUE
)
output$code_plot <- shiny::renderPrint({
cat(rv$code)
})
output$plot <- shiny::renderPlot({
shiny::req(rv$plot)
rv$plot

38
R/helpers.R
View file

@ -393,3 +393,41 @@ if_not_missing <- function(data,default=NULL){
return(data)
}
}
#' Merge list of expressions
#'
#' @param data list
#'
#' @returns expression
#' @export
#'
#' @examples
#' list(
#' rlang::call2(.fn = "select",!!!list(c("cyl","disp")),.ns = "dplyr"),
#' rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
#' ) |> merge_expression()
merge_expression <- function(data){
Reduce(
f = function(x, y) rlang::expr(!!x %>% !!y),
x = data
)
}
#' Deparses expression as string, substitutes native pipe and adds assign
#'
#' @param data expression
#'
#' @returns string
#' @export
#'
#' @examples
#' list(
#' rlang::call2(.fn = "select",!!!list(c("cyl","disp")),.ns = "dplyr"),
#' rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
#' ) |> merge_expression() |> expression_string()
expression_string <- function(data,assign.str="data <- "){
out <- paste0(assign.str, gsub("%>%","|>\n",paste(gsub('"',"'",deparse(data)),collapse = "")))
gsub(" ","",out)
}

2
R/redcap_read_shiny_module.R
View file

@ -70,6 +70,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
# width = 6,
shiny::tags$h4("Data import parameters"),
shiny::helpText("Options here will show, when API and uri are typed"),
shiny::tags$br(),
shiny::uiOutput(outputId = ns("fields")),
shiny::tags$div(
class = "shiny-input-container",
@ -91,6 +92,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
),
shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters")
),
shiny::tags$br(),
shiny::uiOutput(outputId = ns("data_type")),
shiny::uiOutput(outputId = ns("fill")),
shiny::actionButton(

79
R/regression-module.R
View file

@ -285,24 +285,22 @@ regression_server <- function(id,
## imputed or
## minimally adjusted
model_lists <- list(
"Univariable" = regression_model_uv_list,
"Multivariable" = regression_model_list
"Univariable" = "regression_model_uv_list",
"Multivariable" = "regression_model_list"
) |>
lapply(\(.fun){
ls <- do.call(
parameters=list(
data = data_r()[regression_vars()],
outcome.str = input$outcome_var,
fun.descr = input$regression_type
)
do.call(
.fun,
c(
list(data = data_r() |>
(\(.x){
.x[regression_vars()]
})()),
list(outcome.str = input$outcome_var),
list(fun.descr = input$regression_type)
)
parameters
)
})
rv$list$regression$params <- get_fun_options(input$regression_type) |>
(\(.x){
.x[[1]]
@ -415,7 +413,7 @@ regression_server <- function(id,
alt = "Assumptions testing of the multivariable regression model"
)
### Creating the regression table
shiny::observeEvent(
input$load,
{
@ -425,20 +423,44 @@ regression_server <- function(id,
tryCatch(
{
parameters <- list(
add_p = input$add_regression_p == "no"
)
out <- lapply(rv$list$regression$models, \(.x){
.x$model
}) |>
purrr::map(regression_table)
purrr::map(\(.x){
do.call(
regression_table,
append_list(.x,parameters,"x")
)
})
if (input$add_regression_p == "no") {
out <- out |>
lapply(\(.x){
.x |>
gtsummary::modify_column_hide(
column = "p.value"
)
})
}
# if (input$add_regression_p == "no") {
# out <- out |>
# lapply(\(.x){
# .x |>
# gtsummary::modify_column_hide(
# column = "p.value"
# )
# })
# }
rv$list$regression$models |>
purrr::imap(\(.x,.i){
rv$list$regression$models[[.i]][["code_table"]] <- paste(
.x$code,
expression_string(rlang::call2(.fn = "regression_table",!!!parameters,.ns = "FreesearchR"),assign.str=NULL),sep="|>\n")
})
list(
rv$code$import,
rlang::call2(.fn = "select",!!!list(input$import_var),.ns = "dplyr"),
rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
) |>
merge_expression() |>
expression_string()
rv$list$regression$tables <- out
@ -550,16 +572,7 @@ regression_server <- function(id,
##############################################################################
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)
return(rv$list)
}))
}
)

90
R/regression_model.R
View file

@ -97,7 +97,7 @@ regression_model <- function(data,
if (is.null(fun)) auto.mode <- TRUE
if (auto.mode) {
if (isTRUE(auto.mode)) {
if (is.numeric(data[[outcome.str]])) {
fun <- "stats::lm"
} else if (is.factor(data[[outcome.str]])) {
@ -318,7 +318,7 @@ supported_functions <- function() {
design = "cross-sectional",
out.type = "dichotomous",
fun = "stats::glm",
args.list = list(family = stats::binomial(link = "logit")),
args.list = list(family = "binomial"),
formula.str = "{outcome.str}~{paste(vars,collapse='+')}",
table.fun = "gtsummary::tbl_regression",
table.args.list = list()
@ -326,7 +326,7 @@ supported_functions <- function() {
polr = list(
descr = "Ordinal logistic regression model",
design = "cross-sectional",
out.type = c("ordinal","categorical"),
out.type = c("ordinal", "categorical"),
fun = "MASS::polr",
args.list = list(
Hess = TRUE,
@ -449,6 +449,7 @@ get_fun_options <- function(data) {
#' )
#' ls <- regression_model_list(data = default_parsing(mtcars), outcome.str = "cyl", fun.descr = "Ordinal logistic regression model")
#' summary(ls$model)
#' ls <- regression_model_list(data = default_parsing(mtcars), outcome.str = "mpg", fun.descr = "Linear regression model")
#'
#' ls <- regression_model_list(data = default_parsing(gtsummary::trial), outcome.str = "trt", fun.descr = "Logistic regression model")
#' tbl <- gtsummary::tbl_regression(ls$model, exponentiate = TRUE)
@ -458,7 +459,7 @@ get_fun_options <- function(data) {
#' outcome.str = "trt",
#' fun = "stats::glm",
#' formula.str = "{outcome.str}~.",
#' args.list = list(family = stats::binomial(link = "logit"))
#' args.list = list(family = "binomial")
#' )
#' tbl2 <- gtsummary::tbl_regression(m, exponentiate = TRUE)
#' broom::tidy(ls$model)
@ -509,20 +510,27 @@ regression_model_list <- function(data,
}
}
parameters <- list(
outcome.str = outcome.str,
fun = fun.c,
formula.str = formula.str.c,
args.list = args.list.c
)
model <- do.call(
regression_model,
list(
data = data,
outcome.str = outcome.str,
fun = fun.c,
formula.str = formula.str.c,
args.list = args.list.c
append_list(parameters,
data = data, "data"
)
)
code <- glue::glue(
"{fun.c}({paste(Filter(length,list(glue::glue(formula.str.c),'data = data',list2str(args.list.c))),collapse=', ')})"
)
parameters_print <- list2str(Filter(length,
modifyList(parameters, list(
formula.str = glue::glue(formula.str.c),
args.list = NULL
))))
code <- glue::glue("FreesearchR::regression_model(data,{parameters_print}, args.list=list({list2str(args.list.c)}))",.null = "NULL")
list(
options = options,
@ -566,6 +574,7 @@ list2str <- function(data) {
#' lapply(broom::tidy) |>
#' dplyr::bind_rows()
#' ms <- regression_model_uv_list(data = default_parsing(mtcars), outcome.str = "mpg", fun.descr = "Linear regression model")
#' ms$code
#' lapply(ms$model, broom::tidy) |> dplyr::bind_rows()
#' }
regression_model_uv_list <- function(data,
@ -628,28 +637,43 @@ regression_model_uv_list <- function(data,
# )
# )
model <- vars |>
lapply(\(.var){
do.call(
regression_model,
list(
data = data[c(outcome.str, .var)],
outcome.str = outcome.str,
fun = fun.c,
formula.str = formula.str.c,
args.list = args.list.c
)
)
})
vars <- "."
code_raw <- glue::glue(
"{fun.c}({paste(Filter(length,list(glue::glue(formula.str.c),'data = .d',list2str(args.list.c))),collapse=', ')})"
parameters <- list(
outcome.str = outcome.str,
fun = fun.c,
formula.str = formula.str.c,
args.list = args.list.c
)
code <- glue::glue("lapply(data,function(.d){code_raw})")
model <- vars |>
lapply(\(.var){
out <- do.call(
regression_model,
append_list(parameters,
data = data[c(outcome.str, .var)], "data"
)
)
## This is the very long version
## Handles deeply nested glue string
code <- glue::glue("dplyr::select(data,{paste0(paste(names(data[c(outcome.str, .var)]),collapse=','))})|>\nFreesearchR::regression_model({list2str(modifyList(parameters,list(formula.str = glue::glue(gsub('vars','.var',formula.str.c)))))})")
REDCapCAST::set_attr(out, code, "code")
})
# vars <- "."
#
# code_raw <- glue::glue(
# "{fun.c}({paste(Filter(length,list(glue::glue(formula.str.c),'data = .d',list2str(args.list.c))),collapse=', ')})"
# )
# browser()
# code <- glue::glue("lapply(data,function(.d){code_raw})")
code <- model |>
lapply(\(.x)REDCapCAST::get_attr(.x, "code")) |>
purrr::reduce(c) |>
(\(.x){
paste0("list(\n", paste(.x, collapse = ",\n"), ")")
})()
list(
options = options,

505
inst/apps/FreesearchR/app.R
View file

@ -10,7 +10,7 @@
#### Current file: /Users/au301842/FreesearchR/R//app_version.R
########
app_version <- function()'Version: 25.4.1.250408_1343'
app_version <- function()'Version: 25.4.1.250409_1216'
########
@ -1227,7 +1227,10 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
),
bslib::nav_panel(
title = tab_title,
shiny::plotOutput(ns("plot"))
shiny::plotOutput(ns("plot"),height = "70vh"),
shiny::tags$br(),
shiny::h4("Plot code:"),
shiny::verbatimTextOutput(outputId = ns("code_plot"))
)
)
}
@ -1250,7 +1253,8 @@ data_visuals_server <- function(id,
rv <- shiny::reactiveValues(
plot.params = NULL,
plot = NULL
plot = NULL,
code=NULL
)
# ## --- New attempt
@ -1443,15 +1447,26 @@ data_visuals_server <- function(id,
{
tryCatch(
{
shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
rv$plot <- create_plot(
data = data(),
parameters <- list(
type = rv$plot.params()[["fun"]],
x = input$primary,
y = input$secondary,
z = input$tertiary
)
shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
rv$plot <- rlang::exec(create_plot, !!!append_list(data(),parameters,"data"))
# rv$plot <- create_plot(
# data = data(),
# type = rv$plot.params()[["fun"]],
# x = input$primary,
# y = input$secondary,
# z = input$tertiary
# )
})
rv$code <- glue::glue("FreesearchR::create_plot(data,{list2str(parameters)})")
},
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
@ -1464,6 +1479,10 @@ data_visuals_server <- function(id,
ignoreInit = TRUE
)
output$code_plot <- shiny::renderPrint({
cat(rv$code)
})
output$plot <- shiny::renderPlot({
shiny::req(rv$plot)
rv$plot
@ -2047,7 +2066,7 @@ data_summary_ui <- function(id) {
#' @param data data
#' @param color.main main color
#' @param color.sec secondary color
#' @param ... arguments passed to toastui::datagrid
#' @param ... arguments passed to create_overview_datagrid
#'
#' @name data-summary
#' @returns shiny server module
@ -2068,7 +2087,7 @@ data_summary_server <- function(id,
shiny::req(data())
data() |>
overview_vars() |>
create_overview_datagrid() |>
create_overview_datagrid(...) |>
add_sparkline(
column = "vals",
color.main = color.main,
@ -2207,7 +2226,7 @@ overview_vars <- function(data) {
#' mtcars |>
#' overview_vars() |>
#' create_overview_datagrid()
create_overview_datagrid <- function(data) {
create_overview_datagrid <- function(data,...) {
# browser()
gridTheme <- getOption("datagrid.theme")
if (length(gridTheme) < 1) {
@ -2238,7 +2257,8 @@ create_overview_datagrid <- function(data) {
grid <- toastui::datagrid(
data = data,
theme = "default",
colwidths = "fit"
colwidths = "fit",
...
)
grid <- toastui::grid_columns(
@ -2872,6 +2892,44 @@ if_not_missing <- function(data,default=NULL){
}
#' Merge list of expressions
#'
#' @param data list
#'
#' @returns expression
#' @export
#'
#' @examples
#' list(
#' rlang::call2(.fn = "select",!!!list(c("cyl","disp")),.ns = "dplyr"),
#' rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
#' ) |> merge_expression()
merge_expression <- function(data){
Reduce(
f = function(x, y) rlang::expr(!!x %>% !!y),
x = data
)
}
#' Deparses expression as string, substitutes native pipe and adds assign
#'
#' @param data expression
#'
#' @returns string
#' @export
#'
#' @examples
#' list(
#' rlang::call2(.fn = "select",!!!list(c("cyl","disp")),.ns = "dplyr"),
#' rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
#' ) |> merge_expression() |> expression_string()
expression_string <- function(data,assign.str="data <- "){
out <- paste0(assign.str, gsub("%>%","|>\n",paste(gsub('"',"'",deparse(data)),collapse = "")))
gsub(" ","",out)
}
########
#### Current file: /Users/au301842/FreesearchR/R//import-file-ext.R
########
@ -4274,6 +4332,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
# width = 6,
shiny::tags$h4("Data import parameters"),
shiny::helpText("Options here will show, when API and uri are typed"),
shiny::tags$br(),
shiny::uiOutput(outputId = ns("fields")),
shiny::tags$div(
class = "shiny-input-container",
@ -4295,6 +4354,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
),
shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters")
),
shiny::tags$br(),
shiny::uiOutput(outputId = ns("data_type")),
shiny::uiOutput(outputId = ns("fill")),
shiny::actionButton(
@ -4964,7 +5024,7 @@ regression_model <- function(data,
if (is.null(fun)) auto.mode <- TRUE
if (auto.mode) {
if (isTRUE(auto.mode)) {
if (is.numeric(data[[outcome.str]])) {
fun <- "stats::lm"
} else if (is.factor(data[[outcome.str]])) {
@ -5185,7 +5245,7 @@ supported_functions <- function() {
design = "cross-sectional",
out.type = "dichotomous",
fun = "stats::glm",
args.list = list(family = stats::binomial(link = "logit")),
args.list = list(family = "binomial"),
formula.str = "{outcome.str}~{paste(vars,collapse='+')}",
table.fun = "gtsummary::tbl_regression",
table.args.list = list()
@ -5193,7 +5253,7 @@ supported_functions <- function() {
polr = list(
descr = "Ordinal logistic regression model",
design = "cross-sectional",
out.type = c("ordinal","categorical"),
out.type = c("ordinal", "categorical"),
fun = "MASS::polr",
args.list = list(
Hess = TRUE,
@ -5316,6 +5376,7 @@ get_fun_options <- function(data) {
#' )
#' ls <- regression_model_list(data = default_parsing(mtcars), outcome.str = "cyl", fun.descr = "Ordinal logistic regression model")
#' summary(ls$model)
#' ls <- regression_model_list(data = default_parsing(mtcars), outcome.str = "mpg", fun.descr = "Linear regression model")
#'
#' ls <- regression_model_list(data = default_parsing(gtsummary::trial), outcome.str = "trt", fun.descr = "Logistic regression model")
#' tbl <- gtsummary::tbl_regression(ls$model, exponentiate = TRUE)
@ -5325,7 +5386,7 @@ get_fun_options <- function(data) {
#' outcome.str = "trt",
#' fun = "stats::glm",
#' formula.str = "{outcome.str}~.",
#' args.list = list(family = stats::binomial(link = "logit"))
#' args.list = list(family = "binomial")
#' )
#' tbl2 <- gtsummary::tbl_regression(m, exponentiate = TRUE)
#' broom::tidy(ls$model)
@ -5376,20 +5437,27 @@ regression_model_list <- function(data,
}
}
parameters <- list(
outcome.str = outcome.str,
fun = fun.c,
formula.str = formula.str.c,
args.list = args.list.c
)
model <- do.call(
regression_model,
list(
data = data,
outcome.str = outcome.str,
fun = fun.c,
formula.str = formula.str.c,
args.list = args.list.c
append_list(parameters,
data = data, "data"
)
)
code <- glue::glue(
"{fun.c}({paste(Filter(length,list(glue::glue(formula.str.c),'data = data',list2str(args.list.c))),collapse=', ')})"
)
parameters_print <- list2str(Filter(length,
modifyList(parameters, list(
formula.str = glue::glue(formula.str.c),
args.list = NULL
))))
code <- glue::glue("FreesearchR::regression_model(data,{parameters_print}, args.list=list({list2str(args.list.c)}))",.null = "NULL")
list(
options = options,
@ -5433,6 +5501,7 @@ list2str <- function(data) {
#' lapply(broom::tidy) |>
#' dplyr::bind_rows()
#' ms <- regression_model_uv_list(data = default_parsing(mtcars), outcome.str = "mpg", fun.descr = "Linear regression model")
#' ms$code
#' lapply(ms$model, broom::tidy) |> dplyr::bind_rows()
#' }
regression_model_uv_list <- function(data,
@ -5495,28 +5564,43 @@ regression_model_uv_list <- function(data,
# )
# )
model <- vars |>
lapply(\(.var){
do.call(
regression_model,
list(
data = data[c(outcome.str, .var)],
outcome.str = outcome.str,
fun = fun.c,
formula.str = formula.str.c,
args.list = args.list.c
)
)
})
vars <- "."
code_raw <- glue::glue(
"{fun.c}({paste(Filter(length,list(glue::glue(formula.str.c),'data = .d',list2str(args.list.c))),collapse=', ')})"
parameters <- list(
outcome.str = outcome.str,
fun = fun.c,
formula.str = formula.str.c,
args.list = args.list.c
)
code <- glue::glue("lapply(data,function(.d){code_raw})")
model <- vars |>
lapply(\(.var){
out <- do.call(
regression_model,
append_list(parameters,
data = data[c(outcome.str, .var)], "data"
)
)
## This is the very long version
## Handles deeply nested glue string
code <- glue::glue("dplyr::select(data,{paste0(paste(names(data[c(outcome.str, .var)]),collapse=','))})|>\nFreesearchR::regression_model({list2str(modifyList(parameters,list(formula.str = glue::glue(gsub('vars','.var',formula.str.c)))))})")
REDCapCAST::set_attr(out, code, "code")
})
# vars <- "."
#
# code_raw <- glue::glue(
# "{fun.c}({paste(Filter(length,list(glue::glue(formula.str.c),'data = .d',list2str(args.list.c))),collapse=', ')})"
# )
# browser()
# code <- glue::glue("lapply(data,function(.d){code_raw})")
code <- model |>
lapply(\(.x)REDCapCAST::get_attr(.x, "code")) |>
purrr::reduce(c) |>
(\(.x){
paste0("list(\n", paste(.x, collapse = ",\n"), ")")
})()
list(
options = options,
@ -6152,24 +6236,22 @@ regression_server <- function(id,
## imputed or
## minimally adjusted
model_lists <- list(
"Univariable" = regression_model_uv_list,
"Multivariable" = regression_model_list
"Univariable" = "regression_model_uv_list",
"Multivariable" = "regression_model_list"
) |>
lapply(\(.fun){
ls <- do.call(
parameters=list(
data = data_r()[regression_vars()],
outcome.str = input$outcome_var,
fun.descr = input$regression_type
)
do.call(
.fun,
c(
list(data = data_r() |>
(\(.x){
.x[regression_vars()]
})()),
list(outcome.str = input$outcome_var),
list(fun.descr = input$regression_type)
)
parameters
)
})
rv$list$regression$params <- get_fun_options(input$regression_type) |>
(\(.x){
.x[[1]]
@ -6282,7 +6364,7 @@ regression_server <- function(id,
alt = "Assumptions testing of the multivariable regression model"
)
### Creating the regression table
shiny::observeEvent(
input$load,
{
@ -6292,20 +6374,44 @@ regression_server <- function(id,
tryCatch(
{
parameters <- list(
add_p = input$add_regression_p == "no"
)
out <- lapply(rv$list$regression$models, \(.x){
.x$model
}) |>
purrr::map(regression_table)
purrr::map(\(.x){
do.call(
regression_table,
append_list(.x,parameters,"x")
)
})
if (input$add_regression_p == "no") {
out <- out |>
lapply(\(.x){
.x |>
gtsummary::modify_column_hide(
column = "p.value"
)
})
}
# if (input$add_regression_p == "no") {
# out <- out |>
# lapply(\(.x){
# .x |>
# gtsummary::modify_column_hide(
# column = "p.value"
# )
# })
# }
rv$list$regression$models |>
purrr::imap(\(.x,.i){
rv$list$regression$models[[.i]][["code_table"]] <- paste(
.x$code,
expression_string(rlang::call2(.fn = "regression_table",!!!parameters,.ns = "FreesearchR"),assign.str=NULL),sep="|>\n")
})
list(
rv$code$import,
rlang::call2(.fn = "select",!!!list(input$import_var),.ns = "dplyr"),
rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
) |>
merge_expression() |>
expression_string()
rv$list$regression$tables <- out
@ -6417,16 +6523,7 @@ regression_server <- function(id,
##############################################################################
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)
return(rv$list)
}))
}
)
@ -8047,22 +8144,6 @@ ui_elements <- list(
)
)
),
# 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"),
@ -8213,11 +8294,11 @@ ui_elements <- list(
)
),
bslib::nav_panel(
title = "Baseline characteristics",
title = "Characteristics",
gt::gt_output(outputId = "table1")
),
bslib::nav_panel(
title = "Variable correlations",
title = "Correlations",
data_correlations_ui(id = "correlations", height = 600)
)
)
@ -8264,110 +8345,6 @@ ui_elements <- list(
bslib::navset_bar,
regression_ui("regression")
)
# 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"
# )
# ),
# 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'")),
# # 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")
# )
# )
),
##############################################################################
#########
@ -8441,13 +8418,21 @@ ui_elements <- list(
shiny::br(),
shiny::h4("Code snippets"),
shiny::tags$p("Below are the code used to create the final data set. This can be saved for reproducibility. The code may not be 100 % correct, but kan be used for learning and example code to get started on coding yourself."),
shiny::verbatimTextOutput(outputId = "code_import"),
shiny::verbatimTextOutput(outputId = "code_data"),
shiny::verbatimTextOutput(outputId = "code_filter"),
shiny::tagAppendChildren(
shiny::tagList(
shiny::verbatimTextOutput(outputId = "code_import"),
shiny::verbatimTextOutput(outputId = "code_data"),
shiny::verbatimTextOutput(outputId = "code_filter"),
shiny::verbatimTextOutput(outputId = "code_table1")
),
lapply(paste0("code_",c("univariable","multivariable")),
\(.x)shiny::verbatimTextOutput(outputId = .x))
)
,
shiny::tags$br(),
shiny::br(),
shiny::column(width = 2)
)
shiny::br()
),
shiny::column(width = 2)
)
),
##############################################################################
@ -8703,6 +8688,7 @@ server <- function(input, output, session) {
),
handlerExpr = {
shiny::req(rv$data_temp)
shiny::req(input$import_var)
# browser()
temp_data <- rv$data_temp
if (all(input$import_var %in% names(temp_data))){
@ -8712,16 +8698,24 @@ server <- function(input, output, session) {
rv$data_original <- temp_data |>
default_parsing()
rv$code$import <- list(
rv$code$import,
rlang::call2(.fn = "select",input$import_var,.ns = "dplyr"),
rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
) |>
merge_expression() |>
expression_string()
rv$code$import <- rv$code$import |>
deparse() |>
paste(collapse = "") |>
paste("|>
dplyr::select(", paste(input$import_var, collapse = ","), ") |>
FreesearchR::default_parsing()") |>
(\(.x){
paste0("data <- ", .x)
})()
# rv$code$import <- rv$code$import |>
# deparse() |>
# paste(collapse = "") |>
# paste("|>
# dplyr::select(", paste(input$import_var, collapse = ","), ") |>
# FreesearchR::default_parsing()") |>
# (\(.x){
# paste0("data <- ", .x)
# })()
rv$code$filter <- NULL
rv$code$modify <- NULL
@ -8924,18 +8918,6 @@ server <- function(input, output, session) {
}
)
# shiny::observeEvent(
# list(
# shiny::reactive(rv$data),
# shiny::reactive(rv$data_original),
# data_filter(),
# shiny::reactive(rv$data_filtered)
# ),
# {
#
# }
# )
######### Data preview
### Overview
@ -8947,36 +8929,13 @@ server <- function(input, output, session) {
}),
color.main = "#2A004E",
color.sec = "#C62300",
pagination = 20
pagination = 10
)
observeEvent(input$modal_browse, {
datamods::show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal")
})
# 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)
})
@ -8990,7 +8949,12 @@ server <- function(input, output, session) {
})
##############################################################################
#########
######### Code export
#########
##############################################################################
output$code_import <- shiny::renderPrint({
shiny::req(rv$code$import)
cat(rv$code$import)
@ -9022,6 +8986,18 @@ server <- function(input, output, session) {
cat(rv$code$filter)
})
output$code_table1 <- shiny::renderPrint({
shiny::req(rv$code$table1)
cat(rv$code$table1)
})
shiny::observe({
rv$regression()$regression$models |> purrr::imap(\(.x,.i){
output[[paste0("code_",tolower(.i))]] <- shiny::renderPrint({cat(.x$code_table)})
})
})
##############################################################################
#########
######### Data analyses Inputs
@ -9139,16 +9115,33 @@ server <- function(input, output, session) {
shiny::req(input$strat_var)
shiny::req(rv$list$data)
# data_tbl1 <- rv$list$data
parameters <- list(
by.var = input$strat_var,
add.p = input$add_p == "yes",
add.overall = TRUE
)
shiny::withProgress(message = "Creating the table. Hold on for a moment..", {
rv$list$table1 <- create_baseline(
rv$list$data,
by.var = input$strat_var,
add.p = input$add_p == "yes",
add.overall = TRUE
)
rv$list$table1 <- rlang::exec(create_baseline, !!!append_list(rv$list$data,parameters,"data"))
# rv$list$table1 <- create_baseline(
# data = rv$list$data,
# by.var = input$strat_var,
# add.p = input$add_p == "yes",
# add.overall = TRUE
# )
})
rv$code$table1 <- glue::glue("FreesearchR::create_baseline(data,{list2str(parameters)})")
# list(
# rv$code$import,
# rlang::call2(.fn = "select",!!!list(input$import_var),.ns = "dplyr"),
# rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
# ) |>
# merge_expression() |>
# expression_string()
}
)

2
inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
View file

@ -5,6 +5,6 @@ account: agdamsbo
server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1
appId: 13611288
bundleId: 10077795
bundleId: 10084710
url: https://agdamsbo.shinyapps.io/freesearcheR/
version: 1

112
inst/apps/FreesearchR/server.R
View file

@ -176,6 +176,7 @@ server <- function(input, output, session) {
),
handlerExpr = {
shiny::req(rv$data_temp)
shiny::req(input$import_var)
# browser()
temp_data <- rv$data_temp
if (all(input$import_var %in% names(temp_data))){
@ -185,16 +186,24 @@ server <- function(input, output, session) {
rv$data_original <- temp_data |>
default_parsing()
rv$code$import <- list(
rv$code$import,
rlang::call2(.fn = "select",input$import_var,.ns = "dplyr"),
rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
) |>
merge_expression() |>
expression_string()
rv$code$import <- rv$code$import |>
deparse() |>
paste(collapse = "") |>
paste("|>
dplyr::select(", paste(input$import_var, collapse = ","), ") |>
FreesearchR::default_parsing()") |>
(\(.x){
paste0("data <- ", .x)
})()
# rv$code$import <- rv$code$import |>
# deparse() |>
# paste(collapse = "") |>
# paste("|>
# dplyr::select(", paste(input$import_var, collapse = ","), ") |>
# FreesearchR::default_parsing()") |>
# (\(.x){
# paste0("data <- ", .x)
# })()
rv$code$filter <- NULL
rv$code$modify <- NULL
@ -397,18 +406,6 @@ server <- function(input, output, session) {
}
)
# shiny::observeEvent(
# list(
# shiny::reactive(rv$data),
# shiny::reactive(rv$data_original),
# data_filter(),
# shiny::reactive(rv$data_filtered)
# ),
# {
#
# }
# )
######### Data preview
### Overview
@ -420,36 +417,13 @@ server <- function(input, output, session) {
}),
color.main = "#2A004E",
color.sec = "#C62300",
pagination = 20
pagination = 10
)
observeEvent(input$modal_browse, {
datamods::show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal")
})
# 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)
})
@ -463,7 +437,12 @@ server <- function(input, output, session) {
})
##############################################################################
#########
######### Code export
#########
##############################################################################
output$code_import <- shiny::renderPrint({
shiny::req(rv$code$import)
cat(rv$code$import)
@ -495,6 +474,18 @@ server <- function(input, output, session) {
cat(rv$code$filter)
})
output$code_table1 <- shiny::renderPrint({
shiny::req(rv$code$table1)
cat(rv$code$table1)
})
shiny::observe({
rv$regression()$regression$models |> purrr::imap(\(.x,.i){
output[[paste0("code_",tolower(.i))]] <- shiny::renderPrint({cat(.x$code_table)})
})
})
##############################################################################
#########
######### Data analyses Inputs
@ -612,16 +603,33 @@ server <- function(input, output, session) {
shiny::req(input$strat_var)
shiny::req(rv$list$data)
# data_tbl1 <- rv$list$data
parameters <- list(
by.var = input$strat_var,
add.p = input$add_p == "yes",
add.overall = TRUE
)
shiny::withProgress(message = "Creating the table. Hold on for a moment..", {
rv$list$table1 <- create_baseline(
rv$list$data,
by.var = input$strat_var,
add.p = input$add_p == "yes",
add.overall = TRUE
)
rv$list$table1 <- rlang::exec(create_baseline, !!!append_list(rv$list$data,parameters,"data"))
# rv$list$table1 <- create_baseline(
# data = rv$list$data,
# by.var = input$strat_var,
# add.p = input$add_p == "yes",
# add.overall = TRUE
# )
})
rv$code$table1 <- glue::glue("FreesearchR::create_baseline(data,{list2str(parameters)})")
# list(
# rv$code$import,
# rlang::call2(.fn = "select",!!!list(input$import_var),.ns = "dplyr"),
# rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
# ) |>
# merge_expression() |>
# expression_string()
}
)

144
inst/apps/FreesearchR/ui.R
View file

@ -161,22 +161,6 @@ ui_elements <- list(
)
)
),
# 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"),
@ -327,11 +311,11 @@ ui_elements <- list(
)
),
bslib::nav_panel(
title = "Baseline characteristics",
title = "Characteristics",
gt::gt_output(outputId = "table1")
),
bslib::nav_panel(
title = "Variable correlations",
title = "Correlations",
data_correlations_ui(id = "correlations", height = 600)
)
)
@ -378,110 +362,6 @@ ui_elements <- list(
bslib::navset_bar,
regression_ui("regression")
)
# 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"
# )
# ),
# 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'")),
# # 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")
# )
# )
),
##############################################################################
#########
@ -555,13 +435,21 @@ ui_elements <- list(
shiny::br(),
shiny::h4("Code snippets"),
shiny::tags$p("Below are the code used to create the final data set. This can be saved for reproducibility. The code may not be 100 % correct, but kan be used for learning and example code to get started on coding yourself."),
shiny::verbatimTextOutput(outputId = "code_import"),
shiny::verbatimTextOutput(outputId = "code_data"),
shiny::verbatimTextOutput(outputId = "code_filter"),
shiny::tagAppendChildren(
shiny::tagList(
shiny::verbatimTextOutput(outputId = "code_import"),
shiny::verbatimTextOutput(outputId = "code_data"),
shiny::verbatimTextOutput(outputId = "code_filter"),
shiny::verbatimTextOutput(outputId = "code_table1")
),
lapply(paste0("code_",c("univariable","multivariable")),
\(.x)shiny::verbatimTextOutput(outputId = .x))
)
,
shiny::tags$br(),
shiny::br(),
shiny::column(width = 2)
)
shiny::br()
),
shiny::column(width = 2)
)
),
##############################################################################

2
man/create_overview_datagrid.Rd
View file

@ -4,7 +4,7 @@
\alias{create_overview_datagrid}
\title{Create a data overview datagrid}
\usage{
create_overview_datagrid(data)
create_overview_datagrid(data, ...)
}
\arguments{
\item{data}{data}

2
man/data-summary.Rd
View file

@ -19,7 +19,7 @@ data_summary_server(id, data, color.main, color.sec, ...)
\item{color.sec}{secondary color}
\item{...}{arguments passed to toastui::datagrid}
\item{...}{arguments passed to create_overview_datagrid}
}
\value{
Shiny ui module

23
man/expression_string.Rd Normal file
View file

@ -0,0 +1,23 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/helpers.R
\name{expression_string}
\alias{expression_string}
\title{Deparses expression as string, substitutes native pipe and adds assign}
\usage{
expression_string(data, assign.str = "data <- ")
}
\arguments{
\item{data}{expression}
}
\value{
string
}
\description{
Deparses expression as string, substitutes native pipe and adds assign
}
\examples{
list(
rlang::call2(.fn = "select",!!!list(c("cyl","disp")),.ns = "dplyr"),
rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
) |> merge_expression() |> expression_string()
}

23
man/merge_expression.Rd Normal file
View file

@ -0,0 +1,23 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/helpers.R
\name{merge_expression}
\alias{merge_expression}
\title{Merge list of expressions}
\usage{
merge_expression(data)
}
\arguments{
\item{data}{list}
}
\value{
expression
}
\description{
Merge list of expressions
}
\examples{
list(
rlang::call2(.fn = "select",!!!list(c("cyl","disp")),.ns = "dplyr"),
rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
) |> merge_expression()
}

4
man/regression_model.Rd
View file

@ -138,6 +138,7 @@ gtsummary::trial |>
)
ls <- regression_model_list(data = default_parsing(mtcars), outcome.str = "cyl", fun.descr = "Ordinal logistic regression model")
summary(ls$model)
ls <- regression_model_list(data = default_parsing(mtcars), outcome.str = "mpg", fun.descr = "Linear regression model")
ls <- regression_model_list(data = default_parsing(gtsummary::trial), outcome.str = "trt", fun.descr = "Logistic regression model")
tbl <- gtsummary::tbl_regression(ls$model, exponentiate = TRUE)
@ -147,7 +148,7 @@ m <- gtsummary::trial |>
outcome.str = "trt",
fun = "stats::glm",
formula.str = "{outcome.str}~.",
args.list = list(family = stats::binomial(link = "logit"))
args.list = list(family = "binomial")
)
tbl2 <- gtsummary::tbl_regression(m, exponentiate = TRUE)
broom::tidy(ls$model)
@ -163,6 +164,7 @@ gtsummary::trial |>
lapply(broom::tidy) |>
dplyr::bind_rows()
ms <- regression_model_uv_list(data = default_parsing(mtcars), outcome.str = "mpg", fun.descr = "Linear regression model")
ms$code
lapply(ms$model, broom::tidy) |> dplyr::bind_rows()
}
}

60
renv.lock
View file

@ -749,7 +749,7 @@
},
"Rdpack": {
"Package": "Rdpack",
"Version": "2.6.3",
"Version": "2.6.4",
"Source": "Repository",
"Type": "Package",
"Title": "Update and Manipulate Rd Documentation Objects",
@ -1067,29 +1067,28 @@
},
"bigD": {
"Package": "bigD",
"Version": "0.3.0",
"Version": "0.3.1",
"Source": "Repository",
"Type": "Package",
"Title": "Flexibly Format Dates and Times to a Given Locale",
"Description": "Format dates and times flexibly and to whichever locales make sense. Parses dates, times, and date-times in various formats (including string-based ISO 8601 constructions). The formatting syntax gives the user many options for formatting the date and time output in a precise manner. Time zones in the input can be expressed in multiple ways and there are many options for formatting time zones in the output as well. Several of the provided helper functions allow for automatic generation of locale-aware formatting patterns based on date/time skeleton formats and standardized date/time formats with varying specificity.",
"Authors@R": "c( person(\"Richard\", \"Iannone\", , \"rich@posit.co\", c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0003-3925-190X\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
"Authors@R": "c( person(\"Richard\", \"Iannone\", , \"rich@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0003-3925-190X\")), person(\"Olivier\", \"Roy\", role = \"ctb\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
"License": "MIT + file LICENSE",
"URL": "https://rstudio.github.io/bigD/, https://github.com/rstudio/bigD",
"BugReports": "https://github.com/rstudio/bigD/issues",
"Encoding": "UTF-8",
"RoxygenNote": "7.3.2",
"Depends": [
"R (>= 3.3.0)"
"R (>= 3.6.0)"
],
"Suggests": [
"covr",
"testthat (>= 3.0.0)",
"tibble (>= 3.2.1)"
"vctrs (>= 0.5.0)"
],
"Config/testthat/edition": "3",
"Config/testthat/parallel": "true",
"NeedsCompilation": "no",
"Author": "Richard Iannone [aut, cre] (<https://orcid.org/0000-0003-3925-190X>), Posit Software, PBC [cph, fnd]",
"Author": "Richard Iannone [aut, cre] (<https://orcid.org/0000-0003-3925-190X>), Olivier Roy [ctb], Posit Software, PBC [cph, fnd]",
"Maintainer": "Richard Iannone <rich@posit.co>",
"Repository": "CRAN"
},
@ -4201,7 +4200,7 @@
},
"gt": {
"Package": "gt",
"Version": "0.11.1",
"Version": "1.0.0",
"Source": "Repository",
"Type": "Package",
"Title": "Easily Create Presentation-Ready Display Tables",
@ -4236,11 +4235,10 @@
"xml2 (>= 1.3.6)"
],
"Suggests": [
"digest (>= 0.6.31)",
"fontawesome (>= 0.5.2)",
"ggplot2",
"grid",
"gtable",
"gtable (>= 0.3.6)",
"katex (>= 1.4.1)",
"knitr",
"lubridate",
@ -4252,7 +4250,7 @@
"rvest",
"shiny (>= 1.9.1)",
"testthat (>= 3.1.9)",
"tidyr",
"tidyr (>= 1.0.0)",
"webshot2 (>= 0.1.0)",
"withr"
],
@ -5378,7 +5376,7 @@
},
"later": {
"Package": "later",
"Version": "1.4.1",
"Version": "1.4.2",
"Source": "Repository",
"Type": "Package",
"Title": "Utilities for Scheduling Functions to Execute Later with Event Loops",
@ -5411,9 +5409,9 @@
},
"lattice": {
"Package": "lattice",
"Version": "0.22-6",
"Version": "0.22-7",
"Source": "Repository",
"Date": "2024-03-20",
"Date": "2025-03-31",
"Priority": "recommended",
"Title": "Trellis Graphics for R",
"Authors@R": "c(person(\"Deepayan\", \"Sarkar\", role = c(\"aut\", \"cre\"), email = \"deepayan.sarkar@r-project.org\", comment = c(ORCID = \"0000-0003-4107-1553\")), person(\"Felix\", \"Andrews\", role = \"ctb\"), person(\"Kevin\", \"Wright\", role = \"ctb\", comment = \"documentation\"), person(\"Neil\", \"Klepeis\", role = \"ctb\"), person(\"Johan\", \"Larsson\", role = \"ctb\", comment = \"miscellaneous improvements\"), person(\"Zhijian (Jason)\", \"Wen\", role = \"cph\", comment = \"filled contour code\"), person(\"Paul\", \"Murrell\", role = \"ctb\", email = \"paul@stat.auckland.ac.nz\"), person(\"Stefan\", \"Eng\", role = \"ctb\", comment = \"violin plot improvements\"), person(\"Achim\", \"Zeileis\", role = \"ctb\", comment = \"modern colors\"), person(\"Alexandre\", \"Courtiol\", role = \"ctb\", comment = \"generics for larrows, lpolygon, lrect and lsegments\") )",
@ -5542,7 +5540,7 @@
},
"litedown": {
"Package": "litedown",
"Version": "0.6",
"Version": "0.7",
"Source": "Repository",
"Type": "Package",
"Title": "A Lightweight Version of R Markdown",
@ -5553,8 +5551,8 @@
],
"Imports": [
"utils",
"commonmark (>= 1.9.1)",
"xfun (>= 0.51)"
"commonmark (>= 1.9.5)",
"xfun (>= 0.52)"
],
"Suggests": [
"rbibutils",
@ -5809,10 +5807,9 @@
},
"mgcv": {
"Package": "mgcv",
"Version": "1.9-1",
"Version": "1.9-3",
"Source": "Repository",
"Author": "Simon Wood <simon.wood@r-project.org>",
"Maintainer": "Simon Wood <simon.wood@r-project.org>",
"Authors@R": "person(given = \"Simon\", family = \"Wood\", role = c(\"aut\", \"cre\"), email = \"simon.wood@r-project.org\")",
"Title": "Mixed GAM Computation Vehicle with Automatic Smoothness Estimation",
"Description": "Generalized additive (mixed) models, some of their extensions and other generalized ridge regression with multiple smoothing parameter estimation by (Restricted) Marginal Likelihood, Generalized Cross Validation and similar, or using iterated nested Laplace approximation for fully Bayesian inference. See Wood (2017) <doi:10.1201/9781315370279> for an overview. Includes a gam() function, a wide variety of smoothers, 'JAGS' support and distributions beyond the exponential family.",
"Priority": "recommended",
@ -5837,6 +5834,8 @@
"ByteCompile": "yes",
"License": "GPL (>= 2)",
"NeedsCompilation": "yes",
"Author": "Simon Wood [aut, cre]",
"Maintainer": "Simon Wood <simon.wood@r-project.org>",
"Repository": "CRAN"
},
"mime": {
@ -6750,7 +6749,7 @@
},
"pillar": {
"Package": "pillar",
"Version": "1.10.1",
"Version": "1.10.2",
"Source": "Repository",
"Title": "Coloured Formatting for Columns",
"Authors@R": "c(person(given = \"Kirill\", family = \"M\\u00fcller\", role = c(\"aut\", \"cre\"), email = \"kirill@cynkra.com\", comment = c(ORCID = \"0000-0002-1416-3412\")), person(given = \"Hadley\", family = \"Wickham\", role = \"aut\"), person(given = \"RStudio\", role = \"cph\"))",
@ -6798,7 +6797,7 @@
"Config/testthat/start-first": "format_multi_fuzz, format_multi_fuzz_2, format_multi, ctl_colonnade, ctl_colonnade_1, ctl_colonnade_2",
"Config/autostyle/scope": "line_breaks",
"Config/autostyle/strict": "true",
"Config/gha/extra-packages": "DiagrammeR=?ignore-before-r=3.5.0",
"Config/gha/extra-packages": "units=?ignore-before-r=4.3.0",
"Config/Needs/website": "tidyverse/tidytemplate",
"NeedsCompilation": "no",
"Author": "Kirill Müller [aut, cre] (<https://orcid.org/0000-0002-1416-3412>), Hadley Wickham [aut], RStudio [cph]",
@ -9189,7 +9188,7 @@
},
"systemfonts": {
"Package": "systemfonts",
"Version": "1.2.1",
"Version": "1.2.2",
"Source": "Repository",
"Type": "Package",
"Title": "System Native Font Finding",
@ -9548,11 +9547,11 @@
},
"toastui": {
"Package": "toastui",
"Version": "0.3.4",
"Version": "0.4.0",
"Source": "Repository",
"Title": "Interactive Tables, Calendars and Charts for the Web",
"Authors@R": "c( person(\"Victor\", \"Perrier\", email = \"victor.perrier@dreamrs.fr\", role = c(\"aut\", \"cre\", \"cph\")), person(\"Fanny\", \"Meyer\", role = \"aut\"), person(\"NHN FE Development Lab\", role = \"cph\", comment = \"tui-grid, tui-calendar, tui-chart libraries\"))",
"Description": "Create interactive tables, calendars and charts with 'TOAST UI' <https://ui.toast.com/> libraries to integrate in 'shiny' applications or 'rmarkdown' 'HTML' documents.",
"Description": "Create interactive tables, calendars, charts and markdown WYSIWYG editor with 'TOAST UI' <https://ui.toast.com/> libraries to integrate in 'shiny' applications or 'rmarkdown' 'HTML' documents.",
"License": "MIT + file LICENSE",
"Encoding": "UTF-8",
"LazyData": "true",
@ -9989,7 +9988,7 @@
},
"writexl": {
"Package": "writexl",
"Version": "1.5.2",
"Version": "1.5.3",
"Source": "Repository",
"Type": "Package",
"Title": "Export Data Frames to Excel 'xlsx' Format",
@ -10016,7 +10015,7 @@
},
"xfun": {
"Package": "xfun",
"Version": "0.51",
"Version": "0.52",
"Source": "Repository",
"Type": "Package",
"Title": "Supporting Functions for Packages Maintained by 'Yihui Xie'",
@ -10040,18 +10039,15 @@
"mime",
"litedown (>= 0.4)",
"commonmark",
"knitr (>= 1.47)",
"knitr (>= 1.50)",
"remotes",
"pak",
"rhub",
"renv",
"curl",
"xml2",
"jsonlite",
"magick",
"yaml",
"qs",
"rmarkdown"
"qs"
],
"License": "MIT + file LICENSE",
"URL": "https://github.com/yihui/xfun",

3
vignettes/FreesearchR.Rmd
View file

@ -86,7 +86,8 @@ c("continuous", "dichotomous", "ordinal", "categorical") |>
setNames(c("Plot type","Description")))
}) |>
dplyr::bind_rows() |>
toastui::datagrid(filters=TRUE,theme="striped")
# toastui::datagrid(filters=TRUE,theme="striped") |>
kableExtra::kable()
```
## Regression