code export works!

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)

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.

R/app_version.R

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

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(

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..", {
+              parameters <- list(
-              rv$plot <- create_plot(
-                data = data(),
                 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

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)
+}
+

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(

R/regression-module.R

@@ -285,24 +285,22 @@ regression_server <- function(id,
               ##   imputed or
               ##   minimally adjusted
               model_lists <- list(
-                "Univariable" = regression_model_uv_list,
+                "Univariable" = "regression_model_uv_list",
-                "Multivariable" = regression_model_list
+                "Multivariable" = "regression_model_list"
               ) |>
                 lapply(\(.fun){
-                  ls <- do.call(
+                  parameters=list(
-                    .fun,
+                    data = data_r()[regression_vars()],
-                    c(
+                  outcome.str = input$outcome_var,
-                      list(data = data_r() |>
+              fun.descr = input$regression_type
-                        (\(.x){
-                          .x[regression_vars()]
-                        })()),
-                      list(outcome.str = input$outcome_var),
-                      list(fun.descr = input$regression_type)
                   )
+
+                  do.call(
+                    .fun,
+                    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(
-              if (input$add_regression_p == "no") {
+                    regression_table,
-                out <- out |>
+                    append_list(.x,parameters,"x")
-                  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
+        return(rv$list)
-        # code <- list()
-        #
-        # if (length(code) > 0) {
-        #   attr(data, "code") <- Reduce(
-        #     f = function(x, y) rlang::expr(!!x %>% !!y),
-        #     x = code
-        #   )
-        # }
-        return(data)
       }))
     }
   )

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()
@@ -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,
     }
   }
 
-  model <- do.call(
+  parameters <- list(
-    regression_model,
-    list(
-      data = data,
     outcome.str = outcome.str,
     fun = fun.c,
     formula.str = formula.str.c,
     args.list = args.list.c
   )
+
+  model <- do.call(
+    regression_model,
+    append_list(parameters,
+      data = data, "data"
+    )
   )
 
-  code <- glue::glue(
+  parameters_print <- list2str(Filter(length,
-    "{fun.c}({paste(Filter(length,list(glue::glue(formula.str.c),'data = data',list2str(args.list.c))),collapse=', ')})"
+                                      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 |>
+  parameters <- list(
-    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
   )
+
+  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})")
 
-  vars <- "."
+  code <- model |>
+    lapply(\(.x)REDCapCAST::get_attr(.x, "code")) |>
+    purrr::reduce(c) |>
+    (\(.x){
+      paste0("list(\n", paste(.x, collapse = ",\n"), ")")
+    })()
 
-  code_raw <- glue::glue(
-    "{fun.c}({paste(Filter(length,list(glue::glue(formula.str.c),'data = .d',list2str(args.list.c))),collapse=', ')})"
-  )
-
-  code <- glue::glue("lapply(data,function(.d){code_raw})")
 
   list(
     options = options,

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..", {
+              parameters <- list(
-              rv$plot <- create_plot(
-                data = data(),
                 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()
@@ -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,
     }
   }
 
-  model <- do.call(
+  parameters <- list(
-    regression_model,
-    list(
-      data = data,
     outcome.str = outcome.str,
     fun = fun.c,
     formula.str = formula.str.c,
     args.list = args.list.c
   )
+
+  model <- do.call(
+    regression_model,
+    append_list(parameters,
+      data = data, "data"
+    )
   )
 
-  code <- glue::glue(
+  parameters_print <- list2str(Filter(length,
-    "{fun.c}({paste(Filter(length,list(glue::glue(formula.str.c),'data = data',list2str(args.list.c))),collapse=', ')})"
+                                      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 |>
+  parameters <- list(
-    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
   )
+
+  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})")
 
-  vars <- "."
+  code <- model |>
+    lapply(\(.x)REDCapCAST::get_attr(.x, "code")) |>
+    purrr::reduce(c) |>
+    (\(.x){
+      paste0("list(\n", paste(.x, collapse = ",\n"), ")")
+    })()
 
-  code_raw <- glue::glue(
-    "{fun.c}({paste(Filter(length,list(glue::glue(formula.str.c),'data = .d',list2str(args.list.c))),collapse=', ')})"
-  )
-
-  code <- glue::glue("lapply(data,function(.d){code_raw})")
 
   list(
     options = options,
@@ -6152,24 +6236,22 @@ regression_server <- function(id,
               ##   imputed or
               ##   minimally adjusted
               model_lists <- list(
-                "Univariable" = regression_model_uv_list,
+                "Univariable" = "regression_model_uv_list",
-                "Multivariable" = regression_model_list
+                "Multivariable" = "regression_model_list"
               ) |>
                 lapply(\(.fun){
-                  ls <- do.call(
+                  parameters=list(
-                    .fun,
+                    data = data_r()[regression_vars()],
-                    c(
+                  outcome.str = input$outcome_var,
-                      list(data = data_r() |>
+              fun.descr = input$regression_type
-                        (\(.x){
-                          .x[regression_vars()]
-                        })()),
-                      list(outcome.str = input$outcome_var),
-                      list(fun.descr = input$regression_type)
                   )
+
+                  do.call(
+                    .fun,
+                    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(
-              if (input$add_regression_p == "no") {
+                    regression_table,
-                out <- out |>
+                    append_list(.x,parameters,"x")
-                  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
+        return(rv$list)
-        # code <- list()
-        #
-        # if (length(code) > 0) {
-        #   attr(data, "code") <- Reduce(
-        #     f = function(x, y) rlang::expr(!!x %>% !!y),
-        #     x = code
-        #   )
-        # }
-        return(data)
       }))
     }
   )
@@ -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::tagAppendChildren(
+            shiny::tagList(
             shiny::verbatimTextOutput(outputId = "code_import"),
             shiny::verbatimTextOutput(outputId = "code_data"),
             shiny::verbatimTextOutput(outputId = "code_filter"),
-          shiny::tags$br(),
+            shiny::verbatimTextOutput(outputId = "code_table1")
-          shiny::br(),
+          ),
-          shiny::column(width = 2)
+          lapply(paste0("code_",c("univariable","multivariable")),
+                 \(.x)shiny::verbatimTextOutput(outputId = .x))
           )
+          ,
+          shiny::tags$br(),
+          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() |>
+      # rv$code$import <- rv$code$import |>
-        paste(collapse = "") |>
+      #   deparse() |>
-        paste("|>
+      #   paste(collapse = "") |>
-        dplyr::select(", paste(input$import_var, collapse = ","), ") |>
+      #   paste("|>
-        FreesearchR::default_parsing()") |>
+      #   dplyr::select(", paste(input$import_var, collapse = ","), ") |>
-        (\(.x){
+      #   FreesearchR::default_parsing()") |>
-          paste0("data <- ", .x)
+      #   (\(.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(
-
-      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
       )
+
+      shiny::withProgress(message = "Creating the table. Hold on for a moment..", {
+        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()
+
     }
   )
 

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

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() |>
+      # rv$code$import <- rv$code$import |>
-        paste(collapse = "") |>
+      #   deparse() |>
-        paste("|>
+      #   paste(collapse = "") |>
-        dplyr::select(", paste(input$import_var, collapse = ","), ") |>
+      #   paste("|>
-        FreesearchR::default_parsing()") |>
+      #   dplyr::select(", paste(input$import_var, collapse = ","), ") |>
-        (\(.x){
+      #   FreesearchR::default_parsing()") |>
-          paste0("data <- ", .x)
+      #   (\(.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(
-
-      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
       )
+
+      shiny::withProgress(message = "Creating the table. Hold on for a moment..", {
+        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()
+
     }
   )
 

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::tagAppendChildren(
+            shiny::tagList(
             shiny::verbatimTextOutput(outputId = "code_import"),
             shiny::verbatimTextOutput(outputId = "code_data"),
             shiny::verbatimTextOutput(outputId = "code_filter"),
-          shiny::tags$br(),
+            shiny::verbatimTextOutput(outputId = "code_table1")
-          shiny::br(),
+          ),
-          shiny::column(width = 2)
+          lapply(paste0("code_",c("univariable","multivariable")),
+                 \(.x)shiny::verbatimTextOutput(outputId = .x))
           )
+          ,
+          shiny::tags$br(),
+          shiny::br()
+        ),
+        shiny::column(width = 2)
       )
     ),
   ##############################################################################

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}

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

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()
+}

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()
+}

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()
 }
 }

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] (<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)",
+        "commonmark (>= 1.9.5)",
-        "xfun (>= 0.51)"
+        "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>",
+      "Authors@R": "person(given = \"Simon\", family = \"Wood\", role = c(\"aut\", \"cre\"), email = \"simon.wood@r-project.org\")",
-      "Maintainer": "Simon Wood <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",
+        "qs"
-        "rmarkdown"
       ],
       "License": "MIT + file LICENSE",
       "URL": "https://github.com/yihui/xfun",

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