diff --git a/NAMESPACE b/NAMESPACE index c906cb2..83d8147 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -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) diff --git a/NEWS.md b/NEWS.md index 369c774..b041b88 100644 --- a/NEWS.md +++ b/NEWS.md @@ -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. diff --git a/R/app_version.R b/R/app_version.R index 9f8ecb9..9427fca 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'Version: 25.4.1.250408_1343' +app_version <- function()'Version: 25.4.1.250409_1216' diff --git a/R/data-summary.R b/R/data-summary.R index b0c72ee..b7216b9 100644 --- a/R/data-summary.R +++ b/R/data-summary.R @@ -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( diff --git a/R/data_plots.R b/R/data_plots.R index 3f40de8..0267b74 100644 --- a/R/data_plots.R +++ b/R/data_plots.R @@ -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 diff --git a/R/helpers.R b/R/helpers.R index b75d7d8..6f47ddb 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -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) +} + diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R index 28003ac..b051fc7 100644 --- a/R/redcap_read_shiny_module.R +++ b/R/redcap_read_shiny_module.R @@ -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( diff --git a/R/regression-module.R b/R/regression-module.R index d01478c..cc8bc29 100644 --- a/R/regression-module.R +++ b/R/regression-module.R @@ -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) })) } ) diff --git a/R/regression_model.R b/R/regression_model.R index 3185536..61cf9cf 100644 --- a/R/regression_model.R +++ b/R/regression_model.R @@ -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, diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 15383d9..1c95ea0 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -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() + } ) diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf index 2cace92..dae3768 100644 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf +++ b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf @@ -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 diff --git a/inst/apps/FreesearchR/server.R b/inst/apps/FreesearchR/server.R index 1ee9348..9b0414f 100644 --- a/inst/apps/FreesearchR/server.R +++ b/inst/apps/FreesearchR/server.R @@ -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() + } ) diff --git a/inst/apps/FreesearchR/ui.R b/inst/apps/FreesearchR/ui.R index 32f9cb5..47bb075 100644 --- a/inst/apps/FreesearchR/ui.R +++ b/inst/apps/FreesearchR/ui.R @@ -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) ) ), ############################################################################## diff --git a/man/create_overview_datagrid.Rd b/man/create_overview_datagrid.Rd index d8a1731..07dbde2 100644 --- a/man/create_overview_datagrid.Rd +++ b/man/create_overview_datagrid.Rd @@ -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} diff --git a/man/data-summary.Rd b/man/data-summary.Rd index 6e9ecc9..376a7ee 100644 --- a/man/data-summary.Rd +++ b/man/data-summary.Rd @@ -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 diff --git a/man/expression_string.Rd b/man/expression_string.Rd new file mode 100644 index 0000000..754f8e0 --- /dev/null +++ b/man/expression_string.Rd @@ -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() +} diff --git a/man/merge_expression.Rd b/man/merge_expression.Rd new file mode 100644 index 0000000..5261941 --- /dev/null +++ b/man/merge_expression.Rd @@ -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() +} diff --git a/man/regression_model.Rd b/man/regression_model.Rd index d86453b..723e4f4 100644 --- a/man/regression_model.Rd +++ b/man/regression_model.Rd @@ -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() } } diff --git a/renv.lock b/renv.lock index f615a69..521be62 100644 --- a/renv.lock +++ b/renv.lock @@ -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] (), Posit Software, PBC [cph, fnd]", + "Author": "Richard Iannone [aut, cre] (), Olivier Roy [ctb], Posit Software, PBC [cph, fnd]", "Maintainer": "Richard Iannone ", "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 ", - "Maintainer": "Simon Wood ", + "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) 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 ", "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] (), 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' libraries to integrate in 'shiny' applications or 'rmarkdown' 'HTML' documents.", + "Description": "Create interactive tables, calendars, charts and markdown WYSIWYG editor with 'TOAST UI' 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", diff --git a/vignettes/FreesearchR.Rmd b/vignettes/FreesearchR.Rmd index c675da2..93bec72 100644 --- a/vignettes/FreesearchR.Rmd +++ b/vignettes/FreesearchR.Rmd @@ -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