mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 09:59:39 +02:00
data summary module
This commit is contained in:
parent
c02cd4417b
commit
2588cf2b4f
7 changed files with 996 additions and 892 deletions
|
|
@ -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) {
|
||||
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) {
|
||||
data,
|
||||
color.main,
|
||||
color.sec) {
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
module = function(input, output, session) {
|
||||
ns <- session$ns
|
||||
|
||||
data_r <- shiny::reactive({
|
||||
if (shiny::is.reactive(data)) {
|
||||
data()
|
||||
} else {
|
||||
data
|
||||
}
|
||||
})
|
||||
# data_r <- shiny::reactive({
|
||||
# if (shiny::is.reactive(data)) {
|
||||
# data()
|
||||
# } else {
|
||||
# data
|
||||
# }
|
||||
# })
|
||||
|
||||
output$tbl_summary <- shiny::reactive({
|
||||
output$tbl_summary <-
|
||||
toastui::renderDatagrid(
|
||||
data_r() |>
|
||||
overview_vars() |>
|
||||
create_overview_datagrid() |>
|
||||
add_sparkline(
|
||||
column = "vals"
|
||||
)
|
||||
)
|
||||
})
|
||||
data() |>
|
||||
overview_vars() |>
|
||||
create_overview_datagrid() |>
|
||||
add_sparkline(
|
||||
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)
|
||||
horizontal <- FALSE
|
||||
} else if (any(c("numeric", "integer") %in% data_cl)) {
|
||||
if (length(unique(data)) == length(data)) {
|
||||
if (is_consecutive(data)) {
|
||||
type <- "line"
|
||||
ds <- data.frame(x = NA, y = NA)
|
||||
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
|
||||
#'
|
||||
#' @param data data
|
||||
|
|
@ -182,11 +215,11 @@ create_overview_datagrid <- function(data) {
|
|||
column = "class"
|
||||
)
|
||||
|
||||
# grid <- toastui::grid_format(
|
||||
# grid = grid,
|
||||
# "p_complete",
|
||||
# formatter = toastui::JS("function(obj) {return (obj.value*100).toFixed(0) + '%';}")
|
||||
# )
|
||||
grid <- toastui::grid_format(
|
||||
grid = grid,
|
||||
"p_complete",
|
||||
formatter = toastui::JS("function(obj) {return (obj.value*100).toFixed(0) + '%';}")
|
||||
)
|
||||
|
||||
return(grid)
|
||||
}
|
||||
|
|
@ -209,9 +242,9 @@ add_class_icon <- function(grid, column = "class") {
|
|||
X = value,
|
||||
FUN = function(x) {
|
||||
if (identical(x, "numeric")) {
|
||||
shiny::icon("chart-line")
|
||||
shiny::icon("calculator")
|
||||
} else if (identical(x, "factor")) {
|
||||
shiny::icon("chart-column")
|
||||
shiny::icon("chart-simple")
|
||||
} else if (identical(x, "integer")) {
|
||||
shiny::icon("arrow-down-1-9")
|
||||
} else if (identical(x, "character")) {
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
@ -13,7 +13,6 @@ library(rlang)
|
|||
#'
|
||||
#' @name update-variables
|
||||
#'
|
||||
#' @example examples/variables.R
|
||||
update_variables_ui <- function(id, title = TRUE) {
|
||||
ns <- NS(id)
|
||||
if (isTRUE(title)) {
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -5,6 +5,6 @@ account: agdamsbo
|
|||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 13611288
|
||||
bundleId: 9641114
|
||||
bundleId: 9652350
|
||||
url: https://agdamsbo.shinyapps.io/freesearcheR/
|
||||
version: 1
|
||||
|
|
|
|||
|
|
@ -145,40 +145,58 @@ server <- function(input, output, session) {
|
|||
#########
|
||||
##############################################################################
|
||||
|
||||
shiny::observeEvent(rv$data_original, rv$data <- rv$data_original |> default_parsing())
|
||||
shiny::observeEvent(input$data_reset, rv$data <- rv$data_original |> default_parsing())
|
||||
shiny::observeEvent(rv$data_original, {
|
||||
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
|
||||
|
||||
output$tbl_overview <- toastui::renderDatagrid(
|
||||
data_filter() |>
|
||||
overview_vars() |>
|
||||
create_overview_datagrid()|>
|
||||
add_sparkline(
|
||||
column = "vals",
|
||||
color.main = "#2A004E",
|
||||
color.sec = "#C62300"
|
||||
)
|
||||
data_summary_server(
|
||||
id = "data_summary",
|
||||
data = shiny::reactive({
|
||||
rv$data_filtered
|
||||
}),
|
||||
color.main = "#2A004E",
|
||||
color.sec = "#C62300"
|
||||
)
|
||||
|
||||
# data_summary_server(id = "data_summary",
|
||||
# data = data_filter())
|
||||
|
||||
#########
|
||||
######### Modifications
|
||||
|
||||
#########
|
||||
|
||||
## Using modified version of the datamods::cut_variable_server function
|
||||
## Further modifications are needed to have cut/bin options based on class of variable
|
||||
## 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(
|
||||
id = "modal_cut",
|
||||
data_r = shiny::reactive(rv$data)
|
||||
)
|
||||
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(
|
||||
id = "modal_update",
|
||||
data_r = reactive(rv$data)
|
||||
|
|
@ -188,9 +206,20 @@ server <- function(input, output, session) {
|
|||
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({
|
||||
shiny::req(rv$data)
|
||||
# data <- rv$data
|
||||
|
|
@ -208,7 +237,7 @@ server <- function(input, output, session) {
|
|||
})
|
||||
|
||||
# updated_data <- datamods::update_variables_server(
|
||||
updated_data <- update_variables_server(
|
||||
updated_data <- update_variables_server(
|
||||
id = "vars_update",
|
||||
data = reactive(rv$data),
|
||||
return_data_on_init = FALSE
|
||||
|
|
@ -219,7 +248,11 @@ server <- function(input, output, session) {
|
|||
})
|
||||
|
||||
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(), {
|
||||
|
|
@ -229,24 +262,29 @@ server <- function(input, output, session) {
|
|||
# IDEAFilter has the least cluttered UI, but might have a License issue
|
||||
data_filter <- IDEAFilter::IDEAFilter("data_filter", data = reactive(rv$data), verbose = TRUE)
|
||||
|
||||
# shiny::observeEvent(data_filter(), {
|
||||
# rv$data_filtered <- data_filter()
|
||||
# })
|
||||
shiny::observeEvent(data_filter(), {
|
||||
rv$data_filtered <- data_filter()
|
||||
})
|
||||
|
||||
output$filtered_code <- shiny::renderPrint({
|
||||
cat(gsub(
|
||||
"%>%", "|> \n ",
|
||||
out <- gsub(
|
||||
"filter", "dplyr::filter",
|
||||
gsub(
|
||||
"\\s{2,}", " ",
|
||||
gsub(
|
||||
"reactive(rv$data)", "data",
|
||||
paste0(
|
||||
capture.output(attr(data_filter(), "code")),
|
||||
collapse = " "
|
||||
)
|
||||
paste0(
|
||||
capture.output(attr(rv$data_filtered, "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",
|
||||
selected = NULL,
|
||||
label = "Covariables to include",
|
||||
choices = colnames(data_filter()),
|
||||
choices = colnames(rv$data_filtered),
|
||||
multiple = TRUE
|
||||
)
|
||||
})
|
||||
|
|
@ -274,7 +312,7 @@ server <- function(input, output, session) {
|
|||
inputId = "outcome_var",
|
||||
selected = NULL,
|
||||
label = "Select outcome variable",
|
||||
choices = colnames(data_filter()),
|
||||
choices = colnames(rv$data_filtered),
|
||||
multiple = FALSE
|
||||
)
|
||||
})
|
||||
|
|
@ -283,16 +321,16 @@ server <- function(input, output, session) {
|
|||
output$factor_vars <- shiny::renderUI({
|
||||
shiny::selectizeInput(
|
||||
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",
|
||||
choices = colnames(data_filter()),
|
||||
choices = colnames(rv$data_filtered),
|
||||
multiple = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
base_vars <- shiny::reactive({
|
||||
if (is.null(input$include_vars)) {
|
||||
out <- colnames(data_filter())
|
||||
out <- colnames(rv$data_filtered)
|
||||
} else {
|
||||
out <- unique(c(input$include_vars, input$outcome_var))
|
||||
}
|
||||
|
|
@ -304,7 +342,19 @@ server <- function(input, output, session) {
|
|||
inputId = "strat_var",
|
||||
selected = "none",
|
||||
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
|
||||
)
|
||||
})
|
||||
|
|
@ -340,7 +390,7 @@ server <- function(input, output, session) {
|
|||
# data <- data_filter$filtered() |>
|
||||
tryCatch(
|
||||
{
|
||||
data <- data_filter() |>
|
||||
data <- rv$data_filtered |>
|
||||
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor)) |>
|
||||
REDCapCAST::fct_drop.data.frame() |>
|
||||
factorize(vars = input$factor_vars) |>
|
||||
|
|
@ -577,12 +627,11 @@ server <- function(input, output, session) {
|
|||
paste0("modified_data.", input$data_type)
|
||||
}),
|
||||
content = function(file, type = input$data_type) {
|
||||
if (type == "rds"){
|
||||
readr::write_rds(rv$list$data,file = file)
|
||||
if (type == "rds") {
|
||||
readr::write_rds(rv$list$data, file = file)
|
||||
} else {
|
||||
haven::write_dta(as.data.frame(rv$list$data),path = file)
|
||||
haven::write_dta(as.data.frame(rv$list$data), path = file)
|
||||
}
|
||||
|
||||
}
|
||||
)
|
||||
|
||||
|
|
|
|||
|
|
@ -115,15 +115,15 @@ ui_elements <- list(
|
|||
# ),
|
||||
shiny::column(
|
||||
width = 9,
|
||||
toastui::datagridOutput(outputId = "tbl_overview"),
|
||||
# data_summary_ui(id = "data_summary"),
|
||||
shiny::tags$b("Reproducible code:"),
|
||||
shiny::verbatimTextOutput(outputId = "filtered_code")
|
||||
data_summary_ui(id = "data_summary")
|
||||
),
|
||||
shiny::column(
|
||||
width = 3,
|
||||
IDEAFilter::IDEAFilter_ui("data_filter") # ,
|
||||
# shiny::actionButton("save_filter", "Apply the filter")
|
||||
IDEAFilter::IDEAFilter_ui("data_filter"),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$b("Filter code:"),
|
||||
shiny::verbatimTextOutput(outputId = "filtered_code"),
|
||||
shiny::tags$br()
|
||||
)
|
||||
),
|
||||
fluidRow(
|
||||
|
|
@ -163,6 +163,8 @@ ui_elements <- list(
|
|||
),
|
||||
shiny::column(
|
||||
width = 3,
|
||||
tags$h3("Create new variables"),
|
||||
shiny::tags$br(),
|
||||
shiny::actionButton("modal_cut", "Create factor variable"),
|
||||
shiny::tags$br(),
|
||||
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::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::tags$br(),
|
||||
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("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(
|
||||
condition = "input.strat_var!='none'",
|
||||
shiny::radioButtons(
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue