mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 18:09:39 +02:00
Compare commits
3 commits
68c93d94e4
...
1b425b5a94
| Author | SHA1 | Date | |
|---|---|---|---|
| 1b425b5a94 | |||
| 111393c73f | |||
| 04784a7a24 |
50 changed files with 1067 additions and 452 deletions
|
|
@ -1,6 +1,6 @@
|
|||
^renv$
|
||||
^renv\.lock$
|
||||
^freesearcheR\.Rproj$
|
||||
^FreesearchR\.Rproj$
|
||||
^\.Rproj\.user$
|
||||
^LICENSE\.md$
|
||||
^dev$
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
Package: freesearcheR
|
||||
Package: FreesearchR
|
||||
Title: Browser Based Data Analysis
|
||||
Version: 25.3.2
|
||||
Authors@R:
|
||||
|
|
@ -80,6 +80,6 @@ Suggests:
|
|||
rsconnect,
|
||||
knitr,
|
||||
rmarkdown
|
||||
URL: https://github.com/agdamsbo/freesearcheR, https://agdamsbo.github.io/freesearcheR/
|
||||
BugReports: https://github.com/agdamsbo/freesearcheR/issues
|
||||
URL: https://github.com/agdamsbo/FreesearchR, https://agdamsbo.github.io/FreesearchR/
|
||||
BugReports: https://github.com/agdamsbo/FreesearchR/issues
|
||||
VignetteBuilder: knitr
|
||||
|
|
|
|||
|
|
@ -20,4 +20,4 @@ LineEndingConversion: Posix
|
|||
BuildType: Package
|
||||
PackageUseDevtools: Yes
|
||||
PackageInstallArgs: --no-multiarch --with-keep.source
|
||||
PackageRoxygenize: rd,collate,namespace
|
||||
PackageRoxygenize: rd,collate,namespace,vignette
|
||||
|
|
@ -5,6 +5,8 @@ S3method(plot,tbl_regression)
|
|||
export(add_class_icon)
|
||||
export(add_sparkline)
|
||||
export(all_but)
|
||||
export(allign_axes)
|
||||
export(append_list)
|
||||
export(argsstring2list)
|
||||
export(baseline_table)
|
||||
export(clean_date)
|
||||
|
|
@ -48,7 +50,8 @@ export(is_consecutive)
|
|||
export(is_datetime)
|
||||
export(is_valid_redcap_url)
|
||||
export(is_valid_token)
|
||||
export(launch_freesearcheR)
|
||||
export(launch_FreesearchR)
|
||||
export(limit_log)
|
||||
export(line_break)
|
||||
export(m_datafileUI)
|
||||
export(m_redcap_readServer)
|
||||
|
|
@ -81,11 +84,11 @@ export(remove_na_attr)
|
|||
export(repeated_instruments)
|
||||
export(sankey_ready)
|
||||
export(selectInputIcon)
|
||||
export(shiny_freesearcheR)
|
||||
export(specify_qmd_format)
|
||||
export(subset_types)
|
||||
export(supported_functions)
|
||||
export(supported_plots)
|
||||
export(symmetrical_scale_x_log10)
|
||||
export(tbl_merge)
|
||||
export(update_factor_server)
|
||||
export(update_factor_ui)
|
||||
|
|
@ -96,6 +99,7 @@ export(vertical_stacked_bars)
|
|||
export(wide2long)
|
||||
export(winbox_cut_variable)
|
||||
export(winbox_update_factor)
|
||||
export(wrap_plot_list)
|
||||
export(write_quarto)
|
||||
importFrom(classInt,classIntervals)
|
||||
importFrom(data.table,as.data.table)
|
||||
|
|
|
|||
6
NEWS.md
6
NEWS.md
|
|
@ -1,12 +1,12 @@
|
|||
# freesearcheR 25.3.2
|
||||
# FreesearchR 25.3.2
|
||||
|
||||
Focus is on polish and improved ui/ux.
|
||||
|
||||
First steps towards an updated name (will be FreesearchR), with renamed repository. Also, the repo will move to an organisation (named FreesearchR).
|
||||
Updating name (will be FreesearchR), with renamed repository and some graphics are comng. This may introduce some breaking chances for others calling or installing the package. No future changes are planned. A complete transition is planned before attending and presenting a poster at the European Stroke Organisation Conference 2025 in May.
|
||||
|
||||
Testing file upload conducted and improved.
|
||||
|
||||
Working on omproving code export.
|
||||
Working on improving code export.
|
||||
|
||||
# freesearcheR 25.3.1
|
||||
|
||||
|
|
|
|||
2
QA.md
2
QA.md
|
|
@ -1,6 +1,6 @@
|
|||
# Questions and answers
|
||||
|
||||
A complete instructions set is not available, but below are a collection of questions and answers about the project and use of the app.
|
||||
A complete instructions set [is also available](https://agdamsbo.github.io/FreesearchR/articles/FreesearchR.html), but below are a collection of questions and answers about the project and use of the ***FreesearchR*** app.
|
||||
|
||||
## Are you keeping the uploaded data?
|
||||
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
app_version <- function()'250318_0819'
|
||||
app_version <- function()'250319_1327'
|
||||
|
|
|
|||
|
|
@ -102,13 +102,16 @@ library(shiny)
|
|||
#' f <- d_t |> cut(2)
|
||||
#' readr::parse_time(c("01:00:20", "03:00:20", "01:20:20", "03:02:20", NA)) |> cut(breaks = lubridate::as_datetime(c(hms::as_hms(levels(f)), hms::as_hms(max(d_t, na.rm = TRUE) + 1))), right = FALSE)
|
||||
cut.hms <- function(x, breaks, ...) {
|
||||
## as_hms keeps returning warnings on tz(); ignored
|
||||
suppressWarnings({
|
||||
if (hms::is_hms(breaks)) {
|
||||
breaks <- lubridate::as_datetime(breaks, tz = "UTC")
|
||||
breaks <- lubridate::as_datetime(breaks)
|
||||
}
|
||||
x <- lubridate::as_datetime(x, tz = "UTC")
|
||||
x <- lubridate::as_datetime(x)
|
||||
out <- cut.POSIXt(x, breaks = breaks, ...)
|
||||
attr(out, which = "brks") <- hms::as_hms(lubridate::as_datetime(attr(out, which = "brks")))
|
||||
attr(out, which = "levels") <- as.character(hms::as_hms(lubridate::as_datetime(attr(out, which = "levels"))))
|
||||
})
|
||||
out
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -59,27 +59,7 @@ data_import_server <- function(id) {
|
|||
id = ns("file_import"),
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame",
|
||||
read_fns = list(
|
||||
ods = import_ods,
|
||||
dta = function(file) {
|
||||
haven::read_dta(
|
||||
file = file,
|
||||
.name_repair = "unique_quiet"
|
||||
)
|
||||
},
|
||||
csv = import_delim,
|
||||
tsv = import_delim,
|
||||
txt = import_delim,
|
||||
xls = import_xls,
|
||||
xlsx = import_xls,
|
||||
rds = function(file) {
|
||||
readr::read_rds(
|
||||
file = file,
|
||||
name_repair = "unique_quiet"
|
||||
)
|
||||
}
|
||||
)
|
||||
return_class = "data.frame"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_file$data(), {
|
||||
|
|
|
|||
178
R/data_plots.R
178
R/data_plots.R
|
|
@ -112,6 +112,99 @@ data_visuals_server <- function(id,
|
|||
plot = NULL
|
||||
)
|
||||
|
||||
# ## --- New attempt
|
||||
#
|
||||
# rv$plot.params <- shiny::reactive({
|
||||
# get_plot_options(input$type) |> purrr::pluck(1)
|
||||
# })
|
||||
#
|
||||
# c(output,
|
||||
# list(shiny::renderUI({
|
||||
# columnSelectInput(
|
||||
# inputId = ns("primary"),
|
||||
# data = data,
|
||||
# placeholder = "Select variable",
|
||||
# label = "Response variable",
|
||||
# multiple = FALSE
|
||||
# )
|
||||
# }),
|
||||
# shiny::renderUI({
|
||||
# shiny::req(input$primary)
|
||||
# # browser()
|
||||
#
|
||||
# if (!input$primary %in% names(data())) {
|
||||
# plot_data <- data()[1]
|
||||
# } else {
|
||||
# plot_data <- data()[input$primary]
|
||||
# }
|
||||
#
|
||||
# plots <- possible_plots(
|
||||
# data = plot_data
|
||||
# )
|
||||
#
|
||||
# plots_named <- get_plot_options(plots) |>
|
||||
# lapply(\(.x){
|
||||
# stats::setNames(.x$descr, .x$note)
|
||||
# })
|
||||
#
|
||||
# vectorSelectInput(
|
||||
# inputId = ns("type"),
|
||||
# selected = NULL,
|
||||
# label = shiny::h4("Plot type"),
|
||||
# choices = Reduce(c, plots_named),
|
||||
# multiple = FALSE
|
||||
# )
|
||||
# }),
|
||||
# shiny::renderUI({
|
||||
# shiny::req(input$type)
|
||||
#
|
||||
# cols <- c(
|
||||
# rv$plot.params()[["secondary.extra"]],
|
||||
# all_but(
|
||||
# colnames(subset_types(
|
||||
# data(),
|
||||
# rv$plot.params()[["secondary.type"]]
|
||||
# )),
|
||||
# input$primary
|
||||
# )
|
||||
# )
|
||||
#
|
||||
# columnSelectInput(
|
||||
# inputId = ns("secondary"),
|
||||
# data = data,
|
||||
# selected = cols[1],
|
||||
# placeholder = "Please select",
|
||||
# label = if (isTRUE(rv$plot.params()[["secondary.multi"]])) "Additional variables" else "Secondary variable",
|
||||
# multiple = rv$plot.params()[["secondary.multi"]],
|
||||
# maxItems = rv$plot.params()[["secondary.max"]],
|
||||
# col_subset = cols,
|
||||
# none_label = "No variable"
|
||||
# )
|
||||
# }),
|
||||
# shiny::renderUI({
|
||||
# shiny::req(input$type)
|
||||
# columnSelectInput(
|
||||
# inputId = ns("tertiary"),
|
||||
# data = data,
|
||||
# placeholder = "Please select",
|
||||
# label = "Grouping variable",
|
||||
# multiple = FALSE,
|
||||
# col_subset = c(
|
||||
# "none",
|
||||
# all_but(
|
||||
# colnames(subset_types(
|
||||
# data(),
|
||||
# rv$plot.params()[["tertiary.type"]]
|
||||
# )),
|
||||
# input$primary,
|
||||
# input$secondary
|
||||
# )
|
||||
# ),
|
||||
# none_label = "No stratification"
|
||||
# )
|
||||
# })
|
||||
# )|> setNames(c("primary","type","secondary","tertiary")),keep.null = TRUE)
|
||||
|
||||
output$primary <- shiny::renderUI({
|
||||
columnSelectInput(
|
||||
inputId = ns("primary"),
|
||||
|
|
@ -364,6 +457,16 @@ supported_plots <- function() {
|
|||
tertiary.type = c("dichotomous", "ordinal"),
|
||||
secondary.extra = NULL
|
||||
),
|
||||
plot_box = list(
|
||||
fun = "plot_box",
|
||||
descr = "Box plot",
|
||||
note = "A classic way to plot data distribution by groups",
|
||||
primary.type = c("continuous", "dichotomous", "ordinal"),
|
||||
secondary.type = c("dichotomous", "ordinal"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "ordinal"),
|
||||
secondary.extra = "none"
|
||||
),
|
||||
plot_euler = list(
|
||||
fun = "plot_euler",
|
||||
descr = "Euler diagram",
|
||||
|
|
@ -535,18 +638,49 @@ line_break <- function(data, lineLength = 20, fixed = FALSE) {
|
|||
}
|
||||
|
||||
|
||||
wrap_plot_list <- function(data) {
|
||||
if (length(data) > 1) {
|
||||
out <- data |>
|
||||
allign_axes() |>
|
||||
patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect")
|
||||
#' Wrapping
|
||||
#'
|
||||
#' @param data list of ggplot2 objects
|
||||
#' @param tag_levels passed to patchwork::plot_annotation if given. Default is NULL
|
||||
#'
|
||||
#' @returns list of ggplot2 objects
|
||||
#' @export
|
||||
#'
|
||||
wrap_plot_list <- function(data, tag_levels = NULL) {
|
||||
if (ggplot2::is.ggplot(data[[1]])) {
|
||||
if (length(data) > 1) {
|
||||
out <- data |>
|
||||
(\(.x){
|
||||
if (rlang::is_named(.x)) {
|
||||
purrr::imap(.x, \(.y, .i){
|
||||
.y + ggplot2::ggtitle(.i)
|
||||
})
|
||||
} else {
|
||||
.x
|
||||
}
|
||||
})() |>
|
||||
allign_axes() |>
|
||||
patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect")
|
||||
if (!is.null(tag_levels)) {
|
||||
out <- out + patchwork::plot_annotation(tag_levels = tag_levels)
|
||||
}
|
||||
} else {
|
||||
out <- data
|
||||
}
|
||||
} else {
|
||||
out <- data
|
||||
cli::cli_abort("Can only wrap lists of {.cls ggplot} objects")
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
|
||||
#' Alligns axes between plots
|
||||
#'
|
||||
#' @param ... ggplot2 objects or list of ggplot2 objects
|
||||
#'
|
||||
#' @returns list of ggplot2 objects
|
||||
#' @export
|
||||
#'
|
||||
allign_axes <- function(...) {
|
||||
# https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
|
||||
# https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
|
||||
|
|
@ -558,16 +692,30 @@ allign_axes <- function(...) {
|
|||
cli::cli_abort("Can only align {.cls ggplot} objects or a list of them")
|
||||
}
|
||||
|
||||
# browser()
|
||||
yr <- purrr::map(p, ~ ggplot2::layer_scales(.x)$y$get_limits()) |>
|
||||
unlist() |>
|
||||
range() |>
|
||||
unique()
|
||||
yr <- clean_common_axis(p, "y")
|
||||
|
||||
xr <- purrr::map(p, ~ ggplot2::layer_scales(.x)$x$get_limits()) |>
|
||||
unlist() |>
|
||||
range() |>
|
||||
unique()
|
||||
xr <- clean_common_axis(p, "x")
|
||||
|
||||
p |> purrr::map(~ .x + ggplot2::xlim(xr) + ggplot2::ylim(yr))
|
||||
}
|
||||
|
||||
#' Extract and clean axis ranges
|
||||
#'
|
||||
#' @param p plot
|
||||
#' @param axis axis. x or y.
|
||||
#'
|
||||
#' @returns vector
|
||||
#' @export
|
||||
#'
|
||||
clean_common_axis <- function(p, axis) {
|
||||
purrr::map(p, ~ ggplot2::layer_scales(.x)[[axis]]$get_limits()) |>
|
||||
unlist() |>
|
||||
(\(.x){
|
||||
if (is.numeric(.x)) {
|
||||
range(.x)
|
||||
} else {
|
||||
.x
|
||||
}
|
||||
})() |>
|
||||
unique()
|
||||
}
|
||||
|
|
|
|||
|
|
@ -215,7 +215,9 @@ default_parsing <- function(data) {
|
|||
out <- data |>
|
||||
REDCapCAST::parse_data() |>
|
||||
REDCapCAST::as_factor() |>
|
||||
REDCapCAST::numchar2fct()
|
||||
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=="")) {
|
||||
|
|
@ -275,6 +277,7 @@ remove_empty_cols <- function(data,cutoff=.7){
|
|||
#' @param index index name
|
||||
#'
|
||||
#' @returns list
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' ls_d <- list(test=c(1:20))
|
||||
|
|
|
|||
|
|
@ -254,7 +254,7 @@ import_file_server <- function(id,
|
|||
parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(get(read_fns[[extension]])))]
|
||||
# parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))]
|
||||
imported <- try(rlang::exec(read_fns[[extension]], !!!parameters), silent = TRUE)
|
||||
code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)), .ns = "freesearcheR")
|
||||
code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)), .ns = "FreesearchR")
|
||||
|
||||
if (inherits(imported, "try-error")) {
|
||||
imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE)
|
||||
|
|
|
|||
24
R/launch_FreesearchR.R
Normal file
24
R/launch_FreesearchR.R
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
#' Easily launch the FreesearchR app
|
||||
#'
|
||||
#' @description
|
||||
#' All data.frames in the global environment will be accessible through the app.
|
||||
#'
|
||||
#' @param ... passed on to `shiny::runApp()`
|
||||
#'
|
||||
#' @returns shiny app
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' data(mtcars)
|
||||
#' shiny_FreesearchR(launch.browser = TRUE)
|
||||
#' }
|
||||
launch_FreesearchR <- function(...){
|
||||
appDir <- system.file("apps", "FreesearchR", package = "FreesearchR")
|
||||
if (appDir == "") {
|
||||
stop("Could not find the app directory. Try re-installing `FreesearchR`.", call. = FALSE)
|
||||
}
|
||||
|
||||
a <- shiny::runApp(appDir = paste0(appDir,"/app.R"), ...)
|
||||
return(invisible(a))
|
||||
}
|
||||
80
R/plot_box.R
Normal file
80
R/plot_box.R
Normal file
|
|
@ -0,0 +1,80 @@
|
|||
#' Beautiful box plot(s)
|
||||
#'
|
||||
#' @returns ggplot2 object
|
||||
#' @export
|
||||
#'
|
||||
#' @name data-plots
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |> plot_box(x = "mpg", y = "cyl", z = "gear")
|
||||
#' mtcars |>
|
||||
#' default_parsing() |>
|
||||
#' plot_box(x = "mpg", y = "cyl", z = "gear")
|
||||
plot_box <- function(data, x, y, z = NULL) {
|
||||
if (!is.null(z)) {
|
||||
ds <- split(data, data[z])
|
||||
} else {
|
||||
ds <- list(data)
|
||||
}
|
||||
|
||||
out <- lapply(ds, \(.ds){
|
||||
plot_box_single(
|
||||
data = .ds,
|
||||
x = x,
|
||||
y = y
|
||||
)
|
||||
})
|
||||
|
||||
wrap_plot_list(out)
|
||||
# patchwork::wrap_plots(out,guides = "collect")
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
#' Create nice box-plots
|
||||
#'
|
||||
#' @name data-plots
|
||||
#'
|
||||
#' @returns
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |> plot_box_single("mpg","cyl")
|
||||
plot_box_single <- function(data, x, y=NULL, seed = 2103) {
|
||||
set.seed(seed)
|
||||
|
||||
if (is.null(y)) {
|
||||
y <- "All"
|
||||
data[[y]] <- y
|
||||
}
|
||||
|
||||
discrete <- !outcome_type(data[[y]]) %in% "continuous"
|
||||
|
||||
data |>
|
||||
ggplot2::ggplot(ggplot2::aes(x = !!dplyr::sym(x), y = !!dplyr::sym(y), fill = !!dplyr::sym(y), group = !!dplyr::sym(y))) +
|
||||
ggplot2::geom_boxplot(linewidth = 1.8, outliers = FALSE) +
|
||||
## THis could be optional in future
|
||||
ggplot2::geom_jitter(color = "black", size = 2, alpha = 0.9) +
|
||||
ggplot2::coord_flip() +
|
||||
viridis::scale_fill_viridis(discrete = discrete, option = "D") +
|
||||
# ggplot2::theme_void() +
|
||||
ggplot2::theme_bw(base_size = 24) +
|
||||
ggplot2::theme(
|
||||
legend.position = "none",
|
||||
# panel.grid.major = element_blank(),
|
||||
# panel.grid.minor = element_blank(),
|
||||
# axis.text.y = element_blank(),
|
||||
# axis.title.y = element_blank(),
|
||||
# text = ggplot2::element_text(size = 20),
|
||||
# axis.text = ggplot2::element_blank(),
|
||||
# plot.title = element_blank(),
|
||||
panel.background = ggplot2::element_rect(fill = "white"),
|
||||
plot.background = ggplot2::element_rect(fill = "white"),
|
||||
panel.border = ggplot2::element_blank(),
|
||||
panel.grid.major = ggplot2::element_blank(),
|
||||
panel.grid.minor = ggplot2::element_blank(),
|
||||
axis.line = ggplot2::element_line(colour = "black"),
|
||||
axis.ticks = ggplot2::element_line(colour = "black")
|
||||
)
|
||||
}
|
||||
|
|
@ -78,9 +78,6 @@ ggeulerr <- function(
|
|||
#' mtcars |> plot_euler("vs", "am", seed = 1)
|
||||
plot_euler <- function(data, x, y, z = NULL, seed = 2103) {
|
||||
set.seed(seed = seed)
|
||||
|
||||
# data <- data[c(...,z)]
|
||||
|
||||
if (!is.null(z)) {
|
||||
ds <- split(data, data[z])
|
||||
} else {
|
||||
|
|
@ -93,6 +90,7 @@ plot_euler <- function(data, x, y, z = NULL, seed = 2103) {
|
|||
plot_euler_single()
|
||||
})
|
||||
|
||||
# names(out)
|
||||
wrap_plot_list(out)
|
||||
# patchwork::wrap_plots(out, guides = "collect")
|
||||
}
|
||||
|
|
@ -116,7 +114,7 @@ plot_euler_single <- function(data) {
|
|||
ggeulerr(shape = "circle") +
|
||||
ggplot2::theme_void() +
|
||||
ggplot2::theme(
|
||||
legend.position = "right",
|
||||
legend.position = "none",
|
||||
# panel.grid.major = element_blank(),
|
||||
# panel.grid.minor = element_blank(),
|
||||
# axis.text.y = element_blank(),
|
||||
|
|
|
|||
|
|
@ -15,15 +15,16 @@
|
|||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' mod <- lm(mpg ~ ., mtcars)
|
||||
#' mod <- lm(mpg ~ ., default_parsing(mtcars))
|
||||
#' p <- mod |>
|
||||
#' gtsummary::tbl_regression() |>
|
||||
#' plot(colour = "variable")
|
||||
#' }
|
||||
#'
|
||||
plot.tbl_regression <- function(x,
|
||||
# remove_header_rows = TRUE,
|
||||
# remove_reference_rows = FALSE,
|
||||
plot_ref = TRUE,
|
||||
remove_header_rows = TRUE,
|
||||
remove_reference_rows = FALSE,
|
||||
...) {
|
||||
# check_dots_empty()
|
||||
gtsummary:::check_pkg_installed("ggstats")
|
||||
|
|
@ -32,33 +33,31 @@ plot.tbl_regression <- function(x,
|
|||
# gtsummary:::check_scalar_logical(remove_reference_rows)
|
||||
|
||||
df_coefs <- x$table_body
|
||||
# if (isTRUE(remove_header_rows)) {
|
||||
# df_coefs <- df_coefs |> dplyr::filter(!.data$header_row %in% TRUE)
|
||||
# }
|
||||
# if (isTRUE(remove_reference_rows)) {
|
||||
# df_coefs <- df_coefs |> dplyr::filter(!.data$reference_row %in% TRUE)
|
||||
# }
|
||||
|
||||
# browser()
|
||||
if (isTRUE(remove_header_rows)) {
|
||||
df_coefs <- df_coefs |> dplyr::filter(!header_row %in% TRUE)
|
||||
}
|
||||
if (isTRUE(remove_reference_rows)) {
|
||||
df_coefs <- df_coefs |> dplyr::filter(!reference_row %in% TRUE)
|
||||
}
|
||||
|
||||
# Removes redundant label
|
||||
df_coefs$label[df_coefs$row_type == "label"] <- ""
|
||||
|
||||
df_coefs %>%
|
||||
# Add estimate value to reference level
|
||||
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){
|
||||
p <- symmetrical_scale_x_log10(p)
|
||||
}
|
||||
p
|
||||
}
|
||||
|
||||
|
||||
# default_parsing(mtcars) |> lapply(class)
|
||||
#
|
||||
# purrr::imap(mtcars,\(.x,.i){
|
||||
# if (.i %in% c("vs","am","gear","carb")){
|
||||
# as.factor(.x)
|
||||
# } else .x
|
||||
# }) |> dplyr::bind_cols()
|
||||
#
|
||||
#
|
||||
|
||||
|
||||
#' Wrapper to pivot gtsummary table data to long for plotting
|
||||
#'
|
||||
#' @param list a custom regression models list
|
||||
|
|
@ -98,3 +97,47 @@ merge_long <- function(list, model.names) {
|
|||
|
||||
l_merged
|
||||
}
|
||||
|
||||
|
||||
#' Easily round log scale limits for nice plots
|
||||
#'
|
||||
#' @param data data
|
||||
#' @param fun rounding function (floor/ceiling)
|
||||
#' @param ... ignored
|
||||
#'
|
||||
#' @returns numeric vector
|
||||
#' @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)
|
||||
}
|
||||
|
||||
#' Ensure symmetrical plot around 1 on a logarithmic x scale for ratio plots
|
||||
#'
|
||||
#' @param plot ggplot2 plot
|
||||
#' @param breaks breaks used and mirrored
|
||||
#' @param ... ignored
|
||||
#'
|
||||
#' @returns ggplot2 object
|
||||
#' @export
|
||||
#'
|
||||
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
|
||||
|
||||
rx_min <- limit_log(rx[1],floor)
|
||||
rx_max <- limit_log(rx[2],ceiling)
|
||||
|
||||
max_abs_x <- max(abs(c(x_min,x_max)))
|
||||
|
||||
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]))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -81,7 +81,7 @@
|
|||
#' #' @export
|
||||
#' regression_table.default <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
|
||||
#' # Stripping custom class
|
||||
#' class(x) <- class(x)[class(x) != "freesearcher_model"]
|
||||
#' class(x) <- class(x)[class(x) != "freesearchr_model"]
|
||||
#'
|
||||
#' if (any(c(length(class(x)) != 1, class(x) != "lm"))) {
|
||||
#' if (!"exponentiate" %in% names(args.list)) {
|
||||
|
|
@ -110,7 +110,7 @@ regression_table <- function(x, ...) {
|
|||
|
||||
regression_table_create <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
|
||||
# Stripping custom class
|
||||
class(x) <- class(x)[class(x) != "freesearcher_model"]
|
||||
class(x) <- class(x)[class(x) != "freesearchr_model"]
|
||||
|
||||
if (any(c(length(class(x)) != 1, class(x) != "lm"))) {
|
||||
if (!"exponentiate" %in% names(args.list)) {
|
||||
|
|
|
|||
|
|
@ -1,37 +0,0 @@
|
|||
#' Launch the freesearcheR tool locally
|
||||
#'
|
||||
#' @description
|
||||
#' All data.frames in the global environment will be accessible through the app.
|
||||
#'
|
||||
#'
|
||||
#' @param ... arguments passed on to `shiny::runApp()`
|
||||
#'
|
||||
#' @return shiny app
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' data(mtcars)
|
||||
#' shiny_freesearcheR(launch.browser = TRUE)
|
||||
#' }
|
||||
shiny_freesearcheR <- function(...) {
|
||||
appDir <- system.file("apps", "freesearcheR", package = "freesearcheR")
|
||||
if (appDir == "") {
|
||||
stop("Could not find the app directory. Try re-installing `freesearcheR`.", call. = FALSE)
|
||||
}
|
||||
|
||||
a <- shiny::runApp(appDir = paste0(appDir,"/app.R"), ...)
|
||||
return(invisible(a))
|
||||
}
|
||||
|
||||
|
||||
#' Easily launch the freesearcheR app
|
||||
#'
|
||||
#' @param ... passed on to `shiny::runApp()`
|
||||
#'
|
||||
#' @returns shiny app
|
||||
#' @export
|
||||
#'
|
||||
launch_freesearcheR <- function(...){
|
||||
shiny_freesearcheR(...)
|
||||
}
|
||||
|
|
@ -265,7 +265,7 @@ modal_update_factor <- function(id,
|
|||
#'
|
||||
#' @importFrom shinyWidgets WinBox wbOptions wbControls
|
||||
#' @importFrom htmltools tagList
|
||||
#' @rdname create-column
|
||||
#' @rdname update-factor
|
||||
winbox_update_factor <- function(id,
|
||||
title = i18n("Update levels of a factor"),
|
||||
options = shinyWidgets::wbOptions(),
|
||||
|
|
|
|||
22
README.md
22
README.md
|
|
@ -1,35 +1,35 @@
|
|||
# freesearcheR
|
||||
# FreesearchR
|
||||
|
||||
<!-- badges: start -->
|
||||
[](https://lifecycle.r-lib.org/articles/stages.html#experimental)
|
||||
[](https://github.com/agdamsbo/freesearcheR/actions/workflows/rhub.yaml)
|
||||
[](https://doi.org/10.5281/zenodo.14527429)
|
||||
[](https://agdamsbo.shinyapps.io/freesearcheR/)
|
||||
[](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml)
|
||||
[](https://agdamsbo.shinyapps.io/freesearcheR/)
|
||||
<!-- badges: end -->
|
||||
|
||||
This package is the backbone of the ***freesearcheR***, a free and open-source browser based data exploration and analysis tool for clinicians and researchers with publication ready output.
|
||||
This package is the backbone of the ***FreesearchR***, a free and open-source browser based data exploration and analysis tool for clinicians and researchers with publication ready output.
|
||||
|
||||
This package and the ***freesearcheR***-tool is part of a larger initiative to democratize health data analysis and remove barriers for clinicians to engage in health research.
|
||||
This package and the ***FreesearchR***-tool is part of a larger initiative to democratize health data analysis and remove barriers for clinicians to engage in health research.
|
||||
|
||||
the ***freesearcheR***-tool is online and accessible here: [link to the app freely hosted on shinyapps.io](https://agdamsbo.shinyapps.io/freesearcheR/). All feedback is welcome and can be shared as a GitHub issue.
|
||||
the ***FreesearchR***-tool is online and accessible here: [link to the app freely hosted on shinyapps.io](https://agdamsbo.shinyapps.io/FreesearchR/). All feedback is welcome and can be shared as a GitHub issue.
|
||||
|
||||
Initiatives for funding continued development of the tool and surrounding initiatives is ongoing.
|
||||
|
||||
|
||||
## Install locally
|
||||
|
||||
The ***freesearcheR***-tool can also be launched locally. Any data.frame available in the global environment will be accessible from the interface.
|
||||
The ***FreesearchR***-tool can also be launched locally. Any data.frame available in the global environment will be accessible from the interface.
|
||||
|
||||
```
|
||||
require("devtools")
|
||||
devtools::install_github("agdamsbo/freesearcheR")
|
||||
library(freesearcheR)
|
||||
devtools::install_github("agdamsbo/FreesearchR")
|
||||
library(FreesearchR)
|
||||
# By loading mtcars to the environment, it will be available
|
||||
# in the interface like any other data.frame
|
||||
data(mtcars)
|
||||
shiny_freesearcheR()
|
||||
launch_FreesearchR()
|
||||
```
|
||||
|
||||
## Code of Conduct
|
||||
|
||||
Please note that the freesearcheR project is released with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/1/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms.
|
||||
Please note that the ***FreesearchR*** project is released with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/1/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms.
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
url: https://agdamsbo.github.io/freesearcheR/
|
||||
url: https://agdamsbo.github.io/FreesearchR/
|
||||
template:
|
||||
bslib:
|
||||
version: 5
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/freesearcheR/inst/apps/freesearcheR/functions.R
|
||||
#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/functions.R
|
||||
########
|
||||
|
||||
|
||||
|
|
@ -10,7 +10,7 @@
|
|||
#### Current file: R//app_version.R
|
||||
########
|
||||
|
||||
app_version <- function()'250318_0819'
|
||||
app_version <- function()'250319_1327'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -554,13 +554,16 @@ library(shiny)
|
|||
#' f <- d_t |> cut(2)
|
||||
#' readr::parse_time(c("01:00:20", "03:00:20", "01:20:20", "03:02:20", NA)) |> cut(breaks = lubridate::as_datetime(c(hms::as_hms(levels(f)), hms::as_hms(max(d_t, na.rm = TRUE) + 1))), right = FALSE)
|
||||
cut.hms <- function(x, breaks, ...) {
|
||||
## as_hms keeps returning warnings on tz(); ignored
|
||||
suppressWarnings({
|
||||
if (hms::is_hms(breaks)) {
|
||||
breaks <- lubridate::as_datetime(breaks, tz = "UTC")
|
||||
breaks <- lubridate::as_datetime(breaks)
|
||||
}
|
||||
x <- lubridate::as_datetime(x, tz = "UTC")
|
||||
x <- lubridate::as_datetime(x)
|
||||
out <- cut.POSIXt(x, breaks = breaks, ...)
|
||||
attr(out, which = "brks") <- hms::as_hms(lubridate::as_datetime(attr(out, which = "brks")))
|
||||
attr(out, which = "levels") <- as.character(hms::as_hms(lubridate::as_datetime(attr(out, which = "levels"))))
|
||||
})
|
||||
out
|
||||
}
|
||||
|
||||
|
|
@ -1206,6 +1209,99 @@ data_visuals_server <- function(id,
|
|||
plot = NULL
|
||||
)
|
||||
|
||||
# ## --- New attempt
|
||||
#
|
||||
# rv$plot.params <- shiny::reactive({
|
||||
# get_plot_options(input$type) |> purrr::pluck(1)
|
||||
# })
|
||||
#
|
||||
# c(output,
|
||||
# list(shiny::renderUI({
|
||||
# columnSelectInput(
|
||||
# inputId = ns("primary"),
|
||||
# data = data,
|
||||
# placeholder = "Select variable",
|
||||
# label = "Response variable",
|
||||
# multiple = FALSE
|
||||
# )
|
||||
# }),
|
||||
# shiny::renderUI({
|
||||
# shiny::req(input$primary)
|
||||
# # browser()
|
||||
#
|
||||
# if (!input$primary %in% names(data())) {
|
||||
# plot_data <- data()[1]
|
||||
# } else {
|
||||
# plot_data <- data()[input$primary]
|
||||
# }
|
||||
#
|
||||
# plots <- possible_plots(
|
||||
# data = plot_data
|
||||
# )
|
||||
#
|
||||
# plots_named <- get_plot_options(plots) |>
|
||||
# lapply(\(.x){
|
||||
# stats::setNames(.x$descr, .x$note)
|
||||
# })
|
||||
#
|
||||
# vectorSelectInput(
|
||||
# inputId = ns("type"),
|
||||
# selected = NULL,
|
||||
# label = shiny::h4("Plot type"),
|
||||
# choices = Reduce(c, plots_named),
|
||||
# multiple = FALSE
|
||||
# )
|
||||
# }),
|
||||
# shiny::renderUI({
|
||||
# shiny::req(input$type)
|
||||
#
|
||||
# cols <- c(
|
||||
# rv$plot.params()[["secondary.extra"]],
|
||||
# all_but(
|
||||
# colnames(subset_types(
|
||||
# data(),
|
||||
# rv$plot.params()[["secondary.type"]]
|
||||
# )),
|
||||
# input$primary
|
||||
# )
|
||||
# )
|
||||
#
|
||||
# columnSelectInput(
|
||||
# inputId = ns("secondary"),
|
||||
# data = data,
|
||||
# selected = cols[1],
|
||||
# placeholder = "Please select",
|
||||
# label = if (isTRUE(rv$plot.params()[["secondary.multi"]])) "Additional variables" else "Secondary variable",
|
||||
# multiple = rv$plot.params()[["secondary.multi"]],
|
||||
# maxItems = rv$plot.params()[["secondary.max"]],
|
||||
# col_subset = cols,
|
||||
# none_label = "No variable"
|
||||
# )
|
||||
# }),
|
||||
# shiny::renderUI({
|
||||
# shiny::req(input$type)
|
||||
# columnSelectInput(
|
||||
# inputId = ns("tertiary"),
|
||||
# data = data,
|
||||
# placeholder = "Please select",
|
||||
# label = "Grouping variable",
|
||||
# multiple = FALSE,
|
||||
# col_subset = c(
|
||||
# "none",
|
||||
# all_but(
|
||||
# colnames(subset_types(
|
||||
# data(),
|
||||
# rv$plot.params()[["tertiary.type"]]
|
||||
# )),
|
||||
# input$primary,
|
||||
# input$secondary
|
||||
# )
|
||||
# ),
|
||||
# none_label = "No stratification"
|
||||
# )
|
||||
# })
|
||||
# )|> setNames(c("primary","type","secondary","tertiary")),keep.null = TRUE)
|
||||
|
||||
output$primary <- shiny::renderUI({
|
||||
columnSelectInput(
|
||||
inputId = ns("primary"),
|
||||
|
|
@ -1458,6 +1554,16 @@ supported_plots <- function() {
|
|||
tertiary.type = c("dichotomous", "ordinal"),
|
||||
secondary.extra = NULL
|
||||
),
|
||||
plot_box = list(
|
||||
fun = "plot_box",
|
||||
descr = "Box plot",
|
||||
note = "A classic way to plot data distribution by groups",
|
||||
primary.type = c("continuous", "dichotomous", "ordinal"),
|
||||
secondary.type = c("dichotomous", "ordinal"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "ordinal"),
|
||||
secondary.extra = "none"
|
||||
),
|
||||
plot_euler = list(
|
||||
fun = "plot_euler",
|
||||
descr = "Euler diagram",
|
||||
|
|
@ -1629,18 +1735,49 @@ line_break <- function(data, lineLength = 20, fixed = FALSE) {
|
|||
}
|
||||
|
||||
|
||||
wrap_plot_list <- function(data) {
|
||||
if (length(data) > 1) {
|
||||
out <- data |>
|
||||
allign_axes() |>
|
||||
patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect")
|
||||
#' Wrapping
|
||||
#'
|
||||
#' @param data list of ggplot2 objects
|
||||
#' @param tag_levels passed to patchwork::plot_annotation if given. Default is NULL
|
||||
#'
|
||||
#' @returns list of ggplot2 objects
|
||||
#' @export
|
||||
#'
|
||||
wrap_plot_list <- function(data, tag_levels = NULL) {
|
||||
if (ggplot2::is.ggplot(data[[1]])) {
|
||||
if (length(data) > 1) {
|
||||
out <- data |>
|
||||
(\(.x){
|
||||
if (rlang::is_named(.x)) {
|
||||
purrr::imap(.x, \(.y, .i){
|
||||
.y + ggplot2::ggtitle(.i)
|
||||
})
|
||||
} else {
|
||||
.x
|
||||
}
|
||||
})() |>
|
||||
allign_axes() |>
|
||||
patchwork::wrap_plots(guides = "collect", axes = "collect", axis_titles = "collect")
|
||||
if (!is.null(tag_levels)) {
|
||||
out <- out + patchwork::plot_annotation(tag_levels = tag_levels)
|
||||
}
|
||||
} else {
|
||||
out <- data
|
||||
}
|
||||
} else {
|
||||
out <- data
|
||||
cli::cli_abort("Can only wrap lists of {.cls ggplot} objects")
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
|
||||
#' Alligns axes between plots
|
||||
#'
|
||||
#' @param ... ggplot2 objects or list of ggplot2 objects
|
||||
#'
|
||||
#' @returns list of ggplot2 objects
|
||||
#' @export
|
||||
#'
|
||||
allign_axes <- function(...) {
|
||||
# https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
|
||||
# https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
|
||||
|
|
@ -1652,20 +1789,34 @@ allign_axes <- function(...) {
|
|||
cli::cli_abort("Can only align {.cls ggplot} objects or a list of them")
|
||||
}
|
||||
|
||||
# browser()
|
||||
yr <- purrr::map(p, ~ ggplot2::layer_scales(.x)$y$get_limits()) |>
|
||||
unlist() |>
|
||||
range() |>
|
||||
unique()
|
||||
yr <- clean_common_axis(p, "y")
|
||||
|
||||
xr <- purrr::map(p, ~ ggplot2::layer_scales(.x)$x$get_limits()) |>
|
||||
unlist() |>
|
||||
range() |>
|
||||
unique()
|
||||
xr <- clean_common_axis(p, "x")
|
||||
|
||||
p |> purrr::map(~ .x + ggplot2::xlim(xr) + ggplot2::ylim(yr))
|
||||
}
|
||||
|
||||
#' Extract and clean axis ranges
|
||||
#'
|
||||
#' @param p plot
|
||||
#' @param axis axis. x or y.
|
||||
#'
|
||||
#' @returns vector
|
||||
#' @export
|
||||
#'
|
||||
clean_common_axis <- function(p, axis) {
|
||||
purrr::map(p, ~ ggplot2::layer_scales(.x)[[axis]]$get_limits()) |>
|
||||
unlist() |>
|
||||
(\(.x){
|
||||
if (is.numeric(.x)) {
|
||||
range(.x)
|
||||
} else {
|
||||
.x
|
||||
}
|
||||
})() |>
|
||||
unique()
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//data-import.R
|
||||
|
|
@ -1732,27 +1883,7 @@ data_import_server <- function(id) {
|
|||
id = ns("file_import"),
|
||||
show_data_in = "popup",
|
||||
trigger_return = "change",
|
||||
return_class = "data.frame",
|
||||
read_fns = list(
|
||||
ods = import_ods,
|
||||
dta = function(file) {
|
||||
haven::read_dta(
|
||||
file = file,
|
||||
.name_repair = "unique_quiet"
|
||||
)
|
||||
},
|
||||
csv = import_delim,
|
||||
tsv = import_delim,
|
||||
txt = import_delim,
|
||||
xls = import_xls,
|
||||
xlsx = import_xls,
|
||||
rds = function(file) {
|
||||
readr::read_rds(
|
||||
file = file,
|
||||
name_repair = "unique_quiet"
|
||||
)
|
||||
}
|
||||
)
|
||||
return_class = "data.frame"
|
||||
)
|
||||
|
||||
shiny::observeEvent(data_file$data(), {
|
||||
|
|
@ -2505,7 +2636,9 @@ default_parsing <- function(data) {
|
|||
out <- data |>
|
||||
REDCapCAST::parse_data() |>
|
||||
REDCapCAST::as_factor() |>
|
||||
REDCapCAST::numchar2fct()
|
||||
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=="")) {
|
||||
|
|
@ -2565,6 +2698,7 @@ remove_empty_cols <- function(data,cutoff=.7){
|
|||
#' @param index index name
|
||||
#'
|
||||
#' @returns list
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' ls_d <- list(test=c(1:20))
|
||||
|
|
@ -2858,7 +2992,7 @@ import_file_server <- function(id,
|
|||
parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(get(read_fns[[extension]])))]
|
||||
# parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))]
|
||||
imported <- try(rlang::exec(read_fns[[extension]], !!!parameters), silent = TRUE)
|
||||
code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)), .ns = "freesearcheR")
|
||||
code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)), .ns = "FreesearchR")
|
||||
|
||||
if (inherits(imported, "try-error")) {
|
||||
imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE)
|
||||
|
|
@ -3173,6 +3307,122 @@ import_file_demo_app <- function() {
|
|||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//launch_FreesearchR.R
|
||||
########
|
||||
|
||||
#' Easily launch the FreesearchR app
|
||||
#'
|
||||
#' @description
|
||||
#' All data.frames in the global environment will be accessible through the app.
|
||||
#'
|
||||
#' @param ... passed on to `shiny::runApp()`
|
||||
#'
|
||||
#' @returns shiny app
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' data(mtcars)
|
||||
#' shiny_FreesearchR(launch.browser = TRUE)
|
||||
#' }
|
||||
launch_FreesearchR <- function(...){
|
||||
appDir <- system.file("apps", "FreesearchR", package = "FreesearchR")
|
||||
if (appDir == "") {
|
||||
stop("Could not find the app directory. Try re-installing `FreesearchR`.", call. = FALSE)
|
||||
}
|
||||
|
||||
a <- shiny::runApp(appDir = paste0(appDir,"/app.R"), ...)
|
||||
return(invisible(a))
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//plot_box.R
|
||||
########
|
||||
|
||||
#' Beautiful box plot(s)
|
||||
#'
|
||||
#' @returns ggplot2 object
|
||||
#' @export
|
||||
#'
|
||||
#' @name data-plots
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |> plot_box(x = "mpg", y = "cyl", z = "gear")
|
||||
#' mtcars |>
|
||||
#' default_parsing() |>
|
||||
#' plot_box(x = "mpg", y = "cyl", z = "gear")
|
||||
plot_box <- function(data, x, y, z = NULL) {
|
||||
if (!is.null(z)) {
|
||||
ds <- split(data, data[z])
|
||||
} else {
|
||||
ds <- list(data)
|
||||
}
|
||||
|
||||
out <- lapply(ds, \(.ds){
|
||||
plot_box_single(
|
||||
data = .ds,
|
||||
x = x,
|
||||
y = y
|
||||
)
|
||||
})
|
||||
|
||||
wrap_plot_list(out)
|
||||
# patchwork::wrap_plots(out,guides = "collect")
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
#' Create nice box-plots
|
||||
#'
|
||||
#' @name data-plots
|
||||
#'
|
||||
#' @returns
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |> plot_box_single("mpg","cyl")
|
||||
plot_box_single <- function(data, x, y=NULL, seed = 2103) {
|
||||
set.seed(seed)
|
||||
|
||||
if (is.null(y)) {
|
||||
y <- "All"
|
||||
data[[y]] <- y
|
||||
}
|
||||
|
||||
discrete <- !outcome_type(data[[y]]) %in% "continuous"
|
||||
|
||||
data |>
|
||||
ggplot2::ggplot(ggplot2::aes(x = !!dplyr::sym(x), y = !!dplyr::sym(y), fill = !!dplyr::sym(y), group = !!dplyr::sym(y))) +
|
||||
ggplot2::geom_boxplot(linewidth = 1.8, outliers = FALSE) +
|
||||
## THis could be optional in future
|
||||
ggplot2::geom_jitter(color = "black", size = 2, alpha = 0.9) +
|
||||
ggplot2::coord_flip() +
|
||||
viridis::scale_fill_viridis(discrete = discrete, option = "D") +
|
||||
# ggplot2::theme_void() +
|
||||
ggplot2::theme_bw(base_size = 24) +
|
||||
ggplot2::theme(
|
||||
legend.position = "none",
|
||||
# panel.grid.major = element_blank(),
|
||||
# panel.grid.minor = element_blank(),
|
||||
# axis.text.y = element_blank(),
|
||||
# axis.title.y = element_blank(),
|
||||
# text = ggplot2::element_text(size = 20),
|
||||
# axis.text = ggplot2::element_blank(),
|
||||
# plot.title = element_blank(),
|
||||
panel.background = ggplot2::element_rect(fill = "white"),
|
||||
plot.background = ggplot2::element_rect(fill = "white"),
|
||||
panel.border = ggplot2::element_blank(),
|
||||
panel.grid.major = ggplot2::element_blank(),
|
||||
panel.grid.minor = ggplot2::element_blank(),
|
||||
axis.line = ggplot2::element_line(colour = "black"),
|
||||
axis.ticks = ggplot2::element_line(colour = "black")
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//plot_euler.R
|
||||
########
|
||||
|
|
@ -3257,9 +3507,6 @@ ggeulerr <- function(
|
|||
#' mtcars |> plot_euler("vs", "am", seed = 1)
|
||||
plot_euler <- function(data, x, y, z = NULL, seed = 2103) {
|
||||
set.seed(seed = seed)
|
||||
|
||||
# data <- data[c(...,z)]
|
||||
|
||||
if (!is.null(z)) {
|
||||
ds <- split(data, data[z])
|
||||
} else {
|
||||
|
|
@ -3272,6 +3519,7 @@ plot_euler <- function(data, x, y, z = NULL, seed = 2103) {
|
|||
plot_euler_single()
|
||||
})
|
||||
|
||||
# names(out)
|
||||
wrap_plot_list(out)
|
||||
# patchwork::wrap_plots(out, guides = "collect")
|
||||
}
|
||||
|
|
@ -3295,7 +3543,7 @@ plot_euler_single <- function(data) {
|
|||
ggeulerr(shape = "circle") +
|
||||
ggplot2::theme_void() +
|
||||
ggplot2::theme(
|
||||
legend.position = "right",
|
||||
legend.position = "none",
|
||||
# panel.grid.major = element_blank(),
|
||||
# panel.grid.minor = element_blank(),
|
||||
# axis.text.y = element_blank(),
|
||||
|
|
@ -4972,15 +5220,16 @@ regression_model_uv_list <- function(data,
|
|||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' mod <- lm(mpg ~ ., mtcars)
|
||||
#' mod <- lm(mpg ~ ., default_parsing(mtcars))
|
||||
#' p <- mod |>
|
||||
#' gtsummary::tbl_regression() |>
|
||||
#' plot(colour = "variable")
|
||||
#' }
|
||||
#'
|
||||
plot.tbl_regression <- function(x,
|
||||
# remove_header_rows = TRUE,
|
||||
# remove_reference_rows = FALSE,
|
||||
plot_ref = TRUE,
|
||||
remove_header_rows = TRUE,
|
||||
remove_reference_rows = FALSE,
|
||||
...) {
|
||||
# check_dots_empty()
|
||||
gtsummary:::check_pkg_installed("ggstats")
|
||||
|
|
@ -4989,33 +5238,31 @@ plot.tbl_regression <- function(x,
|
|||
# gtsummary:::check_scalar_logical(remove_reference_rows)
|
||||
|
||||
df_coefs <- x$table_body
|
||||
# if (isTRUE(remove_header_rows)) {
|
||||
# df_coefs <- df_coefs |> dplyr::filter(!.data$header_row %in% TRUE)
|
||||
# }
|
||||
# if (isTRUE(remove_reference_rows)) {
|
||||
# df_coefs <- df_coefs |> dplyr::filter(!.data$reference_row %in% TRUE)
|
||||
# }
|
||||
|
||||
# browser()
|
||||
if (isTRUE(remove_header_rows)) {
|
||||
df_coefs <- df_coefs |> dplyr::filter(!header_row %in% TRUE)
|
||||
}
|
||||
if (isTRUE(remove_reference_rows)) {
|
||||
df_coefs <- df_coefs |> dplyr::filter(!reference_row %in% TRUE)
|
||||
}
|
||||
|
||||
# Removes redundant label
|
||||
df_coefs$label[df_coefs$row_type == "label"] <- ""
|
||||
|
||||
df_coefs %>%
|
||||
# Add estimate value to reference level
|
||||
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){
|
||||
p <- symmetrical_scale_x_log10(p)
|
||||
}
|
||||
p
|
||||
}
|
||||
|
||||
|
||||
# default_parsing(mtcars) |> lapply(class)
|
||||
#
|
||||
# purrr::imap(mtcars,\(.x,.i){
|
||||
# if (.i %in% c("vs","am","gear","carb")){
|
||||
# as.factor(.x)
|
||||
# } else .x
|
||||
# }) |> dplyr::bind_cols()
|
||||
#
|
||||
#
|
||||
|
||||
|
||||
#' Wrapper to pivot gtsummary table data to long for plotting
|
||||
#'
|
||||
#' @param list a custom regression models list
|
||||
|
|
@ -5057,6 +5304,50 @@ merge_long <- function(list, model.names) {
|
|||
}
|
||||
|
||||
|
||||
#' Easily round log scale limits for nice plots
|
||||
#'
|
||||
#' @param data data
|
||||
#' @param fun rounding function (floor/ceiling)
|
||||
#' @param ... ignored
|
||||
#'
|
||||
#' @returns numeric vector
|
||||
#' @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)
|
||||
}
|
||||
|
||||
#' Ensure symmetrical plot around 1 on a logarithmic x scale for ratio plots
|
||||
#'
|
||||
#' @param plot ggplot2 plot
|
||||
#' @param breaks breaks used and mirrored
|
||||
#' @param ... ignored
|
||||
#'
|
||||
#' @returns ggplot2 object
|
||||
#' @export
|
||||
#'
|
||||
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
|
||||
|
||||
rx_min <- limit_log(rx[1],floor)
|
||||
rx_max <- limit_log(rx[2],ceiling)
|
||||
|
||||
max_abs_x <- max(abs(c(x_min,x_max)))
|
||||
|
||||
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]))
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//regression_table.R
|
||||
########
|
||||
|
|
@ -5144,7 +5435,7 @@ merge_long <- function(list, model.names) {
|
|||
#' #' @export
|
||||
#' regression_table.default <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
|
||||
#' # Stripping custom class
|
||||
#' class(x) <- class(x)[class(x) != "freesearcher_model"]
|
||||
#' class(x) <- class(x)[class(x) != "freesearchr_model"]
|
||||
#'
|
||||
#' if (any(c(length(class(x)) != 1, class(x) != "lm"))) {
|
||||
#' if (!"exponentiate" %in% names(args.list)) {
|
||||
|
|
@ -5173,7 +5464,7 @@ regression_table <- function(x, ...) {
|
|||
|
||||
regression_table_create <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
|
||||
# Stripping custom class
|
||||
class(x) <- class(x)[class(x) != "freesearcher_model"]
|
||||
class(x) <- class(x)[class(x) != "freesearchr_model"]
|
||||
|
||||
if (any(c(length(class(x)) != 1, class(x) != "lm"))) {
|
||||
if (!"exponentiate" %in% names(args.list)) {
|
||||
|
|
@ -5296,49 +5587,6 @@ modify_qmd <- function(file, format) {
|
|||
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//shiny_freesearcheR.R
|
||||
########
|
||||
|
||||
#' Launch the freesearcheR tool locally
|
||||
#'
|
||||
#' @description
|
||||
#' All data.frames in the global environment will be accessible through the app.
|
||||
#'
|
||||
#'
|
||||
#' @param ... arguments passed on to `shiny::runApp()`
|
||||
#'
|
||||
#' @return shiny app
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' data(mtcars)
|
||||
#' shiny_freesearcheR(launch.browser = TRUE)
|
||||
#' }
|
||||
shiny_freesearcheR <- function(...) {
|
||||
appDir <- system.file("apps", "freesearcheR", package = "freesearcheR")
|
||||
if (appDir == "") {
|
||||
stop("Could not find the app directory. Try re-installing `freesearcheR`.", call. = FALSE)
|
||||
}
|
||||
|
||||
a <- shiny::runApp(appDir = paste0(appDir,"/app.R"), ...)
|
||||
return(invisible(a))
|
||||
}
|
||||
|
||||
|
||||
#' Easily launch the freesearcheR app
|
||||
#'
|
||||
#' @param ... passed on to `shiny::runApp()`
|
||||
#'
|
||||
#' @returns shiny app
|
||||
#' @export
|
||||
#'
|
||||
launch_freesearcheR <- function(...){
|
||||
shiny_freesearcheR(...)
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//theme.R
|
||||
########
|
||||
|
|
@ -5692,7 +5940,7 @@ modal_update_factor <- function(id,
|
|||
#'
|
||||
#' @importFrom shinyWidgets WinBox wbOptions wbControls
|
||||
#' @importFrom htmltools tagList
|
||||
#' @rdname create-column
|
||||
#' @rdname update-factor
|
||||
winbox_update_factor <- function(id,
|
||||
title = i18n("Update levels of a factor"),
|
||||
options = shinyWidgets::wbOptions(),
|
||||
|
|
@ -6660,7 +6908,7 @@ grepl_fix <- function(data, pattern, type = c("prefix", "infix", "suffix")) {
|
|||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/freesearcheR/inst/apps/freesearcheR/ui.R
|
||||
#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/ui.R
|
||||
########
|
||||
|
||||
# ns <- NS(id)
|
||||
|
|
@ -6672,7 +6920,7 @@ ui_elements <- list(
|
|||
#########
|
||||
##############################################################################
|
||||
"home" = bslib::nav_panel(
|
||||
title = "freesearcheR",
|
||||
title = "FreesearchR",
|
||||
shiny::fluidRow(
|
||||
shiny::column(width = 2),
|
||||
shiny::column(
|
||||
|
|
@ -7214,7 +7462,8 @@ ui_elements <- list(
|
|||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::tags$b("Code snippets:"),
|
||||
shiny::h4("Code snippets"),
|
||||
shiny::tags$p("Below are the code used to create the final data set. This can be saved for reproducibility. The code may not be 100 % correct, but kan be used for learning and example code to get started on coding yourself."),
|
||||
shiny::verbatimTextOutput(outputId = "code_import"),
|
||||
shiny::verbatimTextOutput(outputId = "code_data"),
|
||||
shiny::verbatimTextOutput(outputId = "code_filter"),
|
||||
|
|
@ -7262,10 +7511,10 @@ ui <- bslib::page_fixed(
|
|||
# add the name of the tab you want to use as title in data-value
|
||||
shiny::HTML(
|
||||
".container-fluid > .nav > li >
|
||||
a[data-value='freesearcheR'] {font-size: 28px}"
|
||||
a[data-value='FreesearchR'] {font-size: 28px}"
|
||||
)
|
||||
),
|
||||
title = "freesearcheR",
|
||||
title = "FreesearchR",
|
||||
theme = light,
|
||||
shiny::useBusyIndicators(),
|
||||
bslib::page_navbar(
|
||||
|
|
@ -7288,7 +7537,7 @@ ui <- bslib::page_fixed(
|
|||
),
|
||||
shiny::p(
|
||||
style = "margin: 1; color: #888;",
|
||||
"AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
|
||||
"AG Damsbo | v", app_version(), " | ",shiny::tags$a("AGPLv3 license", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer")," | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
|
||||
),
|
||||
)
|
||||
)
|
||||
|
|
@ -7296,7 +7545,7 @@ ui <- bslib::page_fixed(
|
|||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/freesearcheR/inst/apps/freesearcheR/server.R
|
||||
#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/server.R
|
||||
########
|
||||
|
||||
library(readr)
|
||||
|
|
@ -7327,7 +7576,7 @@ library(IDEAFilter)
|
|||
library(shinyWidgets)
|
||||
library(DT)
|
||||
library(gtsummary)
|
||||
# library(freesearcheR)
|
||||
# library(FreesearchR)
|
||||
|
||||
# source("functions.R")
|
||||
|
||||
|
|
@ -7475,7 +7724,7 @@ server <- function(input, output, session) {
|
|||
paste(collapse = "") |>
|
||||
paste("|>
|
||||
dplyr::select(", paste(input$import_var, collapse = ","), ") |>
|
||||
freesearcheR::default_parsing()") |>
|
||||
FreesearchR::default_parsing()") |>
|
||||
(\(.x){
|
||||
paste0("data <- ", .x)
|
||||
})()
|
||||
|
|
@ -7535,11 +7784,6 @@ server <- function(input, output, session) {
|
|||
)
|
||||
})
|
||||
|
||||
# shiny::observeEvent(input$reset_confirm, {
|
||||
# rv$data <- rv$data_original |> default_parsing()
|
||||
# })
|
||||
|
||||
|
||||
|
||||
#########
|
||||
######### Modifications
|
||||
|
|
@ -7612,7 +7856,6 @@ server <- function(input, output, session) {
|
|||
}
|
||||
)
|
||||
|
||||
|
||||
######### Subset, rename, reclass
|
||||
|
||||
updated_data <- update_variables_server(
|
||||
|
|
@ -7626,8 +7869,6 @@ server <- function(input, output, session) {
|
|||
rv$code$modify[[length(rv$code$modify) + 1]] <- attr(rv$data, "code")
|
||||
})
|
||||
|
||||
|
||||
|
||||
######### Data filter
|
||||
# IDEAFilter has the least cluttered UI, but might have a License issue
|
||||
data_filter <- IDEAFilter::IDEAFilter("data_filter",
|
||||
|
|
@ -7765,7 +8006,6 @@ server <- function(input, output, session) {
|
|||
})
|
||||
|
||||
output$code_filter <- shiny::renderPrint({
|
||||
shiny::req(rv$code$filter)
|
||||
cat(rv$code$filter)
|
||||
})
|
||||
|
||||
|
|
@ -8287,7 +8527,7 @@ server <- function(input, output, session) {
|
|||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/freesearcheR/inst/apps/freesearcheR/launch.R
|
||||
#### Current file: /Users/au301842/FreesearchR/inst/apps/FreesearchR/launch.R
|
||||
########
|
||||
|
||||
shinyApp(ui, server)
|
||||
|
|
@ -5,6 +5,6 @@ account: agdamsbo
|
|||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 13611288
|
||||
bundleId: 9958862
|
||||
bundleId: 9969300
|
||||
url: https://agdamsbo.shinyapps.io/freesearcheR/
|
||||
version: 1
|
||||
|
|
@ -26,7 +26,7 @@ library(IDEAFilter)
|
|||
library(shinyWidgets)
|
||||
library(DT)
|
||||
library(gtsummary)
|
||||
# library(freesearcheR)
|
||||
# library(FreesearchR)
|
||||
|
||||
# source("functions.R")
|
||||
|
||||
|
|
@ -174,7 +174,7 @@ server <- function(input, output, session) {
|
|||
paste(collapse = "") |>
|
||||
paste("|>
|
||||
dplyr::select(", paste(input$import_var, collapse = ","), ") |>
|
||||
freesearcheR::default_parsing()") |>
|
||||
FreesearchR::default_parsing()") |>
|
||||
(\(.x){
|
||||
paste0("data <- ", .x)
|
||||
})()
|
||||
|
|
@ -7,7 +7,7 @@ ui_elements <- list(
|
|||
#########
|
||||
##############################################################################
|
||||
"home" = bslib::nav_panel(
|
||||
title = "freesearcheR",
|
||||
title = "FreesearchR",
|
||||
shiny::fluidRow(
|
||||
shiny::column(width = 2),
|
||||
shiny::column(
|
||||
|
|
@ -598,10 +598,10 @@ ui <- bslib::page_fixed(
|
|||
# add the name of the tab you want to use as title in data-value
|
||||
shiny::HTML(
|
||||
".container-fluid > .nav > li >
|
||||
a[data-value='freesearcheR'] {font-size: 28px}"
|
||||
a[data-value='FreesearchR'] {font-size: 28px}"
|
||||
)
|
||||
),
|
||||
title = "freesearcheR",
|
||||
title = "FreesearchR",
|
||||
theme = light,
|
||||
shiny::useBusyIndicators(),
|
||||
bslib::page_navbar(
|
||||
|
|
@ -624,7 +624,7 @@ ui <- bslib::page_fixed(
|
|||
),
|
||||
shiny::p(
|
||||
style = "margin: 1; color: #888;",
|
||||
"AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
|
||||
"AG Damsbo | v", app_version(), " | ",shiny::tags$a("AGPLv3 license", href = "https://github.com/agdamsbo/FreesearchR/blob/main/LICENSE.md", target = "_blank", rel = "noopener noreferrer")," | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer")
|
||||
),
|
||||
)
|
||||
)
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
# Welcome
|
||||
|
||||
This is the ***freesearcheR*** data analysis tool. We intend the ***freesearcheR*** to be a powerful and free tool for easy data evaluation and analysis at the hands of the clinician. If you need more advanced tools for regression models or plotting, you'll probably be better off using *R* or similar directly on your own machine.
|
||||
This is the ***FreesearchR*** data analysis tool. We intend the ***FreesearchR*** to be a powerful and free tool for easy data evaluation and analysis at the hands of the clinician. If you need more advanced tools for regression models or plotting, you'll probably be better off using *R* or similar directly on your own machine.
|
||||
|
||||
By intention, this tool has been designed to be simple to use with a minimum of mandatory options to keep the workflow streamlined, while also including a few options to go even further.
|
||||
|
||||
|
|
@ -24,6 +24,6 @@ There are some simple steps to go through (see corresponding tabs in the top):
|
|||
|
||||
1. Export the the analyses results for MS Word or [LibreOffice](https://www.libreoffice.org/) as well as the data with preserved metadata.
|
||||
|
||||
Have a look at the [documentations page](https://agdamsbo.github.io/freesearcheR/) for further project description. If you're interested in the source code, then go on, [have a look](https://github.com/agdamsbo/freesearcheR)!
|
||||
The full [project documentation is here](https://agdamsbo.github.io/FreesearchR/) for documenting the project, functions, road map and more. If you're interested in the source code, then [everything is open and you are free to read, copy, modify and improve](https://github.com/agdamsbo/FreesearchR), and please let us know if you want to contribute!
|
||||
|
||||
If you encounter anything strange or the app doesn't act as expected. Please [report on Github](https://github.com/agdamsbo/freesearcheR/issues).
|
||||
Contributions can be reporting issues, suggesting new functionality, improving code or any other feedback. [It all goes here](https://github.com/agdamsbo/FreesearchR/issues).
|
||||
11
inst/apps/FreesearchR/www/notes_visuals.md
Normal file
11
inst/apps/FreesearchR/www/notes_visuals.md
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
# Basic visualisations
|
||||
|
||||
The goal of ***FreesearchR*** is to keep things simple. Visuals can get very complicated. We provide a selection of plots, that helps visualise typical clinical and will be enough for most use cases, and for publishing to most journals.
|
||||
|
||||
If you want to go further, have a look at these sites with suggestions and sample code for data plotting:
|
||||
|
||||
- [*R* Charts](https://r-charts.com/): Extensive gallery with great plots
|
||||
|
||||
- [*R* Graph gallery](https://r-graph-gallery.com/): Another gallery with great graphs
|
||||
|
||||
- [graphics principles](https://graphicsprinciples.github.io/): Easy to follow recommendations for clear visuals.
|
||||
24
inst/apps/FreesearchR/www/references.bib
Normal file
24
inst/apps/FreesearchR/www/references.bib
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
|
||||
@book{andreasgammelgaarddamsbo2025,
|
||||
title = {agdamsbo/freesearcheR: freesearcheR 25.3.1},
|
||||
author = {Andreas Gammelgaard Damsbo, },
|
||||
year = {2025},
|
||||
month = {03},
|
||||
date = {2025-03-06},
|
||||
publisher = {Zenodo},
|
||||
doi = {10.5281/ZENODO.14527429},
|
||||
url = {https://zenodo.org/doi/10.5281/zenodo.14527429}
|
||||
}
|
||||
|
||||
@article{Aam2020,
|
||||
title = {Post-stroke Cognitive Impairment{\textemdash}Impact of Follow-Up Time and Stroke Subtype on Severity and Cognitive Profile: The Nor-COAST Study},
|
||||
author = {Aam, Stina and Einstad, Marte Stine and Munthe-Kaas, Ragnhild and Lydersen, Stian and Ihle-Hansen, Hege and Knapskog, Anne Brita and {Ellekjær}, Hanne and Seljeseth, Yngve and Saltvedt, Ingvild},
|
||||
year = {2020},
|
||||
date = {2020},
|
||||
journal = {Frontiers in Neurology},
|
||||
pages = {1--10},
|
||||
volume = {11},
|
||||
number = {July},
|
||||
doi = {10.3389/fneur.2020.00699},
|
||||
note = {Citation Key: Aam2020}
|
||||
}
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
---
|
||||
title: "freesearcheR data report"
|
||||
title: "FreesearchR data report"
|
||||
date: "Report generated `r gsub('(\\D)0', '\\1', format(Sys.time(), '%A, %d.%m.%Y'))`"
|
||||
format: docx
|
||||
author: freesearcheR data analysis tool
|
||||
author: FreesearchR data analysis tool
|
||||
toc: false
|
||||
params:
|
||||
data.file: NA
|
||||
|
|
@ -13,7 +13,6 @@ knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
|
|||
# glue::glue("{format(lubridate::today(),'%A')}, {lubridate::day(lubridate::today())}.{lubridate::month(lubridate::today())}.{lubridate::year(lubridate::today())}")
|
||||
```
|
||||
|
||||
|
||||
```{r}
|
||||
web_data <- readr::read_rds(file = params$data.file)
|
||||
library(gtsummary)
|
||||
|
|
@ -42,11 +41,11 @@ vec2sentence <- function(data, sep.word = "and") {
|
|||
|
||||
## Introduction
|
||||
|
||||
Research should be free and open with easy access for all. The freesearcheR tool attempts to help lower the bar to participate in contributing to science by making guided data analysis easily accessible in the web-browser.
|
||||
Research should be free and open with easy access for all. The FreesearchR tool attempts to help lower the bar to participate in contributing to science by making guided data analysis easily accessible in the web-browser.
|
||||
|
||||
## Methods
|
||||
|
||||
Analyses were conducted in the *freesearcheR* data analysis web-tool based on R version 4.4.1.
|
||||
Analyses were conducted in the *FreesearchR* data analysis web-tool based on R version 4.4.1.
|
||||
|
||||
## Results
|
||||
|
||||
|
|
@ -70,3 +69,4 @@ knitr::knit_print(tbl_merge(reg_tbl))
|
|||
## Discussion
|
||||
|
||||
Good luck on your further work!
|
||||
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
# Basic visualisations
|
||||
|
||||
This section on plotting data is kept very minimal, and includes only the most common plot types for clinical projects.
|
||||
|
||||
If you want to go further, have a look at these sites with suggestions and sample code for data plotting:
|
||||
|
||||
- [*R* Charts](https://r-charts.com/): Extensive gallery with great plots
|
||||
|
||||
- [*R* Graph gallery](https://r-graph-gallery.com/): Another gallery with great graphs
|
||||
|
||||
- [grphics principles](https://graphicsprinciples.github.io/): Easy to follow recommendations for clear visuals.
|
||||
17
man/allign_axes.Rd
Normal file
17
man/allign_axes.Rd
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R
|
||||
\name{allign_axes}
|
||||
\alias{allign_axes}
|
||||
\title{Alligns axes between plots}
|
||||
\usage{
|
||||
allign_axes(...)
|
||||
}
|
||||
\arguments{
|
||||
\item{...}{ggplot2 objects or list of ggplot2 objects}
|
||||
}
|
||||
\value{
|
||||
list of ggplot2 objects
|
||||
}
|
||||
\description{
|
||||
Alligns axes between plots
|
||||
}
|
||||
23
man/launch_FreesearchR.Rd
Normal file
23
man/launch_FreesearchR.Rd
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/launch_FreesearchR.R
|
||||
\name{launch_FreesearchR}
|
||||
\alias{launch_FreesearchR}
|
||||
\title{Easily launch the FreesearchR app}
|
||||
\usage{
|
||||
launch_FreesearchR(...)
|
||||
}
|
||||
\arguments{
|
||||
\item{...}{passed on to \code{shiny::runApp()}}
|
||||
}
|
||||
\value{
|
||||
shiny app
|
||||
}
|
||||
\description{
|
||||
All data.frames in the global environment will be accessible through the app.
|
||||
}
|
||||
\examples{
|
||||
\dontrun{
|
||||
data(mtcars)
|
||||
shiny_FreesearchR(launch.browser = TRUE)
|
||||
}
|
||||
}
|
||||
|
|
@ -1,17 +0,0 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/shiny_freesearcheR.R
|
||||
\name{launch_freesearcheR}
|
||||
\alias{launch_freesearcheR}
|
||||
\title{Easily launch the freesearcheR app}
|
||||
\usage{
|
||||
launch_freesearcheR(...)
|
||||
}
|
||||
\arguments{
|
||||
\item{...}{passed on to \code{shiny::runApp()}}
|
||||
}
|
||||
\value{
|
||||
shiny app
|
||||
}
|
||||
\description{
|
||||
Easily launch the freesearcheR app
|
||||
}
|
||||
27
man/limit_log.Rd
Normal file
27
man/limit_log.Rd
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/regression_plot.R
|
||||
\name{limit_log}
|
||||
\alias{limit_log}
|
||||
\title{Easily round log scale limits for nice plots}
|
||||
\usage{
|
||||
limit_log(data, fun, ...)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{data}
|
||||
|
||||
\item{fun}{rounding function (floor/ceiling)}
|
||||
|
||||
\item{...}{ignored}
|
||||
}
|
||||
\value{
|
||||
numeric vector
|
||||
}
|
||||
\description{
|
||||
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)
|
||||
}
|
||||
|
|
@ -4,7 +4,13 @@
|
|||
\alias{plot.tbl_regression}
|
||||
\title{Regression coef plot from gtsummary. Slightly modified to pass on arguments}
|
||||
\usage{
|
||||
\method{plot}{tbl_regression}(x, ...)
|
||||
\method{plot}{tbl_regression}(
|
||||
x,
|
||||
plot_ref = TRUE,
|
||||
remove_header_rows = TRUE,
|
||||
remove_reference_rows = FALSE,
|
||||
...
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{x}{(\code{tbl_regression}, \code{tbl_uvregression})\cr
|
||||
|
|
@ -20,7 +26,7 @@ Regression coef plot from gtsummary. Slightly modified to pass on arguments
|
|||
}
|
||||
\examples{
|
||||
\dontrun{
|
||||
mod <- lm(mpg ~ ., mtcars)
|
||||
mod <- lm(mpg ~ ., default_parsing(mtcars))
|
||||
p <- mod |>
|
||||
gtsummary::tbl_regression() |>
|
||||
plot(colour = "variable")
|
||||
|
|
|
|||
|
|
@ -93,7 +93,7 @@ regression_table.list <- function(x, ...) {
|
|||
#' @export
|
||||
regression_table.default <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
|
||||
# Stripping custom class
|
||||
class(x) <- class(x)[class(x) != "freesearcher_model"]
|
||||
class(x) <- class(x)[class(x) != "freesearchr_model"]
|
||||
|
||||
if (any(c(length(class(x)) != 1, class(x) != "lm"))) {
|
||||
if (!"exponentiate" \%in\% names(args.list)) {
|
||||
|
|
|
|||
|
|
@ -1,23 +0,0 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/shiny_freesearcheR.R
|
||||
\name{shiny_freesearcheR}
|
||||
\alias{shiny_freesearcheR}
|
||||
\title{Launch the freesearcheR tool locally}
|
||||
\usage{
|
||||
shiny_freesearcheR(...)
|
||||
}
|
||||
\arguments{
|
||||
\item{...}{arguments passed on to \code{shiny::runApp()}}
|
||||
}
|
||||
\value{
|
||||
shiny app
|
||||
}
|
||||
\description{
|
||||
All data.frames in the global environment will be accessible through the app.
|
||||
}
|
||||
\examples{
|
||||
\dontrun{
|
||||
data(mtcars)
|
||||
shiny_freesearcheR(launch.browser = TRUE)
|
||||
}
|
||||
}
|
||||
21
man/symmetrical_scale_x_log10.Rd
Normal file
21
man/symmetrical_scale_x_log10.Rd
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/regression_plot.R
|
||||
\name{symmetrical_scale_x_log10}
|
||||
\alias{symmetrical_scale_x_log10}
|
||||
\title{Ensure symmetrical plot around 1 on a logarithmic x scale for ratio plots}
|
||||
\usage{
|
||||
symmetrical_scale_x_log10(plot, breaks = c(1, 2, 3, 5, 10), ...)
|
||||
}
|
||||
\arguments{
|
||||
\item{plot}{ggplot2 plot}
|
||||
|
||||
\item{breaks}{breaks used and mirrored}
|
||||
|
||||
\item{...}{ignored}
|
||||
}
|
||||
\value{
|
||||
ggplot2 object
|
||||
}
|
||||
\description{
|
||||
Ensure symmetrical plot around 1 on a logarithmic x scale for ratio plots
|
||||
}
|
||||
|
|
@ -5,6 +5,7 @@
|
|||
\alias{update_factor_ui}
|
||||
\alias{update_factor_server}
|
||||
\alias{modal_update_factor}
|
||||
\alias{winbox_update_factor}
|
||||
\title{Module to Reorder the Levels of a Factor Variable}
|
||||
\usage{
|
||||
update_factor_ui(id)
|
||||
|
|
@ -18,6 +19,13 @@ modal_update_factor(
|
|||
size = "l",
|
||||
footer = NULL
|
||||
)
|
||||
|
||||
winbox_update_factor(
|
||||
id,
|
||||
title = i18n("Update levels of a factor"),
|
||||
options = shinyWidgets::wbOptions(),
|
||||
controls = shinyWidgets::wbControls()
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{id}{Module ID.}
|
||||
|
|
@ -39,6 +47,10 @@ pass \code{\link[bslib:bs_theme]{bslib::bs_theme()}} to the \code{theme} argumen
|
|||
like \code{\link[shiny:fluidPage]{fluidPage()}}).}
|
||||
|
||||
\item{footer}{UI for footer. Use \code{NULL} for no footer.}
|
||||
|
||||
\item{options}{List of options, see \code{\link[shinyWidgets:wbOptions]{wbOptions()}}.}
|
||||
|
||||
\item{controls}{List of controls, see \code{\link[shinyWidgets:wbControls]{wbControls()}}.}
|
||||
}
|
||||
\value{
|
||||
A \code{\link[shiny:reactive]{shiny::reactive()}} function returning the data.
|
||||
|
|
|
|||
19
man/wrap_plot_list.Rd
Normal file
19
man/wrap_plot_list.Rd
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R
|
||||
\name{wrap_plot_list}
|
||||
\alias{wrap_plot_list}
|
||||
\title{Wrapping}
|
||||
\usage{
|
||||
wrap_plot_list(data, tag_levels = NULL)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{list of ggplot2 objects}
|
||||
|
||||
\item{tag_levels}{passed to patchwork::plot_annotation if given. Default is NULL}
|
||||
}
|
||||
\value{
|
||||
list of ggplot2 objects
|
||||
}
|
||||
\description{
|
||||
Wrapping
|
||||
}
|
||||
89
renv.lock
89
renv.lock
File diff suppressed because one or more lines are too long
|
|
@ -2,7 +2,7 @@
|
|||
local({
|
||||
|
||||
# the requested version of renv
|
||||
version <- "1.1.2"
|
||||
version <- "1.1.3"
|
||||
attr(version, "sha") <- NULL
|
||||
|
||||
# the project directory
|
||||
|
|
@ -695,11 +695,19 @@ local({
|
|||
|
||||
}
|
||||
|
||||
renv_bootstrap_platform_prefix <- function() {
|
||||
renv_bootstrap_platform_prefix_default <- function() {
|
||||
|
||||
# construct version prefix
|
||||
version <- paste(R.version$major, R.version$minor, sep = ".")
|
||||
prefix <- paste("R", numeric_version(version)[1, 1:2], sep = "-")
|
||||
# read version component
|
||||
version <- Sys.getenv("RENV_PATHS_VERSION", unset = "R-%v")
|
||||
|
||||
# expand placeholders
|
||||
placeholders <- list(
|
||||
list("%v", format(getRversion()[1, 1:2])),
|
||||
list("%V", format(getRversion()[1, 1:3]))
|
||||
)
|
||||
|
||||
for (placeholder in placeholders)
|
||||
version <- gsub(placeholder[[1L]], placeholder[[2L]], version, fixed = TRUE)
|
||||
|
||||
# include SVN revision for development versions of R
|
||||
# (to avoid sharing platform-specific artefacts with released versions of R)
|
||||
|
|
@ -708,10 +716,19 @@ local({
|
|||
identical(R.version[["nickname"]], "Unsuffered Consequences")
|
||||
|
||||
if (devel)
|
||||
prefix <- paste(prefix, R.version[["svn rev"]], sep = "-r")
|
||||
version <- paste(version, R.version[["svn rev"]], sep = "-r")
|
||||
|
||||
version
|
||||
|
||||
}
|
||||
|
||||
renv_bootstrap_platform_prefix <- function() {
|
||||
|
||||
# construct version prefix
|
||||
version <- renv_bootstrap_platform_prefix_default()
|
||||
|
||||
# build list of path components
|
||||
components <- c(prefix, R.version$platform)
|
||||
components <- c(version, R.version$platform)
|
||||
|
||||
# include prefix if provided by user
|
||||
prefix <- renv_bootstrap_platform_prefix_impl()
|
||||
|
|
@ -1202,15 +1219,18 @@ local({
|
|||
list(
|
||||
|
||||
# objects
|
||||
list("{", "\t\n\tobject(\t\n\t"),
|
||||
list("}", "\t\n\t)\t\n\t"),
|
||||
list("{", "\t\n\tobject(\t\n\t", TRUE),
|
||||
list("}", "\t\n\t)\t\n\t", TRUE),
|
||||
|
||||
# arrays
|
||||
list("[", "\t\n\tarray(\t\n\t"),
|
||||
list("]", "\n\t\n)\n\t\n"),
|
||||
list("[", "\t\n\tarray(\t\n\t", TRUE),
|
||||
list("]", "\n\t\n)\n\t\n", TRUE),
|
||||
|
||||
# maps
|
||||
list(":", "\t\n\t=\t\n\t")
|
||||
list(":", "\t\n\t=\t\n\t", TRUE),
|
||||
|
||||
# newlines
|
||||
list("\\u000a", "\n", FALSE)
|
||||
|
||||
)
|
||||
|
||||
|
|
@ -1287,7 +1307,8 @@ local({
|
|||
# evaluate in safe environment
|
||||
result <- eval(json, envir = renv_json_read_envir())
|
||||
|
||||
# fix up strings if necessary
|
||||
# fix up strings if necessary -- do so only with reversible patterns
|
||||
patterns <- Filter(function(pattern) pattern[[3L]], patterns)
|
||||
renv_json_read_remap(result, patterns)
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
---
|
||||
title: "freesearcheR"
|
||||
title: "FreesearchR"
|
||||
output: rmarkdown::html_vignette
|
||||
vignette: >
|
||||
%\VignetteIndexEntry{freesearcheR}
|
||||
%\VignetteIndexEntry{FreesearchR}
|
||||
%\VignetteEngine{knitr::rmarkdown}
|
||||
%\VignetteEncoding{UTF-8}
|
||||
---
|
||||
|
|
@ -11,9 +11,9 @@ vignette: >
|
|||
knitr::opts_chunk$set(echo = TRUE,eval = FALSE)
|
||||
```
|
||||
|
||||
# Getting started with ***freesearcheR***
|
||||
# Getting started with ***FreesearchR***
|
||||
|
||||
Below is a simple walk-trough and basic instructions for the functions on the freesearcheR app.
|
||||
Below is a simple walk-trough and basic instructions for the functions on the FreesearchR app.
|
||||
|
||||
## Launching
|
||||
|
||||
|
|
@ -21,13 +21,13 @@ The easiest way to get started is to launch [the hosted version of the app on sh
|
|||
|
||||
Additionally you have the option to run the app locally with access to any data in your current working environment.
|
||||
|
||||
To do this, open *R* (or RStudio or similar), and run the following code to install the latest version of ***freesearcheR*** and launch the app:
|
||||
To do this, open *R* (or RStudio or similar), and run the following code to install the latest version of ***FreesearchR*** and launch the app:
|
||||
|
||||
``` {r}
|
||||
```{r}
|
||||
require("pak")
|
||||
pak::pak("agdamsbo/freesearcheR")
|
||||
library(freesearcheR)
|
||||
freesearcheR::launch_freesearcheR()
|
||||
pak::pak("agdamsbo/FreesearchR")
|
||||
library(FreesearchR)
|
||||
FreesearchR::launch_FreesearchR()
|
||||
```
|
||||
|
||||
As a small note, a standalone Windows app version is on the drawing board as well, but no time frame is available.
|
||||
Loading…
Add table
Reference in a new issue