mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-13 10:19:39 +02:00
Compare commits
3 commits
e3ac3bc66e
...
6ea46ea233
Author | SHA1 | Date | |
---|---|---|---|
6ea46ea233 | |||
2800177fc5 | |||
3e49868ff4 |
16 changed files with 556 additions and 345 deletions
|
@ -42,6 +42,7 @@ export(getfun)
|
||||||
export(gg_theme_export)
|
export(gg_theme_export)
|
||||||
export(gg_theme_shiny)
|
export(gg_theme_shiny)
|
||||||
export(grepl_fix)
|
export(grepl_fix)
|
||||||
|
export(if_not_missing)
|
||||||
export(import_delim)
|
export(import_delim)
|
||||||
export(import_dta)
|
export(import_dta)
|
||||||
export(import_file_server)
|
export(import_file_server)
|
||||||
|
|
4
NEWS.md
4
NEWS.md
|
@ -1,3 +1,7 @@
|
||||||
|
# FreesearchR 25.4.12
|
||||||
|
|
||||||
|
Polished and simplified data import module including a much improved REDCap import module.
|
||||||
|
|
||||||
# FreesearchR 25.4.1
|
# FreesearchR 25.4.1
|
||||||
|
|
||||||
Focus is on polish and improved ui/ux.
|
Focus is on polish and improved ui/ux.
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
app_version <- function()'250402_1131'
|
app_version <- function()'Version: 25.4.1.250403_1409'
|
||||||
|
|
|
@ -128,7 +128,7 @@ sentence_paste <- function(data, and.str = "and") {
|
||||||
} else if (length(data) == 2) {
|
} else if (length(data) == 2) {
|
||||||
paste(data, collapse = glue::glue(" {and.str} "))
|
paste(data, collapse = glue::glue(" {and.str} "))
|
||||||
} else if (length(data) > 2) {
|
} else if (length(data) > 2) {
|
||||||
paste(paste(data[-length(data)], collapse = ", "), data[length(data)], collapse = glue::glue(" {and.str} "))
|
paste(paste(data[-length(data)], collapse = ", "), data[length(data)], sep = glue::glue(" {and.str} "))
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
25
R/helpers.R
25
R/helpers.R
|
@ -335,7 +335,7 @@ data_description <- function(data) {
|
||||||
p_complete <- n_complete/n
|
p_complete <- n_complete/n
|
||||||
|
|
||||||
sprintf(
|
sprintf(
|
||||||
i18n("Data has %s observations and %s variables, with %s (%s%%) complete cases"),
|
i18n("Data has %s observations and %s variables, with %s (%s%%) complete cases."),
|
||||||
n,
|
n,
|
||||||
n_var,
|
n_var,
|
||||||
n_complete,
|
n_complete,
|
||||||
|
@ -369,3 +369,26 @@ get_ggplot_label <- function(data,label){
|
||||||
assertthat::assert_that(ggplot2::is.ggplot(data))
|
assertthat::assert_that(ggplot2::is.ggplot(data))
|
||||||
data$labels[[label]]
|
data$labels[[label]]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#' Return if available
|
||||||
|
#'
|
||||||
|
#' @param data vector
|
||||||
|
#' @param default assigned value for missings
|
||||||
|
#'
|
||||||
|
#' @returns vector
|
||||||
|
#' @export
|
||||||
|
#'
|
||||||
|
#' @examples
|
||||||
|
#' NULL |> if_not_missing("new")
|
||||||
|
#' c(2,"a",NA) |> if_not_missing()
|
||||||
|
#' "See" |> if_not_missing()
|
||||||
|
if_not_missing <- function(data,default=NULL){
|
||||||
|
if (length(data)>1){
|
||||||
|
Reduce(c,lapply(data,if_not_missing))
|
||||||
|
} else if (is.na(data) || is.null(data)){
|
||||||
|
return(default)
|
||||||
|
} else {
|
||||||
|
return(data)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
|
@ -7,7 +7,7 @@
|
||||||
#'
|
#'
|
||||||
#' @return shiny ui element
|
#' @return shiny ui element
|
||||||
#' @export
|
#' @export
|
||||||
m_redcap_readUI <- function(id, title = TRUE) {
|
m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
||||||
ns <- shiny::NS(id)
|
ns <- shiny::NS(id)
|
||||||
|
|
||||||
if (isTRUE(title)) {
|
if (isTRUE(title)) {
|
||||||
|
@ -23,7 +23,7 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
||||||
shiny::textInput(
|
shiny::textInput(
|
||||||
inputId = ns("uri"),
|
inputId = ns("uri"),
|
||||||
label = "Web address",
|
label = "Web address",
|
||||||
value = "https://redcap.your.institution/"
|
value = if_not_missing(url, "https://redcap.your.institution/")
|
||||||
),
|
),
|
||||||
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(
|
||||||
|
@ -32,11 +32,13 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
||||||
value = ""
|
value = ""
|
||||||
),
|
),
|
||||||
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(),
|
||||||
shiny::actionButton(
|
shiny::actionButton(
|
||||||
inputId = ns("data_connect"),
|
inputId = ns("data_connect"),
|
||||||
label = "Connect",
|
label = "Connect",
|
||||||
icon = shiny::icon("link", lib = "glyphicon"),
|
icon = shiny::icon("link", lib = "glyphicon"),
|
||||||
# width = NULL,
|
width = "100%",
|
||||||
disabled = TRUE
|
disabled = TRUE
|
||||||
),
|
),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
|
@ -53,6 +55,15 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
||||||
shiny::br()
|
shiny::br()
|
||||||
)
|
)
|
||||||
|
|
||||||
|
filter_ui <-
|
||||||
|
shiny::tagList(
|
||||||
|
# width = 6,
|
||||||
|
shiny::uiOutput(outputId = ns("arms")),
|
||||||
|
shiny::textInput(
|
||||||
|
inputId = ns("filter"),
|
||||||
|
label = "Optional filter logic (e.g., [gender] = 'female')"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
params_ui <-
|
params_ui <-
|
||||||
shiny::tagList(
|
shiny::tagList(
|
||||||
|
@ -60,41 +71,28 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
||||||
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::helpText("Options here will show, when API and uri are typed"),
|
||||||
shiny::uiOutput(outputId = ns("fields")),
|
shiny::uiOutput(outputId = ns("fields")),
|
||||||
|
shiny::tags$div(
|
||||||
|
class = "shiny-input-container",
|
||||||
|
shiny::tags$label(
|
||||||
|
class = "control-label",
|
||||||
|
`for` = ns("dropdown_params"),
|
||||||
|
"...",
|
||||||
|
style = htmltools::css(visibility = "hidden")
|
||||||
|
),
|
||||||
|
shinyWidgets::dropMenu(
|
||||||
|
shiny::actionButton(
|
||||||
|
inputId = ns("dropdown_params"),
|
||||||
|
label = "Add data filters",
|
||||||
|
icon = shiny::icon("filter"),
|
||||||
|
width = "100%",
|
||||||
|
class = "px-1"
|
||||||
|
),
|
||||||
|
filter_ui
|
||||||
|
),
|
||||||
|
shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters")
|
||||||
|
),
|
||||||
shiny::uiOutput(outputId = ns("data_type")),
|
shiny::uiOutput(outputId = ns("data_type")),
|
||||||
shiny::uiOutput(outputId = ns("fill")),
|
shiny::uiOutput(outputId = ns("fill")),
|
||||||
shinyWidgets::switchInput(
|
|
||||||
inputId = "do_filter",
|
|
||||||
label = "Apply filter?",
|
|
||||||
value = FALSE,
|
|
||||||
inline = FALSE,
|
|
||||||
onLabel = "YES",
|
|
||||||
offLabel = "NO"
|
|
||||||
),
|
|
||||||
shiny::conditionalPanel(
|
|
||||||
condition = "input.do_filter",
|
|
||||||
shiny::uiOutput(outputId = ns("arms")),
|
|
||||||
shiny::textInput(
|
|
||||||
inputId = ns("filter"),
|
|
||||||
label = "Optional filter logic (e.g., [gender] = 'female')"
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
shiny::fluidPage(
|
|
||||||
title=title,
|
|
||||||
bslib::layout_columns(
|
|
||||||
server_ui,
|
|
||||||
params_ui,
|
|
||||||
col_widths = bslib::breakpoints(
|
|
||||||
sm = c(12, 12),
|
|
||||||
md = c(12, 12)
|
|
||||||
)
|
|
||||||
),
|
|
||||||
shiny::column(
|
|
||||||
width = 12,
|
|
||||||
# shiny::actionButton(inputId = ns("import"), label = "Import"),
|
|
||||||
## TODO: Use busy indicator like on download to have button activate/deactivate
|
|
||||||
shiny::actionButton(
|
shiny::actionButton(
|
||||||
inputId = ns("data_import"),
|
inputId = ns("data_import"),
|
||||||
label = "Import",
|
label = "Import",
|
||||||
|
@ -102,6 +100,18 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
||||||
width = "100%",
|
width = "100%",
|
||||||
disabled = TRUE
|
disabled = TRUE
|
||||||
),
|
),
|
||||||
|
shiny::tags$br(),
|
||||||
|
shiny::tags$br(),
|
||||||
|
tags$div(
|
||||||
|
id = ns("retrieved-placeholder"),
|
||||||
|
shinyWidgets::alert(
|
||||||
|
id = ns("retrieved-result"),
|
||||||
|
status = "info",
|
||||||
|
tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
|
||||||
|
),
|
||||||
|
dismissible = TRUE
|
||||||
|
)#,
|
||||||
|
## TODO: Use busy indicator like on download to have button activate/deactivate
|
||||||
# bslib::input_task_button(
|
# bslib::input_task_button(
|
||||||
# id = ns("data_import"),
|
# id = ns("data_import"),
|
||||||
# label = "Import",
|
# label = "Import",
|
||||||
|
@ -114,12 +124,20 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
||||||
# type = "primary",
|
# type = "primary",
|
||||||
# auto_reset = TRUE#,state="busy"
|
# auto_reset = TRUE#,state="busy"
|
||||||
# ),
|
# ),
|
||||||
shiny::br(),
|
# shiny::br(),
|
||||||
shiny::br(),
|
# shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.")
|
||||||
shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding."),
|
|
||||||
shiny::br(),
|
|
||||||
shiny::br()
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
shiny::fluidPage(
|
||||||
|
title = title,
|
||||||
|
server_ui,
|
||||||
|
shiny::conditionalPanel(
|
||||||
|
condition = "output.connect_success == true",
|
||||||
|
params_ui,
|
||||||
|
ns = ns
|
||||||
|
),
|
||||||
|
shiny::br()
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -204,9 +222,11 @@ m_redcap_readServer <- function(id) {
|
||||||
datamods:::insert_alert(
|
datamods:::insert_alert(
|
||||||
selector = ns("connect"),
|
selector = ns("connect"),
|
||||||
status = "success",
|
status = "success",
|
||||||
include_data_alert(see_data_text = "Click to see data dictionary",
|
include_data_alert(
|
||||||
|
see_data_text = "Click to see data dictionary",
|
||||||
dataIdName = "see_data",
|
dataIdName = "see_data",
|
||||||
extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$info$project_title, " loaded."))),
|
extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
|
||||||
|
glue::glue("The {data_rv$info$project_title} project is loaded.")),
|
||||||
btn_show_data = TRUE
|
btn_show_data = TRUE
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
@ -225,6 +245,9 @@ m_redcap_readServer <- function(id) {
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
|
||||||
|
shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
|
||||||
|
|
||||||
shiny::observeEvent(input$see_data, {
|
shiny::observeEvent(input$see_data, {
|
||||||
datamods::show_data(
|
datamods::show_data(
|
||||||
purrr::pluck(data_rv$dd_list, "data"),
|
purrr::pluck(data_rv$dd_list, "data"),
|
||||||
|
@ -313,6 +336,7 @@ m_redcap_readServer <- function(id) {
|
||||||
})
|
})
|
||||||
|
|
||||||
output$arms <- shiny::renderUI({
|
output$arms <- shiny::renderUI({
|
||||||
|
if (NROW(arms()) > 0) {
|
||||||
vectorSelectInput(
|
vectorSelectInput(
|
||||||
inputId = ns("arms"),
|
inputId = ns("arms"),
|
||||||
selected = NULL,
|
selected = NULL,
|
||||||
|
@ -320,10 +344,13 @@ m_redcap_readServer <- function(id) {
|
||||||
choices = stats::setNames(arms()[[3]], arms()[[1]]),
|
choices = stats::setNames(arms()[[3]], arms()[[1]]),
|
||||||
multiple = TRUE
|
multiple = TRUE
|
||||||
)
|
)
|
||||||
|
}
|
||||||
})
|
})
|
||||||
|
|
||||||
shiny::observeEvent(input$data_import, {
|
shiny::observeEvent(input$data_import, {
|
||||||
shiny::req(input$fields)
|
shiny::req(input$fields)
|
||||||
|
|
||||||
|
# browser()
|
||||||
record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
|
record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
|
||||||
|
|
||||||
|
|
||||||
|
@ -334,7 +361,11 @@ m_redcap_readServer <- function(id) {
|
||||||
events = input$arms,
|
events = input$arms,
|
||||||
raw_or_label = "both",
|
raw_or_label = "both",
|
||||||
filter_logic = input$filter,
|
filter_logic = input$filter,
|
||||||
split_forms = if (input$data_type == "long") "none" else "all"
|
split_forms = ifelse(
|
||||||
|
input$data_type == "long" && !is.null(input$data_type),
|
||||||
|
"none",
|
||||||
|
"all"
|
||||||
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
|
shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
|
||||||
|
@ -342,19 +373,24 @@ m_redcap_readServer <- function(id) {
|
||||||
})
|
})
|
||||||
|
|
||||||
code <- rlang::call2("read_redcap_tables",
|
code <- rlang::call2("read_redcap_tables",
|
||||||
!!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")),
|
!!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), ,
|
||||||
, .ns = "REDCapCAST")
|
.ns = "REDCapCAST"
|
||||||
|
)
|
||||||
|
|
||||||
|
# browser()
|
||||||
|
|
||||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||||
data_rv$data_status <- "error"
|
data_rv$data_status <- "error"
|
||||||
data_rv$data_list <- NULL
|
data_rv$data_list <- NULL
|
||||||
|
data_rv$data_message <- imported$raw_text
|
||||||
} else {
|
} else {
|
||||||
data_rv$data_status <- "success"
|
data_rv$data_status <- "success"
|
||||||
|
data_rv$data_message <- "Requested data was retrieved!"
|
||||||
|
|
||||||
## The data management below should be separated to allow for changing
|
## The data management below should be separated to allow for changing
|
||||||
## "wide"/"long" without re-importing data
|
## "wide"/"long" without re-importing data
|
||||||
if (input$data_type != "long") {
|
|
||||||
|
if (parameters$split_form == "all") {
|
||||||
# browser()
|
# browser()
|
||||||
out <- imported |>
|
out <- imported |>
|
||||||
# redcap_wider()
|
# redcap_wider()
|
||||||
|
@ -378,6 +414,20 @@ m_redcap_readServer <- function(id) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# browser()
|
||||||
|
in_data_check <- parameters$fields %in% names(out) |
|
||||||
|
sapply(names(out), \(.x) any(sapply(parameters$fields, \(.y) startsWith(.x, .y))))
|
||||||
|
|
||||||
|
if (!any(in_data_check[-1])) {
|
||||||
|
data_rv$data_status <- "warning"
|
||||||
|
data_rv$data_message <- "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||||
|
}
|
||||||
|
|
||||||
|
if (!all(in_data_check)) {
|
||||||
|
data_rv$data_status <- "warning"
|
||||||
|
data_rv$data_message <- "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||||
|
}
|
||||||
|
|
||||||
data_rv$code <- code
|
data_rv$code <- code
|
||||||
|
|
||||||
data_rv$data <- out |>
|
data_rv$data <- out |>
|
||||||
|
@ -387,13 +437,33 @@ m_redcap_readServer <- function(id) {
|
||||||
}
|
}
|
||||||
})
|
})
|
||||||
|
|
||||||
# shiny::observe({
|
shiny::observeEvent(
|
||||||
# shiny::req(data_rv$imported)
|
data_rv$data_status,
|
||||||
#
|
{
|
||||||
# imported <- data_rv$imported
|
# browser()
|
||||||
#
|
if (identical(data_rv$data_status, "error")) {
|
||||||
#
|
datamods:::insert_error(mssg = data_rv$data_message, selector = ns("retrieved"))
|
||||||
# })
|
} else if (identical(data_rv$data_status, "success")) {
|
||||||
|
datamods:::insert_alert(
|
||||||
|
selector = ns("retrieved"),
|
||||||
|
status = data_rv$data_status,
|
||||||
|
tags$p(
|
||||||
|
tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
|
||||||
|
data_rv$data_message
|
||||||
|
)
|
||||||
|
)
|
||||||
|
} else {
|
||||||
|
datamods:::insert_alert(
|
||||||
|
selector = ns("retrieved"),
|
||||||
|
status = data_rv$data_status,
|
||||||
|
tags$p(
|
||||||
|
tags$b(phosphoricons::ph("warning", weight = "bold"), "Warning!"),
|
||||||
|
data_rv$data_message
|
||||||
|
)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
return(list(
|
return(list(
|
||||||
status = shiny::reactive(data_rv$data_status),
|
status = shiny::reactive(data_rv$data_status),
|
||||||
|
@ -553,13 +623,12 @@ drop_empty_event <- function(data, event = "redcap_event_name") {
|
||||||
#' }
|
#' }
|
||||||
redcap_demo_app <- function() {
|
redcap_demo_app <- function() {
|
||||||
ui <- shiny::fluidPage(
|
ui <- shiny::fluidPage(
|
||||||
m_redcap_readUI("data"),
|
m_redcap_readUI("data", url = NULL),
|
||||||
DT::DTOutput("data"),
|
DT::DTOutput("data"),
|
||||||
shiny::tags$b("Code:"),
|
shiny::tags$b("Code:"),
|
||||||
shiny::verbatimTextOutput(outputId = "code")
|
shiny::verbatimTextOutput(outputId = "code")
|
||||||
)
|
)
|
||||||
server <- function(input, output, session) {
|
server <- function(input, output, session) {
|
||||||
|
|
||||||
data_val <- m_redcap_readServer(id = "data")
|
data_val <- m_redcap_readServer(id = "data")
|
||||||
|
|
||||||
output$data <- DT::renderDataTable(
|
output$data <- DT::renderDataTable(
|
||||||
|
|
|
@ -2,12 +2,14 @@
|
||||||
#'
|
#'
|
||||||
#' @param x (`tbl_regression`, `tbl_uvregression`)\cr
|
#' @param x (`tbl_regression`, `tbl_uvregression`)\cr
|
||||||
#' A 'tbl_regression' or 'tbl_uvregression' object
|
#' A 'tbl_regression' or 'tbl_uvregression' object
|
||||||
## #' @param remove_header_rows (scalar `logical`)\cr
|
#' @param plot_ref (scalar `logical`)\cr
|
||||||
## #' logical indicating whether to remove header rows
|
#' plot reference values
|
||||||
## #' for categorical variables. Default is `TRUE`
|
#' @param remove_header_rows (scalar `logical`)\cr
|
||||||
## #' @param remove_reference_rows (scalar `logical`)\cr
|
#' logical indicating whether to remove header rows
|
||||||
## #' logical indicating whether to remove reference rows
|
#' for categorical variables. Default is `TRUE`
|
||||||
## #' for categorical variables. Default is `FALSE`.
|
#' @param remove_reference_rows (scalar `logical`)\cr
|
||||||
|
#' logical indicating whether to remove reference rows
|
||||||
|
#' for categorical variables. Default is `FALSE`.
|
||||||
#' @param ... arguments passed to `ggstats::ggcoef_plot(...)`
|
#' @param ... arguments passed to `ggstats::ggcoef_plot(...)`
|
||||||
#'
|
#'
|
||||||
#' @returns ggplot object
|
#' @returns ggplot object
|
||||||
|
|
|
@ -118,8 +118,8 @@ update_variables_server <- function(id,
|
||||||
|
|
||||||
output$data_info <- shiny::renderUI({
|
output$data_info <- shiny::renderUI({
|
||||||
shiny::req(data_r())
|
shiny::req(data_r())
|
||||||
data <- data_r()
|
data_description(data_r())
|
||||||
sprintf(i18n("Data has %s observations and %s variables."), nrow(data), ncol(data))
|
# sprintf(i18n("Data has %s observations and %s variables."), nrow(data), ncol(data))
|
||||||
})
|
})
|
||||||
|
|
||||||
variables_r <- shiny::reactive({
|
variables_r <- shiny::reactive({
|
||||||
|
@ -645,10 +645,10 @@ convert_to <- function(data,
|
||||||
setNames(list(expr(as.character(!!sym(variable)))), variable)
|
setNames(list(expr(as.character(!!sym(variable)))), variable)
|
||||||
)
|
)
|
||||||
} else if (identical(new_class, "factor")) {
|
} else if (identical(new_class, "factor")) {
|
||||||
data[[variable]] <- as.factor(x = data[[variable]])
|
data[[variable]] <- REDCapCAST::as_factor(x = data[[variable]])
|
||||||
attr(data, "code_03_convert") <- c(
|
attr(data, "code_03_convert") <- c(
|
||||||
attr(data, "code_03_convert"),
|
attr(data, "code_03_convert"),
|
||||||
setNames(list(expr(as.factor(!!sym(variable)))), variable)
|
setNames(list(expr(REDCapCAST::as_factor(!!sym(variable)))), variable)
|
||||||
)
|
)
|
||||||
} else if (identical(new_class, "numeric")) {
|
} else if (identical(new_class, "numeric")) {
|
||||||
data[[variable]] <- as.numeric(data[[variable]], ...)
|
data[[variable]] <- as.numeric(data[[variable]], ...)
|
||||||
|
|
|
@ -10,7 +10,7 @@
|
||||||
#### Current file: /Users/au301842/FreesearchR/R//app_version.R
|
#### Current file: /Users/au301842/FreesearchR/R//app_version.R
|
||||||
########
|
########
|
||||||
|
|
||||||
app_version <- function()'250402_1131'
|
app_version <- function()'Version: 25.4.1.250403_1409'
|
||||||
|
|
||||||
|
|
||||||
########
|
########
|
||||||
|
@ -287,7 +287,7 @@ sentence_paste <- function(data, and.str = "and") {
|
||||||
} else if (length(data) == 2) {
|
} else if (length(data) == 2) {
|
||||||
paste(data, collapse = glue::glue(" {and.str} "))
|
paste(data, collapse = glue::glue(" {and.str} "))
|
||||||
} else if (length(data) > 2) {
|
} else if (length(data) > 2) {
|
||||||
paste(paste(data[-length(data)], collapse = ", "), data[length(data)], collapse = glue::glue(" {and.str} "))
|
paste(paste(data[-length(data)], collapse = ", "), data[length(data)], sep = glue::glue(" {and.str} "))
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -2808,7 +2808,7 @@ data_description <- function(data) {
|
||||||
p_complete <- n_complete/n
|
p_complete <- n_complete/n
|
||||||
|
|
||||||
sprintf(
|
sprintf(
|
||||||
i18n("Data has %s observations and %s variables, with %s (%s%%) complete cases"),
|
i18n("Data has %s observations and %s variables, with %s (%s%%) complete cases."),
|
||||||
n,
|
n,
|
||||||
n_var,
|
n_var,
|
||||||
n_complete,
|
n_complete,
|
||||||
|
@ -2844,6 +2844,29 @@ get_ggplot_label <- function(data,label){
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#' Return if available
|
||||||
|
#'
|
||||||
|
#' @param data vector
|
||||||
|
#' @param default assigned value for missings
|
||||||
|
#'
|
||||||
|
#' @returns vector
|
||||||
|
#' @export
|
||||||
|
#'
|
||||||
|
#' @examples
|
||||||
|
#' NULL |> if_not_missing("new")
|
||||||
|
#' c(2,"a",NA) |> if_not_missing()
|
||||||
|
#' "See" |> if_not_missing()
|
||||||
|
if_not_missing <- function(data,default=NULL){
|
||||||
|
if (length(data)>1){
|
||||||
|
Reduce(c,lapply(data,if_not_missing))
|
||||||
|
} else if (is.na(data) || is.null(data)){
|
||||||
|
return(default)
|
||||||
|
} else {
|
||||||
|
return(data)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
########
|
########
|
||||||
#### Current file: /Users/au301842/FreesearchR/R//import-file-ext.R
|
#### Current file: /Users/au301842/FreesearchR/R//import-file-ext.R
|
||||||
########
|
########
|
||||||
|
@ -4168,7 +4191,7 @@ plot_download_server <- function(id,
|
||||||
#'
|
#'
|
||||||
#' @return shiny ui element
|
#' @return shiny ui element
|
||||||
#' @export
|
#' @export
|
||||||
m_redcap_readUI <- function(id, title = TRUE) {
|
m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
||||||
ns <- shiny::NS(id)
|
ns <- shiny::NS(id)
|
||||||
|
|
||||||
if (isTRUE(title)) {
|
if (isTRUE(title)) {
|
||||||
|
@ -4184,7 +4207,7 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
||||||
shiny::textInput(
|
shiny::textInput(
|
||||||
inputId = ns("uri"),
|
inputId = ns("uri"),
|
||||||
label = "Web address",
|
label = "Web address",
|
||||||
value = "https://redcap.your.institution/"
|
value = if_not_missing(url, "https://redcap.your.institution/")
|
||||||
),
|
),
|
||||||
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(
|
||||||
|
@ -4193,11 +4216,13 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
||||||
value = ""
|
value = ""
|
||||||
),
|
),
|
||||||
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(),
|
||||||
shiny::actionButton(
|
shiny::actionButton(
|
||||||
inputId = ns("data_connect"),
|
inputId = ns("data_connect"),
|
||||||
label = "Connect",
|
label = "Connect",
|
||||||
icon = shiny::icon("link", lib = "glyphicon"),
|
icon = shiny::icon("link", lib = "glyphicon"),
|
||||||
# width = NULL,
|
width = "100%",
|
||||||
disabled = TRUE
|
disabled = TRUE
|
||||||
),
|
),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
|
@ -4214,6 +4239,15 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
||||||
shiny::br()
|
shiny::br()
|
||||||
)
|
)
|
||||||
|
|
||||||
|
filter_ui <-
|
||||||
|
shiny::tagList(
|
||||||
|
# width = 6,
|
||||||
|
shiny::uiOutput(outputId = ns("arms")),
|
||||||
|
shiny::textInput(
|
||||||
|
inputId = ns("filter"),
|
||||||
|
label = "Optional filter logic (e.g., [gender] = 'female')"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
params_ui <-
|
params_ui <-
|
||||||
shiny::tagList(
|
shiny::tagList(
|
||||||
|
@ -4221,41 +4255,28 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
||||||
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::helpText("Options here will show, when API and uri are typed"),
|
||||||
shiny::uiOutput(outputId = ns("fields")),
|
shiny::uiOutput(outputId = ns("fields")),
|
||||||
|
shiny::tags$div(
|
||||||
|
class = "shiny-input-container",
|
||||||
|
shiny::tags$label(
|
||||||
|
class = "control-label",
|
||||||
|
`for` = ns("dropdown_params"),
|
||||||
|
"...",
|
||||||
|
style = htmltools::css(visibility = "hidden")
|
||||||
|
),
|
||||||
|
shinyWidgets::dropMenu(
|
||||||
|
shiny::actionButton(
|
||||||
|
inputId = ns("dropdown_params"),
|
||||||
|
label = "Add data filters",
|
||||||
|
icon = shiny::icon("filter"),
|
||||||
|
width = "100%",
|
||||||
|
class = "px-1"
|
||||||
|
),
|
||||||
|
filter_ui
|
||||||
|
),
|
||||||
|
shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters")
|
||||||
|
),
|
||||||
shiny::uiOutput(outputId = ns("data_type")),
|
shiny::uiOutput(outputId = ns("data_type")),
|
||||||
shiny::uiOutput(outputId = ns("fill")),
|
shiny::uiOutput(outputId = ns("fill")),
|
||||||
shinyWidgets::switchInput(
|
|
||||||
inputId = "do_filter",
|
|
||||||
label = "Apply filter?",
|
|
||||||
value = FALSE,
|
|
||||||
inline = FALSE,
|
|
||||||
onLabel = "YES",
|
|
||||||
offLabel = "NO"
|
|
||||||
),
|
|
||||||
shiny::conditionalPanel(
|
|
||||||
condition = "input.do_filter",
|
|
||||||
shiny::uiOutput(outputId = ns("arms")),
|
|
||||||
shiny::textInput(
|
|
||||||
inputId = ns("filter"),
|
|
||||||
label = "Optional filter logic (e.g., [gender] = 'female')"
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
shiny::fluidPage(
|
|
||||||
title=title,
|
|
||||||
bslib::layout_columns(
|
|
||||||
server_ui,
|
|
||||||
params_ui,
|
|
||||||
col_widths = bslib::breakpoints(
|
|
||||||
sm = c(12, 12),
|
|
||||||
md = c(12, 12)
|
|
||||||
)
|
|
||||||
),
|
|
||||||
shiny::column(
|
|
||||||
width = 12,
|
|
||||||
# shiny::actionButton(inputId = ns("import"), label = "Import"),
|
|
||||||
## TODO: Use busy indicator like on download to have button activate/deactivate
|
|
||||||
shiny::actionButton(
|
shiny::actionButton(
|
||||||
inputId = ns("data_import"),
|
inputId = ns("data_import"),
|
||||||
label = "Import",
|
label = "Import",
|
||||||
|
@ -4263,6 +4284,18 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
||||||
width = "100%",
|
width = "100%",
|
||||||
disabled = TRUE
|
disabled = TRUE
|
||||||
),
|
),
|
||||||
|
shiny::tags$br(),
|
||||||
|
shiny::tags$br(),
|
||||||
|
tags$div(
|
||||||
|
id = ns("retrieved-placeholder"),
|
||||||
|
shinyWidgets::alert(
|
||||||
|
id = ns("retrieved-result"),
|
||||||
|
status = "info",
|
||||||
|
tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
|
||||||
|
),
|
||||||
|
dismissible = TRUE
|
||||||
|
)#,
|
||||||
|
## TODO: Use busy indicator like on download to have button activate/deactivate
|
||||||
# bslib::input_task_button(
|
# bslib::input_task_button(
|
||||||
# id = ns("data_import"),
|
# id = ns("data_import"),
|
||||||
# label = "Import",
|
# label = "Import",
|
||||||
|
@ -4275,12 +4308,20 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
||||||
# type = "primary",
|
# type = "primary",
|
||||||
# auto_reset = TRUE#,state="busy"
|
# auto_reset = TRUE#,state="busy"
|
||||||
# ),
|
# ),
|
||||||
shiny::br(),
|
# shiny::br(),
|
||||||
shiny::br(),
|
# shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.")
|
||||||
shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding."),
|
|
||||||
shiny::br(),
|
|
||||||
shiny::br()
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
shiny::fluidPage(
|
||||||
|
title = title,
|
||||||
|
server_ui,
|
||||||
|
shiny::conditionalPanel(
|
||||||
|
condition = "output.connect_success == true",
|
||||||
|
params_ui,
|
||||||
|
ns = ns
|
||||||
|
),
|
||||||
|
shiny::br()
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -4365,9 +4406,11 @@ m_redcap_readServer <- function(id) {
|
||||||
datamods:::insert_alert(
|
datamods:::insert_alert(
|
||||||
selector = ns("connect"),
|
selector = ns("connect"),
|
||||||
status = "success",
|
status = "success",
|
||||||
include_data_alert(see_data_text = "Click to see data dictionary",
|
include_data_alert(
|
||||||
|
see_data_text = "Click to see data dictionary",
|
||||||
dataIdName = "see_data",
|
dataIdName = "see_data",
|
||||||
extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$info$project_title, " loaded."))),
|
extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
|
||||||
|
glue::glue("The {data_rv$info$project_title} project is loaded.")),
|
||||||
btn_show_data = TRUE
|
btn_show_data = TRUE
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
@ -4386,6 +4429,9 @@ m_redcap_readServer <- function(id) {
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
|
||||||
|
shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
|
||||||
|
|
||||||
shiny::observeEvent(input$see_data, {
|
shiny::observeEvent(input$see_data, {
|
||||||
datamods::show_data(
|
datamods::show_data(
|
||||||
purrr::pluck(data_rv$dd_list, "data"),
|
purrr::pluck(data_rv$dd_list, "data"),
|
||||||
|
@ -4474,6 +4520,7 @@ m_redcap_readServer <- function(id) {
|
||||||
})
|
})
|
||||||
|
|
||||||
output$arms <- shiny::renderUI({
|
output$arms <- shiny::renderUI({
|
||||||
|
if (NROW(arms()) > 0) {
|
||||||
vectorSelectInput(
|
vectorSelectInput(
|
||||||
inputId = ns("arms"),
|
inputId = ns("arms"),
|
||||||
selected = NULL,
|
selected = NULL,
|
||||||
|
@ -4481,10 +4528,13 @@ m_redcap_readServer <- function(id) {
|
||||||
choices = stats::setNames(arms()[[3]], arms()[[1]]),
|
choices = stats::setNames(arms()[[3]], arms()[[1]]),
|
||||||
multiple = TRUE
|
multiple = TRUE
|
||||||
)
|
)
|
||||||
|
}
|
||||||
})
|
})
|
||||||
|
|
||||||
shiny::observeEvent(input$data_import, {
|
shiny::observeEvent(input$data_import, {
|
||||||
shiny::req(input$fields)
|
shiny::req(input$fields)
|
||||||
|
|
||||||
|
# browser()
|
||||||
record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
|
record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
|
||||||
|
|
||||||
|
|
||||||
|
@ -4495,7 +4545,11 @@ m_redcap_readServer <- function(id) {
|
||||||
events = input$arms,
|
events = input$arms,
|
||||||
raw_or_label = "both",
|
raw_or_label = "both",
|
||||||
filter_logic = input$filter,
|
filter_logic = input$filter,
|
||||||
split_forms = if (input$data_type == "long") "none" else "all"
|
split_forms = ifelse(
|
||||||
|
input$data_type == "long" && !is.null(input$data_type),
|
||||||
|
"none",
|
||||||
|
"all"
|
||||||
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
|
shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
|
||||||
|
@ -4503,19 +4557,24 @@ m_redcap_readServer <- function(id) {
|
||||||
})
|
})
|
||||||
|
|
||||||
code <- rlang::call2("read_redcap_tables",
|
code <- rlang::call2("read_redcap_tables",
|
||||||
!!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")),
|
!!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), ,
|
||||||
, .ns = "REDCapCAST")
|
.ns = "REDCapCAST"
|
||||||
|
)
|
||||||
|
|
||||||
|
# browser()
|
||||||
|
|
||||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||||
data_rv$data_status <- "error"
|
data_rv$data_status <- "error"
|
||||||
data_rv$data_list <- NULL
|
data_rv$data_list <- NULL
|
||||||
|
data_rv$data_message <- imported$raw_text
|
||||||
} else {
|
} else {
|
||||||
data_rv$data_status <- "success"
|
data_rv$data_status <- "success"
|
||||||
|
data_rv$data_message <- "Requested data was retrieved!"
|
||||||
|
|
||||||
## The data management below should be separated to allow for changing
|
## The data management below should be separated to allow for changing
|
||||||
## "wide"/"long" without re-importing data
|
## "wide"/"long" without re-importing data
|
||||||
if (input$data_type != "long") {
|
|
||||||
|
if (parameters$split_form == "all") {
|
||||||
# browser()
|
# browser()
|
||||||
out <- imported |>
|
out <- imported |>
|
||||||
# redcap_wider()
|
# redcap_wider()
|
||||||
|
@ -4539,6 +4598,20 @@ m_redcap_readServer <- function(id) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# browser()
|
||||||
|
in_data_check <- parameters$fields %in% names(out) |
|
||||||
|
sapply(names(out), \(.x) any(sapply(parameters$fields, \(.y) startsWith(.x, .y))))
|
||||||
|
|
||||||
|
if (!any(in_data_check[-1])) {
|
||||||
|
data_rv$data_status <- "warning"
|
||||||
|
data_rv$data_message <- "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||||
|
}
|
||||||
|
|
||||||
|
if (!all(in_data_check)) {
|
||||||
|
data_rv$data_status <- "warning"
|
||||||
|
data_rv$data_message <- "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||||
|
}
|
||||||
|
|
||||||
data_rv$code <- code
|
data_rv$code <- code
|
||||||
|
|
||||||
data_rv$data <- out |>
|
data_rv$data <- out |>
|
||||||
|
@ -4548,13 +4621,33 @@ m_redcap_readServer <- function(id) {
|
||||||
}
|
}
|
||||||
})
|
})
|
||||||
|
|
||||||
# shiny::observe({
|
shiny::observeEvent(
|
||||||
# shiny::req(data_rv$imported)
|
data_rv$data_status,
|
||||||
#
|
{
|
||||||
# imported <- data_rv$imported
|
# browser()
|
||||||
#
|
if (identical(data_rv$data_status, "error")) {
|
||||||
#
|
datamods:::insert_error(mssg = data_rv$data_message, selector = ns("retrieved"))
|
||||||
# })
|
} else if (identical(data_rv$data_status, "success")) {
|
||||||
|
datamods:::insert_alert(
|
||||||
|
selector = ns("retrieved"),
|
||||||
|
status = data_rv$data_status,
|
||||||
|
tags$p(
|
||||||
|
tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
|
||||||
|
data_rv$data_message
|
||||||
|
)
|
||||||
|
)
|
||||||
|
} else {
|
||||||
|
datamods:::insert_alert(
|
||||||
|
selector = ns("retrieved"),
|
||||||
|
status = data_rv$data_status,
|
||||||
|
tags$p(
|
||||||
|
tags$b(phosphoricons::ph("warning", weight = "bold"), "Warning!"),
|
||||||
|
data_rv$data_message
|
||||||
|
)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
return(list(
|
return(list(
|
||||||
status = shiny::reactive(data_rv$data_status),
|
status = shiny::reactive(data_rv$data_status),
|
||||||
|
@ -4714,13 +4807,12 @@ drop_empty_event <- function(data, event = "redcap_event_name") {
|
||||||
#' }
|
#' }
|
||||||
redcap_demo_app <- function() {
|
redcap_demo_app <- function() {
|
||||||
ui <- shiny::fluidPage(
|
ui <- shiny::fluidPage(
|
||||||
m_redcap_readUI("data"),
|
m_redcap_readUI("data", url = NULL),
|
||||||
DT::DTOutput("data"),
|
DT::DTOutput("data"),
|
||||||
shiny::tags$b("Code:"),
|
shiny::tags$b("Code:"),
|
||||||
shiny::verbatimTextOutput(outputId = "code")
|
shiny::verbatimTextOutput(outputId = "code")
|
||||||
)
|
)
|
||||||
server <- function(input, output, session) {
|
server <- function(input, output, session) {
|
||||||
|
|
||||||
data_val <- m_redcap_readServer(id = "data")
|
data_val <- m_redcap_readServer(id = "data")
|
||||||
|
|
||||||
output$data <- DT::renderDataTable(
|
output$data <- DT::renderDataTable(
|
||||||
|
@ -5422,12 +5514,14 @@ regression_model_uv_list <- function(data,
|
||||||
#'
|
#'
|
||||||
#' @param x (`tbl_regression`, `tbl_uvregression`)\cr
|
#' @param x (`tbl_regression`, `tbl_uvregression`)\cr
|
||||||
#' A 'tbl_regression' or 'tbl_uvregression' object
|
#' A 'tbl_regression' or 'tbl_uvregression' object
|
||||||
## #' @param remove_header_rows (scalar `logical`)\cr
|
#' @param plot_ref (scalar `logical`)\cr
|
||||||
## #' logical indicating whether to remove header rows
|
#' plot reference values
|
||||||
## #' for categorical variables. Default is `TRUE`
|
#' @param remove_header_rows (scalar `logical`)\cr
|
||||||
## #' @param remove_reference_rows (scalar `logical`)\cr
|
#' logical indicating whether to remove header rows
|
||||||
## #' logical indicating whether to remove reference rows
|
#' for categorical variables. Default is `TRUE`
|
||||||
## #' for categorical variables. Default is `FALSE`.
|
#' @param remove_reference_rows (scalar `logical`)\cr
|
||||||
|
#' logical indicating whether to remove reference rows
|
||||||
|
#' for categorical variables. Default is `FALSE`.
|
||||||
#' @param ... arguments passed to `ggstats::ggcoef_plot(...)`
|
#' @param ... arguments passed to `ggstats::ggcoef_plot(...)`
|
||||||
#'
|
#'
|
||||||
#' @returns ggplot object
|
#' @returns ggplot object
|
||||||
|
@ -6911,8 +7005,8 @@ update_variables_server <- function(id,
|
||||||
|
|
||||||
output$data_info <- shiny::renderUI({
|
output$data_info <- shiny::renderUI({
|
||||||
shiny::req(data_r())
|
shiny::req(data_r())
|
||||||
data <- data_r()
|
data_description(data_r())
|
||||||
sprintf(i18n("Data has %s observations and %s variables."), nrow(data), ncol(data))
|
# sprintf(i18n("Data has %s observations and %s variables."), nrow(data), ncol(data))
|
||||||
})
|
})
|
||||||
|
|
||||||
variables_r <- shiny::reactive({
|
variables_r <- shiny::reactive({
|
||||||
|
@ -7438,10 +7532,10 @@ convert_to <- function(data,
|
||||||
setNames(list(expr(as.character(!!sym(variable)))), variable)
|
setNames(list(expr(as.character(!!sym(variable)))), variable)
|
||||||
)
|
)
|
||||||
} else if (identical(new_class, "factor")) {
|
} else if (identical(new_class, "factor")) {
|
||||||
data[[variable]] <- as.factor(x = data[[variable]])
|
data[[variable]] <- REDCapCAST::as_factor(x = data[[variable]])
|
||||||
attr(data, "code_03_convert") <- c(
|
attr(data, "code_03_convert") <- c(
|
||||||
attr(data, "code_03_convert"),
|
attr(data, "code_03_convert"),
|
||||||
setNames(list(expr(as.factor(!!sym(variable)))), variable)
|
setNames(list(expr(REDCapCAST::as_factor(!!sym(variable)))), variable)
|
||||||
)
|
)
|
||||||
} else if (identical(new_class, "numeric")) {
|
} else if (identical(new_class, "numeric")) {
|
||||||
data[[variable]] <- as.numeric(data[[variable]], ...)
|
data[[variable]] <- as.numeric(data[[variable]], ...)
|
||||||
|
@ -7840,6 +7934,8 @@ ui_elements <- list(
|
||||||
condition = "input.source=='redcap'",
|
condition = "input.source=='redcap'",
|
||||||
DT::DTOutput(outputId = "redcap_prev")
|
DT::DTOutput(outputId = "redcap_prev")
|
||||||
),
|
),
|
||||||
|
shiny::conditionalPanel(
|
||||||
|
condition = "output.data_loaded == true",
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::h5("Specify variables to include"),
|
shiny::h5("Specify variables to include"),
|
||||||
|
@ -7856,7 +7952,7 @@ ui_elements <- list(
|
||||||
shinyWidgets::noUiSliderInput(
|
shinyWidgets::noUiSliderInput(
|
||||||
inputId = "complete_cutoff",
|
inputId = "complete_cutoff",
|
||||||
label = NULL,
|
label = NULL,
|
||||||
update_on = "change",
|
update_on = "end",
|
||||||
min = 0,
|
min = 0,
|
||||||
max = 100,
|
max = 100,
|
||||||
step = 5,
|
step = 5,
|
||||||
|
@ -7864,12 +7960,13 @@ 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("Filter variables with completeness above the specified percentage."),
|
shiny::helpText("Exclude variables with completeness below the specified percentage."),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::uiOutput(outputId = "import_var"),
|
shiny::uiOutput(outputId = "import_var"),
|
||||||
shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
|
shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
|
||||||
)
|
)
|
||||||
|
)
|
||||||
),
|
),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
|
@ -7952,36 +8049,20 @@ ui_elements <- list(
|
||||||
fluidRow(
|
fluidRow(
|
||||||
shiny::column(
|
shiny::column(
|
||||||
width = 9,
|
width = 9,
|
||||||
shiny::tags$p(shiny::markdown("Below, are several options to update variables (rename, set new labels (for nicer tables in the report) and change variable classes (numeric, factor/categorical etc.).), modify factor/categorical variables as well as create new factor from a continous variable or new variables with *R* code."))
|
shiny::tags$p(shiny::markdown("Below, are several options for simple data manipulation like update variables by renaming, creating new labels (for nicer tables in the report) and changing variable classes (numeric, factor/categorical etc.)."),
|
||||||
|
shiny::tags$p("There are also more advanced options to modify factor/categorical variables as well as create new factor from a continous variable or new variables with *R* code. At the bottom you can restore the original data."))
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
shiny::tags$br(),
|
# shiny::tags$br(),
|
||||||
shiny::tags$br(),
|
|
||||||
update_variables_ui("modal_variables"),
|
update_variables_ui("modal_variables"),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
fluidRow(
|
|
||||||
shiny::column(
|
|
||||||
width = 2
|
|
||||||
),
|
|
||||||
shiny::column(
|
|
||||||
width = 8,
|
|
||||||
tags$h4("Advanced data manipulation"),
|
tags$h4("Advanced data manipulation"),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
fluidRow(
|
shiny::tags$br(),
|
||||||
|
shiny::fluidRow(
|
||||||
shiny::column(
|
shiny::column(
|
||||||
width = 6,
|
width = 4,
|
||||||
# tags$h4("Update or modify variables"),
|
|
||||||
# shiny::tags$br(),
|
|
||||||
# shiny::actionButton(
|
|
||||||
# inputId = "modal_variables",
|
|
||||||
# label = "Subset, rename and change class/type",
|
|
||||||
# width = "100%"
|
|
||||||
# ),
|
|
||||||
# shiny::tags$br(),
|
|
||||||
# shiny::helpText("Subset variables, rename variables and labels, and apply new class to variables"),
|
|
||||||
# shiny::tags$br(),
|
|
||||||
# shiny::tags$br(),
|
|
||||||
shiny::actionButton(
|
shiny::actionButton(
|
||||||
inputId = "modal_update",
|
inputId = "modal_update",
|
||||||
label = "Reorder factor levels",
|
label = "Reorder factor levels",
|
||||||
|
@ -7989,7 +8070,50 @@ ui_elements <- list(
|
||||||
),
|
),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
shiny::helpText("Reorder the levels of factor/categorical variables."),
|
shiny::helpText("Reorder the levels of factor/categorical variables."),
|
||||||
|
),
|
||||||
|
shiny::column(
|
||||||
|
width = 4,
|
||||||
|
shiny::actionButton(
|
||||||
|
inputId = "modal_cut",
|
||||||
|
label = "New factor",
|
||||||
|
width = "100%"
|
||||||
|
),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
|
shiny::helpText("Create factor/categorical variable from a continous variable (number/date/time).")
|
||||||
|
),
|
||||||
|
shiny::column(
|
||||||
|
width = 4,
|
||||||
|
shiny::actionButton(
|
||||||
|
inputId = "modal_column",
|
||||||
|
label = "New variable",
|
||||||
|
width = "100%"
|
||||||
|
),
|
||||||
|
shiny::tags$br(),
|
||||||
|
shiny::helpText(shiny::markdown("Create a new variable/column based on an *R*-expression."))
|
||||||
|
)
|
||||||
|
),
|
||||||
|
shiny::tags$br(),
|
||||||
|
shiny::tags$br(),
|
||||||
|
tags$h4("Compare modified data to original"),
|
||||||
|
shiny::tags$br(),
|
||||||
|
shiny::tags$p(
|
||||||
|
"Raw print of the original vs the modified data."
|
||||||
|
),
|
||||||
|
shiny::tags$br(),
|
||||||
|
shiny::fluidRow(
|
||||||
|
shiny::column(
|
||||||
|
width = 6,
|
||||||
|
shiny::tags$b("Original data:"),
|
||||||
|
# verbatimTextOutput("original"),
|
||||||
|
shiny::verbatimTextOutput("original_str")
|
||||||
|
),
|
||||||
|
shiny::column(
|
||||||
|
width = 6,
|
||||||
|
shiny::tags$b("Modified data:"),
|
||||||
|
# verbatimTextOutput("modified"),
|
||||||
|
shiny::verbatimTextOutput("modified_str")
|
||||||
|
)
|
||||||
|
),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
shiny::actionButton(
|
shiny::actionButton(
|
||||||
inputId = "data_reset",
|
inputId = "data_reset",
|
||||||
|
@ -7998,69 +8122,7 @@ ui_elements <- list(
|
||||||
),
|
),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."),
|
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."),
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::tags$br()
|
shiny::tags$br()
|
||||||
),
|
|
||||||
shiny::column(
|
|
||||||
width = 6,
|
|
||||||
# tags$h4("Create new variables"),
|
|
||||||
# shiny::tags$br(),
|
|
||||||
shiny::actionButton(
|
|
||||||
inputId = "modal_cut",
|
|
||||||
label = "New factor",
|
|
||||||
width = "100%"
|
|
||||||
),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::helpText("Create factor/categorical variable from a continous variable (number/date/time)."),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::actionButton(
|
|
||||||
inputId = "modal_column",
|
|
||||||
label = "New variable",
|
|
||||||
width = "100%"
|
|
||||||
),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::helpText(shiny::markdown("Create a new variable/column based on an *R*-expression.")),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::tags$br()
|
|
||||||
)
|
|
||||||
) # ,
|
|
||||||
# tags$h4("Restore"),
|
|
||||||
# shiny::actionButton(
|
|
||||||
# inputId = "data_reset",
|
|
||||||
# label = "Restore original data",
|
|
||||||
# width = "100%"
|
|
||||||
# ),
|
|
||||||
# shiny::tags$br(),
|
|
||||||
# shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing.")
|
|
||||||
),
|
|
||||||
shiny::column(
|
|
||||||
width = 2
|
|
||||||
)
|
|
||||||
),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::tags$br(),
|
|
||||||
tags$h4("Compare modified data to original"),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::tags$p(
|
|
||||||
"Here is a overview of the original vs the modified data."
|
|
||||||
),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::tags$br(),
|
|
||||||
fluidRow(
|
|
||||||
column(
|
|
||||||
width = 6,
|
|
||||||
tags$b("Original data:"),
|
|
||||||
# verbatimTextOutput("original"),
|
|
||||||
verbatimTextOutput("original_str")
|
|
||||||
),
|
|
||||||
column(
|
|
||||||
width = 6,
|
|
||||||
tags$b("Modified data:"),
|
|
||||||
# verbatimTextOutput("modified"),
|
|
||||||
verbatimTextOutput("modified_str")
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
|
@ -8603,19 +8665,34 @@ server <- function(input, output, session) {
|
||||||
)
|
)
|
||||||
})
|
})
|
||||||
|
|
||||||
|
output$data_loaded <- shiny::reactive({
|
||||||
|
!is.null(rv$data_temp)
|
||||||
|
})
|
||||||
|
|
||||||
|
shiny::observeEvent(input$source,{
|
||||||
|
rv$data_temp <- NULL
|
||||||
|
})
|
||||||
|
|
||||||
|
shiny::outputOptions(output, "data_loaded", suspendWhenHidden = FALSE)
|
||||||
|
|
||||||
shiny::observeEvent(
|
shiny::observeEvent(
|
||||||
eventExpr = list(
|
eventExpr = list(
|
||||||
input$import_var,
|
input$import_var,
|
||||||
input$complete_cutoff
|
input$complete_cutoff,
|
||||||
|
rv$data_temp
|
||||||
),
|
),
|
||||||
handlerExpr = {
|
handlerExpr = {
|
||||||
shiny::req(rv$data_temp)
|
shiny::req(rv$data_temp)
|
||||||
# browser()
|
# browser()
|
||||||
rv$data_original <- rv$data_temp |>
|
temp_data <- rv$data_temp
|
||||||
dplyr::select(input$import_var) |>
|
if (all(input$import_var %in% names(temp_data))){
|
||||||
|
temp_data <- temp_data |> dplyr::select(input$import_var)
|
||||||
|
}
|
||||||
|
|
||||||
|
rv$data_original <- temp_data |>
|
||||||
default_parsing()
|
default_parsing()
|
||||||
|
|
||||||
|
|
||||||
rv$code$import <- rv$code$import |>
|
rv$code$import <- rv$code$import |>
|
||||||
deparse() |>
|
deparse() |>
|
||||||
paste(collapse = "") |>
|
paste(collapse = "") |>
|
||||||
|
@ -8628,7 +8705,7 @@ server <- function(input, output, session) {
|
||||||
|
|
||||||
rv$code$filter <- NULL
|
rv$code$filter <- NULL
|
||||||
rv$code$modify <- NULL
|
rv$code$modify <- NULL
|
||||||
}
|
},ignoreNULL = FALSE
|
||||||
)
|
)
|
||||||
|
|
||||||
output$data_info_import <- shiny::renderUI({
|
output$data_info_import <- shiny::renderUI({
|
||||||
|
@ -8653,8 +8730,7 @@ server <- function(input, output, session) {
|
||||||
|
|
||||||
shiny::observeEvent(
|
shiny::observeEvent(
|
||||||
eventExpr = list(
|
eventExpr = list(
|
||||||
rv$data_original,
|
rv$data_original
|
||||||
input$complete_cutoff
|
|
||||||
),
|
),
|
||||||
handlerExpr = {
|
handlerExpr = {
|
||||||
shiny::req(rv$data_original)
|
shiny::req(rv$data_original)
|
||||||
|
|
|
@ -5,6 +5,6 @@ account: agdamsbo
|
||||||
server: shinyapps.io
|
server: shinyapps.io
|
||||||
hostUrl: https://api.shinyapps.io/v1
|
hostUrl: https://api.shinyapps.io/v1
|
||||||
appId: 13611288
|
appId: 13611288
|
||||||
bundleId: 10042980
|
bundleId: 10049531
|
||||||
url: https://agdamsbo.shinyapps.io/freesearcheR/
|
url: https://agdamsbo.shinyapps.io/freesearcheR/
|
||||||
version: 1
|
version: 1
|
||||||
|
|
|
@ -158,19 +158,34 @@ server <- function(input, output, session) {
|
||||||
)
|
)
|
||||||
})
|
})
|
||||||
|
|
||||||
|
output$data_loaded <- shiny::reactive({
|
||||||
|
!is.null(rv$data_temp)
|
||||||
|
})
|
||||||
|
|
||||||
|
shiny::observeEvent(input$source,{
|
||||||
|
rv$data_temp <- NULL
|
||||||
|
})
|
||||||
|
|
||||||
|
shiny::outputOptions(output, "data_loaded", suspendWhenHidden = FALSE)
|
||||||
|
|
||||||
shiny::observeEvent(
|
shiny::observeEvent(
|
||||||
eventExpr = list(
|
eventExpr = list(
|
||||||
input$import_var,
|
input$import_var,
|
||||||
input$complete_cutoff
|
input$complete_cutoff,
|
||||||
|
rv$data_temp
|
||||||
),
|
),
|
||||||
handlerExpr = {
|
handlerExpr = {
|
||||||
shiny::req(rv$data_temp)
|
shiny::req(rv$data_temp)
|
||||||
# browser()
|
# browser()
|
||||||
rv$data_original <- rv$data_temp |>
|
temp_data <- rv$data_temp
|
||||||
dplyr::select(input$import_var) |>
|
if (all(input$import_var %in% names(temp_data))){
|
||||||
|
temp_data <- temp_data |> dplyr::select(input$import_var)
|
||||||
|
}
|
||||||
|
|
||||||
|
rv$data_original <- temp_data |>
|
||||||
default_parsing()
|
default_parsing()
|
||||||
|
|
||||||
|
|
||||||
rv$code$import <- rv$code$import |>
|
rv$code$import <- rv$code$import |>
|
||||||
deparse() |>
|
deparse() |>
|
||||||
paste(collapse = "") |>
|
paste(collapse = "") |>
|
||||||
|
@ -183,7 +198,7 @@ server <- function(input, output, session) {
|
||||||
|
|
||||||
rv$code$filter <- NULL
|
rv$code$filter <- NULL
|
||||||
rv$code$modify <- NULL
|
rv$code$modify <- NULL
|
||||||
}
|
},ignoreNULL = FALSE
|
||||||
)
|
)
|
||||||
|
|
||||||
output$data_info_import <- shiny::renderUI({
|
output$data_info_import <- shiny::renderUI({
|
||||||
|
@ -208,8 +223,7 @@ server <- function(input, output, session) {
|
||||||
|
|
||||||
shiny::observeEvent(
|
shiny::observeEvent(
|
||||||
eventExpr = list(
|
eventExpr = list(
|
||||||
rv$data_original,
|
rv$data_original
|
||||||
input$complete_cutoff
|
|
||||||
),
|
),
|
||||||
handlerExpr = {
|
handlerExpr = {
|
||||||
shiny::req(rv$data_original)
|
shiny::req(rv$data_original)
|
||||||
|
|
|
@ -68,6 +68,8 @@ ui_elements <- list(
|
||||||
condition = "input.source=='redcap'",
|
condition = "input.source=='redcap'",
|
||||||
DT::DTOutput(outputId = "redcap_prev")
|
DT::DTOutput(outputId = "redcap_prev")
|
||||||
),
|
),
|
||||||
|
shiny::conditionalPanel(
|
||||||
|
condition = "output.data_loaded == true",
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::h5("Specify variables to include"),
|
shiny::h5("Specify variables to include"),
|
||||||
|
@ -84,7 +86,7 @@ ui_elements <- list(
|
||||||
shinyWidgets::noUiSliderInput(
|
shinyWidgets::noUiSliderInput(
|
||||||
inputId = "complete_cutoff",
|
inputId = "complete_cutoff",
|
||||||
label = NULL,
|
label = NULL,
|
||||||
update_on = "change",
|
update_on = "end",
|
||||||
min = 0,
|
min = 0,
|
||||||
max = 100,
|
max = 100,
|
||||||
step = 5,
|
step = 5,
|
||||||
|
@ -92,12 +94,13 @@ 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("Filter variables with completeness above the specified percentage."),
|
shiny::helpText("Exclude variables with completeness below the specified percentage."),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::uiOutput(outputId = "import_var"),
|
shiny::uiOutput(outputId = "import_var"),
|
||||||
shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
|
shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
|
||||||
)
|
)
|
||||||
|
)
|
||||||
),
|
),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
|
@ -180,36 +183,20 @@ ui_elements <- list(
|
||||||
fluidRow(
|
fluidRow(
|
||||||
shiny::column(
|
shiny::column(
|
||||||
width = 9,
|
width = 9,
|
||||||
shiny::tags$p(shiny::markdown("Below, are several options to update variables (rename, set new labels (for nicer tables in the report) and change variable classes (numeric, factor/categorical etc.).), modify factor/categorical variables as well as create new factor from a continous variable or new variables with *R* code."))
|
shiny::tags$p(shiny::markdown("Below, are several options for simple data manipulation like update variables by renaming, creating new labels (for nicer tables in the report) and changing variable classes (numeric, factor/categorical etc.)."),
|
||||||
|
shiny::tags$p("There are also more advanced options to modify factor/categorical variables as well as create new factor from a continous variable or new variables with *R* code. At the bottom you can restore the original data."))
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
shiny::tags$br(),
|
# shiny::tags$br(),
|
||||||
shiny::tags$br(),
|
|
||||||
update_variables_ui("modal_variables"),
|
update_variables_ui("modal_variables"),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
fluidRow(
|
|
||||||
shiny::column(
|
|
||||||
width = 2
|
|
||||||
),
|
|
||||||
shiny::column(
|
|
||||||
width = 8,
|
|
||||||
tags$h4("Advanced data manipulation"),
|
tags$h4("Advanced data manipulation"),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
fluidRow(
|
shiny::tags$br(),
|
||||||
|
shiny::fluidRow(
|
||||||
shiny::column(
|
shiny::column(
|
||||||
width = 6,
|
width = 4,
|
||||||
# tags$h4("Update or modify variables"),
|
|
||||||
# shiny::tags$br(),
|
|
||||||
# shiny::actionButton(
|
|
||||||
# inputId = "modal_variables",
|
|
||||||
# label = "Subset, rename and change class/type",
|
|
||||||
# width = "100%"
|
|
||||||
# ),
|
|
||||||
# shiny::tags$br(),
|
|
||||||
# shiny::helpText("Subset variables, rename variables and labels, and apply new class to variables"),
|
|
||||||
# shiny::tags$br(),
|
|
||||||
# shiny::tags$br(),
|
|
||||||
shiny::actionButton(
|
shiny::actionButton(
|
||||||
inputId = "modal_update",
|
inputId = "modal_update",
|
||||||
label = "Reorder factor levels",
|
label = "Reorder factor levels",
|
||||||
|
@ -217,7 +204,50 @@ ui_elements <- list(
|
||||||
),
|
),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
shiny::helpText("Reorder the levels of factor/categorical variables."),
|
shiny::helpText("Reorder the levels of factor/categorical variables."),
|
||||||
|
),
|
||||||
|
shiny::column(
|
||||||
|
width = 4,
|
||||||
|
shiny::actionButton(
|
||||||
|
inputId = "modal_cut",
|
||||||
|
label = "New factor",
|
||||||
|
width = "100%"
|
||||||
|
),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
|
shiny::helpText("Create factor/categorical variable from a continous variable (number/date/time).")
|
||||||
|
),
|
||||||
|
shiny::column(
|
||||||
|
width = 4,
|
||||||
|
shiny::actionButton(
|
||||||
|
inputId = "modal_column",
|
||||||
|
label = "New variable",
|
||||||
|
width = "100%"
|
||||||
|
),
|
||||||
|
shiny::tags$br(),
|
||||||
|
shiny::helpText(shiny::markdown("Create a new variable/column based on an *R*-expression."))
|
||||||
|
)
|
||||||
|
),
|
||||||
|
shiny::tags$br(),
|
||||||
|
shiny::tags$br(),
|
||||||
|
tags$h4("Compare modified data to original"),
|
||||||
|
shiny::tags$br(),
|
||||||
|
shiny::tags$p(
|
||||||
|
"Raw print of the original vs the modified data."
|
||||||
|
),
|
||||||
|
shiny::tags$br(),
|
||||||
|
shiny::fluidRow(
|
||||||
|
shiny::column(
|
||||||
|
width = 6,
|
||||||
|
shiny::tags$b("Original data:"),
|
||||||
|
# verbatimTextOutput("original"),
|
||||||
|
shiny::verbatimTextOutput("original_str")
|
||||||
|
),
|
||||||
|
shiny::column(
|
||||||
|
width = 6,
|
||||||
|
shiny::tags$b("Modified data:"),
|
||||||
|
# verbatimTextOutput("modified"),
|
||||||
|
shiny::verbatimTextOutput("modified_str")
|
||||||
|
)
|
||||||
|
),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
shiny::actionButton(
|
shiny::actionButton(
|
||||||
inputId = "data_reset",
|
inputId = "data_reset",
|
||||||
|
@ -226,69 +256,7 @@ ui_elements <- list(
|
||||||
),
|
),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."),
|
shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."),
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::tags$br()
|
shiny::tags$br()
|
||||||
),
|
|
||||||
shiny::column(
|
|
||||||
width = 6,
|
|
||||||
# tags$h4("Create new variables"),
|
|
||||||
# shiny::tags$br(),
|
|
||||||
shiny::actionButton(
|
|
||||||
inputId = "modal_cut",
|
|
||||||
label = "New factor",
|
|
||||||
width = "100%"
|
|
||||||
),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::helpText("Create factor/categorical variable from a continous variable (number/date/time)."),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::actionButton(
|
|
||||||
inputId = "modal_column",
|
|
||||||
label = "New variable",
|
|
||||||
width = "100%"
|
|
||||||
),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::helpText(shiny::markdown("Create a new variable/column based on an *R*-expression.")),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::tags$br()
|
|
||||||
)
|
|
||||||
) # ,
|
|
||||||
# tags$h4("Restore"),
|
|
||||||
# shiny::actionButton(
|
|
||||||
# inputId = "data_reset",
|
|
||||||
# label = "Restore original data",
|
|
||||||
# width = "100%"
|
|
||||||
# ),
|
|
||||||
# shiny::tags$br(),
|
|
||||||
# shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing.")
|
|
||||||
),
|
|
||||||
shiny::column(
|
|
||||||
width = 2
|
|
||||||
)
|
|
||||||
),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::tags$br(),
|
|
||||||
tags$h4("Compare modified data to original"),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::tags$p(
|
|
||||||
"Here is a overview of the original vs the modified data."
|
|
||||||
),
|
|
||||||
shiny::tags$br(),
|
|
||||||
shiny::tags$br(),
|
|
||||||
fluidRow(
|
|
||||||
column(
|
|
||||||
width = 6,
|
|
||||||
tags$b("Original data:"),
|
|
||||||
# verbatimTextOutput("original"),
|
|
||||||
verbatimTextOutput("original_str")
|
|
||||||
),
|
|
||||||
column(
|
|
||||||
width = 6,
|
|
||||||
tags$b("Modified data:"),
|
|
||||||
# verbatimTextOutput("modified"),
|
|
||||||
verbatimTextOutput("modified_str")
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
|
|
24
man/if_not_missing.Rd
Normal file
24
man/if_not_missing.Rd
Normal file
|
@ -0,0 +1,24 @@
|
||||||
|
% Generated by roxygen2: do not edit by hand
|
||||||
|
% Please edit documentation in R/helpers.R
|
||||||
|
\name{if_not_missing}
|
||||||
|
\alias{if_not_missing}
|
||||||
|
\title{Return if available}
|
||||||
|
\usage{
|
||||||
|
if_not_missing(data, default = NULL)
|
||||||
|
}
|
||||||
|
\arguments{
|
||||||
|
\item{data}{vector}
|
||||||
|
|
||||||
|
\item{default}{assigned value for missings}
|
||||||
|
}
|
||||||
|
\value{
|
||||||
|
vector
|
||||||
|
}
|
||||||
|
\description{
|
||||||
|
Return if available
|
||||||
|
}
|
||||||
|
\examples{
|
||||||
|
NULL |> if_not_missing("new")
|
||||||
|
c(2,"a",NA) |> if_not_missing()
|
||||||
|
"See" |> if_not_missing()
|
||||||
|
}
|
|
@ -16,6 +16,17 @@
|
||||||
\item{x}{(\code{tbl_regression}, \code{tbl_uvregression})\cr
|
\item{x}{(\code{tbl_regression}, \code{tbl_uvregression})\cr
|
||||||
A 'tbl_regression' or 'tbl_uvregression' object}
|
A 'tbl_regression' or 'tbl_uvregression' object}
|
||||||
|
|
||||||
|
\item{plot_ref}{(scalar \code{logical})\cr
|
||||||
|
plot reference values}
|
||||||
|
|
||||||
|
\item{remove_header_rows}{(scalar \code{logical})\cr
|
||||||
|
logical indicating whether to remove header rows
|
||||||
|
for categorical variables. Default is \code{TRUE}}
|
||||||
|
|
||||||
|
\item{remove_reference_rows}{(scalar \code{logical})\cr
|
||||||
|
logical indicating whether to remove reference rows
|
||||||
|
for categorical variables. Default is \code{FALSE}.}
|
||||||
|
|
||||||
\item{...}{arguments passed to \code{ggstats::ggcoef_plot(...)}}
|
\item{...}{arguments passed to \code{ggstats::ggcoef_plot(...)}}
|
||||||
}
|
}
|
||||||
\value{
|
\value{
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
\alias{redcap_demo_app}
|
\alias{redcap_demo_app}
|
||||||
\title{Shiny module to browser and export REDCap data}
|
\title{Shiny module to browser and export REDCap data}
|
||||||
\usage{
|
\usage{
|
||||||
m_redcap_readUI(id, title = TRUE)
|
m_redcap_readUI(id, title = TRUE, url = NULL)
|
||||||
|
|
||||||
m_redcap_readServer(id)
|
m_redcap_readServer(id)
|
||||||
|
|
||||||
|
|
|
@ -9,6 +9,7 @@ vignette: >
|
||||||
|
|
||||||
```{r setup, include=FALSE}
|
```{r setup, include=FALSE}
|
||||||
knitr::opts_chunk$set(echo = TRUE,eval = FALSE)
|
knitr::opts_chunk$set(echo = TRUE,eval = FALSE)
|
||||||
|
source(here::here("functions.R"))
|
||||||
```
|
```
|
||||||
|
|
||||||
# Getting started with ***FreesearchR***
|
# Getting started with ***FreesearchR***
|
||||||
|
@ -57,7 +58,25 @@ Currently several data file formats are supported for easy import (csv, txt, xls
|
||||||
|
|
||||||
## Visualise
|
## Visualise
|
||||||
|
|
||||||
- Would be nice to have a table of possible plots, their description and data options
|
Below are the available plot types listed.
|
||||||
|
|
||||||
|
```{r echo = FALSE, eval = TRUE}
|
||||||
|
c("continuous", "dichotomous", "ordinal", "categorical") |>
|
||||||
|
lapply(\(.x){
|
||||||
|
dplyr::bind_cols(
|
||||||
|
dplyr::tibble("Data type"=.x),
|
||||||
|
supported_plots() |>
|
||||||
|
lapply(\(.y){
|
||||||
|
if (.x %in% .y$primary.type){
|
||||||
|
.y[c("descr","note")]|> dplyr::bind_cols()
|
||||||
|
}
|
||||||
|
})|>
|
||||||
|
dplyr::bind_rows() |>
|
||||||
|
setNames(c("Plot type","Description")))
|
||||||
|
}) |>
|
||||||
|
dplyr::bind_rows() |>
|
||||||
|
toastui::datagrid(filters=TRUE,theme="striped")
|
||||||
|
```
|
||||||
|
|
||||||
|
|
||||||
## Regression
|
## Regression
|
||||||
|
|
Loading…
Add table
Reference in a new issue