mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 04:27:30 +02:00
polish and move to new hosted address
This commit is contained in:
parent
20ae86a346
commit
54ba126a8b
14 changed files with 111 additions and 48 deletions
|
|
@ -10,7 +10,7 @@
|
|||
#### 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 = "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 = "%W")
|
||||
cut_var.POSIXt <- function(x, breaks, right = FALSE, include.lowest = TRUE, start.on.monday = TRUE, ...) {
|
||||
breaks_o <- breaks
|
||||
args <- list(...)
|
||||
|
|
@ -626,7 +627,10 @@ cut_var.POSIXct <- cut_var.POSIXt
|
|||
#' @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(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)){
|
||||
assertthat::assert_that(is.character(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)
|
||||
|
||||
choices <- c(
|
||||
# "fixed",
|
||||
# "quantile"
|
||||
)
|
||||
|
||||
if ("hms" %in% class(data[[variable]])) {
|
||||
if (any(c("hms","POSIXct") %in% class(data[[variable]]))) {
|
||||
choices <- c(choices, "hour")
|
||||
} else if (any(c("POSIXt", "Date") %in% class(data[[variable]]))) {
|
||||
choices <- c(
|
||||
|
|
@ -848,6 +853,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
"day",
|
||||
"weekday",
|
||||
"week",
|
||||
# "week_only",
|
||||
"month",
|
||||
"month_only",
|
||||
"quarter",
|
||||
|
|
@ -872,6 +878,8 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
)
|
||||
}
|
||||
|
||||
choices <- unique(choices)
|
||||
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = session$ns("method"),
|
||||
label = i18n("Method:"),
|
||||
|
|
@ -889,7 +897,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
req(input$n_breaks, input$method)
|
||||
if (input$method == "fixed") {
|
||||
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
|
||||
f <- cut_var(data[[variable]], breaks = input$fixed_brks)
|
||||
list(var = f, brks = levels(f))
|
||||
|
|
@ -932,6 +940,11 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
# cut.POSIXct <- cut.POSIXt
|
||||
f <- cut_var(data[[variable]], breaks = "hour")
|
||||
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 {
|
||||
classInt::classIntervals(
|
||||
var = as.numeric(data[[variable]]),
|
||||
|
|
@ -945,6 +958,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
data <- req(data_r())
|
||||
variable <- req(input$variable)
|
||||
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
|
||||
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 <- as.numeric(x)
|
||||
op <- par(mar = rep(1.5, 4))
|
||||
on.exit(par(op))
|
||||
|
|
@ -8739,7 +8758,7 @@ ui_elements <- list(
|
|||
shiny::tagList(
|
||||
lapply(
|
||||
paste0("code_", c(
|
||||
"import", "data", "variables", "filter", "table1", "univariable", "multivariable"
|
||||
"import", "format", "data", "variables", "filter", "table1", "univariable", "multivariable"
|
||||
)),
|
||||
\(.x)shiny::htmlOutput(outputId = .x)
|
||||
)
|
||||
|
|
@ -8861,7 +8880,8 @@ library(gtsummary)
|
|||
|
||||
data(starwars)
|
||||
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)
|
||||
|
||||
|
||||
|
|
@ -9018,8 +9038,11 @@ server <- function(input, output, session) {
|
|||
rv$data_original <- temp_data |>
|
||||
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::call2(.fn = "default_parsing", .ns = "FreesearchR")
|
||||
) |>
|
||||
|
|
@ -9304,7 +9327,11 @@ server <- function(input, output, session) {
|
|||
# })
|
||||
|
||||
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({
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -5,6 +5,6 @@ account: agdamsbo
|
|||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 13611288
|
||||
bundleId: 10164419
|
||||
bundleId: 10164589
|
||||
url: https://agdamsbo.shinyapps.io/freesearcheR/
|
||||
version: 1
|
||||
|
|
|
|||
|
|
@ -32,7 +32,8 @@ library(gtsummary)
|
|||
|
||||
data(starwars)
|
||||
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)
|
||||
|
||||
|
||||
|
|
@ -189,8 +190,11 @@ server <- function(input, output, session) {
|
|||
rv$data_original <- temp_data |>
|
||||
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::call2(.fn = "default_parsing", .ns = "FreesearchR")
|
||||
) |>
|
||||
|
|
@ -475,7 +479,11 @@ server <- function(input, output, session) {
|
|||
# })
|
||||
|
||||
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({
|
||||
|
|
|
|||
|
|
@ -462,7 +462,7 @@ ui_elements <- list(
|
|||
shiny::tagList(
|
||||
lapply(
|
||||
paste0("code_", c(
|
||||
"import", "data", "variables", "filter", "table1", "univariable", "multivariable"
|
||||
"import", "format", "data", "variables", "filter", "table1", "univariable", "multivariable"
|
||||
)),
|
||||
\(.x)shiny::htmlOutput(outputId = .x)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1,24 +1,11 @@
|
|||
|
||||
@book{andreasgammelgaarddamsbo2025,
|
||||
title = {agdamsbo/freesearcheR: freesearcheR 25.3.1},
|
||||
author = {Andreas Gammelgaard Damsbo, },
|
||||
title = {agdamsbo/FreesearchR: FreesearchR 25.4.3},
|
||||
author = {Damsbo, Andreas Gammelgaard},
|
||||
year = {2025},
|
||||
month = {03},
|
||||
date = {2025-03-06},
|
||||
month = {04},
|
||||
date = {2025-04-24},
|
||||
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}
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue