polish and move to new hosted address

This commit is contained in:
Andreas Gammelgaard Damsbo 2025-04-24 11:00:56 +02:00
parent 20ae86a346
commit 54ba126a8b
No known key found for this signature in database
14 changed files with 111 additions and 48 deletions

View file

@ -1,6 +1,6 @@
Package: FreesearchR Package: FreesearchR
Title: Browser Based Data Analysis Title: Browser Based Data Analysis
Version: 25.4.3 Version: 25.4.4
Authors@R: Authors@R:
person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"), person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"),
comment = c(ORCID = "0000-0002-7559-1154")) comment = c(ORCID = "0000-0002-7559-1154"))

View file

@ -1,3 +1,7 @@
# FreesearchR 25.4.4
Polishing and moved hosted app to new address to fully reflect name change: [https://agdamsbo.shinyapps.io/FreesearchR/](https://agdamsbo.shinyapps.io/FreesearchR/)
# FreesearchR 25.4.3 # FreesearchR 25.4.3
- *NEW*: Added a variables type filter to easily exclude unwanted types. This also includes having data type rather than data class in the summary table. Will evaluate. Types are a simpler, more practical version of the *R* data class to easy interpretation. - *NEW*: Added a variables type filter to easily exclude unwanted types. This also includes having data type rather than data class in the summary table. Will evaluate. Types are a simpler, more practical version of the *R* data class to easy interpretation.

View file

@ -1 +1 @@
app_version <- function()'v25.4.3.250423' app_version <- function()'v25.4.4.250424'

View file

@ -56,6 +56,7 @@ cut_var.hms <- function(x, breaks, ...) {
#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday")
#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "month_only") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "month_only")
#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%A-%H") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%A-%H")
#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%W")
cut_var.POSIXt <- function(x, breaks, right = FALSE, include.lowest = TRUE, start.on.monday = TRUE, ...) { cut_var.POSIXt <- function(x, breaks, right = FALSE, include.lowest = TRUE, start.on.monday = TRUE, ...) {
breaks_o <- breaks breaks_o <- breaks
args <- list(...) args <- list(...)
@ -126,7 +127,10 @@ cut_var.POSIXct <- cut_var.POSIXt
#' @examples #' @examples
#' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(2) #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(2)
#' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday")
cut_var.Date <- function(x, breaks, start.on.monday = TRUE, ...) { #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(format = "%W")
cut_var.Date <- function(x, breaks=NULL, start.on.monday = TRUE, ...) {
args <- list(...)
if ("format" %in% names(args)){ if ("format" %in% names(args)){
assertthat::assert_that(is.character(args$format)) assertthat::assert_that(is.character(args$format))
out <- forcats::as_factor(format(x,format=args$format)) out <- forcats::as_factor(format(x,format=args$format))
@ -337,10 +341,11 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
variable <- req(input$variable) variable <- req(input$variable)
choices <- c( choices <- c(
# "fixed",
# "quantile" # "quantile"
) )
if ("hms" %in% class(data[[variable]])) { if (any(c("hms","POSIXct") %in% class(data[[variable]]))) {
choices <- c(choices, "hour") choices <- c(choices, "hour")
} else if (any(c("POSIXt", "Date") %in% class(data[[variable]]))) { } else if (any(c("POSIXt", "Date") %in% class(data[[variable]]))) {
choices <- c( choices <- c(
@ -348,6 +353,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
"day", "day",
"weekday", "weekday",
"week", "week",
# "week_only",
"month", "month",
"month_only", "month_only",
"quarter", "quarter",
@ -372,6 +378,8 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
) )
} }
choices <- unique(choices)
shinyWidgets::virtualSelectInput( shinyWidgets::virtualSelectInput(
inputId = session$ns("method"), inputId = session$ns("method"),
label = i18n("Method:"), label = i18n("Method:"),
@ -389,7 +397,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
req(input$n_breaks, input$method) req(input$n_breaks, input$method)
if (input$method == "fixed") { if (input$method == "fixed") {
req(input$fixed_brks) req(input$fixed_brks)
if (any(c("hms", "POSIXt") %in% class(data[[variable]]))) { if (any(c("hms", "POSIXct") %in% class(data[[variable]]))) {
# cut.POSIXct <- cut.POSIXt # cut.POSIXct <- cut.POSIXt
f <- cut_var(data[[variable]], breaks = input$fixed_brks) f <- cut_var(data[[variable]], breaks = input$fixed_brks)
list(var = f, brks = levels(f)) list(var = f, brks = levels(f))
@ -432,6 +440,11 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
# cut.POSIXct <- cut.POSIXt # cut.POSIXct <- cut.POSIXt
f <- cut_var(data[[variable]], breaks = "hour") f <- cut_var(data[[variable]], breaks = "hour")
list(var = f, brks = levels(f)) list(var = f, brks = levels(f))
# } else if (input$method %in% c("week_only")) {
# # As a proof of concept a single option to use "format" parameter
# # https://www.stat.berkeley.edu/~s133/dates.html
# f <- cut_var(data[[variable]], format = "%W")
# list(var = f, brks = levels(f))
} else { } else {
classInt::classIntervals( classInt::classIntervals(
var = as.numeric(data[[variable]]), var = as.numeric(data[[variable]]),
@ -445,6 +458,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
data <- req(data_r()) data <- req(data_r())
variable <- req(input$variable) variable <- req(input$variable)
plot_histogram(data, variable, breaks = breaks_r()$brks, color = datamods:::get_primary_color()) plot_histogram(data, variable, breaks = breaks_r()$brks, color = datamods:::get_primary_color())
# plot_histogram(data = breaks_r()$var, breaks = breaks_r()$brks, color = datamods:::get_primary_color())
}) })
@ -582,8 +596,13 @@ modal_cut_variable <- function(id,
#' @importFrom graphics abline axis hist par plot.new plot.window #' @importFrom graphics abline axis hist par plot.new plot.window
plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112466") { plot_histogram <- function(data, column=NULL, bins = 30, breaks = NULL, color = "#112466") {
if (is.vector(data)){
x <- data
} else {
x <- data[[column]] x <- data[[column]]
}
x <- as.numeric(x) x <- as.numeric(x)
op <- par(mar = rep(1.5, 4)) op <- par(mar = rep(1.5, 4))
on.exit(par(op)) on.exit(par(op))

Binary file not shown.

View file

@ -4,12 +4,12 @@
[![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental)
[![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.14527429.svg)](https://doi.org/10.5281/zenodo.14527429) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.14527429.svg)](https://doi.org/10.5281/zenodo.14527429)
[![rhub](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml/badge.svg)](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml) [![rhub](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml/badge.svg)](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml)
[![FreesearchR](https://img.shields.io/badge/Shiny-shinyapps.io-blue?style=flat&labelColor=white&logo=RStudio&logoColor=blue)](https://agdamsbo.shinyapps.io/freesearcheR/) [![FreesearchR](https://img.shields.io/badge/Shiny-shinyapps.io-blue?style=flat&labelColor=white&logo=RStudio&logoColor=blue)](https://agdamsbo.shinyapps.io/FreesearchR/)
<!-- badges: end --> <!-- badges: end -->
This package is the backbone of the ***FreesearchR***, a free and open-source browser based data exploration and analysis tool intended to democratise clinical research by assisting any researcher to easily evaluate and analyse data and export publication ready results. This package is the backbone of the ***FreesearchR***, a free and open-source browser based data exploration and analysis tool intended to democratise clinical research by assisting any researcher to easily evaluate and analyse data and export publication ready results.
The ***FreesearchR***-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. Any suggestions on collaboration is much welcomed. Please reach out! 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. Any suggestions on collaboration is much welcomed. Please reach out!
## Motivation ## Motivation

View file

@ -11,11 +11,11 @@
|collate |en_US.UTF-8 | |collate |en_US.UTF-8 |
|ctype |en_US.UTF-8 | |ctype |en_US.UTF-8 |
|tz |Europe/Copenhagen | |tz |Europe/Copenhagen |
|date |2025-04-23 | |date |2025-04-24 |
|rstudio |2024.12.1+563 Kousa Dogwood (desktop) | |rstudio |2024.12.1+563 Kousa Dogwood (desktop) |
|pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
|quarto |1.6.40 @ /usr/local/bin/quarto | |quarto |1.6.40 @ /usr/local/bin/quarto |
|FreesearchR |25.4.3.250423 | |FreesearchR |25.4.4.250424 |
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -40,7 +40,7 @@
|class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) | |class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) |
|classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) | |classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) |
|cli |3.6.4 |2025-02-13 |CRAN (R 4.4.1) | |cli |3.6.4 |2025-02-13 |CRAN (R 4.4.1) |
|clipr |0.8.0 |2022-02-22 |CRAN (R 4.4.1) | |codetools |0.2-20 |2024-03-31 |CRAN (R 4.4.1) |
|colorspace |2.1-1 |2024-07-26 |CRAN (R 4.4.1) | |colorspace |2.1-1 |2024-07-26 |CRAN (R 4.4.1) |
|commonmark |1.9.5 |2025-03-17 |CRAN (R 4.4.1) | |commonmark |1.9.5 |2025-03-17 |CRAN (R 4.4.1) |
|correlation |0.8.7 |2025-03-03 |CRAN (R 4.4.1) | |correlation |0.8.7 |2025-03-03 |CRAN (R 4.4.1) |
@ -66,9 +66,11 @@
|fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) | |fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) |
|fontawesome |0.5.3 |2024-11-16 |CRAN (R 4.4.1) | |fontawesome |0.5.3 |2024-11-16 |CRAN (R 4.4.1) |
|forcats |1.0.0 |2023-01-29 |CRAN (R 4.4.0) | |forcats |1.0.0 |2023-01-29 |CRAN (R 4.4.0) |
|foreach |1.5.2 |2022-02-02 |CRAN (R 4.4.0) |
|fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) | |fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) |
|generics |0.1.3 |2022-07-05 |CRAN (R 4.4.1) | |generics |0.1.3 |2022-07-05 |CRAN (R 4.4.1) |
|ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) | |ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) |
|glmnet |4.1-8 |NA |NA |
|glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) | |glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) |
|gt |1.0.0 |2025-04-05 |CRAN (R 4.4.1) | |gt |1.0.0 |2025-04-05 |CRAN (R 4.4.1) |
|gtable |0.3.6 |2024-10-25 |CRAN (R 4.4.1) | |gtable |0.3.6 |2024-10-25 |CRAN (R 4.4.1) |
@ -81,6 +83,7 @@
|httpuv |1.6.16 |2025-04-16 |CRAN (R 4.4.1) | |httpuv |1.6.16 |2025-04-16 |CRAN (R 4.4.1) |
|IDEAFilter |0.2.0 |2024-04-15 |CRAN (R 4.4.0) | |IDEAFilter |0.2.0 |2024-04-15 |CRAN (R 4.4.0) |
|insight |1.2.0 |2025-04-22 |CRAN (R 4.4.1) | |insight |1.2.0 |2025-04-22 |CRAN (R 4.4.1) |
|iterators |1.0.14 |2022-02-05 |CRAN (R 4.4.1) |
|jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.4.0) | |jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.4.0) |
|jsonlite |2.0.0 |2025-03-27 |CRAN (R 4.4.1) | |jsonlite |2.0.0 |2025-03-27 |CRAN (R 4.4.1) |
|KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.4.1) | |KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.4.1) |
@ -90,7 +93,6 @@
|lattice |0.22-7 |2025-04-02 |CRAN (R 4.4.1) | |lattice |0.22-7 |2025-04-02 |CRAN (R 4.4.1) |
|lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) | |lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) |
|lme4 |1.1-37 |2025-03-26 |CRAN (R 4.4.1) | |lme4 |1.1-37 |2025-03-26 |CRAN (R 4.4.1) |
|magick |2.8.6 |NA |NA |
|magrittr |2.0.3 |2022-03-30 |CRAN (R 4.4.1) | |magrittr |2.0.3 |2022-03-30 |CRAN (R 4.4.1) |
|MASS |7.3-65 |2025-02-28 |CRAN (R 4.4.1) | |MASS |7.3-65 |2025-02-28 |CRAN (R 4.4.1) |
|Matrix |1.7-3 |2025-03-11 |CRAN (R 4.4.1) | |Matrix |1.7-3 |2025-03-11 |CRAN (R 4.4.1) |
@ -104,7 +106,6 @@
|nloptr |2.2.1 |2025-03-17 |CRAN (R 4.4.1) | |nloptr |2.2.1 |2025-03-17 |CRAN (R 4.4.1) |
|openssl |2.3.2 |2025-02-03 |CRAN (R 4.4.1) | |openssl |2.3.2 |2025-02-03 |CRAN (R 4.4.1) |
|openxlsx2 |1.14 |2025-03-20 |CRAN (R 4.4.1) | |openxlsx2 |1.14 |2025-03-20 |CRAN (R 4.4.1) |
|pak |0.8.0.2 |2025-04-08 |CRAN (R 4.4.1) |
|parameters |0.24.2 |2025-03-04 |CRAN (R 4.4.1) | |parameters |0.24.2 |2025-03-04 |CRAN (R 4.4.1) |
|patchwork |1.3.0 |2024-09-16 |CRAN (R 4.4.1) | |patchwork |1.3.0 |2024-09-16 |CRAN (R 4.4.1) |
|performance |0.13.0 |2025-01-15 |CRAN (R 4.4.1) | |performance |0.13.0 |2025-01-15 |CRAN (R 4.4.1) |
@ -112,7 +113,6 @@
|pillar |1.10.2 |2025-04-05 |CRAN (R 4.4.1) | |pillar |1.10.2 |2025-04-05 |CRAN (R 4.4.1) |
|pkgbuild |1.4.7 |2025-03-24 |CRAN (R 4.4.1) | |pkgbuild |1.4.7 |2025-03-24 |CRAN (R 4.4.1) |
|pkgconfig |2.0.3 |2019-09-22 |CRAN (R 4.4.1) | |pkgconfig |2.0.3 |2019-09-22 |CRAN (R 4.4.1) |
|pkgdown |2.1.1 |2024-09-17 |CRAN (R 4.4.1) |
|pkgload |1.4.0 |2024-06-28 |CRAN (R 4.4.0) | |pkgload |1.4.0 |2024-06-28 |CRAN (R 4.4.0) |
|processx |3.8.6 |2025-02-21 |CRAN (R 4.4.1) | |processx |3.8.6 |2025-02-21 |CRAN (R 4.4.1) |
|profvis |0.4.0 |2024-09-20 |CRAN (R 4.4.1) | |profvis |0.4.0 |2024-09-20 |CRAN (R 4.4.1) |
@ -122,6 +122,7 @@
|purrr |1.0.4 |2025-02-05 |CRAN (R 4.4.1) | |purrr |1.0.4 |2025-02-05 |CRAN (R 4.4.1) |
|quarto |1.4.4 |2024-07-20 |CRAN (R 4.4.0) | |quarto |1.4.4 |2024-07-20 |CRAN (R 4.4.0) |
|R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) | |R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) |
|ragg |1.4.0 |2025-04-10 |CRAN (R 4.4.1) |
|rbibutils |2.3 |2024-10-04 |CRAN (R 4.4.1) | |rbibutils |2.3 |2024-10-04 |CRAN (R 4.4.1) |
|RColorBrewer |1.1-3 |2022-04-03 |CRAN (R 4.4.1) | |RColorBrewer |1.1-3 |2022-04-03 |CRAN (R 4.4.1) |
|Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) | |Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) |
@ -130,6 +131,8 @@
|readODS |2.3.2 |2025-01-13 |CRAN (R 4.4.1) | |readODS |2.3.2 |2025-01-13 |CRAN (R 4.4.1) |
|readr |2.1.5 |2024-01-10 |CRAN (R 4.4.0) | |readr |2.1.5 |2024-01-10 |CRAN (R 4.4.0) |
|readxl |1.4.5 |2025-03-07 |CRAN (R 4.4.1) | |readxl |1.4.5 |2025-03-07 |CRAN (R 4.4.1) |
|REDCapCAST |25.3.2 |2025-03-10 |CRAN (R 4.4.1) |
|REDCapR |1.4.0 |2025-01-11 |CRAN (R 4.4.1) |
|reformulas |0.4.0 |2024-11-03 |CRAN (R 4.4.1) | |reformulas |0.4.0 |2024-11-03 |CRAN (R 4.4.1) |
|remotes |2.5.0 |2024-03-17 |CRAN (R 4.4.1) | |remotes |2.5.0 |2024-03-17 |CRAN (R 4.4.1) |
|renv |1.1.4 |2025-03-20 |CRAN (R 4.4.1) | |renv |1.1.4 |2025-03-20 |CRAN (R 4.4.1) |
@ -144,11 +147,16 @@
|scales |1.3.0 |2023-11-28 |CRAN (R 4.4.0) | |scales |1.3.0 |2023-11-28 |CRAN (R 4.4.0) |
|see |0.11.0 |2025-03-11 |CRAN (R 4.4.1) | |see |0.11.0 |2025-03-11 |CRAN (R 4.4.1) |
|sessioninfo |1.2.3 |2025-02-05 |CRAN (R 4.4.1) | |sessioninfo |1.2.3 |2025-02-05 |CRAN (R 4.4.1) |
|shape |1.4.6.1 |NA |NA |
|shiny |1.10.0 |2024-12-14 |CRAN (R 4.4.1) | |shiny |1.10.0 |2024-12-14 |CRAN (R 4.4.1) |
|shinybusy |0.3.3 |2024-03-09 |CRAN (R 4.4.0) | |shinybusy |0.3.3 |2024-03-09 |CRAN (R 4.4.0) |
|shinyTime |1.0.3 |2022-08-19 |CRAN (R 4.4.0) | |shinyTime |1.0.3 |2022-08-19 |CRAN (R 4.4.0) |
|shinyWidgets |0.9.0 |2025-02-21 |CRAN (R 4.4.1) | |shinyWidgets |0.9.0 |2025-02-21 |CRAN (R 4.4.1) |
|stringi |1.8.7 |2025-03-27 |CRAN (R 4.4.1) | |stringi |1.8.7 |2025-03-27 |CRAN (R 4.4.1) |
|stringr |1.5.1 |2023-11-14 |CRAN (R 4.4.0) |
|survival |3.8-3 |2024-12-17 |CRAN (R 4.4.1) |
|systemfonts |1.2.2 |2025-04-04 |CRAN (R 4.4.1) |
|textshaping |1.0.0 |2025-01-20 |CRAN (R 4.4.1) |
|tibble |3.2.1 |2023-03-20 |CRAN (R 4.4.0) | |tibble |3.2.1 |2023-03-20 |CRAN (R 4.4.0) |
|tidyr |1.3.1 |2024-01-24 |CRAN (R 4.4.1) | |tidyr |1.3.1 |2024-01-24 |CRAN (R 4.4.1) |
|tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.4.0) | |tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.4.0) |

View file

@ -10,7 +10,7 @@
#### Current file: /Users/au301842/FreesearchR/R//app_version.R #### Current file: /Users/au301842/FreesearchR/R//app_version.R
######## ########
app_version <- function()'v25.4.3.250423' app_version <- function()'v25.4.4.250424'
######## ########
@ -556,6 +556,7 @@ cut_var.hms <- function(x, breaks, ...) {
#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday")
#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "month_only") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "month_only")
#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%A-%H") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%A-%H")
#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%W")
cut_var.POSIXt <- function(x, breaks, right = FALSE, include.lowest = TRUE, start.on.monday = TRUE, ...) { cut_var.POSIXt <- function(x, breaks, right = FALSE, include.lowest = TRUE, start.on.monday = TRUE, ...) {
breaks_o <- breaks breaks_o <- breaks
args <- list(...) args <- list(...)
@ -626,7 +627,10 @@ cut_var.POSIXct <- cut_var.POSIXt
#' @examples #' @examples
#' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(2) #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(2)
#' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday")
cut_var.Date <- function(x, breaks, start.on.monday = TRUE, ...) { #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(format = "%W")
cut_var.Date <- function(x, breaks=NULL, start.on.monday = TRUE, ...) {
args <- list(...)
if ("format" %in% names(args)){ if ("format" %in% names(args)){
assertthat::assert_that(is.character(args$format)) assertthat::assert_that(is.character(args$format))
out <- forcats::as_factor(format(x,format=args$format)) out <- forcats::as_factor(format(x,format=args$format))
@ -837,10 +841,11 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
variable <- req(input$variable) variable <- req(input$variable)
choices <- c( choices <- c(
# "fixed",
# "quantile" # "quantile"
) )
if ("hms" %in% class(data[[variable]])) { if (any(c("hms","POSIXct") %in% class(data[[variable]]))) {
choices <- c(choices, "hour") choices <- c(choices, "hour")
} else if (any(c("POSIXt", "Date") %in% class(data[[variable]]))) { } else if (any(c("POSIXt", "Date") %in% class(data[[variable]]))) {
choices <- c( choices <- c(
@ -848,6 +853,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
"day", "day",
"weekday", "weekday",
"week", "week",
# "week_only",
"month", "month",
"month_only", "month_only",
"quarter", "quarter",
@ -872,6 +878,8 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
) )
} }
choices <- unique(choices)
shinyWidgets::virtualSelectInput( shinyWidgets::virtualSelectInput(
inputId = session$ns("method"), inputId = session$ns("method"),
label = i18n("Method:"), label = i18n("Method:"),
@ -889,7 +897,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
req(input$n_breaks, input$method) req(input$n_breaks, input$method)
if (input$method == "fixed") { if (input$method == "fixed") {
req(input$fixed_brks) req(input$fixed_brks)
if (any(c("hms", "POSIXt") %in% class(data[[variable]]))) { if (any(c("hms", "POSIXct") %in% class(data[[variable]]))) {
# cut.POSIXct <- cut.POSIXt # cut.POSIXct <- cut.POSIXt
f <- cut_var(data[[variable]], breaks = input$fixed_brks) f <- cut_var(data[[variable]], breaks = input$fixed_brks)
list(var = f, brks = levels(f)) list(var = f, brks = levels(f))
@ -932,6 +940,11 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
# cut.POSIXct <- cut.POSIXt # cut.POSIXct <- cut.POSIXt
f <- cut_var(data[[variable]], breaks = "hour") f <- cut_var(data[[variable]], breaks = "hour")
list(var = f, brks = levels(f)) list(var = f, brks = levels(f))
# } else if (input$method %in% c("week_only")) {
# # As a proof of concept a single option to use "format" parameter
# # https://www.stat.berkeley.edu/~s133/dates.html
# f <- cut_var(data[[variable]], format = "%W")
# list(var = f, brks = levels(f))
} else { } else {
classInt::classIntervals( classInt::classIntervals(
var = as.numeric(data[[variable]]), var = as.numeric(data[[variable]]),
@ -945,6 +958,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
data <- req(data_r()) data <- req(data_r())
variable <- req(input$variable) variable <- req(input$variable)
plot_histogram(data, variable, breaks = breaks_r()$brks, color = datamods:::get_primary_color()) plot_histogram(data, variable, breaks = breaks_r()$brks, color = datamods:::get_primary_color())
# plot_histogram(data = breaks_r()$var, breaks = breaks_r()$brks, color = datamods:::get_primary_color())
}) })
@ -1082,8 +1096,13 @@ modal_cut_variable <- function(id,
#' @importFrom graphics abline axis hist par plot.new plot.window #' @importFrom graphics abline axis hist par plot.new plot.window
plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112466") { plot_histogram <- function(data, column=NULL, bins = 30, breaks = NULL, color = "#112466") {
if (is.vector(data)){
x <- data
} else {
x <- data[[column]] x <- data[[column]]
}
x <- as.numeric(x) x <- as.numeric(x)
op <- par(mar = rep(1.5, 4)) op <- par(mar = rep(1.5, 4))
on.exit(par(op)) on.exit(par(op))
@ -8739,7 +8758,7 @@ ui_elements <- list(
shiny::tagList( shiny::tagList(
lapply( lapply(
paste0("code_", c( paste0("code_", c(
"import", "data", "variables", "filter", "table1", "univariable", "multivariable" "import", "format", "data", "variables", "filter", "table1", "univariable", "multivariable"
)), )),
\(.x)shiny::htmlOutput(outputId = .x) \(.x)shiny::htmlOutput(outputId = .x)
) )
@ -8861,7 +8880,8 @@ library(gtsummary)
data(starwars) data(starwars)
data(mtcars) data(mtcars)
mtcars <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates")
mtcars_date$date <- as.Date(sample(seq_len(365),nrow(mtcars)))
data(trial) data(trial)
@ -9018,8 +9038,11 @@ server <- function(input, output, session) {
rv$data_original <- temp_data |> rv$data_original <- temp_data |>
default_parsing() default_parsing()
rv$code$import_print <- list( rv$code$import <- rv$code$import |>
rv$code$import, expression_string(assign.str = "df <-")
rv$code$format <- list(
"df",
rlang::expr(dplyr::select(dplyr::all_of(!!input$import_var))), rlang::expr(dplyr::select(dplyr::all_of(!!input$import_var))),
rlang::call2(.fn = "default_parsing", .ns = "FreesearchR") rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
) |> ) |>
@ -9304,7 +9327,11 @@ server <- function(input, output, session) {
# }) # })
output$code_import <- shiny::renderUI({ output$code_import <- shiny::renderUI({
prismCodeBlock(paste0("#Data import\n", rv$code$import_print)) prismCodeBlock(paste0("#Data import\n", rv$code$import))
})
output$code_import <- shiny::renderUI({
prismCodeBlock(paste0("#Data import formatting\n", rv$code$format))
}) })
output$code_data <- shiny::renderUI({ output$code_data <- shiny::renderUI({

View file

@ -0,0 +1,10 @@
name: FreesearchR
title:
username: agdamsbo
account: agdamsbo
server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1
appId: 14600805
bundleId: 10169595
url: https://agdamsbo.shinyapps.io/FreesearchR/
version: 1

View file

@ -5,6 +5,6 @@ account: agdamsbo
server: shinyapps.io server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1 hostUrl: https://api.shinyapps.io/v1
appId: 13611288 appId: 13611288
bundleId: 10164419 bundleId: 10164589
url: https://agdamsbo.shinyapps.io/freesearcheR/ url: https://agdamsbo.shinyapps.io/freesearcheR/
version: 1 version: 1

View file

@ -32,7 +32,8 @@ library(gtsummary)
data(starwars) data(starwars)
data(mtcars) data(mtcars)
mtcars <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates")
mtcars_date$date <- as.Date(sample(seq_len(365),nrow(mtcars)))
data(trial) data(trial)
@ -189,8 +190,11 @@ server <- function(input, output, session) {
rv$data_original <- temp_data |> rv$data_original <- temp_data |>
default_parsing() default_parsing()
rv$code$import_print <- list( rv$code$import <- rv$code$import |>
rv$code$import, expression_string(assign.str = "df <-")
rv$code$format <- list(
"df",
rlang::expr(dplyr::select(dplyr::all_of(!!input$import_var))), rlang::expr(dplyr::select(dplyr::all_of(!!input$import_var))),
rlang::call2(.fn = "default_parsing", .ns = "FreesearchR") rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
) |> ) |>
@ -475,7 +479,11 @@ server <- function(input, output, session) {
# }) # })
output$code_import <- shiny::renderUI({ output$code_import <- shiny::renderUI({
prismCodeBlock(paste0("#Data import\n", rv$code$import_print)) prismCodeBlock(paste0("#Data import\n", rv$code$import))
})
output$code_import <- shiny::renderUI({
prismCodeBlock(paste0("#Data import formatting\n", rv$code$format))
}) })
output$code_data <- shiny::renderUI({ output$code_data <- shiny::renderUI({

View file

@ -462,7 +462,7 @@ ui_elements <- list(
shiny::tagList( shiny::tagList(
lapply( lapply(
paste0("code_", c( paste0("code_", c(
"import", "data", "variables", "filter", "table1", "univariable", "multivariable" "import", "format", "data", "variables", "filter", "table1", "univariable", "multivariable"
)), )),
\(.x)shiny::htmlOutput(outputId = .x) \(.x)shiny::htmlOutput(outputId = .x)
) )

View file

@ -1,24 +1,11 @@
@book{andreasgammelgaarddamsbo2025, @book{andreasgammelgaarddamsbo2025,
title = {agdamsbo/freesearcheR: freesearcheR 25.3.1}, title = {agdamsbo/FreesearchR: FreesearchR 25.4.3},
author = {Andreas Gammelgaard Damsbo, }, author = {Damsbo, Andreas Gammelgaard},
year = {2025}, year = {2025},
month = {03}, month = {04},
date = {2025-03-06}, date = {2025-04-24},
publisher = {Zenodo}, publisher = {Zenodo},
doi = {10.5281/ZENODO.14527429}, doi = {10.5281/ZENODO.14527429},
url = {https://zenodo.org/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}
}

View file

@ -1 +1 @@
<script defer src="https://analytics.gdamsbo.dk/script.js" data-website-id="1f3baf18-29aa-4612-931b-58ea35922ae4"></script> <script defer src="https://analytics.gdamsbo.dk/script.js" data-website-id="e7d4e13a-5824-4778-bbc0-8f92fb08303a"></script>