Compare commits

...

3 commits

Author SHA1 Message Date
60ed75d53e
latest dev version
Some checks are pending
pkgdown.yaml / pkgdown (push) Waiting to run
2025-06-25 10:50:58 +02:00
ab99483772
new missings module and function for plotting 2025-06-25 10:50:05 +02:00
879a4f45dd
api as password - rearranged import parameters - text updates 2025-06-25 10:49:34 +02:00
12 changed files with 644 additions and 187 deletions

View file

@ -9,7 +9,7 @@ type: software
license: AGPL-3.0-or-later license: AGPL-3.0-or-later
title: 'FreesearchR: A free and open-source browser based data analysis tool for researchers title: 'FreesearchR: A free and open-source browser based data analysis tool for researchers
with publication ready output' with publication ready output'
version: 25.6.2 version: 25.6.3
doi: 10.5281/zenodo.14527429 doi: 10.5281/zenodo.14527429
identifiers: identifiers:
- type: url - type: url
@ -1002,6 +1002,19 @@ references:
email: russell-lenth@uiowa.edu email: russell-lenth@uiowa.edu
year: '2025' year: '2025'
doi: 10.32614/CRAN.package.emmeans doi: 10.32614/CRAN.package.emmeans
- type: software
title: visdat
abstract: 'visdat: Preliminary Visualisation of Data'
notes: Imports
url: https://docs.ropensci.org/visdat/
repository: https://CRAN.R-project.org/package=visdat
authors:
- family-names: Tierney
given-names: Nicholas
email: nicholas.tierney@gmail.com
orcid: https://orcid.org/0000-0003-1460-8722
year: '2025'
doi: 10.32614/CRAN.package.visdat
- type: software - type: software
title: styler title: styler
abstract: 'styler: Non-Invasive Pretty Printing of R Code' abstract: 'styler: Non-Invasive Pretty Printing of R Code'

View file

@ -78,6 +78,7 @@ export(m_redcap_readUI)
export(merge_expression) export(merge_expression)
export(merge_long) export(merge_long)
export(missing_fraction) export(missing_fraction)
export(missings_apex_plot)
export(modal_create_column) export(modal_create_column)
export(modal_cut_variable) export(modal_cut_variable)
export(modal_update_factor) export(modal_update_factor)

View file

@ -1,6 +1,10 @@
# FreesearchR 25.6.3 # FreesearchR 25.6.3
- *NEW* First go at introducing more options to evaluate missings. Also reworded the text on the initial filter to only include variables missings less than the given threshold. - *NEW* First go at introducing more options to evaluate missings. This has introduced a new dependency to use the visdat package and visualisation. The solution includes the option to visualise data classes and missingness as well as comparisons of variables by missing outcome variable or not to determine the nature of missingness.
- *FIX* The REDCap import module has been updated visually and the PAI token is now hidden as a password. This module should still only be used when running locally if you are accessing sensitive data.
- minor rewordings and updated UI.
# FreesearchR 25.6.2 # FreesearchR 25.6.2

View file

@ -1 +1 @@
hosted_version <- function()'v25.6.3-250620' hosted_version <- function()'v25.6.3-250625'

View file

@ -9,8 +9,7 @@ data_missings_ui <- function(id) {
ns <- shiny::NS(id) ns <- shiny::NS(id)
shiny::tagList( shiny::tagList(
gt::gt_output(outputId = ns("missings_table")), gt::gt_output(outputId = ns("missings_table"))
shiny::plotOutput(outputId = ns("missings_plot"))
) )
} }
@ -24,20 +23,56 @@ data_missings_ui <- function(id) {
#' @export #' @export
data_missings_server <- function(id, data_missings_server <- function(id,
data, data,
variable,
...) { ...) {
shiny::moduleServer( shiny::moduleServer(
id = id, id = id,
module = function(input, output, session) { module = function(input, output, session) {
# ns <- session$ns # ns <- session$ns
datar <- if (is.reactive(data)) data else reactive(data)
variabler <- if (is.reactive(variable)) variable else reactive(variable)
rv <- shiny::reactiveValues( rv <- shiny::reactiveValues(
data = NULL data = NULL
) )
rv$data <- if (is.reactive(data)) data else reactive(data) rv$data <- shiny::reactive({
df_tbl <- datar()
by_var <- variabler()
output$missings_plot <- shiny::renderPlot({ tryCatch(
visdat::vis_dat(rv$data(),palette = "cb_safe") {
if (!is.null(by_var) && by_var != "" && by_var %in% names(df_tbl)) {
df_tbl[[by_var]] <- ifelse(is.na(df_tbl[[by_var]]), "Missing", "Non-missing")
out <- gtsummary::tbl_summary(df_tbl, by = by_var) |>
gtsummary::add_p()
} else {
out <- gtsummary::tbl_summary(df_tbl)
}
},
error = function(err) {
showNotification(paste0("Error: ", err), type = "err")
}
)
out
})
output$missings_table <- gt::render_gt({
shiny::req(datar)
shiny::req(variabler)
if (is.null(variabler()) || variabler() == "" || !variabler() %in% names(datar())) {
title <- "No missing observations"
} else {
title <- paste("Missing vs non-missing observations in", variabler())
}
rv$data() |>
gtsummary::as_gt() |>
gt::tab_header(title = gt::md(title))
}) })
} }
) )
@ -51,17 +86,24 @@ missing_demo_app <- function() {
label = "Browse data", label = "Browse data",
width = "100%", width = "100%",
disabled = FALSE disabled = FALSE
)#, ),
# data_missings_ui("data") shiny::selectInput(
inputId = "missings_var",
label = "Select variable to stratify analysis", choices = c("cyl", "vs")
),
data_missings_ui("data")
) )
server <- function(input, output, session) { server <- function(input, output, session) {
data_demo <- mtcars data_demo <- mtcars
data_demo[2:4, "cyl"] <- NA data_demo[sample(1:32, 10), "cyl"] <- NA
data_demo[sample(1:32, 8), "vs"] <- NA
data_missings_server(id = "data", data = data_demo, variable = shiny::reactive(input$missings_var))
observeEvent(input$modal_missings, { observeEvent(input$modal_missings, {
tryCatch( tryCatch(
{ {
modal_data_missings(data = data_demo, id = "modal_missings") modal_visual_missings(data = data_demo, id = "modal_missings")
}, },
error = function(err) { error = function(err) {
showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err") showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
@ -75,20 +117,22 @@ missing_demo_app <- function() {
missing_demo_app() missing_demo_app()
modal_data_missings <- function(data, modal_visual_missings <- function(data,
title = "Show missing pattern", title = "Visual overview of data classes and missing observations",
easyClose = TRUE, easyClose = TRUE,
size = "xl", size = "xl",
footer = NULL, footer = NULL,
...) { ...) {
datar <- if (is.reactive(data)) data else reactive(data) datar <- if (is.reactive(data)) data else reactive(data)
showModal(modalDialog( showModal(modalDialog(
title = tagList(title, datamods:::button_close_modal()), title = tagList(title, datamods:::button_close_modal()),
tags$div( tags$div(
# apexcharter::renderApexchart({
# missings_apex_plot(datar(), ...)
# })
shiny::renderPlot({ shiny::renderPlot({
visdat::vis_dat(datar())+ visdat::vis_dat(datar(),sort_type = FALSE) +
ggplot2::guides(fill = ggplot2::guide_legend(title = "Data class")) + ggplot2::guides(fill = ggplot2::guide_legend(title = "Data class")) +
# ggplot2::theme_void() + # ggplot2::theme_void() +
ggplot2::theme( ggplot2::theme(
@ -97,7 +141,7 @@ modal_data_missings <- function(data,
panel.grid.minor = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(),
# axis.text.y = element_blank(), # axis.text.y = element_blank(),
# axis.title.y = element_blank(), # axis.title.y = element_blank(),
text = ggplot2::element_text(size = 15), text = ggplot2::element_text(size = 18),
# axis.text = ggplot2::element_blank(), # axis.text = ggplot2::element_blank(),
# panel.background = ggplot2::element_rect(fill = "white"), # panel.background = ggplot2::element_rect(fill = "white"),
# plot.background = ggplot2::element_rect(fill = "white"), # plot.background = ggplot2::element_rect(fill = "white"),
@ -111,3 +155,99 @@ modal_data_missings <- function(data,
footer = footer footer = footer
)) ))
} }
## Slow with many observations...
#' Plot missings and class with apexcharter
#'
#' @param data data frame
#'
#' @returns An [apexchart()] `htmlwidget` object.
#' @export
#'
#' @examples
#' data_demo <- mtcars
#' data_demo[2:4, "cyl"] <- NA
#' rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot()
#' data_demo |> missings_apex_plot()
#' mtcars |> missings_apex_plot(animation = TRUE)
#' # dplyr::storms |> missings_apex_plot()
#' visdat::vis_dat(dplyr::storms)
missings_apex_plot <- function(data, animation = FALSE, ...) {
browser()
df_plot <- purrr::map_df(data, \(x){
ifelse(is.na(x),
yes = NA,
no = glue::glue_collapse(class(x),
sep = "\n"
)
)
}) %>%
dplyr::mutate(rows = dplyr::row_number()) %>%
tidyr::pivot_longer(
cols = -rows,
names_to = "variable", values_to = "valueType", values_transform = list(valueType = as.character)
) %>%
dplyr::arrange(rows, variable, valueType)
df_plot$valueType_num <- df_plot$valueType |>
forcats::as_factor() |>
as.numeric()
df_plot$valueType[is.na(df_plot$valueType)] <- "NA"
df_plot$valueType_num[is.na(df_plot$valueType_num)] <- max(df_plot$valueType_num, na.rm = TRUE) + 1
labels <- setNames(unique(df_plot$valueType_num), unique(df_plot$valueType))
if (any(df_plot$valueType == "NA")) {
colors <- setNames(c(viridisLite::viridis(n = length(labels) - 1), "#999999"), names(labels))
} else {
colors <- setNames(viridisLite::viridis(n = length(labels)), names(labels))
}
label_list <- labels |>
purrr::imap(\(.x, .i){
list(
from = .x,
to = .x,
color = colors[[.i]],
name = .i
)
}) |>
setNames(NULL)
out <- apexcharter::apex(
data = df_plot,
type = "heatmap",
mapping = apexcharter::aes(x = variable, y = rows, fill = valueType_num),
...
) %>%
apexcharter::ax_stroke(width = NULL) |>
apexcharter::ax_plotOptions(
heatmap = apexcharter::heatmap_opts(
radius = 0,
enableShades = FALSE,
colorScale = list(
ranges = label_list
),
useFillColorAsStroke = TRUE
)
) %>%
apexcharter::ax_dataLabels(enabled = FALSE) |>
apexcharter::ax_tooltip(
enabled = FALSE,
intersect = FALSE
)
if (!isTRUE(animation)) {
out <- out |>
apexcharter::ax_chart(animations = list(enabled = FALSE))
}
out
}

View file

@ -18,18 +18,25 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
} }
server_ui <- shiny::tagList( server_ui <- shiny::tagList(
# width = 6,
shiny::tags$h4("REDCap server"), shiny::tags$h4("REDCap server"),
shiny::textInput( shiny::textInput(
inputId = ns("uri"), inputId = ns("uri"),
label = "Web address", label = "Web address",
value = if_not_missing(url, "https://redcap.your.institution/") value = if_not_missing(url, "https://redcap.your.institution/"),
width = "100%"
), ),
shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"), shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"),
shiny::textInput( # shiny::textInput(
# inputId = ns("api"),
# label = "API token",
# value = "",
# width = "100%"
# ),
shiny::passwordInput(
inputId = ns("api"), inputId = ns("api"),
label = "API token", label = "API token",
value = "" value = "",
width = "100%"
), ),
shiny::helpText("The token is a string of 32 numbers and letters."), shiny::helpText("The token is a string of 32 numbers and letters."),
shiny::br(), shiny::br(),
@ -67,10 +74,13 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
params_ui <- params_ui <-
shiny::tagList( shiny::tagList(
# width = 6,
shiny::tags$h4("Data import parameters"), shiny::tags$h4("Data import parameters"),
shiny::helpText("Options here will show, when API and uri are typed"), shiny::tags$div(
shiny::tags$br(), style = htmltools::css(
display = "grid",
gridTemplateColumns = "1fr 50px",
gridColumnGap = "10px"
),
shiny::uiOutput(outputId = ns("fields")), shiny::uiOutput(outputId = ns("fields")),
shiny::tags$div( shiny::tags$div(
class = "shiny-input-container", class = "shiny-input-container",
@ -83,15 +93,15 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
shinyWidgets::dropMenu( shinyWidgets::dropMenu(
shiny::actionButton( shiny::actionButton(
inputId = ns("dropdown_params"), inputId = ns("dropdown_params"),
label = "Add data filters", label = shiny::icon("filter"),
icon = shiny::icon("filter"), width = "50px"
width = "100%",
class = "px-1"
), ),
filter_ui filter_ui
)
)
), ),
shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters") shiny::helpText("Select fields/variables to import and click the funnel to apply optional filters"),
), shiny::tags$br(),
shiny::tags$br(), shiny::tags$br(),
shiny::uiOutput(outputId = ns("data_type")), shiny::uiOutput(outputId = ns("data_type")),
shiny::uiOutput(outputId = ns("fill")), shiny::uiOutput(outputId = ns("fill")),
@ -112,28 +122,14 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.") tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
), ),
dismissible = TRUE dismissible = TRUE
) # , )
## TODO: Use busy indicator like on download to have button activate/deactivate
# bslib::input_task_button(
# id = ns("data_import"),
# label = "Import",
# icon = shiny::icon("download", lib = "glyphicon"),
# label_busy = "Just a minute...",
# icon_busy = fontawesome::fa_i("arrows-rotate",
# class = "fa-spin",
# "aria-hidden" = "true"
# ),
# type = "primary",
# auto_reset = TRUE#,state="busy"
# ),
# shiny::br(),
# shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.")
) )
shiny::fluidPage( shiny::fluidPage(
title = title, title = title,
server_ui, server_ui,
# shiny::uiOutput(ns("params_ui")),
shiny::conditionalPanel( shiny::conditionalPanel(
condition = "output.connect_success == true", condition = "output.connect_success == true",
params_ui, params_ui,
@ -257,6 +253,7 @@ m_redcap_readServer <- function(id) {
output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success")) output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE) shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
shiny::observeEvent(input$see_dd, { shiny::observeEvent(input$see_dd, {
show_data( show_data(
purrr::pluck(data_rv$dd_list, "data"), purrr::pluck(data_rv$dd_list, "data"),
@ -292,7 +289,7 @@ m_redcap_readServer <- function(id) {
shiny::req(data_rv$dd_list) shiny::req(data_rv$dd_list)
shinyWidgets::virtualSelectInput( shinyWidgets::virtualSelectInput(
inputId = ns("fields"), inputId = ns("fields"),
label = "Select variables to import:", label = "Select fields/variables to import:",
choices = purrr::pluck(data_rv$dd_list, "data") |> choices = purrr::pluck(data_rv$dd_list, "data") |>
dplyr::select(field_name, form_name) |> dplyr::select(field_name, form_name) |>
(\(.x){ (\(.x){
@ -301,7 +298,8 @@ m_redcap_readServer <- function(id) {
updateOn = "change", updateOn = "change",
multiple = TRUE, multiple = TRUE,
search = TRUE, search = TRUE,
showValueAsTags = TRUE showValueAsTags = TRUE,
width = "100%"
) )
}) })
@ -310,13 +308,14 @@ m_redcap_readServer <- function(id) {
if (isTRUE(data_rv$info$has_repeating_instruments_or_events)) { if (isTRUE(data_rv$info$has_repeating_instruments_or_events)) {
vectorSelectInput( vectorSelectInput(
inputId = ns("data_type"), inputId = ns("data_type"),
label = "Select the data format to import", label = "Specify the data format",
choices = c( choices = c(
"Wide data (One row for each subject)" = "wide", "Wide data (One row for each subject)" = "wide",
"Long data for project with repeating instruments (default REDCap)" = "long" "Long data for project with repeating instruments (default REDCap)" = "long"
), ),
selected = "wide", selected = "wide",
multiple = FALSE multiple = FALSE,
width = "100%"
) )
} }
}) })
@ -342,7 +341,8 @@ m_redcap_readServer <- function(id) {
"No, leave the data as is" = "no" "No, leave the data as is" = "no"
), ),
selected = "no", selected = "no",
multiple = FALSE multiple = FALSE,
width = "100%"
) )
} }
}) })
@ -362,7 +362,8 @@ m_redcap_readServer <- function(id) {
selected = NULL, selected = NULL,
label = "Filter by events/arms", label = "Filter by events/arms",
choices = stats::setNames(arms()[[3]], arms()[[1]]), choices = stats::setNames(arms()[[3]], arms()[[1]]),
multiple = TRUE multiple = TRUE,
width = "100%"
) )
} }
}) })

Binary file not shown.

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-06-06 | |date |2025-06-25 |
|rstudio |2025.05.0+496 Mariposa Orchid (desktop) | |rstudio |2025.05.0+496 Mariposa Orchid (desktop) |
|pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) |
|quarto |1.7.30 @ /usr/local/bin/quarto | |quarto |1.7.30 @ /usr/local/bin/quarto |
|FreesearchR |25.6.2.250606 | |FreesearchR |25.6.3.250625 |
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -43,7 +43,6 @@
|cardx |0.2.4 |2025-04-12 |CRAN (R 4.4.1) | |cardx |0.2.4 |2025-04-12 |CRAN (R 4.4.1) |
|caTools |1.18.3 |2024-09-04 |CRAN (R 4.4.1) | |caTools |1.18.3 |2024-09-04 |CRAN (R 4.4.1) |
|cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) | |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) | |checkmate |2.3.2 |2024-07-29 |CRAN (R 4.4.0) |
|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) |
@ -76,6 +75,7 @@
|farver |2.1.2 |2024-05-13 |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) | |fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) |
|flextable |0.9.7 |2024-10-27 |CRAN (R 4.4.1) | |flextable |0.9.7 |2024-10-27 |CRAN (R 4.4.1) |
|fontawesome |0.5.3 |2024-11-16 |CRAN (R 4.4.1) |
|fontBitstreamVera |0.1.1 |2017-02-01 |CRAN (R 4.4.1) | |fontBitstreamVera |0.1.1 |2017-02-01 |CRAN (R 4.4.1) |
|fontLiberation |0.1.0 |2016-10-15 |CRAN (R 4.4.1) | |fontLiberation |0.1.0 |2016-10-15 |CRAN (R 4.4.1) |
|fontquiver |0.2.1 |2017-02-01 |CRAN (R 4.4.0) | |fontquiver |0.2.1 |2017-02-01 |CRAN (R 4.4.0) |
@ -83,7 +83,7 @@
|foreach |1.5.2 |2022-02-02 |CRAN (R 4.4.0) | |foreach |1.5.2 |2022-02-02 |CRAN (R 4.4.0) |
|foreign |0.8-90 |2025-03-31 |CRAN (R 4.4.1) | |foreign |0.8-90 |2025-03-31 |CRAN (R 4.4.1) |
|Formula |1.2-5 |2023-02-24 |CRAN (R 4.4.1) | |Formula |1.2-5 |2023-02-24 |CRAN (R 4.4.1) |
|FreesearchR |25.6.2 |NA |NA | |FreesearchR |25.6.3 |NA |NA |
|fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) | |fs |1.6.6 |2025-04-12 |CRAN (R 4.4.1) |
|gdtools |0.4.2 |2025-03-27 |CRAN (R 4.4.1) | |gdtools |0.4.2 |2025-03-27 |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) |
@ -106,21 +106,24 @@
|htmltools |0.5.8.1 |2024-04-04 |CRAN (R 4.4.1) | |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) | |htmlwidgets |1.6.4 |2023-12-06 |CRAN (R 4.4.0) |
|httpuv |1.6.16 |2025-04-16 |CRAN (R 4.4.1) | |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) | |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) | |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) |
|jsonvalidate |1.5.0 |2025-02-07 |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) |
|keyring |1.3.2 |2023-12-11 |CRAN (R 4.4.0) | |keyring |1.3.2 |2023-12-11 |CRAN (R 4.4.0) |
|knitr |1.50 |2025-03-16 |CRAN (R 4.4.1) | |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) | |later |1.4.2 |2025-04-08 |CRAN (R 4.4.1) |
|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) |
|litedown |0.7 |2025-04-08 |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) |
|lubridate |1.9.4 |2024-12-08 |CRAN (R 4.4.1) | |lubridate |1.9.4 |2024-12-08 |CRAN (R 4.4.1) |
|magrittr |2.0.3 |2022-03-30 |CRAN (R 4.4.1) | |magrittr |2.0.3 |2022-03-30 |CRAN (R 4.4.1) |
|markdown |2.0 |2025-03-23 |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) |
|memoise |2.0.1 |2021-11-26 |CRAN (R 4.4.0) | |memoise |2.0.1 |2021-11-26 |CRAN (R 4.4.0) |
@ -135,6 +138,7 @@
|opdisDownsampling |1.0.1 |2024-04-15 |CRAN (R 4.4.0) | |opdisDownsampling |1.0.1 |2024-04-15 |CRAN (R 4.4.0) |
|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.15 |2025-04-25 |CRAN (R 4.4.1) | |openxlsx2 |1.15 |2025-04-25 |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) |
|pbmcapply |1.5.1 |2022-04-28 |CRAN (R 4.4.1) | |pbmcapply |1.5.1 |2022-04-28 |CRAN (R 4.4.1) |
@ -156,10 +160,13 @@
|qqconf |1.3.2 |2023-04-14 |CRAN (R 4.4.0) | |qqconf |1.3.2 |2023-04-14 |CRAN (R 4.4.0) |
|qqplotr |0.0.6 |2023-01-25 |CRAN (R 4.4.0) | |qqplotr |0.0.6 |2023-01-25 |CRAN (R 4.4.0) |
|quarto |1.4.4 |2024-07-20 |CRAN (R 4.4.0) | |quarto |1.4.4 |2024-07-20 |CRAN (R 4.4.0) |
|R.cache |0.16.0 |2022-07-21 |CRAN (R 4.4.0) |
|R.methodsS3 |1.8.2 |2022-06-13 |CRAN (R 4.4.1) |
|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) | |R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) |
|ragg |1.4.0 |2025-04-10 |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) | |rankinPlot |1.1.0 |2023-01-30 |CRAN (R 4.4.0) |
|rappdirs |0.3.3 |2021-01-31 |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) |
@ -191,11 +198,13 @@
|sessioninfo |1.2.3 |2025-02-05 |CRAN (R 4.4.1) | |sessioninfo |1.2.3 |2025-02-05 |CRAN (R 4.4.1) |
|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) |
|shinydashboard |0.7.3 |NA |NA |
|shinyjs |2.1.0 |2021-12-23 |CRAN (R 4.4.0) | |shinyjs |2.1.0 |2021-12-23 |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) | |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) | |systemfonts |1.2.2 |2025-04-04 |CRAN (R 4.4.1) |
|testthat |3.2.3 |2025-01-13 |CRAN (R 4.4.1) | |testthat |3.2.3 |2025-01-13 |CRAN (R 4.4.1) |
|textshaping |1.0.0 |2025-01-20 |CRAN (R 4.4.1) | |textshaping |1.0.0 |2025-01-20 |CRAN (R 4.4.1) |
@ -211,8 +220,8 @@
|urlchecker |1.0.1 |2021-11-30 |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) | |usethis |3.1.0 |2024-11-26 |CRAN (R 4.4.1) |
|uuid |1.2-1 |2024-07-29 |CRAN (R 4.4.1) | |uuid |1.2-1 |2024-07-29 |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) | |vctrs |0.6.5 |2023-12-01 |CRAN (R 4.4.0) |
|visdat |0.6.0 |2023-02-02 |CRAN (R 4.4.0) |
|vroom |1.6.5 |2023-12-05 |CRAN (R 4.4.0) | |vroom |1.6.5 |2023-12-05 |CRAN (R 4.4.0) |
|withr |3.0.2 |2024-10-28 |CRAN (R 4.4.1) | |withr |3.0.2 |2024-10-28 |CRAN (R 4.4.1) |
|writexl |1.5.4 |2025-04-15 |CRAN (R 4.4.1) | |writexl |1.5.4 |2025-04-15 |CRAN (R 4.4.1) |

View file

@ -3996,7 +3996,7 @@ simple_snake <- function(data){
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R
######## ########
hosted_version <- function()'v25.6.3-250620' hosted_version <- function()'v25.6.3-250625'
######## ########
@ -4670,8 +4670,7 @@ data_missings_ui <- function(id) {
ns <- shiny::NS(id) ns <- shiny::NS(id)
shiny::tagList( shiny::tagList(
gt::gt_output(outputId = ns("missings_table")), gt::gt_output(outputId = ns("missings_table"))
shiny::plotOutput(outputId = ns("missings_plot"))
) )
} }
@ -4685,20 +4684,56 @@ data_missings_ui <- function(id) {
#' @export #' @export
data_missings_server <- function(id, data_missings_server <- function(id,
data, data,
variable,
...) { ...) {
shiny::moduleServer( shiny::moduleServer(
id = id, id = id,
module = function(input, output, session) { module = function(input, output, session) {
# ns <- session$ns # ns <- session$ns
datar <- if (is.reactive(data)) data else reactive(data)
variabler <- if (is.reactive(variable)) variable else reactive(variable)
rv <- shiny::reactiveValues( rv <- shiny::reactiveValues(
data = NULL data = NULL
) )
rv$data <- if (is.reactive(data)) data else reactive(data) rv$data <- shiny::reactive({
df_tbl <- datar()
by_var <- variabler()
output$missings_plot <- shiny::renderPlot({ tryCatch(
visdat::vis_dat(rv$data(),palette = "cb_safe") {
if (!is.null(by_var) && by_var != "" && by_var %in% names(df_tbl)) {
df_tbl[[by_var]] <- ifelse(is.na(df_tbl[[by_var]]), "Missing", "Non-missing")
out <- gtsummary::tbl_summary(df_tbl, by = by_var) |>
gtsummary::add_p()
} else {
out <- gtsummary::tbl_summary(df_tbl)
}
},
error = function(err) {
showNotification(paste0("Error: ", err), type = "err")
}
)
out
})
output$missings_table <- gt::render_gt({
shiny::req(datar)
shiny::req(variabler)
if (is.null(variabler()) || variabler() == "" || !variabler() %in% names(datar())) {
title <- "No missing observations"
} else {
title <- paste("Missing vs non-missing observations in", variabler())
}
rv$data() |>
gtsummary::as_gt() |>
gt::tab_header(title = gt::md(title))
}) })
} }
) )
@ -4712,17 +4747,24 @@ missing_demo_app <- function() {
label = "Browse data", label = "Browse data",
width = "100%", width = "100%",
disabled = FALSE disabled = FALSE
)#, ),
# data_missings_ui("data") shiny::selectInput(
inputId = "missings_var",
label = "Select variable to stratify analysis", choices = c("cyl", "vs")
),
data_missings_ui("data")
) )
server <- function(input, output, session) { server <- function(input, output, session) {
data_demo <- mtcars data_demo <- mtcars
data_demo[2:4, "cyl"] <- NA data_demo[sample(1:32, 10), "cyl"] <- NA
data_demo[sample(1:32, 8), "vs"] <- NA
data_missings_server(id = "data", data = data_demo, variable = shiny::reactive(input$missings_var))
observeEvent(input$modal_missings, { observeEvent(input$modal_missings, {
tryCatch( tryCatch(
{ {
modal_data_missings(data = data_demo, id = "modal_missings") modal_visual_missings(data = data_demo, id = "modal_missings")
}, },
error = function(err) { error = function(err) {
showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err") showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
@ -4736,20 +4778,22 @@ missing_demo_app <- function() {
missing_demo_app() missing_demo_app()
modal_data_missings <- function(data, modal_visual_missings <- function(data,
title = "Show missing pattern", title = "Visual overview of data classes and missing observations",
easyClose = TRUE, easyClose = TRUE,
size = "xl", size = "xl",
footer = NULL, footer = NULL,
...) { ...) {
datar <- if (is.reactive(data)) data else reactive(data) datar <- if (is.reactive(data)) data else reactive(data)
showModal(modalDialog( showModal(modalDialog(
title = tagList(title, datamods:::button_close_modal()), title = tagList(title, datamods:::button_close_modal()),
tags$div( tags$div(
# apexcharter::renderApexchart({
# missings_apex_plot(datar(), ...)
# })
shiny::renderPlot({ shiny::renderPlot({
visdat::vis_dat(datar())+ visdat::vis_dat(datar(),sort_type = FALSE) +
ggplot2::guides(fill = ggplot2::guide_legend(title = "Data class")) + ggplot2::guides(fill = ggplot2::guide_legend(title = "Data class")) +
# ggplot2::theme_void() + # ggplot2::theme_void() +
ggplot2::theme( ggplot2::theme(
@ -4758,7 +4802,7 @@ modal_data_missings <- function(data,
panel.grid.minor = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(),
# axis.text.y = element_blank(), # axis.text.y = element_blank(),
# axis.title.y = element_blank(), # axis.title.y = element_blank(),
text = ggplot2::element_text(size = 15), text = ggplot2::element_text(size = 18),
# axis.text = ggplot2::element_blank(), # axis.text = ggplot2::element_blank(),
# panel.background = ggplot2::element_rect(fill = "white"), # panel.background = ggplot2::element_rect(fill = "white"),
# plot.background = ggplot2::element_rect(fill = "white"), # plot.background = ggplot2::element_rect(fill = "white"),
@ -4774,6 +4818,102 @@ modal_data_missings <- function(data,
} }
## Slow with many observations...
#' Plot missings and class with apexcharter
#'
#' @param data data frame
#'
#' @returns An [apexchart()] `htmlwidget` object.
#' @export
#'
#' @examples
#' data_demo <- mtcars
#' data_demo[2:4, "cyl"] <- NA
#' rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot()
#' data_demo |> missings_apex_plot()
#' mtcars |> missings_apex_plot(animation = TRUE)
#' # dplyr::storms |> missings_apex_plot()
#' visdat::vis_dat(dplyr::storms)
missings_apex_plot <- function(data, animation = FALSE, ...) {
browser()
df_plot <- purrr::map_df(data, \(x){
ifelse(is.na(x),
yes = NA,
no = glue::glue_collapse(class(x),
sep = "\n"
)
)
}) %>%
dplyr::mutate(rows = dplyr::row_number()) %>%
tidyr::pivot_longer(
cols = -rows,
names_to = "variable", values_to = "valueType", values_transform = list(valueType = as.character)
) %>%
dplyr::arrange(rows, variable, valueType)
df_plot$valueType_num <- df_plot$valueType |>
forcats::as_factor() |>
as.numeric()
df_plot$valueType[is.na(df_plot$valueType)] <- "NA"
df_plot$valueType_num[is.na(df_plot$valueType_num)] <- max(df_plot$valueType_num, na.rm = TRUE) + 1
labels <- setNames(unique(df_plot$valueType_num), unique(df_plot$valueType))
if (any(df_plot$valueType == "NA")) {
colors <- setNames(c(viridisLite::viridis(n = length(labels) - 1), "#999999"), names(labels))
} else {
colors <- setNames(viridisLite::viridis(n = length(labels)), names(labels))
}
label_list <- labels |>
purrr::imap(\(.x, .i){
list(
from = .x,
to = .x,
color = colors[[.i]],
name = .i
)
}) |>
setNames(NULL)
out <- apexcharter::apex(
data = df_plot,
type = "heatmap",
mapping = apexcharter::aes(x = variable, y = rows, fill = valueType_num),
...
) %>%
apexcharter::ax_stroke(width = NULL) |>
apexcharter::ax_plotOptions(
heatmap = apexcharter::heatmap_opts(
radius = 0,
enableShades = FALSE,
colorScale = list(
ranges = label_list
),
useFillColorAsStroke = TRUE
)
) %>%
apexcharter::ax_dataLabels(enabled = FALSE) |>
apexcharter::ax_tooltip(
enabled = FALSE,
intersect = FALSE
)
if (!isTRUE(animation)) {
out <- out |>
apexcharter::ax_chart(animations = list(enabled = FALSE))
}
out
}
######## ########
#### Current file: /Users/au301842/FreesearchR/R//plot_box.R #### Current file: /Users/au301842/FreesearchR/R//plot_box.R
######## ########
@ -5543,18 +5683,25 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
} }
server_ui <- shiny::tagList( server_ui <- shiny::tagList(
# width = 6,
shiny::tags$h4("REDCap server"), shiny::tags$h4("REDCap server"),
shiny::textInput( shiny::textInput(
inputId = ns("uri"), inputId = ns("uri"),
label = "Web address", label = "Web address",
value = if_not_missing(url, "https://redcap.your.institution/") value = if_not_missing(url, "https://redcap.your.institution/"),
width = "100%"
), ),
shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"), shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"),
shiny::textInput( # shiny::textInput(
# inputId = ns("api"),
# label = "API token",
# value = "",
# width = "100%"
# ),
shiny::passwordInput(
inputId = ns("api"), inputId = ns("api"),
label = "API token", label = "API token",
value = "" value = "",
width = "100%"
), ),
shiny::helpText("The token is a string of 32 numbers and letters."), shiny::helpText("The token is a string of 32 numbers and letters."),
shiny::br(), shiny::br(),
@ -5592,10 +5739,13 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
params_ui <- params_ui <-
shiny::tagList( shiny::tagList(
# width = 6,
shiny::tags$h4("Data import parameters"), shiny::tags$h4("Data import parameters"),
shiny::helpText("Options here will show, when API and uri are typed"), shiny::tags$div(
shiny::tags$br(), style = htmltools::css(
display = "grid",
gridTemplateColumns = "1fr 50px",
gridColumnGap = "10px"
),
shiny::uiOutput(outputId = ns("fields")), shiny::uiOutput(outputId = ns("fields")),
shiny::tags$div( shiny::tags$div(
class = "shiny-input-container", class = "shiny-input-container",
@ -5608,15 +5758,15 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
shinyWidgets::dropMenu( shinyWidgets::dropMenu(
shiny::actionButton( shiny::actionButton(
inputId = ns("dropdown_params"), inputId = ns("dropdown_params"),
label = "Add data filters", label = shiny::icon("filter"),
icon = shiny::icon("filter"), width = "50px"
width = "100%",
class = "px-1"
), ),
filter_ui filter_ui
)
)
), ),
shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters") shiny::helpText("Select fields/variables to import and click the funnel to apply optional filters"),
), shiny::tags$br(),
shiny::tags$br(), shiny::tags$br(),
shiny::uiOutput(outputId = ns("data_type")), shiny::uiOutput(outputId = ns("data_type")),
shiny::uiOutput(outputId = ns("fill")), shiny::uiOutput(outputId = ns("fill")),
@ -5637,28 +5787,14 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.") tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
), ),
dismissible = TRUE dismissible = TRUE
) # , )
## TODO: Use busy indicator like on download to have button activate/deactivate
# bslib::input_task_button(
# id = ns("data_import"),
# label = "Import",
# icon = shiny::icon("download", lib = "glyphicon"),
# label_busy = "Just a minute...",
# icon_busy = fontawesome::fa_i("arrows-rotate",
# class = "fa-spin",
# "aria-hidden" = "true"
# ),
# type = "primary",
# auto_reset = TRUE#,state="busy"
# ),
# shiny::br(),
# shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.")
) )
shiny::fluidPage( shiny::fluidPage(
title = title, title = title,
server_ui, server_ui,
# shiny::uiOutput(ns("params_ui")),
shiny::conditionalPanel( shiny::conditionalPanel(
condition = "output.connect_success == true", condition = "output.connect_success == true",
params_ui, params_ui,
@ -5782,6 +5918,7 @@ m_redcap_readServer <- function(id) {
output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success")) output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE) shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
shiny::observeEvent(input$see_dd, { shiny::observeEvent(input$see_dd, {
show_data( show_data(
purrr::pluck(data_rv$dd_list, "data"), purrr::pluck(data_rv$dd_list, "data"),
@ -5817,7 +5954,7 @@ m_redcap_readServer <- function(id) {
shiny::req(data_rv$dd_list) shiny::req(data_rv$dd_list)
shinyWidgets::virtualSelectInput( shinyWidgets::virtualSelectInput(
inputId = ns("fields"), inputId = ns("fields"),
label = "Select variables to import:", label = "Select fields/variables to import:",
choices = purrr::pluck(data_rv$dd_list, "data") |> choices = purrr::pluck(data_rv$dd_list, "data") |>
dplyr::select(field_name, form_name) |> dplyr::select(field_name, form_name) |>
(\(.x){ (\(.x){
@ -5826,7 +5963,8 @@ m_redcap_readServer <- function(id) {
updateOn = "change", updateOn = "change",
multiple = TRUE, multiple = TRUE,
search = TRUE, search = TRUE,
showValueAsTags = TRUE showValueAsTags = TRUE,
width = "100%"
) )
}) })
@ -5835,13 +5973,14 @@ m_redcap_readServer <- function(id) {
if (isTRUE(data_rv$info$has_repeating_instruments_or_events)) { if (isTRUE(data_rv$info$has_repeating_instruments_or_events)) {
vectorSelectInput( vectorSelectInput(
inputId = ns("data_type"), inputId = ns("data_type"),
label = "Select the data format to import", label = "Specify the data format",
choices = c( choices = c(
"Wide data (One row for each subject)" = "wide", "Wide data (One row for each subject)" = "wide",
"Long data for project with repeating instruments (default REDCap)" = "long" "Long data for project with repeating instruments (default REDCap)" = "long"
), ),
selected = "wide", selected = "wide",
multiple = FALSE multiple = FALSE,
width = "100%"
) )
} }
}) })
@ -5867,7 +6006,8 @@ m_redcap_readServer <- function(id) {
"No, leave the data as is" = "no" "No, leave the data as is" = "no"
), ),
selected = "no", selected = "no",
multiple = FALSE multiple = FALSE,
width = "100%"
) )
} }
}) })
@ -5887,7 +6027,8 @@ m_redcap_readServer <- function(id) {
selected = NULL, selected = NULL,
label = "Filter by events/arms", label = "Filter by events/arms",
choices = stats::setNames(arms()[[3]], arms()[[1]]), choices = stats::setNames(arms()[[3]], arms()[[1]]),
multiple = TRUE multiple = TRUE,
width = "100%"
) )
} }
}) })
@ -9571,6 +9712,14 @@ ui_elements <- list(
# ), # ),
shiny::conditionalPanel( shiny::conditionalPanel(
condition = "output.data_loaded == true", condition = "output.data_loaded == true",
shiny::br(),
shiny::actionButton(
inputId = "modal_initial_view",
label = "Quick overview",
width = "100%",
icon = shiny::icon("binoculars"),
disabled = FALSE
),
shiny::br(), shiny::br(),
shiny::br(), shiny::br(),
shiny::h5("Select variables for final import"), shiny::h5("Select variables for final import"),
@ -9590,7 +9739,7 @@ ui_elements <- list(
format = shinyWidgets::wNumbFormat(decimals = 0), format = shinyWidgets::wNumbFormat(decimals = 0),
color = datamods:::get_primary_color() color = datamods:::get_primary_color()
), ),
shiny::helpText("Only include variables with missingness below the specified percentage."), shiny::helpText("Only include variables missing less observations than the specified percentage."),
shiny::br() shiny::br()
), ),
shiny::column( shiny::column(
@ -9601,8 +9750,7 @@ ui_elements <- list(
shiny::br() shiny::br()
) )
), ),
shiny::uiOutput(outputId = "data_info_import", inline = TRUE) shiny::uiOutput(outputId = "data_info_import", inline = TRUE),
),
shiny::br(), shiny::br(),
shiny::br(), shiny::br(),
shiny::actionButton( shiny::actionButton(
@ -9614,9 +9762,12 @@ ui_elements <- list(
), ),
shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'), shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'),
shiny::br(), shiny::br(),
shiny::br(), shiny::br()
),
shiny::column(width = 2) shiny::column(width = 2)
) ),
shiny::br(),
shiny::br()
) )
), ),
############################################################################## ##############################################################################
@ -9639,19 +9790,8 @@ ui_elements <- list(
width = 9, width = 9,
shiny::uiOutput(outputId = "data_info", inline = TRUE), shiny::uiOutput(outputId = "data_info", inline = TRUE),
shiny::tags$p( shiny::tags$p(
"Below is a short summary table, on the right you can click to browse data and create data filters." "Below is a short summary table, on the right you can click to visualise data classes or browse data and create different data filters."
) )
)
),
fluidRow(
shiny::column(
width = 9,
data_summary_ui(id = "data_summary"),
shiny::br(),
shiny::br(),
shiny::br(),
shiny::br(),
shiny::br()
), ),
shiny::column( shiny::column(
width = 3, width = 3,
@ -9670,10 +9810,41 @@ ui_elements <- list(
disabled = TRUE disabled = TRUE
), ),
shiny::br(), shiny::br(),
shiny::br()
)
),
fluidRow(
shiny::column(
width = 9,
data_summary_ui(id = "data_summary"),
shiny::br(), shiny::br(),
shiny::br(),
shiny::br(),
shiny::br(),
shiny::br()
),
shiny::column(
width = 3,
# shiny::actionButton(
# inputId = "modal_missings",
# label = "Visual overview",
# width = "100%",
# disabled = TRUE
# ),
# shiny::br(),
# shiny::br(),
# shiny::actionButton(
# inputId = "modal_browse",
# label = "Browse data",
# width = "100%",
# disabled = TRUE
# ),
# shiny::br(),
# shiny::br(),
shiny::tags$h6("Filter data types"), shiny::tags$h6("Filter data types"),
shiny::uiOutput( shiny::uiOutput(
outputId = "column_filter"), outputId = "column_filter"
),
shiny::helpText("Read more on how ", tags$a( shiny::helpText("Read more on how ", tags$a(
"data types", "data types",
href = "https://agdamsbo.github.io/FreesearchR/articles/data-types.html", href = "https://agdamsbo.github.io/FreesearchR/articles/data-types.html",
@ -9682,7 +9853,7 @@ ui_elements <- list(
), " are defined."), ), " are defined."),
shiny::br(), shiny::br(),
shiny::br(), shiny::br(),
shiny::tags$h6("Create data filters"), shiny::tags$h6("Filter observations"),
shiny::tags$p("Filter on observation level"), shiny::tags$p("Filter on observation level"),
IDEAFilter::IDEAFilter_ui("data_filter"), IDEAFilter::IDEAFilter_ui("data_filter"),
shiny::br(), shiny::br(),
@ -9850,6 +10021,13 @@ ui_elements <- list(
color = datamods:::get_primary_color() color = datamods:::get_primary_color()
), ),
shiny::helpText("Set the cut-off for considered 'highly correlated'.") shiny::helpText("Set the cut-off for considered 'highly correlated'.")
),
bslib::accordion_panel(
vlaue = "acc_mis",
title = "Missings",
icon = bsicons::bs_icon("x-circle"),
shiny::uiOutput("missings_var"),
shiny::helpText("To consider if daata is missing by random, choose the outcome/dependent variable, if it has any missings to evaluate if there is a significant difference across other variables depending on missing data or not.")
) )
) )
), ),
@ -9860,6 +10038,10 @@ ui_elements <- list(
bslib::nav_panel( bslib::nav_panel(
title = "Correlations", title = "Correlations",
data_correlations_ui(id = "correlations", height = 600) data_correlations_ui(id = "correlations", height = 600)
),
bslib::nav_panel(
title = "Missings",
data_missings_ui(id = "missingness")
) )
) )
), ),
@ -10089,9 +10271,6 @@ ui <- bslib::page_fixed(
#### Current file: /Users/au301842/FreesearchR/app/server.R #### Current file: /Users/au301842/FreesearchR/app/server.R
######## ########
data(mtcars) data(mtcars)
# trial <- gtsummary::trial # trial <- gtsummary::trial
@ -10231,6 +10410,21 @@ server <- function(input, output, session) {
rv$code <- modifyList(x = rv$code, list(import = from_env$name())) rv$code <- modifyList(x = rv$code, list(import = from_env$name()))
}) })
observeEvent(input$modal_initial_view, {
tryCatch(
{
modal_visual_missings(
data = default_parsing(rv$data_temp),
footer = NULL,
size = "xl"
)
},
error = function(err) {
showNotification(paste0("We encountered the following error showing missingness: ", err), type = "err")
}
)
})
output$import_var <- shiny::renderUI({ output$import_var <- shiny::renderUI({
shiny::req(rv$data_temp) shiny::req(rv$data_temp)
@ -10550,8 +10744,11 @@ server <- function(input, output, session) {
observeEvent(input$modal_missings, { observeEvent(input$modal_missings, {
tryCatch( tryCatch(
{ {
modal_data_missings(data = REDCapCAST::fct_drop(rv$data_filtered), modal_visual_missings(
footer = "This pop-up gives you an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias.") data = REDCapCAST::fct_drop(rv$data_filtered),
footer = "Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias.",
size = "xl"
)
}, },
error = function(err) { error = function(err) {
showNotification(paste0("We encountered the following error showing missingness: ", err), type = "err") showNotification(paste0("We encountered the following error showing missingness: ", err), type = "err")
@ -10711,6 +10908,16 @@ server <- function(input, output, session) {
} }
) )
output$table1 <- gt::render_gt({
if (!is.null(rv$list$table1)) {
rv$list$table1 |>
gtsummary::as_gt() |>
gt::tab_header(gt::md("**Table 1: Baseline Characteristics**"))
} else {
return(NULL)
}
})
output$outcome_var_cor <- shiny::renderUI({ output$outcome_var_cor <- shiny::renderUI({
columnSelectInput( columnSelectInput(
inputId = "outcome_var_cor", inputId = "outcome_var_cor",
@ -10725,16 +10932,6 @@ server <- function(input, output, session) {
) )
}) })
output$table1 <- gt::render_gt({
if (!is.null(rv$list$table1)) {
rv$list$table1 |>
gtsummary::as_gt() |>
gt::tab_header(gt::md("**Table 1: Baseline Characteristics**"))
} else {
return(NULL)
}
})
data_correlations_server( data_correlations_server(
id = "correlations", id = "correlations",
data = shiny::reactive({ data = shiny::reactive({
@ -10748,6 +10945,24 @@ server <- function(input, output, session) {
cutoff = shiny::reactive(input$cor_cutoff) cutoff = shiny::reactive(input$cor_cutoff)
) )
output$missings_var <- shiny::renderUI({
columnSelectInput(
inputId = "missings_var",
label = "Select variable to stratify analysis",
data = shiny::reactive({
shiny::req(rv$data_filtered)
rv$data_filtered[apply(rv$data_filtered,2,anyNA)]
})()
)
})
data_missings_server(
id = "missingness",
data = shiny::reactive(rv$data_filtered),
variable = shiny::reactive(input$missings_var)
)
############################################################################## ##############################################################################
######### #########
######### Data visuals ######### Data visuals

View file

@ -8,7 +8,7 @@
\usage{ \usage{
data_missings_ui(id) data_missings_ui(id)
data_missings_server(id, data, ...) data_missings_server(id, data, variable, ...)
} }
\arguments{ \arguments{
\item{id}{Module id} \item{id}{Module id}

26
man/missings_apex_plot.Rd Normal file
View file

@ -0,0 +1,26 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/missings-module.R
\name{missings_apex_plot}
\alias{missings_apex_plot}
\title{Plot missings and class with apexcharter}
\usage{
missings_apex_plot(data, animation = FALSE, ...)
}
\arguments{
\item{data}{data frame}
}
\value{
An \code{\link[=apexchart]{apexchart()}} \code{htmlwidget} object.
}
\description{
Plot missings and class with apexcharter
}
\examples{
data_demo <- mtcars
data_demo[2:4, "cyl"] <- NA
rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot()
data_demo |> missings_apex_plot()
mtcars |> missings_apex_plot(animation = TRUE)
# dplyr::storms |> missings_apex_plot()
visdat::vis_dat(dplyr::storms)
}

View file

@ -8917,6 +8917,54 @@
"Author": "Simon Garnier [aut, cre], Noam Ross [ctb, cph], Bob Rudis [ctb, cph], Marco Sciaini [ctb, cph], Antônio Pedro Camargo [ctb, cph], Cédric Scherer [ctb, cph]", "Author": "Simon Garnier [aut, cre], Noam Ross [ctb, cph], Bob Rudis [ctb, cph], Marco Sciaini [ctb, cph], Antônio Pedro Camargo [ctb, cph], Cédric Scherer [ctb, cph]",
"Repository": "CRAN" "Repository": "CRAN"
}, },
"visdat": {
"Package": "visdat",
"Version": "0.6.0",
"Source": "Repository",
"Title": "Preliminary Visualisation of Data",
"Authors@R": "c( person(\"Nicholas\", \"Tierney\", role = c(\"aut\", \"cre\"), email = \"nicholas.tierney@gmail.com\", comment = c(ORCID = \"https://orcid.org/0000-0003-1460-8722\")), person(\"Sean\", \"Hughes\", role = \"rev\", comment =c(ORCID = \"https://orcid.org/0000-0002-9409-9405\", \"Sean Hughes reviewed the package for rOpenSci, see https://github.com/ropensci/onboarding/issues/87\")), person(\"Mara\", \"Averick\", role = \"rev\", comment = \"Mara Averick reviewed the package for rOpenSci, see https://github.com/ropensci/onboarding/issues/87\"), person(\"Stuart\", \"Lee\", role = c(\"ctb\")), person(\"Earo\", \"Wang\", role = c(\"ctb\")), person(\"Nic\", \"Crane\", role = c(\"ctb\")), person(\"Christophe\", \"Regouby\", role=c(\"ctb\")) )",
"Description": "Create preliminary exploratory data visualisations of an entire dataset to identify problems or unexpected features using 'ggplot2'.",
"Depends": [
"R (>= 3.2.2)"
],
"License": "MIT + file LICENSE",
"LazyData": "true",
"RoxygenNote": "7.2.3",
"Imports": [
"ggplot2",
"tidyr",
"dplyr",
"purrr",
"readr",
"magrittr",
"stats",
"tibble",
"glue",
"forcats",
"cli",
"scales"
],
"URL": "https://docs.ropensci.org/visdat/, https://github.com/ropensci/visdat",
"BugReports": "https://github.com/ropensci/visdat/issues",
"Suggests": [
"testthat (>= 3.0.0)",
"plotly (>= 4.5.6)",
"knitr",
"rmarkdown",
"vdiffr",
"spelling",
"covr",
"stringr"
],
"VignetteBuilder": "knitr",
"Encoding": "UTF-8",
"Language": "en-US",
"Config/testthat/edition": "3",
"NeedsCompilation": "no",
"Author": "Nicholas Tierney [aut, cre] (<https://orcid.org/0000-0003-1460-8722>), Sean Hughes [rev] (<https://orcid.org/0000-0002-9409-9405>, Sean Hughes reviewed the package for rOpenSci, see https://github.com/ropensci/onboarding/issues/87), Mara Averick [rev] (Mara Averick reviewed the package for rOpenSci, see https://github.com/ropensci/onboarding/issues/87), Stuart Lee [ctb], Earo Wang [ctb], Nic Crane [ctb], Christophe Regouby [ctb]",
"Maintainer": "Nicholas Tierney <nicholas.tierney@gmail.com>",
"Repository": "CRAN"
},
"vroom": { "vroom": {
"Package": "vroom", "Package": "vroom",
"Version": "1.6.5", "Version": "1.6.5",