diff --git a/NAMESPACE b/NAMESPACE
index 9480d521..aa34d84c 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -9,13 +9,10 @@ export(allign_axes)
export(append_list)
export(argsstring2list)
export(baseline_table)
-export(clean_common_axis)
export(clean_date)
export(clean_sep)
export(columnSelectInput)
export(contrast_text)
-export(create_baseline)
-export(create_log_tics)
export(create_overview_datagrid)
export(create_plot)
export(custom_theme)
@@ -23,10 +20,8 @@ export(cut_variable_server)
export(cut_variable_ui)
export(data_correlations_server)
export(data_correlations_ui)
-export(data_description)
export(data_summary_server)
export(data_summary_ui)
-export(data_type)
export(data_visuals_server)
export(data_visuals_ui)
export(default_format_arguments)
@@ -66,9 +61,8 @@ export(missing_fraction)
export(modal_cut_variable)
export(modal_update_factor)
export(modify_qmd)
+export(outcome_type)
export(overview_vars)
-export(plot_box)
-export(plot_box_single)
export(plot_euler)
export(plot_euler_single)
export(plot_hbars)
diff --git a/R/app_version.R b/R/app_version.R
index b5243e9b..ff73a306 100644
--- a/R/app_version.R
+++ b/R/app_version.R
@@ -1 +1 @@
-app_version <- function()'250324_1432'
+app_version <- function()'250320_1310'
diff --git a/R/baseline_table.R b/R/baseline_table.R
index ad90eef4..05af54b6 100644
--- a/R/baseline_table.R
+++ b/R/baseline_table.R
@@ -20,55 +20,3 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
return(out)
}
-
-
-#' Create a baseline table
-#'
-#' @param data data
-#' @param ... passed as fun.arg to baseline_table()
-#' @param strat.var grouping/strat variable
-#' @param add.p add comparison/p-value
-#' @param add.overall add overall column
-#'
-#' @returns gtsummary table list object
-#' @export
-#'
-#' @examples
-#' mtcars |> create_baseline(by.var = "gear", add.p="yes"=="yes")
-create_baseline <- function(data,...,by.var,add.p=FALSE,add.overall=FALSE){
- if (by.var == "none" | !by.var %in% names(data)) {
- by.var <- NULL
- }
-
- ## These steps are to handle logicals/booleans, that messes up the order of columns
- ## Has been reported
-
- if (!is.null(by.var)) {
- if (identical("logical",class(data[[by.var]]))){
- data[by.var] <- as.character(data[[by.var]])
- }
- }
-
- out <- data |>
- baseline_table(
- fun.args =
- list(
- by = by.var,
- ...
- )
- )
-
- if (!is.null(by.var)) {
- if (isTRUE(add.overall)){
- out <- out |> gtsummary::add_overall()
- }
- if (isTRUE(add.p)) {
- out <- out |>
- gtsummary::add_p() |>
- gtsummary::bold_p()
- }
-
- }
-
- out
-}
diff --git a/R/data_plots.R b/R/data_plots.R
index 3f40de8f..e9225dec 100644
--- a/R/data_plots.R
+++ b/R/data_plots.R
@@ -302,7 +302,6 @@ data_visuals_server <- function(id,
{
tryCatch(
{
- shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
rv$plot <- create_plot(
data = data(),
type = rv$plot.params()[["fun"]],
@@ -310,7 +309,6 @@ data_visuals_server <- function(id,
y = input$secondary,
z = input$tertiary
)
- })
},
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
diff --git a/R/helpers.R b/R/helpers.R
index 96968230..4e24796a 100644
--- a/R/helpers.R
+++ b/R/helpers.R
@@ -29,7 +29,7 @@ getfun <- function(x) {
#' @return output file name
#' @export
#'
-write_quarto <- function(data, ...) {
+write_quarto <- function(data,...) {
# Exports data to temporary location
#
# I assume this is more secure than putting it in the www folder and deleting
@@ -50,7 +50,7 @@ write_quarto <- function(data, ...) {
)
}
-write_rmd <- function(data, ...) {
+write_rmd <- function(data,...) {
# Exports data to temporary location
#
# I assume this is more secure than putting it in the www folder and deleting
@@ -210,17 +210,17 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename,
#' default_parsing() |>
#' str()
default_parsing <- function(data) {
- name_labels <- lapply(data, \(.x) REDCapCAST::get_attr(.x, attr = "label"))
+ name_labels <- lapply(data,\(.x) REDCapCAST::get_attr(.x,attr = "label"))
out <- data |>
REDCapCAST::parse_data() |>
REDCapCAST::as_factor() |>
- REDCapCAST::numchar2fct(numeric.threshold = 8, character.throshold = 10) |>
+ REDCapCAST::numchar2fct(numeric.threshold = 8,character.throshold = 10) |>
REDCapCAST::as_logical() |>
REDCapCAST::fct_drop()
- purrr::map2(out, name_labels, \(.x, .l){
- if (!(is.na(.l) | .l == "")) {
+ purrr::map2(out,name_labels,\(.x,.l){
+ if (!(is.na(.l) | .l=="")) {
REDCapCAST::set_attr(.x, .l, attr = "label")
} else {
attr(x = .x, which = "label") <- NULL
@@ -238,14 +238,12 @@ default_parsing <- function(data) {
#' @export
#'
#' @examples
-#' ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label"))
-#' ds |>
-#' remove_na_attr() |>
-#' str()
-remove_na_attr <- function(data, attr = "label") {
+#' ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x,label=NA,attr = "label"))
+#' ds |> remove_na_attr() |> str()
+remove_na_attr <- function(data,attr="label"){
out <- data |> lapply(\(.x){
- ls <- REDCapCAST::get_attr(data = .x, attr = attr)
- if (is.na(ls) | ls == "") {
+ ls <- REDCapCAST::get_attr(data = .x,attr = attr)
+ if (is.na(ls) | ls == ""){
attr(x = .x, which = attr) <- NULL
}
.x
@@ -263,10 +261,10 @@ remove_na_attr <- function(data, attr = "label") {
#' @export
#'
#' @examples
-#' data.frame(a = 1:10, b = NA, c = c(2, NA)) |> remove_empty_cols(cutoff = .5)
-remove_empty_cols <- function(data, cutoff = .7) {
- filter <- apply(X = data, MARGIN = 2, FUN = \(.x){
- sum(as.numeric(!is.na(.x))) / length(.x)
+#'data.frame(a=1:10,b=NA, c=c(2,NA)) |> remove_empty_cols(cutoff=.5)
+remove_empty_cols <- function(data,cutoff=.7){
+ filter <- apply(X = data,MARGIN = 2,FUN = \(.x){
+ sum(as.numeric(!is.na(.x)))/length(.x)
}) >= cutoff
data[filter]
}
@@ -282,18 +280,18 @@ remove_empty_cols <- function(data, cutoff = .7) {
#' @export
#'
#' @examples
-#' ls_d <- list(test = c(1:20))
+#' ls_d <- list(test=c(1:20))
#' ls_d <- list()
-#' data.frame(letters[1:20], 1:20) |> append_list(ls_d, "letters")
-#' letters[1:20] |> append_list(ls_d, "letters")
-append_list <- function(data, list, index) {
+#' data.frame(letters[1:20],1:20) |> append_list(ls_d,"letters")
+#' letters[1:20]|> append_list(ls_d,"letters")
+append_list <- function(data,list,index){
## This will overwrite and not warn
## Not very safe, but convenient to append code to list
- if (index %in% names(list)) {
+ if (index %in% names(list)){
list[[index]] <- data
out <- list
} else {
- out <- setNames(c(list, list(data)), c(names(list), index))
+ out <- setNames(c(list,list(data)),c(names(list),index))
}
out
}
@@ -307,33 +305,7 @@ append_list <- function(data, list, index) {
#' @export
#'
#' @examples
-#' c(NA, 1:10, rep(NA, 3)) |> missing_fraction()
-missing_fraction <- function(data) {
- NROW(data[is.na(data)]) / NROW(data)
-}
-
-
-
-#' Ultra short data dascription
-#'
-#' @param data
-#'
-#' @returns character vector
-#' @export
-#'
-#' @examples
-#' data.frame(
-#' sample(1:8, 20, TRUE),
-#' sample(c(1:8, NA), 20, TRUE)
-#' ) |> data_description()
-data_description <- function(data) {
- data <- if (shiny::is.reactive(data)) data() else data
-
- sprintf(
- i18n("Data has %s observations and %s variables, with %s (%s%%) complete cases"),
- nrow(data),
- ncol(data),
- sum(complete.cases(data)),
- signif(100 * (1 - missing_fraction(data)), 3)
- )
+#' c(NA,1:10,rep(NA,3)) |> missing_fraction()
+missing_fraction <- function(data){
+ NROW(data[is.na(data)])/NROW(data)
}
diff --git a/R/plot_box.R b/R/plot_box.R
index 09ab6c80..97f88f73 100644
--- a/R/plot_box.R
+++ b/R/plot_box.R
@@ -36,7 +36,7 @@ plot_box <- function(data, x, y, z = NULL) {
#'
#' @name data-plots
#'
-#' @returns ggplot object
+#' @returns
#' @export
#'
#' @examples
diff --git a/R/regression_plot.R b/R/regression_plot.R
index a21a4bf8..adb0a471 100644
--- a/R/regression_plot.R
+++ b/R/regression_plot.R
@@ -43,16 +43,15 @@ plot.tbl_regression <- function(x,
# Removes redundant label
df_coefs$label[df_coefs$row_type == "label"] <- ""
- # browser()
+
# Add estimate value to reference level
- if (plot_ref == TRUE) {
- df_coefs[df_coefs$var_type %in% c("categorical", "dichotomous") & df_coefs$reference_row & !is.na(df_coefs$reference_row), "estimate"] <- if (x$inputs$exponentiate) 1 else 0
- }
+ if (plot_ref == TRUE){
+ df_coefs[df_coefs$var_type == "categorical" & is.na(df_coefs$reference_row),"estimate"] <- if (x$inputs$exponentiate) 1 else 0}
p <- df_coefs |>
ggstats::ggcoef_plot(exponentiate = x$inputs$exponentiate, ...)
- if (x$inputs$exponentiate) {
+ if (x$inputs$exponentiate){
p <- symmetrical_scale_x_log10(p)
}
p
@@ -90,8 +89,7 @@ merge_long <- function(list, model.names) {
)
setNames(d, gsub("_[0-9]{,}$", "", names(d)))
}) |>
- dplyr::bind_rows() |>
- dplyr::mutate(model = as_factor(model))
+ dplyr::bind_rows() |> dplyr::mutate(model=as_factor(model))
l_merged$table_body <- df_body_long
@@ -111,25 +109,12 @@ merge_long <- function(list, model.names) {
#' @export
#'
#' @examples
-#' limit_log(-.1, floor)
-#' limit_log(.1, ceiling)
-#' limit_log(-2.1, ceiling)
-#' limit_log(2.1, ceiling)
-limit_log <- function(data, fun, ...) {
- fun(10^-floor(data) * 10^data) / 10^-floor(data)
-}
-
-#' Create summetric log ticks
-#'
-#' @param data numeric vector
-#'
-#' @returns numeric vector
-#' @export
-#'
-#' @examples
-#' c(sample(seq(.1, 1, .1), 3), sample(1:10, 3)) |> create_log_tics()
-create_log_tics <- function(data) {
- sort(round(unique(c(1 / data, data, 1)), 2))
+#' limit_log(-.1,floor)
+#' limit_log(.1,ceiling)
+#' limit_log(-2.1,ceiling)
+#' limit_log(2.1,ceiling)
+limit_log <- function(data,fun,...){
+ fun(10^-floor(data)*10^data)/10^-floor(data)
}
#' Ensure symmetrical plot around 1 on a logarithmic x scale for ratio plots
@@ -141,18 +126,18 @@ create_log_tics <- function(data) {
#' @returns ggplot2 object
#' @export
#'
-symmetrical_scale_x_log10 <- function(plot, breaks = c(1, 2, 3, 5, 10), ...) {
+symmetrical_scale_x_log10 <- function(plot,breaks=c(1,2,3,5,10),...){
rx <- ggplot2::layer_scales(plot)$x$get_limits()
- x_min <- floor(10 * rx[1]) / 10
- x_max <- ceiling(10 * rx[2]) / 10
+ x_min <- floor(10*rx[1])/10
+ x_max <- ceiling(10*rx[2])/10
- rx_min <- limit_log(rx[1], floor)
- rx_max <- limit_log(rx[2], ceiling)
+ rx_min <- limit_log(rx[1],floor)
+ rx_max <- limit_log(rx[2],ceiling)
- max_abs_x <- max(abs(c(x_min, x_max)))
+ max_abs_x <- max(abs(c(x_min,x_max)))
- ticks <- log10(breaks) + (ceiling(max_abs_x) - 1)
+ ticks <- log10(breaks)+(ceiling(max_abs_x)-1)
- plot + ggplot2::scale_x_log10(limits = c(rx_min, rx_max), breaks = create_log_tics(10^ticks[ticks <= max_abs_x]))
+ plot + ggplot2::scale_x_log10(limits=c(rx_min,rx_max),breaks=create_log_tics(10^ticks[ticks<=max_abs_x]))
}
diff --git a/R/regression_table.R b/R/regression_table.R
index 5e90a27f..c9fa5138 100644
--- a/R/regression_table.R
+++ b/R/regression_table.R
@@ -119,8 +119,8 @@ regression_table_create <- function(x, ..., args.list = NULL, fun = "gtsummary::
}
out <- do.call(getfun(fun), c(list(x = x), args.list))
- out #|>
- # gtsummary::add_glance_source_note() # |>
+ out |>
+ gtsummary::add_glance_source_note() # |>
# gtsummary::bold_p()
}
diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R
index 1dbfff57..683b6f23 100644
--- a/inst/apps/FreesearchR/app.R
+++ b/inst/apps/FreesearchR/app.R
@@ -10,7 +10,7 @@
#### Current file: R//app_version.R
########
-app_version <- function()'250324_1432'
+app_version <- function()'250320_1310'
########
@@ -41,58 +41,6 @@ baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary,
-#' Create a baseline table
-#'
-#' @param data data
-#' @param ... passed as fun.arg to baseline_table()
-#' @param strat.var grouping/strat variable
-#' @param add.p add comparison/p-value
-#' @param add.overall add overall column
-#'
-#' @returns gtsummary table list object
-#' @export
-#'
-#' @examples
-#' mtcars |> create_baseline(by.var = "gear", add.p="yes"=="yes")
-create_baseline <- function(data,...,by.var,add.p=FALSE,add.overall=FALSE){
- if (by.var == "none" | !by.var %in% names(data)) {
- by.var <- NULL
- }
-
- ## These steps are to handle logicals/booleans, that messes up the order of columns
- ## Has been reported
-
- if (!is.null(by.var)) {
- if (identical("logical",class(data[[by.var]]))){
- data[by.var] <- as.character(data[[by.var]])
- }
- }
-
- out <- data |>
- baseline_table(
- fun.args =
- list(
- by = by.var,
- ...
- )
- )
-
- if (!is.null(by.var)) {
- if (isTRUE(add.overall)){
- out <- out |> gtsummary::add_overall()
- }
- if (isTRUE(add.p)) {
- out <- out |>
- gtsummary::add_p() |>
- gtsummary::bold_p()
- }
-
- }
-
- out
-}
-
-
########
#### Current file: R//contrast_text.R
########
@@ -408,6 +356,76 @@ columnSelectInput <- function(inputId, label, data, selected = "", ...,
)
}
+columnSelectInputStat <- function(inputId, label, data, selected = "", ...,
+ col_subset = NULL, placeholder = "", onInitialize, none_label="No variable selected",maxItems=NULL) {
+ data <- if (is.reactive(data)) data() else data
+ col_subsetr <- if (is.reactive(col_subset)) col_subset else reactive(col_subset)
+
+ labels <- Map(function(col) {
+ json <- sprintf(
+ IDEAFilter:::strip_leading_ws('
+ {
+ "name": "%s",
+ "label": "%s",
+ "dataclass": "%s",
+ "datatype": "%s"
+ }'),
+ col,
+ attr(data[[col]], "label") %||% "",
+ IDEAFilter:::get_dataFilter_class(data[[col]]),
+ data_type(data[[col]])
+ )
+ }, col = names(data))
+
+ if (!"none" %in% names(data)){
+ labels <- c("none"=list(sprintf('\n {\n \"name\": \"none\",\n \"label\": \"%s\",\n \"dataclass\": \"\",\n \"datatype\": \"\"\n }',none_label)),labels)
+ choices <- setNames(names(labels), labels)
+ choices <- choices[match(if (length(col_subsetr()) == 0 || isTRUE(col_subsetr() == "")) names(data) else col_subsetr(), choices)]
+ } else {
+ choices <- setNames(names(data), labels)
+ choices <- choices[match(if (length(col_subsetr()) == 0 || isTRUE(col_subsetr() == "")) choices else col_subsetr(), choices)]
+ }
+
+ shiny::selectizeInput(
+ inputId = inputId,
+ label = label,
+ choices = choices,
+ selected = selected,
+ ...,
+ options = c(
+ list(render = I("{
+ // format the way that options are rendered
+ option: function(item, escape) {
+ item.data = JSON.parse(item.label);
+ return '
' +
+ '
' +
+ escape(item.data.name) + ' ' +
+ '' +
+ (item.data.dataclass != '' ?
+ ' ' +
+ item.data.dataclass +
+ '' : '' ) + ' ' +
+ (item.data.datatype != '' ?
+ ' ' +
+ item.data.datatype +
+ '' : '' ) +
+ '
' +
+ (item.data.label != '' ? '
' + escape(item.data.label) + '
' : '') +
+ '
';
+ },
+
+ // avoid data vomit splashing on screen when an option is selected
+ item: function(item, escape) {
+ item.data = JSON.parse(item.label);
+ return '' +
+ escape(item.data.name) +
+ '
';
+ }
+ }")),
+ if (!is.null(maxItems)) list(maxItems=maxItems)
+ )
+ )
+}
#' A selectizeInput customized for named vectors
#'
@@ -1458,7 +1476,6 @@ data_visuals_server <- function(id,
{
tryCatch(
{
- shiny::withProgress(message = "Drawing the plot. Hold tight for a moment..", {
rv$plot <- create_plot(
data = data(),
type = rv$plot.params()[["fun"]],
@@ -1466,7 +1483,6 @@ data_visuals_server <- function(id,
y = input$secondary,
z = input$tertiary
)
- })
},
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
@@ -2517,7 +2533,7 @@ getfun <- function(x) {
#' @return output file name
#' @export
#'
-write_quarto <- function(data, ...) {
+write_quarto <- function(data,...) {
# Exports data to temporary location
#
# I assume this is more secure than putting it in the www folder and deleting
@@ -2538,7 +2554,7 @@ write_quarto <- function(data, ...) {
)
}
-write_rmd <- function(data, ...) {
+write_rmd <- function(data,...) {
# Exports data to temporary location
#
# I assume this is more secure than putting it in the www folder and deleting
@@ -2698,17 +2714,17 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename,
#' default_parsing() |>
#' str()
default_parsing <- function(data) {
- name_labels <- lapply(data, \(.x) REDCapCAST::get_attr(.x, attr = "label"))
+ name_labels <- lapply(data,\(.x) REDCapCAST::get_attr(.x,attr = "label"))
out <- data |>
REDCapCAST::parse_data() |>
REDCapCAST::as_factor() |>
- REDCapCAST::numchar2fct(numeric.threshold = 8, character.throshold = 10) |>
+ REDCapCAST::numchar2fct(numeric.threshold = 8,character.throshold = 10) |>
REDCapCAST::as_logical() |>
REDCapCAST::fct_drop()
- purrr::map2(out, name_labels, \(.x, .l){
- if (!(is.na(.l) | .l == "")) {
+ purrr::map2(out,name_labels,\(.x,.l){
+ if (!(is.na(.l) | .l=="")) {
REDCapCAST::set_attr(.x, .l, attr = "label")
} else {
attr(x = .x, which = "label") <- NULL
@@ -2726,14 +2742,12 @@ default_parsing <- function(data) {
#' @export
#'
#' @examples
-#' ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label"))
-#' ds |>
-#' remove_na_attr() |>
-#' str()
-remove_na_attr <- function(data, attr = "label") {
+#' ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x,label=NA,attr = "label"))
+#' ds |> remove_na_attr() |> str()
+remove_na_attr <- function(data,attr="label"){
out <- data |> lapply(\(.x){
- ls <- REDCapCAST::get_attr(data = .x, attr = attr)
- if (is.na(ls) | ls == "") {
+ ls <- REDCapCAST::get_attr(data = .x,attr = attr)
+ if (is.na(ls) | ls == ""){
attr(x = .x, which = attr) <- NULL
}
.x
@@ -2751,10 +2765,10 @@ remove_na_attr <- function(data, attr = "label") {
#' @export
#'
#' @examples
-#' data.frame(a = 1:10, b = NA, c = c(2, NA)) |> remove_empty_cols(cutoff = .5)
-remove_empty_cols <- function(data, cutoff = .7) {
- filter <- apply(X = data, MARGIN = 2, FUN = \(.x){
- sum(as.numeric(!is.na(.x))) / length(.x)
+#'data.frame(a=1:10,b=NA, c=c(2,NA)) |> remove_empty_cols(cutoff=.5)
+remove_empty_cols <- function(data,cutoff=.7){
+ filter <- apply(X = data,MARGIN = 2,FUN = \(.x){
+ sum(as.numeric(!is.na(.x)))/length(.x)
}) >= cutoff
data[filter]
}
@@ -2770,18 +2784,18 @@ remove_empty_cols <- function(data, cutoff = .7) {
#' @export
#'
#' @examples
-#' ls_d <- list(test = c(1:20))
+#' ls_d <- list(test=c(1:20))
#' ls_d <- list()
-#' data.frame(letters[1:20], 1:20) |> append_list(ls_d, "letters")
-#' letters[1:20] |> append_list(ls_d, "letters")
-append_list <- function(data, list, index) {
+#' data.frame(letters[1:20],1:20) |> append_list(ls_d,"letters")
+#' letters[1:20]|> append_list(ls_d,"letters")
+append_list <- function(data,list,index){
## This will overwrite and not warn
## Not very safe, but convenient to append code to list
- if (index %in% names(list)) {
+ if (index %in% names(list)){
list[[index]] <- data
out <- list
} else {
- out <- setNames(c(list, list(data)), c(names(list), index))
+ out <- setNames(c(list,list(data)),c(names(list),index))
}
out
}
@@ -2795,35 +2809,9 @@ append_list <- function(data, list, index) {
#' @export
#'
#' @examples
-#' c(NA, 1:10, rep(NA, 3)) |> missing_fraction()
-missing_fraction <- function(data) {
- NROW(data[is.na(data)]) / NROW(data)
-}
-
-
-
-#' Ultra short data dascription
-#'
-#' @param data
-#'
-#' @returns character vector
-#' @export
-#'
-#' @examples
-#' data.frame(
-#' sample(1:8, 20, TRUE),
-#' sample(c(1:8, NA), 20, TRUE)
-#' ) |> data_description()
-data_description <- function(data) {
- data <- if (shiny::is.reactive(data)) data() else data
-
- sprintf(
- i18n("Data has %s observations and %s variables, with %s (%s%%) complete cases"),
- nrow(data),
- ncol(data),
- sum(complete.cases(data)),
- signif(100 * (1 - missing_fraction(data)), 3)
- )
+#' c(NA,1:10,rep(NA,3)) |> missing_fraction()
+missing_fraction <- function(data){
+ NROW(data[is.na(data)])/NROW(data)
}
@@ -5364,16 +5352,15 @@ plot.tbl_regression <- function(x,
# Removes redundant label
df_coefs$label[df_coefs$row_type == "label"] <- ""
- # browser()
+
# Add estimate value to reference level
- if (plot_ref == TRUE) {
- df_coefs[df_coefs$var_type %in% c("categorical", "dichotomous") & df_coefs$reference_row & !is.na(df_coefs$reference_row), "estimate"] <- if (x$inputs$exponentiate) 1 else 0
- }
+ if (plot_ref == TRUE){
+ df_coefs[df_coefs$var_type == "categorical" & is.na(df_coefs$reference_row),"estimate"] <- if (x$inputs$exponentiate) 1 else 0}
p <- df_coefs |>
ggstats::ggcoef_plot(exponentiate = x$inputs$exponentiate, ...)
- if (x$inputs$exponentiate) {
+ if (x$inputs$exponentiate){
p <- symmetrical_scale_x_log10(p)
}
p
@@ -5411,8 +5398,7 @@ merge_long <- function(list, model.names) {
)
setNames(d, gsub("_[0-9]{,}$", "", names(d)))
}) |>
- dplyr::bind_rows() |>
- dplyr::mutate(model = as_factor(model))
+ dplyr::bind_rows() |> dplyr::mutate(model=as_factor(model))
l_merged$table_body <- df_body_long
@@ -5432,25 +5418,12 @@ merge_long <- function(list, model.names) {
#' @export
#'
#' @examples
-#' limit_log(-.1, floor)
-#' limit_log(.1, ceiling)
-#' limit_log(-2.1, ceiling)
-#' limit_log(2.1, ceiling)
-limit_log <- function(data, fun, ...) {
- fun(10^-floor(data) * 10^data) / 10^-floor(data)
-}
-
-#' Create summetric log ticks
-#'
-#' @param data numeric vector
-#'
-#' @returns
-#' @export
-#'
-#' @examples
-#' c(sample(seq(.1, 1, .1), 3), sample(1:10, 3)) |> create_log_tics()
-create_log_tics <- function(data) {
- sort(round(unique(c(1 / data, data, 1)), 2))
+#' limit_log(-.1,floor)
+#' limit_log(.1,ceiling)
+#' limit_log(-2.1,ceiling)
+#' limit_log(2.1,ceiling)
+limit_log <- function(data,fun,...){
+ fun(10^-floor(data)*10^data)/10^-floor(data)
}
#' Ensure symmetrical plot around 1 on a logarithmic x scale for ratio plots
@@ -5462,20 +5435,20 @@ create_log_tics <- function(data) {
#' @returns ggplot2 object
#' @export
#'
-symmetrical_scale_x_log10 <- function(plot, breaks = c(1, 2, 3, 5, 10), ...) {
+symmetrical_scale_x_log10 <- function(plot,breaks=c(1,2,3,5,10),...){
rx <- ggplot2::layer_scales(plot)$x$get_limits()
- x_min <- floor(10 * rx[1]) / 10
- x_max <- ceiling(10 * rx[2]) / 10
+ x_min <- floor(10*rx[1])/10
+ x_max <- ceiling(10*rx[2])/10
- rx_min <- limit_log(rx[1], floor)
- rx_max <- limit_log(rx[2], ceiling)
+ rx_min <- limit_log(rx[1],floor)
+ rx_max <- limit_log(rx[2],ceiling)
- max_abs_x <- max(abs(c(x_min, x_max)))
+ max_abs_x <- max(abs(c(x_min,x_max)))
- ticks <- log10(breaks) + (ceiling(max_abs_x) - 1)
+ ticks <- log10(breaks)+(ceiling(max_abs_x)-1)
- plot + ggplot2::scale_x_log10(limits = c(rx_min, rx_max), breaks = create_log_tics(10^ticks[ticks <= max_abs_x]))
+ plot + ggplot2::scale_x_log10(limits=c(rx_min,rx_max),breaks=create_log_tics(10^ticks[ticks<=max_abs_x]))
}
@@ -5604,8 +5577,8 @@ regression_table_create <- function(x, ..., args.list = NULL, fun = "gtsummary::
}
out <- do.call(getfun(fun), c(list(x = x), args.list))
- out #|>
- # gtsummary::add_glance_source_note() # |>
+ out |>
+ gtsummary::add_glance_source_note() # |>
# gtsummary::bold_p()
}
@@ -7128,7 +7101,6 @@ ui_elements <- list(
shinyWidgets::noUiSliderInput(
inputId = "complete_cutoff",
label = NULL,
- update_on = "change",
min = 0,
max = 100,
step = 5,
@@ -7139,8 +7111,7 @@ ui_elements <- list(
shiny::helpText("Filter variables with completeness above the specified percentage."),
shiny::br(),
shiny::br(),
- shiny::uiOutput(outputId = "import_var"),
- shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
+ shiny::uiOutput(outputId = "import_var")
)
),
shiny::br(),
@@ -7177,9 +7148,10 @@ ui_elements <- list(
fluidRow(
shiny::column(
width = 9,
- shiny::uiOutput(outputId = "data_info", inline = TRUE),
shiny::tags$p(
- "Below is a short summary table, on the right you can create data filters."
+ "Below is a short summary table of the provided data.
+ On the right hand side you have the option to create filters.
+ At the bottom you'll find a raw overview of the original vs the modified data."
)
)
),
@@ -7434,7 +7406,6 @@ ui_elements <- list(
# bslib::layout_sidebar(
# fillable = TRUE,
sidebar = bslib::sidebar(
- shiny::uiOutput(outputId = "data_info_regression", inline = TRUE),
bslib::accordion(
open = "acc_reg",
multiple = FALSE,
@@ -7496,7 +7467,7 @@ ui_elements <- list(
),
shiny::conditionalPanel(
condition = "input.all==1",
- shiny::uiOutput("regression_vars")
+ shiny::uiOutput("include_vars")
)
)
),
@@ -7852,12 +7823,11 @@ server <- function(input, output, session) {
shiny::observeEvent(
eventExpr = list(
- input$import_var,
- input$complete_cutoff
+ input$import_var
),
handlerExpr = {
shiny::req(rv$data_temp)
-# browser()
+
rv$data_original <- rv$data_temp |>
dplyr::select(input$import_var) |>
default_parsing()
@@ -7877,11 +7847,6 @@ server <- function(input, output, session) {
}
)
- output$data_info_import <- shiny::renderUI({
- shiny::req(rv$data_original)
- data_description(rv$data_original)
- })
-
shiny::observeEvent(rv$data_original, {
if (is.null(rv$data_original) | NROW(rv$data_original) == 0) {
@@ -7946,17 +7911,6 @@ server <- function(input, output, session) {
modal_update_variables("modal_variables", title = "Update and select variables")
)
- output$data_info <- shiny::renderUI({
- shiny::req(data_filter())
- data_description(data_filter())
- })
-
- output$data_info_regression <- shiny::renderUI({
- shiny::req(regression_vars())
- shiny::req(rv$list$data)
- data_description(rv$list$data[regression_vars()])
- })
-
######### Create factor
@@ -8177,25 +8131,40 @@ server <- function(input, output, session) {
## Keep these "old" selection options as a simple alternative to the modification pane
-
- output$regression_vars <- shiny::renderUI({
- columnSelectInput(
- inputId = "regression_vars",
+ output$include_vars <- shiny::renderUI({
+ columnSelectInputStat(
+ inputId = "include_vars",
selected = NULL,
label = "Covariables to include",
data = rv$data_filtered,
- multiple = TRUE,
+ multiple = TRUE
)
+
+ # shiny::selectizeInput(
+ # inputId = "include_vars",
+ # selected = NULL,
+ # label = "Covariables to include",
+ # choices = colnames(rv$data_filtered),
+ # multiple = TRUE
+ # )
})
output$outcome_var <- shiny::renderUI({
- columnSelectInput(
+ columnSelectInputStat(
inputId = "outcome_var",
selected = NULL,
label = "Select outcome variable",
data = rv$data_filtered,
multiple = FALSE
)
+
+ # shiny::selectInput(
+ # inputId = "outcome_var",
+ # selected = NULL,
+ # label = "Select outcome variable",
+ # choices = colnames(rv$data_filtered),
+ # multiple = FALSE
+ # )
})
output$regression_type <- shiny::renderUI({
@@ -8229,16 +8198,16 @@ server <- function(input, output, session) {
## Collected regression variables
regression_vars <- shiny::reactive({
- if (is.null(input$regression_vars)) {
+ if (is.null(input$include_vars)) {
out <- colnames(rv$data_filtered)
} else {
- out <- unique(c(input$regression_vars, input$outcome_var))
+ out <- unique(c(input$include_vars, input$outcome_var))
}
return(out)
})
output$strat_var <- shiny::renderUI({
- columnSelectInput(
+ columnSelectInputStat(
inputId = "strat_var",
selected = "none",
label = "Select variable to stratify baseline",
@@ -8248,6 +8217,27 @@ server <- function(input, output, session) {
names(rv$data_filtered)[unlist(lapply(rv$data_filtered, data_type)) %in% c("dichotomous", "categorical", "ordinal")]
)
)
+
+ # shiny::selectInput(
+ # inputId = "strat_var",
+ # selected = "none",
+ # label = "Select variable to stratify baseline",
+ # choices = c(
+ # "none",
+ # names(rv$list$data)[unlist(lapply(rv$list$data,data_type)) %in% c("dichotomous","categorical","ordinal")]
+ # # rv$data_filtered |>
+ # # (\(.x){
+ # # lapply(.x, \(.c){
+ # # if (identical("factor", class(.c))) {
+ # # .c
+ # # }
+ # # }) |>
+ # # dplyr::bind_cols()
+ # # })() |>
+ # # colnames()
+ # ),
+ # multiple = FALSE
+ # )
})
@@ -8277,7 +8267,7 @@ server <- function(input, output, session) {
# shiny::reactive(rv$data_original),
# data_filter(),
# input$strat_var,
- # input$regression_vars,
+ # input$include_vars,
# input$complete_cutoff,
# input$add_p
input$act_eval
@@ -8286,16 +8276,48 @@ server <- function(input, output, session) {
shiny::req(input$strat_var)
shiny::req(rv$list$data)
- # data_tbl1 <- 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,
- by.var = input$strat_var,
- add.p = input$add_p == "yes",
- add.overall = TRUE
- )
- })
+ if (input$strat_var == "none" | !input$strat_var %in% names(data_tbl1)) {
+ by.var <- NULL
+ } else {
+ by.var <- input$strat_var
+ }
+
+ ## These steps are to handle logicals/booleans, that messes up the order of columns
+ ## Has been reported
+
+ if (!is.null(by.var) & identical("logical",class(data_tbl1[[by.var]]))) {
+ data_tbl1[by.var] <- as.character(data_tbl1[[by.var]])
+ }
+
+ rv$list$table1 <-
+ data_tbl1 |>
+ baseline_table(
+ fun.args =
+ list(
+ by = by.var
+ )
+ ) |>
+ (\(.x){
+ if (!is.null(by.var)) {
+ .x |> gtsummary::add_overall()
+ } else {
+ .x
+ }
+ })() |>
+ (\(.x){
+ if (input$add_p == "yes" & !is.null(by.var)) {
+ .x |>
+ gtsummary::add_p() |>
+ gtsummary::bold_p()
+ } else {
+ .x
+ }
+ })()
+
+ # gtsummary::as_kable(rv$list$table1) |>
+ # readr::write_lines(file="./www/_table1.md")
}
)
@@ -8394,9 +8416,9 @@ server <- function(input, output, session) {
# .x$model
# })
},
- # warning = function(warn) {
- # showNotification(paste0(warn), type = "warning")
- # },
+ warning = function(warn) {
+ showNotification(paste0(warn), type = "warning")
+ },
error = function(err) {
showNotification(paste0("Creating regression models failed with the following error: ", err), type = "err")
}
@@ -8419,9 +8441,9 @@ server <- function(input, output, session) {
purrr::pluck("Multivariable") |>
performance::check_model()
},
- # warning = function(warn) {
- # showNotification(paste0(warn), type = "warning")
- # },
+ warning = function(warn) {
+ showNotification(paste0(warn), type = "warning")
+ },
error = function(err) {
showNotification(paste0("Running model assumptions checks failed with the following error: ", err), type = "err")
}
diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
index ce7c605e..8d5d512d 100644
--- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
+++ b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
@@ -5,6 +5,6 @@ account: agdamsbo
server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1
appId: 13611288
-bundleId: 9994253
+bundleId: 9974967
url: https://agdamsbo.shinyapps.io/freesearcheR/
version: 1
diff --git a/inst/apps/FreesearchR/server.R b/inst/apps/FreesearchR/server.R
index 790d2ddf..30ee43e0 100644
--- a/inst/apps/FreesearchR/server.R
+++ b/inst/apps/FreesearchR/server.R
@@ -160,12 +160,11 @@ server <- function(input, output, session) {
shiny::observeEvent(
eventExpr = list(
- input$import_var,
- input$complete_cutoff
+ input$import_var
),
handlerExpr = {
shiny::req(rv$data_temp)
-# browser()
+
rv$data_original <- rv$data_temp |>
dplyr::select(input$import_var) |>
default_parsing()
@@ -185,11 +184,6 @@ server <- function(input, output, session) {
}
)
- output$data_info_import <- shiny::renderUI({
- shiny::req(rv$data_original)
- data_description(rv$data_original)
- })
-
shiny::observeEvent(rv$data_original, {
if (is.null(rv$data_original) | NROW(rv$data_original) == 0) {
@@ -254,17 +248,6 @@ server <- function(input, output, session) {
modal_update_variables("modal_variables", title = "Update and select variables")
)
- output$data_info <- shiny::renderUI({
- shiny::req(data_filter())
- data_description(data_filter())
- })
-
- output$data_info_regression <- shiny::renderUI({
- shiny::req(regression_vars())
- shiny::req(rv$list$data)
- data_description(rv$list$data[regression_vars()])
- })
-
######### Create factor
@@ -485,25 +468,40 @@ server <- function(input, output, session) {
## Keep these "old" selection options as a simple alternative to the modification pane
-
- output$regression_vars <- shiny::renderUI({
- columnSelectInput(
- inputId = "regression_vars",
+ output$include_vars <- shiny::renderUI({
+ columnSelectInputStat(
+ inputId = "include_vars",
selected = NULL,
label = "Covariables to include",
data = rv$data_filtered,
- multiple = TRUE,
+ multiple = TRUE
)
+
+ # shiny::selectizeInput(
+ # inputId = "include_vars",
+ # selected = NULL,
+ # label = "Covariables to include",
+ # choices = colnames(rv$data_filtered),
+ # multiple = TRUE
+ # )
})
output$outcome_var <- shiny::renderUI({
- columnSelectInput(
+ columnSelectInputStat(
inputId = "outcome_var",
selected = NULL,
label = "Select outcome variable",
data = rv$data_filtered,
multiple = FALSE
)
+
+ # shiny::selectInput(
+ # inputId = "outcome_var",
+ # selected = NULL,
+ # label = "Select outcome variable",
+ # choices = colnames(rv$data_filtered),
+ # multiple = FALSE
+ # )
})
output$regression_type <- shiny::renderUI({
@@ -537,16 +535,16 @@ server <- function(input, output, session) {
## Collected regression variables
regression_vars <- shiny::reactive({
- if (is.null(input$regression_vars)) {
+ if (is.null(input$include_vars)) {
out <- colnames(rv$data_filtered)
} else {
- out <- unique(c(input$regression_vars, input$outcome_var))
+ out <- unique(c(input$include_vars, input$outcome_var))
}
return(out)
})
output$strat_var <- shiny::renderUI({
- columnSelectInput(
+ columnSelectInputStat(
inputId = "strat_var",
selected = "none",
label = "Select variable to stratify baseline",
@@ -556,6 +554,27 @@ server <- function(input, output, session) {
names(rv$data_filtered)[unlist(lapply(rv$data_filtered, data_type)) %in% c("dichotomous", "categorical", "ordinal")]
)
)
+
+ # shiny::selectInput(
+ # inputId = "strat_var",
+ # selected = "none",
+ # label = "Select variable to stratify baseline",
+ # choices = c(
+ # "none",
+ # names(rv$list$data)[unlist(lapply(rv$list$data,data_type)) %in% c("dichotomous","categorical","ordinal")]
+ # # rv$data_filtered |>
+ # # (\(.x){
+ # # lapply(.x, \(.c){
+ # # if (identical("factor", class(.c))) {
+ # # .c
+ # # }
+ # # }) |>
+ # # dplyr::bind_cols()
+ # # })() |>
+ # # colnames()
+ # ),
+ # multiple = FALSE
+ # )
})
@@ -585,7 +604,7 @@ server <- function(input, output, session) {
# shiny::reactive(rv$data_original),
# data_filter(),
# input$strat_var,
- # input$regression_vars,
+ # input$include_vars,
# input$complete_cutoff,
# input$add_p
input$act_eval
@@ -594,16 +613,48 @@ server <- function(input, output, session) {
shiny::req(input$strat_var)
shiny::req(rv$list$data)
- # data_tbl1 <- 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,
- by.var = input$strat_var,
- add.p = input$add_p == "yes",
- add.overall = TRUE
- )
- })
+ if (input$strat_var == "none" | !input$strat_var %in% names(data_tbl1)) {
+ by.var <- NULL
+ } else {
+ by.var <- input$strat_var
+ }
+
+ ## These steps are to handle logicals/booleans, that messes up the order of columns
+ ## Has been reported
+
+ if (!is.null(by.var) & identical("logical",class(data_tbl1[[by.var]]))) {
+ data_tbl1[by.var] <- as.character(data_tbl1[[by.var]])
+ }
+
+ rv$list$table1 <-
+ data_tbl1 |>
+ baseline_table(
+ fun.args =
+ list(
+ by = by.var
+ )
+ ) |>
+ (\(.x){
+ if (!is.null(by.var)) {
+ .x |> gtsummary::add_overall()
+ } else {
+ .x
+ }
+ })() |>
+ (\(.x){
+ if (input$add_p == "yes" & !is.null(by.var)) {
+ .x |>
+ gtsummary::add_p() |>
+ gtsummary::bold_p()
+ } else {
+ .x
+ }
+ })()
+
+ # gtsummary::as_kable(rv$list$table1) |>
+ # readr::write_lines(file="./www/_table1.md")
}
)
@@ -702,9 +753,9 @@ server <- function(input, output, session) {
# .x$model
# })
},
- # warning = function(warn) {
- # showNotification(paste0(warn), type = "warning")
- # },
+ warning = function(warn) {
+ showNotification(paste0(warn), type = "warning")
+ },
error = function(err) {
showNotification(paste0("Creating regression models failed with the following error: ", err), type = "err")
}
@@ -727,9 +778,9 @@ server <- function(input, output, session) {
purrr::pluck("Multivariable") |>
performance::check_model()
},
- # warning = function(warn) {
- # showNotification(paste0(warn), type = "warning")
- # },
+ warning = function(warn) {
+ showNotification(paste0(warn), type = "warning")
+ },
error = function(err) {
showNotification(paste0("Running model assumptions checks failed with the following error: ", err), type = "err")
}
diff --git a/inst/apps/FreesearchR/ui.R b/inst/apps/FreesearchR/ui.R
index 1683c79f..ea40eb8d 100644
--- a/inst/apps/FreesearchR/ui.R
+++ b/inst/apps/FreesearchR/ui.R
@@ -84,7 +84,6 @@ ui_elements <- list(
shinyWidgets::noUiSliderInput(
inputId = "complete_cutoff",
label = NULL,
- update_on = "change",
min = 0,
max = 100,
step = 5,
@@ -95,8 +94,7 @@ ui_elements <- list(
shiny::helpText("Filter variables with completeness above the specified percentage."),
shiny::br(),
shiny::br(),
- shiny::uiOutput(outputId = "import_var"),
- shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
+ shiny::uiOutput(outputId = "import_var")
)
),
shiny::br(),
@@ -133,9 +131,10 @@ ui_elements <- list(
fluidRow(
shiny::column(
width = 9,
- shiny::uiOutput(outputId = "data_info", inline = TRUE),
shiny::tags$p(
- "Below is a short summary table, on the right you can create data filters."
+ "Below is a short summary table of the provided data.
+ On the right hand side you have the option to create filters.
+ At the bottom you'll find a raw overview of the original vs the modified data."
)
)
),
@@ -390,7 +389,6 @@ ui_elements <- list(
# bslib::layout_sidebar(
# fillable = TRUE,
sidebar = bslib::sidebar(
- shiny::uiOutput(outputId = "data_info_regression", inline = TRUE),
bslib::accordion(
open = "acc_reg",
multiple = FALSE,
@@ -452,7 +450,7 @@ ui_elements <- list(
),
shiny::conditionalPanel(
condition = "input.all==1",
- shiny::uiOutput("regression_vars")
+ shiny::uiOutput("include_vars")
)
)
),
diff --git a/man/append_list.Rd b/man/append_list.Rd
index 880daa0e..990f3a60 100644
--- a/man/append_list.Rd
+++ b/man/append_list.Rd
@@ -20,8 +20,8 @@ list
Append list with named index
}
\examples{
-ls_d <- list(test = c(1:20))
+ls_d <- list(test=c(1:20))
ls_d <- list()
-data.frame(letters[1:20], 1:20) |> append_list(ls_d, "letters")
-letters[1:20] |> append_list(ls_d, "letters")
+data.frame(letters[1:20],1:20) |> append_list(ls_d,"letters")
+letters[1:20]|> append_list(ls_d,"letters")
}
diff --git a/man/clean_common_axis.Rd b/man/clean_common_axis.Rd
deleted file mode 100644
index 175053c9..00000000
--- a/man/clean_common_axis.Rd
+++ /dev/null
@@ -1,19 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R
-\name{clean_common_axis}
-\alias{clean_common_axis}
-\title{Extract and clean axis ranges}
-\usage{
-clean_common_axis(p, axis)
-}
-\arguments{
-\item{p}{plot}
-
-\item{axis}{axis. x or y.}
-}
-\value{
-vector
-}
-\description{
-Extract and clean axis ranges
-}
diff --git a/man/create_baseline.Rd b/man/create_baseline.Rd
deleted file mode 100644
index 82e6fe1b..00000000
--- a/man/create_baseline.Rd
+++ /dev/null
@@ -1,28 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/baseline_table.R
-\name{create_baseline}
-\alias{create_baseline}
-\title{Create a baseline table}
-\usage{
-create_baseline(data, ..., by.var, add.p = FALSE, add.overall = FALSE)
-}
-\arguments{
-\item{data}{data}
-
-\item{...}{passed as fun.arg to baseline_table()}
-
-\item{add.p}{add comparison/p-value}
-
-\item{add.overall}{add overall column}
-
-\item{strat.var}{grouping/strat variable}
-}
-\value{
-gtsummary table list object
-}
-\description{
-Create a baseline table
-}
-\examples{
-mtcars |> create_baseline(by.var = "gear", add.p="yes"=="yes")
-}
diff --git a/man/create_log_tics.Rd b/man/create_log_tics.Rd
deleted file mode 100644
index 9baf3940..00000000
--- a/man/create_log_tics.Rd
+++ /dev/null
@@ -1,20 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/regression_plot.R
-\name{create_log_tics}
-\alias{create_log_tics}
-\title{Create summetric log ticks}
-\usage{
-create_log_tics(data)
-}
-\arguments{
-\item{data}{numeric vector}
-}
-\value{
-numeric vector
-}
-\description{
-Create summetric log ticks
-}
-\examples{
-c(sample(seq(.1, 1, .1), 3), sample(1:10, 3)) |> create_log_tics()
-}
diff --git a/man/data-plots.Rd b/man/data-plots.Rd
index f580b0e0..539381fc 100644
--- a/man/data-plots.Rd
+++ b/man/data-plots.Rd
@@ -1,13 +1,11 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/data_plots.R, R/plot_box.R, R/plot_hbar.R,
-% R/plot_ridge.R, R/plot_sankey.R, R/plot_scatter.R, R/plot_violin.R
+% Please edit documentation in R/data_plots.R, R/plot_hbar.R, R/plot_ridge.R,
+% R/plot_sankey.R, R/plot_scatter.R, R/plot_violin.R
\name{data-plots}
\alias{data-plots}
\alias{data_visuals_ui}
\alias{data_visuals_server}
\alias{create_plot}
-\alias{plot_box}
-\alias{plot_box_single}
\alias{plot_hbars}
\alias{plot_ridge}
\alias{sankey_ready}
@@ -22,10 +20,6 @@ data_visuals_server(id, data, ...)
create_plot(data, type, x, y, z = NULL, ...)
-plot_box(data, x, y, z = NULL)
-
-plot_box_single(data, x, y = NULL, seed = 2103)
-
plot_hbars(data, x, y, z = NULL)
plot_ridge(data, x, y, z = NULL, ...)
@@ -62,10 +56,6 @@ ggplot2 object
ggplot2 object
-ggplot object
-
-ggplot2 object
-
ggplot2 object
data.frame
@@ -81,10 +71,6 @@ Data correlations evaluation module
Wrapper to create plot based on provided type
-Beautiful box plot(s)
-
-Create nice box-plots
-
Nice horizontal stacked bars (Grotta bars)
Plot nice ridge plot
@@ -99,11 +85,6 @@ Beatiful violin plot
}
\examples{
create_plot(mtcars, "plot_violin", "mpg", "cyl")
-mtcars |> plot_box(x = "mpg", y = "cyl", z = "gear")
-mtcars |>
- default_parsing() |>
- plot_box(x = "mpg", y = "cyl", z = "gear")
-mtcars |> plot_box_single("mpg","cyl")
mtcars |> plot_hbars(x = "carb", y = "cyl")
mtcars |> plot_hbars(x = "carb", y = NULL)
mtcars |>
diff --git a/man/data_description.Rd b/man/data_description.Rd
deleted file mode 100644
index 97a0b0db..00000000
--- a/man/data_description.Rd
+++ /dev/null
@@ -1,23 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/helpers.R
-\name{data_description}
-\alias{data_description}
-\title{Ultra short data dascription}
-\usage{
-data_description(data)
-}
-\arguments{
-\item{data}{}
-}
-\value{
-character vector
-}
-\description{
-Ultra short data dascription
-}
-\examples{
-data.frame(
- sample(1:8, 20, TRUE),
- sample(c(1:8, NA), 20, TRUE)
-) |> data_description()
-}
diff --git a/man/data_type.Rd b/man/data_type.Rd
deleted file mode 100644
index af3716ad..00000000
--- a/man/data_type.Rd
+++ /dev/null
@@ -1,27 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/regression_model.R
-\name{data_type}
-\alias{data_type}
-\title{Data type assessment}
-\usage{
-data_type(data)
-}
-\arguments{
-\item{data}{data}
-}
-\value{
-outcome type
-}
-\description{
-Data type assessment
-}
-\examples{
-mtcars |>
- default_parsing() |>
- lapply(data_type)
-c(1, 2) |> data_type()
-1 |> data_type()
-c(rep(NA, 10)) |> data_type()
-sample(1:100, 50) |> data_type()
-factor(letters[1:20]) |> data_type()
-}
diff --git a/man/limit_log.Rd b/man/limit_log.Rd
index 95040600..55bcf3ce 100644
--- a/man/limit_log.Rd
+++ b/man/limit_log.Rd
@@ -20,8 +20,8 @@ numeric vector
Easily round log scale limits for nice plots
}
\examples{
-limit_log(-.1, floor)
-limit_log(.1, ceiling)
-limit_log(-2.1, ceiling)
-limit_log(2.1, ceiling)
+limit_log(-.1,floor)
+limit_log(.1,ceiling)
+limit_log(-2.1,ceiling)
+limit_log(2.1,ceiling)
}
diff --git a/man/missing_fraction.Rd b/man/missing_fraction.Rd
index b3acab98..6182c2a8 100644
--- a/man/missing_fraction.Rd
+++ b/man/missing_fraction.Rd
@@ -16,5 +16,5 @@ numeric vector
Get missingsness fraction
}
\examples{
-c(NA, 1:10, rep(NA, 3)) |> missing_fraction()
+c(NA,1:10,rep(NA,3)) |> missing_fraction()
}
diff --git a/man/outcome_type.Rd b/man/outcome_type.Rd
new file mode 100644
index 00000000..6a674dae
--- /dev/null
+++ b/man/outcome_type.Rd
@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/regression_model.R
+\name{outcome_type}
+\alias{outcome_type}
+\title{Outcome data type assessment}
+\usage{
+outcome_type(data)
+}
+\arguments{
+\item{data}{data}
+}
+\value{
+outcome type
+}
+\description{
+Outcome data type assessment
+}
+\examples{
+mtcars |>
+ default_parsing() |>
+ lapply(outcome_type)
+}
diff --git a/man/regression_model.Rd b/man/regression_model.Rd
index d86453b1..049e24d1 100644
--- a/man/regression_model.Rd
+++ b/man/regression_model.Rd
@@ -111,7 +111,7 @@ m <- mtcars |>
args.list = NULL,
vars = c("mpg", "cyl")
)
-broom::tidy(m)
+ broom::tidy(m)
\dontrun{
gtsummary::trial |>
regression_model_uv(outcome.str = "age")
@@ -126,7 +126,7 @@ m <- gtsummary::trial |> regression_model_uv(
fun = "stats::glm",
args.list = list(family = stats::binomial(link = "logit"))
)
-lapply(m, broom::tidy) |> dplyr::bind_rows()
+lapply(m,broom::tidy) |> dplyr::bind_rows()
}
\dontrun{
gtsummary::trial |>
@@ -154,15 +154,12 @@ broom::tidy(ls$model)
broom::tidy(m)
}
\dontrun{
-gtsummary::trial |>
- regression_model_uv(
- outcome.str = "trt",
- fun = "stats::glm",
- args.list = list(family = stats::binomial(link = "logit"))
- ) |>
- lapply(broom::tidy) |>
- dplyr::bind_rows()
+gtsummary::trial |> regression_model_uv(
+ outcome.str = "trt",
+ fun = "stats::glm",
+ args.list = list(family = stats::binomial(link = "logit"))
+) |> lapply(broom::tidy) |> dplyr::bind_rows()
ms <- regression_model_uv_list(data = default_parsing(mtcars), outcome.str = "mpg", fun.descr = "Linear regression model")
-lapply(ms$model, broom::tidy) |> dplyr::bind_rows()
+lapply(ms$model,broom::tidy) |> dplyr::bind_rows()
}
}
diff --git a/man/remove_empty_cols.Rd b/man/remove_empty_cols.Rd
index 48f96992..690a7c9d 100644
--- a/man/remove_empty_cols.Rd
+++ b/man/remove_empty_cols.Rd
@@ -18,5 +18,5 @@ data frame
Removes columns with completenes below cutoff
}
\examples{
-data.frame(a = 1:10, b = NA, c = c(2, NA)) |> remove_empty_cols(cutoff = .5)
+data.frame(a=1:10,b=NA, c=c(2,NA)) |> remove_empty_cols(cutoff=.5)
}
diff --git a/man/remove_na_attr.Rd b/man/remove_na_attr.Rd
index 41bb4ee2..e5e01f81 100644
--- a/man/remove_na_attr.Rd
+++ b/man/remove_na_attr.Rd
@@ -16,8 +16,6 @@ data.frame
Remove NA labels
}
\examples{
-ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label"))
-ds |>
- remove_na_attr() |>
- str()
+ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x,label=NA,attr = "label"))
+ds |> remove_na_attr() |> str()
}
diff --git a/man/subset_types.Rd b/man/subset_types.Rd
index 7b3f3665..bd01efe8 100644
--- a/man/subset_types.Rd
+++ b/man/subset_types.Rd
@@ -4,7 +4,7 @@
\alias{subset_types}
\title{Easily subset by data type function}
\usage{
-subset_types(data, types, type.fun = data_type)
+subset_types(data, types, type.fun = outcome_type)
}
\arguments{
\item{data}{data}
@@ -21,6 +21,6 @@ Easily subset by data type function
}
\examples{
default_parsing(mtcars) |> subset_types("ordinal")
-default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal" ,"categorical"))
+default_parsing(mtcars) |> subset_types(c("dichotomous", "ordinal"))
#' default_parsing(mtcars) |> subset_types("factor",class)
}