mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 09:59:39 +02:00
This commit is contained in:
parent
b3434d9dfb
commit
347490605f
20 changed files with 584 additions and 549 deletions
|
|
@ -32,6 +32,7 @@ export(data_visuals_ui)
|
|||
export(default_format_arguments)
|
||||
export(default_parsing)
|
||||
export(drop_empty_event)
|
||||
export(expression_string)
|
||||
export(factorize)
|
||||
export(file_export)
|
||||
export(format_writer)
|
||||
|
|
@ -62,6 +63,7 @@ export(line_break)
|
|||
export(m_datafileUI)
|
||||
export(m_redcap_readServer)
|
||||
export(m_redcap_readUI)
|
||||
export(merge_expression)
|
||||
export(merge_long)
|
||||
export(missing_fraction)
|
||||
export(modal_cut_variable)
|
||||
|
|
|
|||
2
NEWS.md
2
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.
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
app_version <- function()'Version: 25.4.1.250408_1343'
|
||||
app_version <- function()'Version: 25.4.1.250409_1216'
|
||||
|
|
|
|||
|
|
@ -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(
|
||||
|
|
|
|||
|
|
@ -86,7 +86,10 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
|
|||
),
|
||||
bslib::nav_panel(
|
||||
title = tab_title,
|
||||
shiny::plotOutput(ns("plot"))
|
||||
shiny::plotOutput(ns("plot"),height = "70vh"),
|
||||
shiny::tags$br(),
|
||||
shiny::h4("Plot code:"),
|
||||
shiny::verbatimTextOutput(outputId = ns("code_plot"))
|
||||
)
|
||||
)
|
||||
}
|
||||
|
|
@ -109,7 +112,8 @@ data_visuals_server <- function(id,
|
|||
|
||||
rv <- shiny::reactiveValues(
|
||||
plot.params = NULL,
|
||||
plot = NULL
|
||||
plot = NULL,
|
||||
code=NULL
|
||||
)
|
||||
|
||||
# ## --- New attempt
|
||||
|
|
@ -302,15 +306,26 @@ data_visuals_server <- function(id,
|
|||
{
|
||||
tryCatch(
|
||||
{
|
||||
shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
|
||||
rv$plot <- create_plot(
|
||||
data = data(),
|
||||
parameters <- list(
|
||||
type = rv$plot.params()[["fun"]],
|
||||
x = input$primary,
|
||||
y = input$secondary,
|
||||
z = input$tertiary
|
||||
)
|
||||
|
||||
shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
|
||||
rv$plot <- rlang::exec(create_plot, !!!append_list(data(),parameters,"data"))
|
||||
# rv$plot <- create_plot(
|
||||
# data = data(),
|
||||
# type = rv$plot.params()[["fun"]],
|
||||
# x = input$primary,
|
||||
# y = input$secondary,
|
||||
# z = input$tertiary
|
||||
# )
|
||||
})
|
||||
|
||||
rv$code <- glue::glue("FreesearchR::create_plot(data,{list2str(parameters)})")
|
||||
|
||||
},
|
||||
# warning = function(warn) {
|
||||
# showNotification(paste0(warn), type = "warning")
|
||||
|
|
@ -323,6 +338,10 @@ data_visuals_server <- function(id,
|
|||
ignoreInit = TRUE
|
||||
)
|
||||
|
||||
output$code_plot <- shiny::renderPrint({
|
||||
cat(rv$code)
|
||||
})
|
||||
|
||||
output$plot <- shiny::renderPlot({
|
||||
shiny::req(rv$plot)
|
||||
rv$plot
|
||||
|
|
|
|||
38
R/helpers.R
38
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)
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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(
|
||||
|
|
|
|||
|
|
@ -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(
|
||||
.fun,
|
||||
c(
|
||||
list(data = data_r() |>
|
||||
(\(.x){
|
||||
.x[regression_vars()]
|
||||
})()),
|
||||
list(outcome.str = input$outcome_var),
|
||||
list(fun.descr = input$regression_type)
|
||||
parameters=list(
|
||||
data = data_r()[regression_vars()],
|
||||
outcome.str = input$outcome_var,
|
||||
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)
|
||||
|
||||
if (input$add_regression_p == "no") {
|
||||
out <- out |>
|
||||
lapply(\(.x){
|
||||
.x |>
|
||||
gtsummary::modify_column_hide(
|
||||
column = "p.value"
|
||||
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"
|
||||
# )
|
||||
# })
|
||||
# }
|
||||
|
||||
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)
|
||||
}))
|
||||
}
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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(
|
||||
regression_model,
|
||||
list(
|
||||
data = 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,
|
||||
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)],
|
||||
parameters <- list(
|
||||
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,
|
||||
|
|
|
|||
|
|
@ -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()
|
||||
|
|
@ -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(
|
||||
regression_model,
|
||||
list(
|
||||
data = 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,
|
||||
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)],
|
||||
parameters <- list(
|
||||
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,
|
||||
"Multivariable" = regression_model_list
|
||||
"Univariable" = "regression_model_uv_list",
|
||||
"Multivariable" = "regression_model_list"
|
||||
) |>
|
||||
lapply(\(.fun){
|
||||
ls <- do.call(
|
||||
.fun,
|
||||
c(
|
||||
list(data = data_r() |>
|
||||
(\(.x){
|
||||
.x[regression_vars()]
|
||||
})()),
|
||||
list(outcome.str = input$outcome_var),
|
||||
list(fun.descr = input$regression_type)
|
||||
parameters=list(
|
||||
data = data_r()[regression_vars()],
|
||||
outcome.str = input$outcome_var,
|
||||
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)
|
||||
|
||||
if (input$add_regression_p == "no") {
|
||||
out <- out |>
|
||||
lapply(\(.x){
|
||||
.x |>
|
||||
gtsummary::modify_column_hide(
|
||||
column = "p.value"
|
||||
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"
|
||||
# )
|
||||
# })
|
||||
# }
|
||||
|
||||
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::tagAppendChildren(
|
||||
shiny::tagList(
|
||||
shiny::verbatimTextOutput(outputId = "code_import"),
|
||||
shiny::verbatimTextOutput(outputId = "code_data"),
|
||||
shiny::verbatimTextOutput(outputId = "code_filter"),
|
||||
shiny::tags$br(),
|
||||
shiny::br(),
|
||||
shiny::column(width = 2)
|
||||
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)
|
||||
)
|
||||
),
|
||||
##############################################################################
|
||||
|
|
@ -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
|
||||
|
||||
shiny::withProgress(message = "Creating the table. Hold on for a moment..", {
|
||||
rv$list$table1 <- create_baseline(
|
||||
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 <- 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()
|
||||
|
||||
}
|
||||
)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
shiny::withProgress(message = "Creating the table. Hold on for a moment..", {
|
||||
rv$list$table1 <- create_baseline(
|
||||
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 <- 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()
|
||||
|
||||
}
|
||||
)
|
||||
|
||||
|
|
|
|||
|
|
@ -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::br(),
|
||||
shiny::column(width = 2)
|
||||
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)
|
||||
)
|
||||
),
|
||||
##############################################################################
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ data_summary_server(id, data, color.main, color.sec, ...)
|
|||
|
||||
\item{color.sec}{secondary color}
|
||||
|
||||
\item{...}{arguments passed to toastui::datagrid}
|
||||
\item{...}{arguments passed to create_overview_datagrid}
|
||||
}
|
||||
\value{
|
||||
Shiny ui module
|
||||
|
|
|
|||
23
man/expression_string.Rd
Normal file
23
man/expression_string.Rd
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/helpers.R
|
||||
\name{expression_string}
|
||||
\alias{expression_string}
|
||||
\title{Deparses expression as string, substitutes native pipe and adds assign}
|
||||
\usage{
|
||||
expression_string(data, assign.str = "data <- ")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{expression}
|
||||
}
|
||||
\value{
|
||||
string
|
||||
}
|
||||
\description{
|
||||
Deparses expression as string, substitutes native pipe and adds assign
|
||||
}
|
||||
\examples{
|
||||
list(
|
||||
rlang::call2(.fn = "select",!!!list(c("cyl","disp")),.ns = "dplyr"),
|
||||
rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
|
||||
) |> merge_expression() |> expression_string()
|
||||
}
|
||||
23
man/merge_expression.Rd
Normal file
23
man/merge_expression.Rd
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/helpers.R
|
||||
\name{merge_expression}
|
||||
\alias{merge_expression}
|
||||
\title{Merge list of expressions}
|
||||
\usage{
|
||||
merge_expression(data)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{list}
|
||||
}
|
||||
\value{
|
||||
expression
|
||||
}
|
||||
\description{
|
||||
Merge list of expressions
|
||||
}
|
||||
\examples{
|
||||
list(
|
||||
rlang::call2(.fn = "select",!!!list(c("cyl","disp")),.ns = "dplyr"),
|
||||
rlang::call2(.fn = "default_parsing",.ns = "FreesearchR")
|
||||
) |> merge_expression()
|
||||
}
|
||||
|
|
@ -138,6 +138,7 @@ gtsummary::trial |>
|
|||
)
|
||||
ls <- regression_model_list(data = default_parsing(mtcars), outcome.str = "cyl", fun.descr = "Ordinal logistic regression model")
|
||||
summary(ls$model)
|
||||
ls <- regression_model_list(data = default_parsing(mtcars), outcome.str = "mpg", fun.descr = "Linear regression model")
|
||||
|
||||
ls <- regression_model_list(data = default_parsing(gtsummary::trial), outcome.str = "trt", fun.descr = "Logistic regression model")
|
||||
tbl <- gtsummary::tbl_regression(ls$model, exponentiate = TRUE)
|
||||
|
|
@ -147,7 +148,7 @@ m <- gtsummary::trial |>
|
|||
outcome.str = "trt",
|
||||
fun = "stats::glm",
|
||||
formula.str = "{outcome.str}~.",
|
||||
args.list = list(family = stats::binomial(link = "logit"))
|
||||
args.list = list(family = "binomial")
|
||||
)
|
||||
tbl2 <- gtsummary::tbl_regression(m, exponentiate = TRUE)
|
||||
broom::tidy(ls$model)
|
||||
|
|
@ -163,6 +164,7 @@ gtsummary::trial |>
|
|||
lapply(broom::tidy) |>
|
||||
dplyr::bind_rows()
|
||||
ms <- regression_model_uv_list(data = default_parsing(mtcars), outcome.str = "mpg", fun.descr = "Linear regression model")
|
||||
ms$code
|
||||
lapply(ms$model, broom::tidy) |> dplyr::bind_rows()
|
||||
}
|
||||
}
|
||||
|
|
|
|||
60
renv.lock
60
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)",
|
||||
"xfun (>= 0.51)"
|
||||
"commonmark (>= 1.9.5)",
|
||||
"xfun (>= 0.52)"
|
||||
],
|
||||
"Suggests": [
|
||||
"rbibutils",
|
||||
|
|
@ -5809,10 +5807,9 @@
|
|||
},
|
||||
"mgcv": {
|
||||
"Package": "mgcv",
|
||||
"Version": "1.9-1",
|
||||
"Version": "1.9-3",
|
||||
"Source": "Repository",
|
||||
"Author": "Simon Wood <simon.wood@r-project.org>",
|
||||
"Maintainer": "Simon Wood <simon.wood@r-project.org>",
|
||||
"Authors@R": "person(given = \"Simon\", family = \"Wood\", role = c(\"aut\", \"cre\"), email = \"simon.wood@r-project.org\")",
|
||||
"Title": "Mixed GAM Computation Vehicle with Automatic Smoothness Estimation",
|
||||
"Description": "Generalized additive (mixed) models, some of their extensions and other generalized ridge regression with multiple smoothing parameter estimation by (Restricted) Marginal Likelihood, Generalized Cross Validation and similar, or using iterated nested Laplace approximation for fully Bayesian inference. See Wood (2017) <doi:10.1201/9781315370279> for an overview. Includes a gam() function, a wide variety of smoothers, 'JAGS' support and distributions beyond the exponential family.",
|
||||
"Priority": "recommended",
|
||||
|
|
@ -5837,6 +5834,8 @@
|
|||
"ByteCompile": "yes",
|
||||
"License": "GPL (>= 2)",
|
||||
"NeedsCompilation": "yes",
|
||||
"Author": "Simon Wood [aut, cre]",
|
||||
"Maintainer": "Simon Wood <simon.wood@r-project.org>",
|
||||
"Repository": "CRAN"
|
||||
},
|
||||
"mime": {
|
||||
|
|
@ -6750,7 +6749,7 @@
|
|||
},
|
||||
"pillar": {
|
||||
"Package": "pillar",
|
||||
"Version": "1.10.1",
|
||||
"Version": "1.10.2",
|
||||
"Source": "Repository",
|
||||
"Title": "Coloured Formatting for Columns",
|
||||
"Authors@R": "c(person(given = \"Kirill\", family = \"M\\u00fcller\", role = c(\"aut\", \"cre\"), email = \"kirill@cynkra.com\", comment = c(ORCID = \"0000-0002-1416-3412\")), person(given = \"Hadley\", family = \"Wickham\", role = \"aut\"), person(given = \"RStudio\", role = \"cph\"))",
|
||||
|
|
@ -6798,7 +6797,7 @@
|
|||
"Config/testthat/start-first": "format_multi_fuzz, format_multi_fuzz_2, format_multi, ctl_colonnade, ctl_colonnade_1, ctl_colonnade_2",
|
||||
"Config/autostyle/scope": "line_breaks",
|
||||
"Config/autostyle/strict": "true",
|
||||
"Config/gha/extra-packages": "DiagrammeR=?ignore-before-r=3.5.0",
|
||||
"Config/gha/extra-packages": "units=?ignore-before-r=4.3.0",
|
||||
"Config/Needs/website": "tidyverse/tidytemplate",
|
||||
"NeedsCompilation": "no",
|
||||
"Author": "Kirill Müller [aut, cre] (<https://orcid.org/0000-0002-1416-3412>), Hadley Wickham [aut], RStudio [cph]",
|
||||
|
|
@ -9189,7 +9188,7 @@
|
|||
},
|
||||
"systemfonts": {
|
||||
"Package": "systemfonts",
|
||||
"Version": "1.2.1",
|
||||
"Version": "1.2.2",
|
||||
"Source": "Repository",
|
||||
"Type": "Package",
|
||||
"Title": "System Native Font Finding",
|
||||
|
|
@ -9548,11 +9547,11 @@
|
|||
},
|
||||
"toastui": {
|
||||
"Package": "toastui",
|
||||
"Version": "0.3.4",
|
||||
"Version": "0.4.0",
|
||||
"Source": "Repository",
|
||||
"Title": "Interactive Tables, Calendars and Charts for the Web",
|
||||
"Authors@R": "c( person(\"Victor\", \"Perrier\", email = \"victor.perrier@dreamrs.fr\", role = c(\"aut\", \"cre\", \"cph\")), person(\"Fanny\", \"Meyer\", role = \"aut\"), person(\"NHN FE Development Lab\", role = \"cph\", comment = \"tui-grid, tui-calendar, tui-chart libraries\"))",
|
||||
"Description": "Create interactive tables, calendars and charts with 'TOAST UI' <https://ui.toast.com/> libraries to integrate in 'shiny' applications or 'rmarkdown' 'HTML' documents.",
|
||||
"Description": "Create interactive tables, calendars, charts and markdown WYSIWYG editor with 'TOAST UI' <https://ui.toast.com/> libraries to integrate in 'shiny' applications or 'rmarkdown' 'HTML' documents.",
|
||||
"License": "MIT + file LICENSE",
|
||||
"Encoding": "UTF-8",
|
||||
"LazyData": "true",
|
||||
|
|
@ -9989,7 +9988,7 @@
|
|||
},
|
||||
"writexl": {
|
||||
"Package": "writexl",
|
||||
"Version": "1.5.2",
|
||||
"Version": "1.5.3",
|
||||
"Source": "Repository",
|
||||
"Type": "Package",
|
||||
"Title": "Export Data Frames to Excel 'xlsx' Format",
|
||||
|
|
@ -10016,7 +10015,7 @@
|
|||
},
|
||||
"xfun": {
|
||||
"Package": "xfun",
|
||||
"Version": "0.51",
|
||||
"Version": "0.52",
|
||||
"Source": "Repository",
|
||||
"Type": "Package",
|
||||
"Title": "Supporting Functions for Packages Maintained by 'Yihui Xie'",
|
||||
|
|
@ -10040,18 +10039,15 @@
|
|||
"mime",
|
||||
"litedown (>= 0.4)",
|
||||
"commonmark",
|
||||
"knitr (>= 1.47)",
|
||||
"knitr (>= 1.50)",
|
||||
"remotes",
|
||||
"pak",
|
||||
"rhub",
|
||||
"renv",
|
||||
"curl",
|
||||
"xml2",
|
||||
"jsonlite",
|
||||
"magick",
|
||||
"yaml",
|
||||
"qs",
|
||||
"rmarkdown"
|
||||
"qs"
|
||||
],
|
||||
"License": "MIT + file LICENSE",
|
||||
"URL": "https://github.com/yihui/xfun",
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue