mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 01:49:39 +02:00
quick additional update
This commit is contained in:
parent
d3819b786e
commit
d76c75bd93
17 changed files with 138 additions and 138 deletions
|
|
@ -9,7 +9,7 @@ type: software
|
|||
license: AGPL-3.0-or-later
|
||||
title: 'FreesearchR: A free and open-source browser based data analysis tool for researchers
|
||||
with publication ready output'
|
||||
version: 25.5.3
|
||||
version: 25.5.4
|
||||
doi: 10.5281/zenodo.14527429
|
||||
identifiers:
|
||||
- type: url
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
Package: FreesearchR
|
||||
Title: A free and open-source browser based data analysis tool for researchers with publication ready output
|
||||
Version: 25.5.3
|
||||
Version: 25.5.4
|
||||
Authors@R: c(
|
||||
person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"),
|
||||
comment = c(ORCID = "0000-0002-7559-1154")),
|
||||
|
|
|
|||
10
NEWS.md
10
NEWS.md
|
|
@ -1,3 +1,13 @@
|
|||
# FreesearchR 25.5.4
|
||||
|
||||
- *FIX* correctly omit NAs in `data_type()` call
|
||||
|
||||
- *FIX* omit NAs when plotting Euler diagrams.
|
||||
|
||||
- *FIX* print correct labels in horizontal stacked bars.
|
||||
|
||||
- *FIX* initial app load should feel faster.
|
||||
|
||||
# FreesearchR 25.5.3
|
||||
|
||||
- *FIX* a little polish on the data import
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
app_version <- function()'25.5.3'
|
||||
app_version <- function()'25.5.4'
|
||||
|
|
|
|||
|
|
@ -25,7 +25,6 @@
|
|||
#' contrast_text(c("#F2F2F2", "blue"), method="relative")
|
||||
#' @export
|
||||
#'
|
||||
#' @importFrom grDevices col2rgb
|
||||
#'
|
||||
contrast_text <- function(background,
|
||||
light_text = 'white',
|
||||
|
|
|
|||
|
|
@ -17,20 +17,17 @@
|
|||
#' @export
|
||||
#'
|
||||
#' @importFrom htmltools tagList tags css
|
||||
#' @importFrom shiny NS textInput textAreaInput uiOutput actionButton
|
||||
#' @importFrom phosphoricons ph
|
||||
#' @importFrom shinyWidgets virtualSelectInput
|
||||
#'
|
||||
#' @name create-column
|
||||
#'
|
||||
#' @example examples/create_column_module_demo.R
|
||||
create_column_ui <- function(id) {
|
||||
ns <- NS(id)
|
||||
tagList(
|
||||
htmltools::tagList(
|
||||
# datamods:::html_dependency_datamods(),
|
||||
# html_dependency_FreesearchR(),
|
||||
tags$head(
|
||||
tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css")
|
||||
shiny::tags$head(
|
||||
shiny::tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css")
|
||||
),
|
||||
# tags$head(
|
||||
# # Note the wrapping of the string in HTML()
|
||||
|
|
@ -84,7 +81,7 @@ create_column_ui <- function(id) {
|
|||
)
|
||||
)
|
||||
),
|
||||
textAreaInput(
|
||||
shiny::textAreaInput(
|
||||
inputId = ns("expression"),
|
||||
label = i18n("Enter an expression to define new column:"),
|
||||
value = "",
|
||||
|
|
@ -132,9 +129,6 @@ create_column_ui <- function(id) {
|
|||
#'
|
||||
#' @rdname create-column
|
||||
#'
|
||||
#' @importFrom shiny moduleServer reactiveValues observeEvent renderUI req
|
||||
#' updateTextAreaInput reactive bindEvent observe
|
||||
#' @importFrom shinyWidgets alert updateVirtualSelect
|
||||
create_column_server <- function(id,
|
||||
data_r = reactive(NULL),
|
||||
allowed_operations = list_allowed_operations()) {
|
||||
|
|
|
|||
|
|
@ -1,9 +1,3 @@
|
|||
library(datamods)
|
||||
library(toastui)
|
||||
library(phosphoricons)
|
||||
library(rlang)
|
||||
library(shiny)
|
||||
|
||||
#' Extended cutting function with fall-back to the native base::cut
|
||||
#'
|
||||
#' @param x an object inheriting from class "hms"
|
||||
|
|
@ -212,9 +206,9 @@ cut_variable_ui <- function(id) {
|
|||
shiny::fluidRow(
|
||||
column(
|
||||
width = 3,
|
||||
virtualSelectInput(
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = ns("variable"),
|
||||
label = i18n("Variable to cut:"),
|
||||
label = datamods:::i18n("Variable to cut:"),
|
||||
choices = NULL,
|
||||
width = "100%"
|
||||
)
|
||||
|
|
@ -227,7 +221,7 @@ cut_variable_ui <- function(id) {
|
|||
width = 3,
|
||||
numericInput(
|
||||
inputId = ns("n_breaks"),
|
||||
label = i18n("Number of breaks:"),
|
||||
label = datamods:::i18n("Number of breaks:"),
|
||||
value = 3,
|
||||
min = 2,
|
||||
max = 12,
|
||||
|
|
@ -238,12 +232,12 @@ cut_variable_ui <- function(id) {
|
|||
width = 3,
|
||||
checkboxInput(
|
||||
inputId = ns("right"),
|
||||
label = i18n("Close intervals on the right"),
|
||||
label = datamods:::i18n("Close intervals on the right"),
|
||||
value = TRUE
|
||||
),
|
||||
checkboxInput(
|
||||
inputId = ns("include_lowest"),
|
||||
label = i18n("Include lowest value"),
|
||||
label = datamods:::i18n("Include lowest value"),
|
||||
value = TRUE
|
||||
)
|
||||
)
|
||||
|
|
@ -254,10 +248,10 @@ cut_variable_ui <- function(id) {
|
|||
uiOutput(outputId = ns("slider_fixed"))
|
||||
),
|
||||
plotOutput(outputId = ns("plot"), width = "100%", height = "270px"),
|
||||
datagridOutput2(outputId = ns("count")),
|
||||
toastui::datagridOutput2(outputId = ns("count")),
|
||||
actionButton(
|
||||
inputId = ns("create"),
|
||||
label = tagList(ph("scissors"), i18n("Create factor variable")),
|
||||
label = tagList(phosphoricons::ph("scissors"), datamods:::i18n("Create factor variable")),
|
||||
class = "btn-outline-primary float-end"
|
||||
),
|
||||
tags$div(class = "clearfix")
|
||||
|
|
@ -288,7 +282,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
is.numeric(.x) || is_datetime(.x)
|
||||
}, logical(1))
|
||||
vars_num <- names(vars_num)[vars_num]
|
||||
updateVirtualSelect(
|
||||
shinyWidgets::updateVirtualSelect(
|
||||
inputId = "variable",
|
||||
choices = vars_num,
|
||||
selected = if (isTruthy(input$variable)) input$variable else vars_num[1]
|
||||
|
|
@ -325,9 +319,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
}
|
||||
|
||||
|
||||
noUiSliderInput(
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = session$ns("fixed_brks"),
|
||||
label = i18n("Fixed breaks:"),
|
||||
label = datamods:::i18n("Fixed breaks:"),
|
||||
min = lower,
|
||||
max = upper,
|
||||
value = brks,
|
||||
|
|
@ -382,7 +376,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = session$ns("method"),
|
||||
label = i18n("Method:"),
|
||||
label = datamods:::i18n("Method:"),
|
||||
choices = choices,
|
||||
selected = NULL,
|
||||
width = "100%"
|
||||
|
|
@ -525,7 +519,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
data
|
||||
})
|
||||
|
||||
output$count <- renderDatagrid2({
|
||||
output$count <- toastui::renderDatagrid2({
|
||||
# shiny::req(rv$new_var_name)
|
||||
data <- req(data_cutted_r())
|
||||
# variable <- req(input$variable)
|
||||
|
|
@ -541,14 +535,14 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
datamods:::apply_grid_theme()
|
||||
}
|
||||
on.exit(toastui::reset_grid_theme())
|
||||
grid <- datagrid(
|
||||
grid <- toastui::datagrid(
|
||||
data = count_data,
|
||||
colwidths = "guess",
|
||||
theme = "default",
|
||||
bodyHeight = "auto"
|
||||
)
|
||||
grid <- toastui::grid_columns(grid, className = "font-monospace")
|
||||
grid_colorbar(
|
||||
toastui::grid_colorbar(
|
||||
grid,
|
||||
column = "count",
|
||||
label_outside = TRUE,
|
||||
|
|
@ -576,7 +570,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
#'
|
||||
#' @rdname cut-variable
|
||||
modal_cut_variable <- function(id,
|
||||
title = i18n("Convert Numeric to Factor"),
|
||||
title = datamods:::i18n("Convert Numeric to Factor"),
|
||||
easyClose = TRUE,
|
||||
size = "l",
|
||||
footer = NULL) {
|
||||
|
|
|
|||
|
|
@ -681,6 +681,7 @@ create_plot <- function(data, type, pri, sec, ter = NULL, ...) {
|
|||
#' mtcars |> get_label()
|
||||
#' mtcars$mpg |> get_label()
|
||||
#' gtsummary::trial |> get_label(var = "trt")
|
||||
#' gtsummary::trial$trt |> get_label()
|
||||
#' 1:10 |> get_label()
|
||||
get_label <- function(data, var = NULL) {
|
||||
# data <- if (is.reactive(data)) data() else data
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
hosted_version <- function()'v25.5.3-250510'
|
||||
hosted_version <- function()'v25.5.4-250510'
|
||||
|
|
|
|||
|
|
@ -62,9 +62,8 @@ vertical_stacked_bars <- function(data,
|
|||
contrast_cut <-
|
||||
sum(contrast_text(colors, threshold = .3) == "white")
|
||||
|
||||
score_label <- ifelse(is.na(REDCapCAST::get_attr(data$score, "label")), score, REDCapCAST::get_attr(data$score, "label"))
|
||||
group_label <- ifelse(is.na(REDCapCAST::get_attr(data$group, "label")), group, REDCapCAST::get_attr(data$group, "label"))
|
||||
|
||||
score_label <- data |> get_label(var = score)
|
||||
group_label <- data |> get_label(var = group)
|
||||
|
||||
p |>
|
||||
(\(.x){
|
||||
|
|
|
|||
|
|
@ -119,7 +119,6 @@ plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors
|
|||
#' plot_sankey_single("first", "last", color.group = "pri")
|
||||
#' mtcars |>
|
||||
#' default_parsing() |>
|
||||
#' str()
|
||||
#' plot_sankey_single("cyl", "vs", color.group = "pri")
|
||||
plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), colors = NULL, ...) {
|
||||
color.group <- match.arg(color.group)
|
||||
|
|
@ -132,8 +131,6 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
|
|||
|
||||
data <- data |> sankey_ready(pri = pri, sec = sec, ...)
|
||||
|
||||
library(ggalluvial)
|
||||
|
||||
na.color <- "#2986cc"
|
||||
box.color <- "#1E4B66"
|
||||
|
||||
|
|
@ -197,6 +194,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
|
|||
)
|
||||
}
|
||||
|
||||
## Will fail to use stat="stratum" if library is not loaded.
|
||||
library(ggalluvial)
|
||||
p +
|
||||
ggplot2::geom_text(
|
||||
stat = "stratum",
|
||||
|
|
|
|||
|
|
@ -271,12 +271,13 @@ data_type <- function(data) {
|
|||
sapply(data, data_type)
|
||||
} else {
|
||||
cl_d <- class(data)
|
||||
l_unique <- length(unique(na.omit(data)))
|
||||
if (all(is.na(data))) {
|
||||
out <- "empty"
|
||||
} else if (length(unique(data)) < 2) {
|
||||
} else if (l_unique < 2) {
|
||||
out <- "monotone"
|
||||
} else if (any(c("factor", "logical") %in% cl_d) | length(unique(data)) == 2) {
|
||||
if (identical("logical", cl_d) | length(unique(data)) == 2) {
|
||||
} else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) {
|
||||
if (identical("logical", cl_d) | l_unique == 2) {
|
||||
out <- "dichotomous"
|
||||
} else {
|
||||
# if (is.ordered(data)) {
|
||||
|
|
@ -289,7 +290,7 @@ data_type <- function(data) {
|
|||
out <- "text"
|
||||
} else if (any(c("hms", "Date", "POSIXct", "POSIXt") %in% cl_d)) {
|
||||
out <- "datetime"
|
||||
} else if (!length(unique(data)) == 2) {
|
||||
} else if (l_unique > 2) {
|
||||
## Previously had all thinkable classes
|
||||
## Now just assumes the class has not been defined above
|
||||
## any(c("numeric", "integer", "hms", "Date", "timediff") %in% cl_d) &
|
||||
|
|
|
|||
BIN
R/sysdata.rda
BIN
R/sysdata.rda
Binary file not shown.
|
|
@ -31,7 +31,7 @@ update_factor_ui <- function(id) {
|
|||
fluidRow(
|
||||
column(
|
||||
width = 6,
|
||||
virtualSelectInput(
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = ns("variable"),
|
||||
label = i18n("Factor variable to reorder:"),
|
||||
choices = NULL,
|
||||
|
|
@ -66,10 +66,10 @@ update_factor_ui <- function(id) {
|
|||
)
|
||||
)
|
||||
),
|
||||
datagridOutput(ns("grid")),
|
||||
toastui::datagridOutput(ns("grid")),
|
||||
tags$div(
|
||||
class = "float-end",
|
||||
prettyCheckbox(
|
||||
shinyWidgets::prettyCheckbox(
|
||||
inputId = ns("new_var"),
|
||||
label = i18n("Create a new variable (otherwise replaces the one selected)"),
|
||||
value = FALSE,
|
||||
|
|
|
|||
|
|
@ -1,7 +1,3 @@
|
|||
library(data.table)
|
||||
library(rlang)
|
||||
|
||||
|
||||
#' Select, rename and convert variables
|
||||
#'
|
||||
#' @param id Module id. See [shiny::moduleServer()].
|
||||
|
|
|
|||
20
SESSION.md
20
SESSION.md
|
|
@ -15,7 +15,7 @@
|
|||
|rstudio |2024.12.1+563 Kousa Dogwood (desktop) |
|
||||
|pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
|
||||
|quarto |1.7.30 @ /usr/local/bin/quarto |
|
||||
|FreesearchR |25.5.3.250510 |
|
||||
|FreesearchR |25.5.4.250510 |
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -38,14 +38,12 @@
|
|||
|cachem |1.1.0 |2024-05-16 |CRAN (R 4.4.1) |
|
||||
|cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) |
|
||||
|cffr |1.2.0 |2025-01-25 |CRAN (R 4.4.1) |
|
||||
|checkmate |2.3.2 |2024-07-29 |CRAN (R 4.4.0) |
|
||||
|class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) |
|
||||
|classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) |
|
||||
|cli |3.6.5 |2025-04-23 |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) |
|
||||
|crayon |1.5.3 |2024-06-20 |CRAN (R 4.4.1) |
|
||||
|crosstalk |1.2.1 |2023-11-23 |CRAN (R 4.4.0) |
|
||||
|curl |6.2.2 |2025-03-24 |CRAN (R 4.4.1) |
|
||||
|data.table |1.17.0 |2025-02-22 |CRAN (R 4.4.1) |
|
||||
|datamods |1.5.3 |2024-10-02 |CRAN (R 4.4.1) |
|
||||
|
|
@ -60,6 +58,7 @@
|
|||
|easystats |0.7.4 |2025-02-06 |CRAN (R 4.4.1) |
|
||||
|effectsize |1.0.0 |2024-12-10 |CRAN (R 4.4.1) |
|
||||
|ellipsis |0.3.2 |2021-04-29 |CRAN (R 4.4.1) |
|
||||
|eulerr |7.0.2 |2024-03-28 |CRAN (R 4.4.0) |
|
||||
|evaluate |1.0.3 |2025-01-10 |CRAN (R 4.4.1) |
|
||||
|farver |2.1.2 |2024-05-13 |CRAN (R 4.4.1) |
|
||||
|fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) |
|
||||
|
|
@ -67,8 +66,11 @@
|
|||
|forcats |1.0.0 |2023-01-29 |CRAN (R 4.4.0) |
|
||||
|fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) |
|
||||
|generics |0.1.3 |2022-07-05 |CRAN (R 4.4.1) |
|
||||
|ggalluvial |0.12.5 |2023-02-22 |CRAN (R 4.4.0) |
|
||||
|ggforce |0.4.2 |2024-02-19 |CRAN (R 4.4.0) |
|
||||
|ggplot2 |3.5.2 |2025-04-09 |CRAN (R 4.4.1) |
|
||||
|glue |1.8.0 |2024-09-30 |CRAN (R 4.4.1) |
|
||||
|gridExtra |2.3 |2017-09-09 |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) |
|
||||
|gtsummary |2.2.0 |2025-04-14 |CRAN (R 4.4.1) |
|
||||
|
|
@ -78,7 +80,6 @@
|
|||
|htmltools |0.5.8.1 |2024-04-04 |CRAN (R 4.4.1) |
|
||||
|htmlwidgets |1.6.4 |2023-12-06 |CRAN (R 4.4.0) |
|
||||
|httpuv |1.6.16 |2025-04-16 |CRAN (R 4.4.1) |
|
||||
|httr |1.4.7 |2023-08-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) |
|
||||
|jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.4.0) |
|
||||
|
|
@ -87,6 +88,7 @@
|
|||
|KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.4.1) |
|
||||
|keyring |1.3.2 |2023-12-11 |CRAN (R 4.4.0) |
|
||||
|knitr |1.50 |2025-03-16 |CRAN (R 4.4.1) |
|
||||
|labeling |0.4.3 |2023-08-29 |CRAN (R 4.4.1) |
|
||||
|later |1.4.2 |2025-04-08 |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) |
|
||||
|
|
@ -111,6 +113,8 @@
|
|||
|pkgbuild |1.4.7 |2025-03-24 |CRAN (R 4.4.1) |
|
||||
|pkgconfig |2.0.3 |2019-09-22 |CRAN (R 4.4.1) |
|
||||
|pkgload |1.4.0 |2024-06-28 |CRAN (R 4.4.0) |
|
||||
|polyclip |1.10-7 |2024-07-23 |CRAN (R 4.4.1) |
|
||||
|polylabelr |0.3.0 |2024-11-19 |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) |
|
||||
|promises |1.3.2 |2024-11-28 |CRAN (R 4.4.1) |
|
||||
|
|
@ -123,6 +127,8 @@
|
|||
|R.oo |1.27.0 |2024-11-01 |CRAN (R 4.4.1) |
|
||||
|R.utils |2.13.0 |2025-02-24 |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) |
|
||||
|rankinPlot |1.1.0 |2023-01-30 |CRAN (R 4.4.0) |
|
||||
|rbibutils |2.3 |2024-10-04 |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) |
|
||||
|
|
@ -156,15 +162,21 @@
|
|||
|stringi |1.8.7 |2025-03-27 |CRAN (R 4.4.1) |
|
||||
|stringr |1.5.1 |2023-11-14 |CRAN (R 4.4.0) |
|
||||
|styler |1.10.3 |2024-04-07 |CRAN (R 4.4.0) |
|
||||
|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) |
|
||||
|tidyr |1.3.1 |2024-01-24 |CRAN (R 4.4.1) |
|
||||
|tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.4.0) |
|
||||
|toastui |0.4.0 |2025-04-03 |CRAN (R 4.4.1) |
|
||||
|tweenr |2.0.3 |2024-02-26 |CRAN (R 4.4.0) |
|
||||
|tzdb |0.5.0 |2025-03-15 |CRAN (R 4.4.1) |
|
||||
|urlchecker |1.0.1 |2021-11-30 |CRAN (R 4.4.1) |
|
||||
|usethis |3.1.0 |2024-11-26 |CRAN (R 4.4.1) |
|
||||
|utf8 |1.2.4 |2023-10-22 |CRAN (R 4.4.1) |
|
||||
|V8 |6.0.3 |2025-03-26 |CRAN (R 4.4.1) |
|
||||
|vctrs |0.6.5 |2023-12-01 |CRAN (R 4.4.0) |
|
||||
|viridis |0.6.5 |2024-01-29 |CRAN (R 4.4.0) |
|
||||
|viridisLite |0.4.2 |2023-05-02 |CRAN (R 4.4.1) |
|
||||
|vroom |1.6.5 |2023-12-05 |CRAN (R 4.4.0) |
|
||||
|withr |3.0.2 |2024-10-28 |CRAN (R 4.4.1) |
|
||||
|writexl |1.5.4 |2025-04-15 |CRAN (R 4.4.1) |
|
||||
|
|
|
|||
|
|
@ -1,5 +1,44 @@
|
|||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/FreesearchR/app/libs.R
|
||||
########
|
||||
|
||||
library(shiny)
|
||||
# library(shinyjs)
|
||||
# library(methods)
|
||||
# library(readr)
|
||||
# library(MASS)
|
||||
# library(stats)
|
||||
# library(gt)
|
||||
# library(openxlsx2)
|
||||
# library(haven)
|
||||
# library(readODS)
|
||||
# library(bslib)
|
||||
# library(assertthat)
|
||||
# library(dplyr)
|
||||
# library(quarto)
|
||||
# library(here)
|
||||
# library(broom)
|
||||
# library(broom.helpers)
|
||||
# library(easystats)
|
||||
# library(patchwork)
|
||||
# library(DHARMa)
|
||||
# library(apexcharter)
|
||||
library(toastui)
|
||||
# library(datamods)
|
||||
# library(IDEAFilter)
|
||||
library(shinyWidgets)
|
||||
# library(DT)
|
||||
# library(data.table)
|
||||
# library(gtsummary)
|
||||
library(bsicons)
|
||||
library(rlang)
|
||||
# library(datamods)
|
||||
# library(toastui)
|
||||
# library(phosphoricons)
|
||||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/FreesearchR/app/functions.R
|
||||
########
|
||||
|
|
@ -10,7 +49,7 @@
|
|||
#### Current file: /Users/au301842/FreesearchR/R//app_version.R
|
||||
########
|
||||
|
||||
app_version <- function()'25.5.2'
|
||||
app_version <- function()'25.5.3'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -129,7 +168,6 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALS
|
|||
#' contrast_text(c("#F2F2F2", "blue"), method="relative")
|
||||
#' @export
|
||||
#'
|
||||
#' @importFrom grDevices col2rgb
|
||||
#'
|
||||
contrast_text <- function(background,
|
||||
light_text = 'white',
|
||||
|
|
@ -323,20 +361,17 @@ sentence_paste <- function(data, and.str = "and") {
|
|||
#' @export
|
||||
#'
|
||||
#' @importFrom htmltools tagList tags css
|
||||
#' @importFrom shiny NS textInput textAreaInput uiOutput actionButton
|
||||
#' @importFrom phosphoricons ph
|
||||
#' @importFrom shinyWidgets virtualSelectInput
|
||||
#'
|
||||
#' @name create-column
|
||||
#'
|
||||
#' @example examples/create_column_module_demo.R
|
||||
create_column_ui <- function(id) {
|
||||
ns <- NS(id)
|
||||
tagList(
|
||||
htmltools::tagList(
|
||||
# datamods:::html_dependency_datamods(),
|
||||
# html_dependency_FreesearchR(),
|
||||
tags$head(
|
||||
tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css")
|
||||
shiny::tags$head(
|
||||
shiny::tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css")
|
||||
),
|
||||
# tags$head(
|
||||
# # Note the wrapping of the string in HTML()
|
||||
|
|
@ -390,7 +425,7 @@ create_column_ui <- function(id) {
|
|||
)
|
||||
)
|
||||
),
|
||||
textAreaInput(
|
||||
shiny::textAreaInput(
|
||||
inputId = ns("expression"),
|
||||
label = i18n("Enter an expression to define new column:"),
|
||||
value = "",
|
||||
|
|
@ -438,9 +473,6 @@ create_column_ui <- function(id) {
|
|||
#'
|
||||
#' @rdname create-column
|
||||
#'
|
||||
#' @importFrom shiny moduleServer reactiveValues observeEvent renderUI req
|
||||
#' updateTextAreaInput reactive bindEvent observe
|
||||
#' @importFrom shinyWidgets alert updateVirtualSelect
|
||||
create_column_server <- function(id,
|
||||
data_r = reactive(NULL),
|
||||
allowed_operations = list_allowed_operations()) {
|
||||
|
|
@ -947,12 +979,6 @@ vectorSelectInput <- function(inputId,
|
|||
#### Current file: /Users/au301842/FreesearchR/R//cut-variable-dates.R
|
||||
########
|
||||
|
||||
library(datamods)
|
||||
library(toastui)
|
||||
library(phosphoricons)
|
||||
library(rlang)
|
||||
library(shiny)
|
||||
|
||||
#' Extended cutting function with fall-back to the native base::cut
|
||||
#'
|
||||
#' @param x an object inheriting from class "hms"
|
||||
|
|
@ -1161,9 +1187,9 @@ cut_variable_ui <- function(id) {
|
|||
shiny::fluidRow(
|
||||
column(
|
||||
width = 3,
|
||||
virtualSelectInput(
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = ns("variable"),
|
||||
label = i18n("Variable to cut:"),
|
||||
label = datamods:::i18n("Variable to cut:"),
|
||||
choices = NULL,
|
||||
width = "100%"
|
||||
)
|
||||
|
|
@ -1176,7 +1202,7 @@ cut_variable_ui <- function(id) {
|
|||
width = 3,
|
||||
numericInput(
|
||||
inputId = ns("n_breaks"),
|
||||
label = i18n("Number of breaks:"),
|
||||
label = datamods:::i18n("Number of breaks:"),
|
||||
value = 3,
|
||||
min = 2,
|
||||
max = 12,
|
||||
|
|
@ -1187,12 +1213,12 @@ cut_variable_ui <- function(id) {
|
|||
width = 3,
|
||||
checkboxInput(
|
||||
inputId = ns("right"),
|
||||
label = i18n("Close intervals on the right"),
|
||||
label = datamods:::i18n("Close intervals on the right"),
|
||||
value = TRUE
|
||||
),
|
||||
checkboxInput(
|
||||
inputId = ns("include_lowest"),
|
||||
label = i18n("Include lowest value"),
|
||||
label = datamods:::i18n("Include lowest value"),
|
||||
value = TRUE
|
||||
)
|
||||
)
|
||||
|
|
@ -1203,10 +1229,10 @@ cut_variable_ui <- function(id) {
|
|||
uiOutput(outputId = ns("slider_fixed"))
|
||||
),
|
||||
plotOutput(outputId = ns("plot"), width = "100%", height = "270px"),
|
||||
datagridOutput2(outputId = ns("count")),
|
||||
toastui::datagridOutput2(outputId = ns("count")),
|
||||
actionButton(
|
||||
inputId = ns("create"),
|
||||
label = tagList(ph("scissors"), i18n("Create factor variable")),
|
||||
label = tagList(phosphoricons::ph("scissors"), datamods:::i18n("Create factor variable")),
|
||||
class = "btn-outline-primary float-end"
|
||||
),
|
||||
tags$div(class = "clearfix")
|
||||
|
|
@ -1237,7 +1263,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
is.numeric(.x) || is_datetime(.x)
|
||||
}, logical(1))
|
||||
vars_num <- names(vars_num)[vars_num]
|
||||
updateVirtualSelect(
|
||||
shinyWidgets::updateVirtualSelect(
|
||||
inputId = "variable",
|
||||
choices = vars_num,
|
||||
selected = if (isTruthy(input$variable)) input$variable else vars_num[1]
|
||||
|
|
@ -1274,9 +1300,9 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
}
|
||||
|
||||
|
||||
noUiSliderInput(
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = session$ns("fixed_brks"),
|
||||
label = i18n("Fixed breaks:"),
|
||||
label = datamods:::i18n("Fixed breaks:"),
|
||||
min = lower,
|
||||
max = upper,
|
||||
value = brks,
|
||||
|
|
@ -1331,7 +1357,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = session$ns("method"),
|
||||
label = i18n("Method:"),
|
||||
label = datamods:::i18n("Method:"),
|
||||
choices = choices,
|
||||
selected = NULL,
|
||||
width = "100%"
|
||||
|
|
@ -1474,7 +1500,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
data
|
||||
})
|
||||
|
||||
output$count <- renderDatagrid2({
|
||||
output$count <- toastui::renderDatagrid2({
|
||||
# shiny::req(rv$new_var_name)
|
||||
data <- req(data_cutted_r())
|
||||
# variable <- req(input$variable)
|
||||
|
|
@ -1490,14 +1516,14 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
datamods:::apply_grid_theme()
|
||||
}
|
||||
on.exit(toastui::reset_grid_theme())
|
||||
grid <- datagrid(
|
||||
grid <- toastui::datagrid(
|
||||
data = count_data,
|
||||
colwidths = "guess",
|
||||
theme = "default",
|
||||
bodyHeight = "auto"
|
||||
)
|
||||
grid <- toastui::grid_columns(grid, className = "font-monospace")
|
||||
grid_colorbar(
|
||||
toastui::grid_colorbar(
|
||||
grid,
|
||||
column = "count",
|
||||
label_outside = TRUE,
|
||||
|
|
@ -1525,7 +1551,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
|
|||
#'
|
||||
#' @rdname cut-variable
|
||||
modal_cut_variable <- function(id,
|
||||
title = i18n("Convert Numeric to Factor"),
|
||||
title = datamods:::i18n("Convert Numeric to Factor"),
|
||||
easyClose = TRUE,
|
||||
size = "l",
|
||||
footer = NULL) {
|
||||
|
|
@ -2255,6 +2281,7 @@ create_plot <- function(data, type, pri, sec, ter = NULL, ...) {
|
|||
#' mtcars |> get_label()
|
||||
#' mtcars$mpg |> get_label()
|
||||
#' gtsummary::trial |> get_label(var = "trt")
|
||||
#' gtsummary::trial$trt |> get_label()
|
||||
#' 1:10 |> get_label()
|
||||
get_label <- function(data, var = NULL) {
|
||||
# data <- if (is.reactive(data)) data() else data
|
||||
|
|
@ -3969,7 +3996,7 @@ simple_snake <- function(data){
|
|||
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R
|
||||
########
|
||||
|
||||
hosted_version <- function()'v25.5.2-250510'
|
||||
hosted_version <- function()'v25.5.3-250510'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -4807,10 +4834,11 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103) {
|
|||
out <- lapply(ds, \(.x){
|
||||
.x[c(pri, sec)] |>
|
||||
as.data.frame() |>
|
||||
na.omit() |>
|
||||
plot_euler_single()
|
||||
})
|
||||
|
||||
# names(out)
|
||||
# names(out)
|
||||
wrap_plot_list(out)
|
||||
# patchwork::wrap_plots(out, guides = "collect")
|
||||
}
|
||||
|
|
@ -4922,9 +4950,8 @@ vertical_stacked_bars <- function(data,
|
|||
contrast_cut <-
|
||||
sum(contrast_text(colors, threshold = .3) == "white")
|
||||
|
||||
score_label <- ifelse(is.na(REDCapCAST::get_attr(data$score, "label")), score, REDCapCAST::get_attr(data$score, "label"))
|
||||
group_label <- ifelse(is.na(REDCapCAST::get_attr(data$group, "label")), group, REDCapCAST::get_attr(data$group, "label"))
|
||||
|
||||
score_label <- data |> get_label(var = score)
|
||||
group_label <- data |> get_label(var = group)
|
||||
|
||||
p |>
|
||||
(\(.x){
|
||||
|
|
@ -5114,7 +5141,6 @@ plot_sankey <- function(data, pri, sec, ter = NULL, color.group = "pri", colors
|
|||
#' plot_sankey_single("first", "last", color.group = "pri")
|
||||
#' mtcars |>
|
||||
#' default_parsing() |>
|
||||
#' str()
|
||||
#' plot_sankey_single("cyl", "vs", color.group = "pri")
|
||||
plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), colors = NULL, ...) {
|
||||
color.group <- match.arg(color.group)
|
||||
|
|
@ -5127,8 +5153,6 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
|
|||
|
||||
data <- data |> sankey_ready(pri = pri, sec = sec, ...)
|
||||
|
||||
library(ggalluvial)
|
||||
|
||||
na.color <- "#2986cc"
|
||||
box.color <- "#1E4B66"
|
||||
|
||||
|
|
@ -5192,6 +5216,8 @@ plot_sankey_single <- function(data, pri, sec, color.group = c("pri", "sec"), co
|
|||
)
|
||||
}
|
||||
|
||||
## Will fail to use stat="stratum" if library is not loaded.
|
||||
library(ggalluvial)
|
||||
p +
|
||||
ggplot2::geom_text(
|
||||
stat = "stratum",
|
||||
|
|
@ -6346,12 +6372,13 @@ data_type <- function(data) {
|
|||
sapply(data, data_type)
|
||||
} else {
|
||||
cl_d <- class(data)
|
||||
l_unique <- length(unique(na.omit(data)))
|
||||
if (all(is.na(data))) {
|
||||
out <- "empty"
|
||||
} else if (length(unique(data)) < 2) {
|
||||
} else if (l_unique < 2) {
|
||||
out <- "monotone"
|
||||
} else if (any(c("factor", "logical") %in% cl_d) | length(unique(data)) == 2) {
|
||||
if (identical("logical", cl_d) | length(unique(data)) == 2) {
|
||||
} else if (any(c("factor", "logical") %in% cl_d) | l_unique == 2) {
|
||||
if (identical("logical", cl_d) | l_unique == 2) {
|
||||
out <- "dichotomous"
|
||||
} else {
|
||||
# if (is.ordered(data)) {
|
||||
|
|
@ -6364,7 +6391,7 @@ data_type <- function(data) {
|
|||
out <- "text"
|
||||
} else if (any(c("hms", "Date", "POSIXct", "POSIXt") %in% cl_d)) {
|
||||
out <- "datetime"
|
||||
} else if (!length(unique(data)) == 2) {
|
||||
} else if (l_unique > 2) {
|
||||
## Previously had all thinkable classes
|
||||
## Now just assumes the class has not been defined above
|
||||
## any(c("numeric", "integer", "hms", "Date", "timediff") %in% cl_d) &
|
||||
|
|
@ -8039,7 +8066,7 @@ update_factor_ui <- function(id) {
|
|||
fluidRow(
|
||||
column(
|
||||
width = 6,
|
||||
virtualSelectInput(
|
||||
shinyWidgets::virtualSelectInput(
|
||||
inputId = ns("variable"),
|
||||
label = i18n("Factor variable to reorder:"),
|
||||
choices = NULL,
|
||||
|
|
@ -8074,10 +8101,10 @@ update_factor_ui <- function(id) {
|
|||
)
|
||||
)
|
||||
),
|
||||
datagridOutput(ns("grid")),
|
||||
toastui::datagridOutput(ns("grid")),
|
||||
tags$div(
|
||||
class = "float-end",
|
||||
prettyCheckbox(
|
||||
shinyWidgets::prettyCheckbox(
|
||||
inputId = ns("new_var"),
|
||||
label = i18n("Create a new variable (otherwise replaces the one selected)"),
|
||||
value = FALSE,
|
||||
|
|
@ -8303,10 +8330,6 @@ winbox_update_factor <- function(id,
|
|||
#### Current file: /Users/au301842/FreesearchR/R//update-variables-ext.R
|
||||
########
|
||||
|
||||
library(data.table)
|
||||
library(rlang)
|
||||
|
||||
|
||||
#' Select, rename and convert variables
|
||||
#'
|
||||
#' @param id Module id. See [shiny::moduleServer()].
|
||||
|
|
@ -9870,35 +9893,7 @@ ui <- bslib::page_fixed(
|
|||
#### Current file: /Users/au301842/FreesearchR/app/server.R
|
||||
########
|
||||
|
||||
library(shiny)
|
||||
# library(shinyjs)
|
||||
# library(methods)
|
||||
library(readr)
|
||||
library(MASS)
|
||||
library(stats)
|
||||
library(gt)
|
||||
# library(openxlsx2)
|
||||
library(haven)
|
||||
library(readODS)
|
||||
library(bslib)
|
||||
library(assertthat)
|
||||
library(dplyr)
|
||||
library(quarto)
|
||||
library(here)
|
||||
library(broom)
|
||||
library(broom.helpers)
|
||||
library(easystats)
|
||||
library(patchwork)
|
||||
library(DHARMa)
|
||||
library(apexcharter)
|
||||
library(toastui)
|
||||
library(datamods)
|
||||
library(IDEAFilter)
|
||||
library(shinyWidgets)
|
||||
library(DT)
|
||||
library(data.table)
|
||||
library(gtsummary)
|
||||
library(bsicons)
|
||||
|
||||
|
||||
data(starwars)
|
||||
data(mtcars)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue