andreas/FreesearchR
1
0
Fork 0
mirror of https://github.com/agdamsbo/FreesearchR.git synced 2025-09-12 09:59:39 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

data summary module

Browse source
This commit is contained in:
Andreas Gammelgaard Damsbo 2025-01-16 11:24:26 +01:00
parent c02cd4417b
commit 2588cf2b4f
No known key found for this signature in database
7 changed files with 996 additions and 892 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

85
R/data-summary.R
View file

@ -1,35 +1,54 @@
#' Data summary module
#'
#' @param id Module id. (Use 'ns("id")')
#'
#' @name data-summary
#' @returns Shiny ui module
#' @export
data_summary_ui <- function(id) { data_summary_ui <- function(id) {
ns <- NS(id) ns <- NS(id)
toastui::datagridOutput(outputId = "tbl_summary") toastui::datagridOutput(outputId = ns("tbl_summary"))
} }
#' @param id id
#' @param data data
#' @param color.main main color
#' @param color.sec secondary color
#'
#' @name data-summary
#' @returns shiny server module
#' @export
data_summary_server <- function(id, data_summary_server <- function(id,
data) { data,
color.main,
color.sec) {
shiny::moduleServer( shiny::moduleServer(
id = id, id = id,
module = function(input, output, session) { module = function(input, output, session) {
ns <- session$ns ns <- session$ns
data_r <- shiny::reactive({ # data_r <- shiny::reactive({
if (shiny::is.reactive(data)) { # if (shiny::is.reactive(data)) {
data() # data()
} else { # } else {
data # data
} # }
}) # })
output$tbl_summary <- shiny::reactive({ output$tbl_summary <-
toastui::renderDatagrid( toastui::renderDatagrid(
data_r() |> data() |>
overview_vars() |> overview_vars() |>
create_overview_datagrid() |> create_overview_datagrid() |>
add_sparkline( add_sparkline(
column = "vals" column = "vals",
) color.main = color.main,
) color.sec = color.sec
}) )
)
} }
) )
} }
@ -61,7 +80,7 @@ add_sparkline <- function(grid, column = "vals", color.main = "#2a8484", color.s
ds <- data.frame(x = names(s), y = s) ds <- data.frame(x = names(s), y = s)
horizontal <- FALSE horizontal <- FALSE
} else if (any(c("numeric", "integer") %in% data_cl)) { } else if (any(c("numeric", "integer") %in% data_cl)) {
if (length(unique(data)) == length(data)) { if (is_consecutive(data)) {
type <- "line" type <- "line"
ds <- data.frame(x = NA, y = NA) ds <- data.frame(x = NA, y = NA)
horizontal <- FALSE horizontal <- FALSE
@ -103,6 +122,20 @@ add_sparkline <- function(grid, column = "vals", color.main = "#2a8484", color.s
) )
} }
#' Checks if elements in vector are equally spaced as indication of ID
#'
#' @param data vector
#'
#' @returns
#' @export
#'
#' @examples
#' 1:10 |> is_consecutive()
#' sample(1:100,40) |> is_consecutive()
is_consecutive <- function(data){
suppressWarnings(length(unique(diff(as.numeric(data))))==1)
}
#' Create a data overview data.frame ready for sparklines #' Create a data overview data.frame ready for sparklines
#' #'
#' @param data data #' @param data data
@ -182,11 +215,11 @@ create_overview_datagrid <- function(data) {
column = "class" column = "class"
) )
# grid <- toastui::grid_format( grid <- toastui::grid_format(
# grid = grid, grid = grid,
# "p_complete", "p_complete",
# formatter = toastui::JS("function(obj) {return (obj.value*100).toFixed(0) + '%';}") formatter = toastui::JS("function(obj) {return (obj.value*100).toFixed(0) + '%';}")
# ) )
return(grid) return(grid)
} }
@ -209,9 +242,9 @@ add_class_icon <- function(grid, column = "class") {
X = value, X = value,
FUN = function(x) { FUN = function(x) {
if (identical(x, "numeric")) { if (identical(x, "numeric")) {
shiny::icon("chart-line") shiny::icon("calculator")
} else if (identical(x, "factor")) { } else if (identical(x, "factor")) {
shiny::icon("chart-column") shiny::icon("chart-simple")
} else if (identical(x, "integer")) { } else if (identical(x, "integer")) {
shiny::icon("arrow-down-1-9") shiny::icon("arrow-down-1-9")
} else if (identical(x, "character")) { } else if (identical(x, "character")) {

34
R/sparkline_h_minimal.R
View file

@ -1,34 +0,0 @@
# dependencies
library(apexcharter)
library(toastui)
spark_data <- mtcars |>
(\(.x){
dplyr::tibble(
name = names(.x),
vals = as.list(.x)
)
})()
ui <- fluidPage(
toastui::datagridOutput("tbl")
)
server <- function(input, output) {
output$tbl <- toastui::renderDatagrid(
spark_data |>
toastui::datagrid() |>
toastui::grid_sparkline(
column = "vals",
renderer = function(data) {
apex(data.frame(x = 1, y = data), aes(x, y), type = "box") |>
ax_chart(sparkline = list(enabled = TRUE)) |>
ax_plotOptions(
bar = bar_opts(horizontal=TRUE)
)
}
)
)
}
shinyApp(ui = ui, server = server)

1
R/update-variables-ext.R
View file

@ -13,7 +13,6 @@ library(rlang)
#' #'
#' @name update-variables #' @name update-variables
#' #'
#' @example examples/variables.R
update_variables_ui <- function(id, title = TRUE) { update_variables_ui <- function(id, title = TRUE) {
ns <- NS(id) ns <- NS(id)
if (isTRUE(title)) { if (isTRUE(title)) {

1611
inst/apps/data_analysis_modules/app.R
View file

File diff suppressed because it is too large Load diff

2
inst/apps/data_analysis_modules/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
View file

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

135
inst/apps/data_analysis_modules/server.R
View file

@ -145,40 +145,58 @@ server <- function(input, output, session) {
######### #########
############################################################################## ##############################################################################
shiny::observeEvent(rv$data_original, rv$data <- rv$data_original |> default_parsing()) shiny::observeEvent(rv$data_original, {
shiny::observeEvent(input$data_reset, rv$data <- rv$data_original |> default_parsing()) rv$data <- rv$data_original |> default_parsing()
})
shiny::observeEvent(input$data_reset, {
shinyWidgets::ask_confirmation(
inputId = "reset_confirm",
title = "Please confirm data reset?"
)
})
shiny::observeEvent(input$reset_confirm, {
rv$data <- rv$data_original |> default_parsing()
})
######### Overview ######### Overview
output$tbl_overview <- toastui::renderDatagrid( data_summary_server(
data_filter() |> id = "data_summary",
overview_vars() |> data = shiny::reactive({
create_overview_datagrid()|> rv$data_filtered
add_sparkline( }),
column = "vals", color.main = "#2A004E",
color.main = "#2A004E", color.sec = "#C62300"
color.sec = "#C62300"
)
) )
# data_summary_server(id = "data_summary", #########
# data = data_filter())
######### Modifications ######### Modifications
#########
## Using modified version of the datamods::cut_variable_server function ## Using modified version of the datamods::cut_variable_server function
## Further modifications are needed to have cut/bin options based on class of variable ## Further modifications are needed to have cut/bin options based on class of variable
## Could be defined server-side ## Could be defined server-side
shiny::observeEvent(input$modal_cut, modal_cut_variable("modal_cut"))
######### Create factor
shiny::observeEvent(
input$modal_cut,
modal_cut_variable("modal_cut")
)
data_modal_cut <- cut_variable_server( data_modal_cut <- cut_variable_server(
id = "modal_cut", id = "modal_cut",
data_r = shiny::reactive(rv$data) data_r = shiny::reactive(rv$data)
) )
shiny::observeEvent(data_modal_cut(), rv$data <- data_modal_cut()) shiny::observeEvent(data_modal_cut(), rv$data <- data_modal_cut())
######### Modify factor
shiny::observeEvent(input$modal_update, datamods::modal_update_factor("modal_update")) shiny::observeEvent(
input$modal_update,
datamods::modal_update_factor(id = "modal_update")
)
data_modal_update <- datamods::update_factor_server( data_modal_update <- datamods::update_factor_server(
id = "modal_update", id = "modal_update",
data_r = reactive(rv$data) data_r = reactive(rv$data)
@ -188,9 +206,20 @@ server <- function(input, output, session) {
rv$data <- data_modal_update() rv$data <- data_modal_update()
}) })
######### Create column
shiny::observeEvent(
input$modal_column,
datamods::modal_create_column(id = "modal_column")
)
data_modal_r <- datamods::create_column_server(
id = "modal_column",
data_r = reactive(rv$data)
)
shiny::observeEvent(data_modal_r(), rv$data <- data_modal_r())
######### Show result
# Show result
output$table_mod <- toastui::renderDatagrid({ output$table_mod <- toastui::renderDatagrid({
shiny::req(rv$data) shiny::req(rv$data)
# data <- rv$data # data <- rv$data
@ -208,7 +237,7 @@ server <- function(input, output, session) {
}) })
# updated_data <- datamods::update_variables_server( # updated_data <- datamods::update_variables_server(
updated_data <- update_variables_server( updated_data <- update_variables_server(
id = "vars_update", id = "vars_update",
data = reactive(rv$data), data = reactive(rv$data),
return_data_on_init = FALSE return_data_on_init = FALSE
@ -219,7 +248,11 @@ server <- function(input, output, session) {
}) })
output$modified_str <- renderPrint({ output$modified_str <- renderPrint({
str(rv$data) str(as.data.frame(rv$data_filtered) |>
REDCapCAST::set_attr(
label = NULL,
attr = "code"
))
}) })
shiny::observeEvent(updated_data(), { shiny::observeEvent(updated_data(), {
@ -229,24 +262,29 @@ server <- function(input, output, session) {
# IDEAFilter has the least cluttered UI, but might have a License issue # IDEAFilter has the least cluttered UI, but might have a License issue
data_filter <- IDEAFilter::IDEAFilter("data_filter", data = reactive(rv$data), verbose = TRUE) data_filter <- IDEAFilter::IDEAFilter("data_filter", data = reactive(rv$data), verbose = TRUE)
# shiny::observeEvent(data_filter(), { shiny::observeEvent(data_filter(), {
# rv$data_filtered <- data_filter() rv$data_filtered <- data_filter()
# }) })
output$filtered_code <- shiny::renderPrint({ output$filtered_code <- shiny::renderPrint({
cat(gsub( out <- gsub(
"%>%", "|> \n ", "filter", "dplyr::filter",
gsub( gsub(
"\\s{2,}", " ", "\\s{2,}", " ",
gsub( paste0(
"reactive(rv$data)", "data", capture.output(attr(rv$data_filtered, "code")),
paste0( collapse = " "
capture.output(attr(data_filter(), "code")),
collapse = " "
)
) )
) )
)) )
out <- strsplit(out, "%>%") |>
unlist() |>
(\(.x){
paste(c("data", .x[-1]), collapse = "|> \n ")
})()
cat(out)
}) })
@ -264,7 +302,7 @@ server <- function(input, output, session) {
inputId = "include_vars", inputId = "include_vars",
selected = NULL, selected = NULL,
label = "Covariables to include", label = "Covariables to include",
choices = colnames(data_filter()), choices = colnames(rv$data_filtered),
multiple = TRUE multiple = TRUE
) )
}) })
@ -274,7 +312,7 @@ server <- function(input, output, session) {
inputId = "outcome_var", inputId = "outcome_var",
selected = NULL, selected = NULL,
label = "Select outcome variable", label = "Select outcome variable",
choices = colnames(data_filter()), choices = colnames(rv$data_filtered),
multiple = FALSE multiple = FALSE
) )
}) })
@ -283,16 +321,16 @@ server <- function(input, output, session) {
output$factor_vars <- shiny::renderUI({ output$factor_vars <- shiny::renderUI({
shiny::selectizeInput( shiny::selectizeInput(
inputId = "factor_vars", inputId = "factor_vars",
selected = colnames(data_filter())[sapply(data_filter(), is.factor)], selected = colnames(rv$data_filtered)[sapply(rv$data_filtered, is.factor)],
label = "Covariables to format as categorical", label = "Covariables to format as categorical",
choices = colnames(data_filter()), choices = colnames(rv$data_filtered),
multiple = TRUE multiple = TRUE
) )
}) })
base_vars <- shiny::reactive({ base_vars <- shiny::reactive({
if (is.null(input$include_vars)) { if (is.null(input$include_vars)) {
out <- colnames(data_filter()) out <- colnames(rv$data_filtered)
} else { } else {
out <- unique(c(input$include_vars, input$outcome_var)) out <- unique(c(input$include_vars, input$outcome_var))
} }
@ -304,7 +342,19 @@ server <- function(input, output, session) {
inputId = "strat_var", inputId = "strat_var",
selected = "none", selected = "none",
label = "Select variable to stratify baseline", label = "Select variable to stratify baseline",
choices = c("none", colnames(data_filter()[base_vars()])), choices = c(
"none",
rv$data_filtered[base_vars()] |>
(\(.x){
lapply(.x, \(.c){
if (identical("factor", class(.c))) {
.c
}
}) |>
dplyr::bind_cols()
})() |>
colnames()
),
multiple = FALSE multiple = FALSE
) )
}) })
@ -340,7 +390,7 @@ server <- function(input, output, session) {
# data <- data_filter$filtered() |> # data <- data_filter$filtered() |>
tryCatch( tryCatch(
{ {
data <- data_filter() |> data <- rv$data_filtered |>
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |> dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |>
REDCapCAST::fct_drop.data.frame() |> REDCapCAST::fct_drop.data.frame() |>
factorize(vars = input$factor_vars) |> factorize(vars = input$factor_vars) |>
@ -577,12 +627,11 @@ server <- function(input, output, session) {
paste0("modified_data.", input$data_type) paste0("modified_data.", input$data_type)
}), }),
content = function(file, type = input$data_type) { content = function(file, type = input$data_type) {
if (type == "rds"){ if (type == "rds") {
readr::write_rds(rv$list$data,file = file) readr::write_rds(rv$list$data, file = file)
} else { } else {
haven::write_dta(as.data.frame(rv$list$data),path = file) haven::write_dta(as.data.frame(rv$list$data), path = file)
} }
} }
) )

20
inst/apps/data_analysis_modules/ui.R
View file

@ -115,15 +115,15 @@ ui_elements <- list(
# ), # ),
shiny::column( shiny::column(
width = 9, width = 9,
toastui::datagridOutput(outputId = "tbl_overview"), data_summary_ui(id = "data_summary")
# data_summary_ui(id = "data_summary"),
shiny::tags$b("Reproducible code:"),
shiny::verbatimTextOutput(outputId = "filtered_code")
), ),
shiny::column( shiny::column(
width = 3, width = 3,
IDEAFilter::IDEAFilter_ui("data_filter") # , IDEAFilter::IDEAFilter_ui("data_filter"),
# shiny::actionButton("save_filter", "Apply the filter") shiny::tags$br(),
shiny::tags$b("Filter code:"),
shiny::verbatimTextOutput(outputId = "filtered_code"),
shiny::tags$br()
) )
), ),
fluidRow( fluidRow(
@ -163,6 +163,8 @@ ui_elements <- list(
), ),
shiny::column( shiny::column(
width = 3, width = 3,
tags$h3("Create new variables"),
shiny::tags$br(),
shiny::actionButton("modal_cut", "Create factor variable"), shiny::actionButton("modal_cut", "Create factor variable"),
shiny::tags$br(), shiny::tags$br(),
shiny::helpText("Create factor/categorical variable from an other value."), shiny::helpText("Create factor/categorical variable from an other value."),
@ -173,6 +175,11 @@ ui_elements <- list(
shiny::helpText("Reorder the levels of factor/categorical variables."), shiny::helpText("Reorder the levels of factor/categorical variables."),
shiny::tags$br(), shiny::tags$br(),
shiny::tags$br(), shiny::tags$br(),
shiny::actionButton("modal_column", "New variable"),
shiny::tags$br(),
shiny::helpText("Create a new variable/column based on an R-expression."),
shiny::tags$br(),
shiny::tags$br(),
shiny::actionButton("data_reset", "Restore original data"), shiny::actionButton("data_reset", "Restore original data"),
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."),
@ -268,6 +275,7 @@ ui_elements <- list(
shiny::uiOutput("include_vars") shiny::uiOutput("include_vars")
), ),
shiny::uiOutput("strat_var"), shiny::uiOutput("strat_var"),
shiny::helpText("Only factor/categorical variables are available for stratification. Go back to the 'Data' tab to reclass a variable if it's not on the list."),
shiny::conditionalPanel( shiny::conditionalPanel(
condition = "input.strat_var!='none'", condition = "input.strat_var!='none'",
shiny::radioButtons( shiny::radioButtons(