mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 04:27:30 +02:00
docs
This commit is contained in:
parent
c7a9467b47
commit
4c42636faa
8 changed files with 371 additions and 201 deletions
|
|
@ -3996,7 +3996,7 @@ simple_snake <- function(data){
|
|||
#### Current file: /Users/au301842/FreesearchR/R//hosted_version.R
|
||||
########
|
||||
|
||||
hosted_version <- function()'v25.6.3-250625'
|
||||
hosted_version <- function()'v25.6.3-250626'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -4695,7 +4695,8 @@ data_missings_server <- function(id,
|
|||
variabler <- if (is.reactive(variable)) variable else reactive(variable)
|
||||
|
||||
rv <- shiny::reactiveValues(
|
||||
data = NULL
|
||||
data = NULL,
|
||||
table = NULL
|
||||
)
|
||||
|
||||
rv$data <- shiny::reactive({
|
||||
|
|
@ -4726,15 +4727,25 @@ data_missings_server <- function(id,
|
|||
shiny::req(variabler)
|
||||
|
||||
if (is.null(variabler()) || variabler() == "" || !variabler() %in% names(datar())) {
|
||||
if (anyNA(datar())){
|
||||
title <- "No variable chosen for analysis"
|
||||
} else {
|
||||
title <- "No missing observations"
|
||||
}
|
||||
} else {
|
||||
title <- paste("Missing vs non-missing observations in", variabler())
|
||||
title <- glue::glue("Missing vs non-missing observations in the variable **'{variabler()}'**")
|
||||
}
|
||||
|
||||
rv$data() |>
|
||||
out <- rv$data() |>
|
||||
gtsummary::as_gt() |>
|
||||
gt::tab_header(title = gt::md(title))
|
||||
|
||||
rv$table <- out
|
||||
|
||||
out
|
||||
})
|
||||
|
||||
return(reactive(rv$table))
|
||||
}
|
||||
)
|
||||
}
|
||||
|
|
@ -4761,10 +4772,12 @@ missing_demo_app <- function() {
|
|||
|
||||
data_missings_server(id = "data", data = data_demo, variable = shiny::reactive(input$missings_var))
|
||||
|
||||
visual_summary_server(id = "visual", data = data_demo)
|
||||
|
||||
observeEvent(input$modal_missings, {
|
||||
tryCatch(
|
||||
{
|
||||
modal_visual_missings(data = data_demo, id = "modal_missings")
|
||||
modal_visual_summary(id = "visual")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
|
||||
|
|
@ -4778,140 +4791,12 @@ missing_demo_app <- function() {
|
|||
missing_demo_app()
|
||||
|
||||
|
||||
modal_visual_missings <- function(data,
|
||||
title = "Visual overview of data classes and missing observations",
|
||||
easyClose = TRUE,
|
||||
size = "xl",
|
||||
footer = NULL,
|
||||
...) {
|
||||
datar <- if (is.reactive(data)) data else reactive(data)
|
||||
|
||||
showModal(modalDialog(
|
||||
title = tagList(title, datamods:::button_close_modal()),
|
||||
tags$div(
|
||||
# apexcharter::renderApexchart({
|
||||
# missings_apex_plot(datar(), ...)
|
||||
# })
|
||||
shiny::renderPlot({
|
||||
visdat::vis_dat(datar(),sort_type = FALSE) +
|
||||
ggplot2::guides(fill = ggplot2::guide_legend(title = "Data class")) +
|
||||
# ggplot2::theme_void() +
|
||||
ggplot2::theme(
|
||||
# legend.position = "none",
|
||||
panel.grid.major = ggplot2::element_blank(),
|
||||
panel.grid.minor = ggplot2::element_blank(),
|
||||
# axis.text.y = element_blank(),
|
||||
# axis.title.y = element_blank(),
|
||||
text = ggplot2::element_text(size = 18),
|
||||
# axis.text = ggplot2::element_blank(),
|
||||
# panel.background = ggplot2::element_rect(fill = "white"),
|
||||
# plot.background = ggplot2::element_rect(fill = "white"),
|
||||
# panel.border = ggplot2::element_blank()
|
||||
plot.title = ggplot2::element_blank()
|
||||
)
|
||||
})
|
||||
),
|
||||
easyClose = easyClose,
|
||||
size = size,
|
||||
footer = footer
|
||||
))
|
||||
}
|
||||
|
||||
|
||||
## Slow with many observations...
|
||||
|
||||
#' Plot missings and class with apexcharter
|
||||
#'
|
||||
#' @param data data frame
|
||||
#'
|
||||
#' @returns An [apexchart()] `htmlwidget` object.
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' data_demo <- mtcars
|
||||
#' data_demo[2:4, "cyl"] <- NA
|
||||
#' rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot()
|
||||
#' data_demo |> missings_apex_plot()
|
||||
#' mtcars |> missings_apex_plot(animation = TRUE)
|
||||
#' # dplyr::storms |> missings_apex_plot()
|
||||
#' visdat::vis_dat(dplyr::storms)
|
||||
missings_apex_plot <- function(data, animation = FALSE, ...) {
|
||||
browser()
|
||||
|
||||
df_plot <- purrr::map_df(data, \(x){
|
||||
ifelse(is.na(x),
|
||||
yes = NA,
|
||||
no = glue::glue_collapse(class(x),
|
||||
sep = "\n"
|
||||
)
|
||||
)
|
||||
}) %>%
|
||||
dplyr::mutate(rows = dplyr::row_number()) %>%
|
||||
tidyr::pivot_longer(
|
||||
cols = -rows,
|
||||
names_to = "variable", values_to = "valueType", values_transform = list(valueType = as.character)
|
||||
) %>%
|
||||
dplyr::arrange(rows, variable, valueType)
|
||||
|
||||
|
||||
df_plot$valueType_num <- df_plot$valueType |>
|
||||
forcats::as_factor() |>
|
||||
as.numeric()
|
||||
|
||||
|
||||
df_plot$valueType[is.na(df_plot$valueType)] <- "NA"
|
||||
df_plot$valueType_num[is.na(df_plot$valueType_num)] <- max(df_plot$valueType_num, na.rm = TRUE) + 1
|
||||
|
||||
labels <- setNames(unique(df_plot$valueType_num), unique(df_plot$valueType))
|
||||
|
||||
if (any(df_plot$valueType == "NA")) {
|
||||
colors <- setNames(c(viridisLite::viridis(n = length(labels) - 1), "#999999"), names(labels))
|
||||
} else {
|
||||
colors <- setNames(viridisLite::viridis(n = length(labels)), names(labels))
|
||||
}
|
||||
|
||||
|
||||
label_list <- labels |>
|
||||
purrr::imap(\(.x, .i){
|
||||
list(
|
||||
from = .x,
|
||||
to = .x,
|
||||
color = colors[[.i]],
|
||||
name = .i
|
||||
)
|
||||
}) |>
|
||||
setNames(NULL)
|
||||
|
||||
out <- apexcharter::apex(
|
||||
data = df_plot,
|
||||
type = "heatmap",
|
||||
mapping = apexcharter::aes(x = variable, y = rows, fill = valueType_num),
|
||||
...
|
||||
) %>%
|
||||
apexcharter::ax_stroke(width = NULL) |>
|
||||
apexcharter::ax_plotOptions(
|
||||
heatmap = apexcharter::heatmap_opts(
|
||||
radius = 0,
|
||||
enableShades = FALSE,
|
||||
colorScale = list(
|
||||
ranges = label_list
|
||||
),
|
||||
useFillColorAsStroke = TRUE
|
||||
)
|
||||
) %>%
|
||||
apexcharter::ax_dataLabels(enabled = FALSE) |>
|
||||
apexcharter::ax_tooltip(
|
||||
enabled = FALSE,
|
||||
intersect = FALSE
|
||||
)
|
||||
|
||||
if (!isTRUE(animation)) {
|
||||
out <- out |>
|
||||
apexcharter::ax_chart(animations = list(enabled = FALSE))
|
||||
}
|
||||
|
||||
out
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -8278,7 +8163,7 @@ FreesearchR_colors <- function(choose = NULL) {
|
|||
secondary = "#FF6F61",
|
||||
success = "#00C896",
|
||||
warning = "#FFB100",
|
||||
danger = "#FF3A2F",
|
||||
danger = "#CC2E25",
|
||||
extra = "#8A4FFF",
|
||||
info = "#11A0EC",
|
||||
bg = "#FFFFFF",
|
||||
|
|
@ -8292,7 +8177,18 @@ FreesearchR_colors <- function(choose = NULL) {
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
#' Use the FreesearchR colors
|
||||
#'
|
||||
#' @param n number of colors
|
||||
#'
|
||||
#' @returns character vector
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' FreesearchR_palette(n=7)
|
||||
FreesearchR_palette <- function(n){
|
||||
rep_len(FreesearchR_colors(),n)
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
|
@ -9443,6 +9339,303 @@ clean_date <- function(data) {
|
|||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/FreesearchR/R//visual_summary.R
|
||||
########
|
||||
|
||||
#' Data correlations evaluation module
|
||||
#'
|
||||
#' @param id Module id
|
||||
#'
|
||||
#' @name data-missings
|
||||
#' @returns Shiny ui module
|
||||
#' @export
|
||||
visual_summary_ui <- function(id) {
|
||||
ns <- shiny::NS(id)
|
||||
|
||||
shiny::tagList(
|
||||
shiny::plotOutput(outputId = ns("visual_plot"), height = "70vh")
|
||||
)
|
||||
}
|
||||
|
||||
visual_summary_server <- function(id,
|
||||
data_r=shiny::reactive(NULL),
|
||||
...) {
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
module = function(input, output, session) {
|
||||
# ns <- session$ns
|
||||
rv <- shiny::reactiveValues(data = NULL)
|
||||
|
||||
shiny::bindEvent(shiny::observe({
|
||||
data <- data_r()
|
||||
rv$data <- data
|
||||
# vars_num <- vapply(data, \(.x){
|
||||
# is.numeric(.x) || is_datetime(.x)
|
||||
# }, logical(1))
|
||||
# vars_num <- names(vars_num)[vars_num]
|
||||
# shinyWidgets::updateVirtualSelect(
|
||||
# inputId = "variable",
|
||||
# choices = vars_num,
|
||||
# selected = if (isTruthy(input$variable)) input$variable else vars_num[1]
|
||||
# )
|
||||
}), data_r(), input$hidden)
|
||||
|
||||
# datar <- if (is.reactive(data)) data else reactive(data)
|
||||
|
||||
|
||||
# apexcharter::renderApexchart({
|
||||
# missings_apex_plot(datar(), ...)
|
||||
# })
|
||||
output$visual_plot <- shiny::renderPlot(expr = {
|
||||
visual_summary(data = rv$data,...)
|
||||
})
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
visual_summary_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
shiny::actionButton(
|
||||
inputId = "modal_missings",
|
||||
label = "Visual summary",
|
||||
width = "100%",
|
||||
disabled = FALSE
|
||||
)
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
data_demo <- mtcars
|
||||
data_demo[sample(1:32, 10), "cyl"] <- NA
|
||||
data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
|
||||
visual_summary_server(id = "data", data = shiny::reactive(data_demo))
|
||||
|
||||
observeEvent(input$modal_missings, {
|
||||
tryCatch(
|
||||
{
|
||||
modal_visual_summary(id = "data")
|
||||
},
|
||||
error = function(err) {
|
||||
showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err")
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
||||
visual_summary_demo_app()
|
||||
|
||||
|
||||
modal_visual_summary <- function(id,
|
||||
title = "Visual overview of data classes and missing observations",
|
||||
easyClose = TRUE,
|
||||
size = "xl",
|
||||
footer = NULL,
|
||||
...) {
|
||||
showModal(modalDialog(
|
||||
title = tagList(title, datamods:::button_close_modal()),
|
||||
visual_summary_ui(id = id),
|
||||
easyClose = easyClose,
|
||||
size = size,
|
||||
footer = footer
|
||||
))
|
||||
}
|
||||
|
||||
|
||||
## Slow with many observations...
|
||||
|
||||
#' Plot missings and class with apexcharter
|
||||
#'
|
||||
#' @param data data frame
|
||||
#'
|
||||
#' @returns An [apexchart()] `htmlwidget` object.
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' data_demo <- mtcars
|
||||
#' data_demo[2:4, "cyl"] <- NA
|
||||
#' rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot()
|
||||
#' data_demo |> missings_apex_plot()
|
||||
#' mtcars |> missings_apex_plot(animation = TRUE)
|
||||
#' # dplyr::storms |> missings_apex_plot()
|
||||
#' visdat::vis_dat(dplyr::storms)
|
||||
missings_apex_plot <- function(data, animation = FALSE, ...) {
|
||||
l <- data_summary_gather(data, ...)
|
||||
|
||||
df_plot <- l$data
|
||||
|
||||
out <- apexcharter::apex(
|
||||
data = df_plot,
|
||||
type = "heatmap",
|
||||
mapping = apexcharter::aes(x = variable, y = rows, fill = valueType_num),
|
||||
...
|
||||
) |>
|
||||
apexcharter::ax_stroke(width = NULL) |>
|
||||
apexcharter::ax_plotOptions(
|
||||
heatmap = apexcharter::heatmap_opts(
|
||||
radius = 0,
|
||||
enableShades = FALSE,
|
||||
colorScale = list(
|
||||
ranges = l$labels
|
||||
),
|
||||
useFillColorAsStroke = TRUE
|
||||
)
|
||||
) |>
|
||||
apexcharter::ax_dataLabels(enabled = FALSE) |>
|
||||
apexcharter::ax_tooltip(
|
||||
enabled = FALSE,
|
||||
intersect = FALSE
|
||||
)
|
||||
|
||||
if (!isTRUE(animation)) {
|
||||
out <- out |>
|
||||
apexcharter::ax_chart(animations = list(enabled = FALSE))
|
||||
}
|
||||
|
||||
out
|
||||
}
|
||||
|
||||
|
||||
|
||||
#' Ggplot2 data summary visualisation based on visdat::vis_dat.
|
||||
#'
|
||||
#' @param data data
|
||||
#' @param ... optional arguments passed to data_summary_gather()
|
||||
#'
|
||||
#' @returns ggplot2 object
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' data_demo <- mtcars
|
||||
#' data_demo[sample(1:32, 10), "cyl"] <- NA
|
||||
#' data_demo[sample(1:32, 8), "vs"] <- NA
|
||||
#' visual_summary(data_demo)
|
||||
#' visual_summary(data_demo, palette.fun = scales::hue_pal())
|
||||
#' visual_summary(dplyr::storms)
|
||||
#' visual_summary(dplyr::storms, summary.fun = data_type)
|
||||
visual_summary <- function(data, legend.title = "Data class", ...) {
|
||||
l <- data_summary_gather(data, ...)
|
||||
|
||||
df <- l$data
|
||||
|
||||
df$valueType <- factor(df$valueType, levels = names(l$colors))
|
||||
df$variable <- factor(df$variable, levels = unique_short(names(data)))
|
||||
|
||||
ggplot2::ggplot(data = df, ggplot2::aes(x = variable, y = rows)) +
|
||||
ggplot2::geom_raster(ggplot2::aes(fill = valueType)) +
|
||||
ggplot2::theme_minimal() +
|
||||
ggplot2::theme(axis.text.x = ggplot2::element_text(
|
||||
angle = 45,
|
||||
vjust = 1, hjust = 1
|
||||
)) +
|
||||
ggplot2::scale_fill_manual(values = l$colors) +
|
||||
ggplot2::labs(x = "", y = "Observations") +
|
||||
ggplot2::scale_y_reverse() +
|
||||
ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5)) +
|
||||
ggplot2::guides(colour = "none") +
|
||||
ggplot2::guides(fill = ggplot2::guide_legend(title = legend.title)) +
|
||||
# change the limits etc.
|
||||
ggplot2::guides(fill = ggplot2::guide_legend(title = "Type")) +
|
||||
# add info about the axes
|
||||
ggplot2::scale_x_discrete(position = "top") +
|
||||
ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0)) +
|
||||
ggplot2::theme(
|
||||
panel.grid.major = ggplot2::element_blank(),
|
||||
panel.grid.minor = ggplot2::element_blank(),
|
||||
text = ggplot2::element_text(size = 18),
|
||||
plot.title = ggplot2::element_blank()
|
||||
)
|
||||
}
|
||||
|
||||
#' Data summary for printing visual summary
|
||||
#'
|
||||
#' @param data data.frame
|
||||
#' @param fun summary function. Default is "class"
|
||||
#' @param palette.fun optionally use specific palette functions. First argument
|
||||
#' has to be the length.
|
||||
#'
|
||||
#' @returns data.frame
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |> data_summary_gather()
|
||||
data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis) {
|
||||
df_plot <- setNames(data, unique_short(names(data))) |>
|
||||
purrr::map_df(\(x){
|
||||
ifelse(is.na(x),
|
||||
yes = NA,
|
||||
no = glue::glue_collapse(summary.fun(x),
|
||||
sep = "\n"
|
||||
)
|
||||
)
|
||||
}) |>
|
||||
dplyr::mutate(rows = dplyr::row_number()) |>
|
||||
tidyr::pivot_longer(
|
||||
cols = -rows,
|
||||
names_to = "variable", values_to = "valueType", values_transform = list(valueType = as.character)
|
||||
) |>
|
||||
dplyr::arrange(rows, variable, valueType)
|
||||
|
||||
|
||||
df_plot$valueType_num <- df_plot$valueType |>
|
||||
forcats::as_factor() |>
|
||||
as.numeric()
|
||||
|
||||
df_plot$valueType[is.na(df_plot$valueType)] <- "NA"
|
||||
df_plot$valueType_num[is.na(df_plot$valueType_num)] <- max(df_plot$valueType_num, na.rm = TRUE) + 1
|
||||
|
||||
labels <- setNames(unique(df_plot$valueType_num), unique(df_plot$valueType)) |> sort()
|
||||
|
||||
if (any(df_plot$valueType == "NA")) {
|
||||
colors <- setNames(c(palette.fun(length(labels) - 1), "#999999"), names(labels))
|
||||
} else {
|
||||
colors <- setNames(palette.fun(length(labels)), names(labels))
|
||||
}
|
||||
|
||||
|
||||
label_list <- labels |>
|
||||
purrr::imap(\(.x, .i){
|
||||
list(
|
||||
from = .x,
|
||||
to = .x,
|
||||
color = colors[[.i]],
|
||||
name = .i
|
||||
)
|
||||
}) |>
|
||||
setNames(NULL)
|
||||
|
||||
list(data = df_plot, colors = colors, labels = label_list)
|
||||
}
|
||||
|
||||
|
||||
|
||||
#' Create unique short names of character vector items based on index
|
||||
#'
|
||||
#' @description
|
||||
#' The function will prefer original names, and only append index to long
|
||||
#' strings.
|
||||
#'
|
||||
#'
|
||||
#' @param data character vector
|
||||
#' @param max maximum final name length
|
||||
#'
|
||||
#' @returns character vector
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' c("kahdleidnsallskdj", "hej") |> unique_short()
|
||||
unique_short <- function(data, max = 15) {
|
||||
purrr::imap(data, \(.x, .i){
|
||||
if (nchar(.x) > max) {
|
||||
glue::glue("{substr(.x,1,(max-(nchar(.i)+1)))}_{.i}")
|
||||
} else {
|
||||
.x
|
||||
}
|
||||
}) |> unlist()
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/FreesearchR/R//wide2long.R
|
||||
########
|
||||
|
|
@ -9796,7 +9989,7 @@ ui_elements <- list(
|
|||
shiny::column(
|
||||
width = 3,
|
||||
shiny::actionButton(
|
||||
inputId = "modal_missings",
|
||||
inputId = "modal_visual_overview",
|
||||
label = "Visual overview",
|
||||
width = "100%",
|
||||
disabled = TRUE
|
||||
|
|
@ -10323,6 +10516,7 @@ server <- function(input, output, session) {
|
|||
rv <- shiny::reactiveValues(
|
||||
list = list(),
|
||||
regression = NULL,
|
||||
missings = NULL,
|
||||
ds = NULL,
|
||||
local_temp = NULL,
|
||||
ready = NULL,
|
||||
|
|
@ -10342,28 +10536,6 @@ server <- function(input, output, session) {
|
|||
#########
|
||||
##############################################################################
|
||||
|
||||
## This does not render correctly apparently due to css and load order
|
||||
# output$source <- shiny::renderUI({
|
||||
#
|
||||
# choices <- c(
|
||||
# "File upload" = "file",
|
||||
# "REDCap server export" = "redcap",
|
||||
# "Local or sample data" = "env"
|
||||
# )
|
||||
#
|
||||
# if (isTRUE(is_local)){
|
||||
# choices <- choices[c(1,3)]
|
||||
# }
|
||||
#
|
||||
# shinyWidgets::radioGroupButtons(
|
||||
# inputId = "source",
|
||||
# selected = "file",
|
||||
# choices = choices,
|
||||
# size = "lg"
|
||||
# )
|
||||
# })
|
||||
|
||||
|
||||
data_file <- import_file_server(
|
||||
id = "file_import",
|
||||
show_data_in = "popup",
|
||||
|
|
@ -10386,16 +10558,6 @@ server <- function(input, output, session) {
|
|||
rv$code <- modifyList(x = rv$code, list(import = from_redcap$code()))
|
||||
})
|
||||
|
||||
## This is used to ensure the reactive data is retrieved
|
||||
# output$redcap_prev <- DT::renderDT(
|
||||
# {
|
||||
# DT::datatable(head(from_redcap$data(), 5),
|
||||
# caption = "First 5 observations"
|
||||
# )
|
||||
# },
|
||||
# server = TRUE
|
||||
# )
|
||||
|
||||
from_env <- datamods::import_globalenv_server(
|
||||
id = "env",
|
||||
trigger_return = "change",
|
||||
|
|
@ -10410,11 +10572,20 @@ server <- function(input, output, session) {
|
|||
rv$code <- modifyList(x = rv$code, list(import = from_env$name()))
|
||||
})
|
||||
|
||||
visual_summary_server(
|
||||
id = "initial_summary",
|
||||
data_r = shiny::reactive({
|
||||
shiny::req(rv$data_temp)
|
||||
default_parsing(rv$data_temp)
|
||||
}),
|
||||
palette.fun = FreesearchR_palette
|
||||
)
|
||||
|
||||
observeEvent(input$modal_initial_view, {
|
||||
tryCatch(
|
||||
{
|
||||
modal_visual_missings(
|
||||
data = default_parsing(rv$data_temp),
|
||||
modal_visual_summary(
|
||||
id = "initial_summary",
|
||||
footer = NULL,
|
||||
size = "xl"
|
||||
)
|
||||
|
|
@ -10497,12 +10668,12 @@ server <- function(input, output, session) {
|
|||
if (is.null(rv$data_original) | NROW(rv$data_original) == 0) {
|
||||
shiny::updateActionButton(inputId = "act_start", disabled = TRUE)
|
||||
shiny::updateActionButton(inputId = "modal_browse", disabled = TRUE)
|
||||
shiny::updateActionButton(inputId = "modal_missings", disabled = TRUE)
|
||||
shiny::updateActionButton(inputId = "modal_visual_overview", disabled = TRUE)
|
||||
shiny::updateActionButton(inputId = "act_eval", disabled = TRUE)
|
||||
} else {
|
||||
shiny::updateActionButton(inputId = "act_start", disabled = FALSE)
|
||||
shiny::updateActionButton(inputId = "modal_browse", disabled = FALSE)
|
||||
shiny::updateActionButton(inputId = "modal_missings", disabled = FALSE)
|
||||
shiny::updateActionButton(inputId = "modal_visual_overview", disabled = FALSE)
|
||||
shiny::updateActionButton(inputId = "act_eval", disabled = FALSE)
|
||||
}
|
||||
})
|
||||
|
|
@ -10548,7 +10719,6 @@ server <- function(input, output, session) {
|
|||
)
|
||||
})
|
||||
|
||||
|
||||
#########
|
||||
######### Modifications
|
||||
#########
|
||||
|
|
@ -10741,11 +10911,20 @@ server <- function(input, output, session) {
|
|||
)
|
||||
})
|
||||
|
||||
observeEvent(input$modal_missings, {
|
||||
visual_summary_server(
|
||||
id = "visual_overview",
|
||||
data_r = shiny::reactive({
|
||||
shiny::req(rv$data_filtered)
|
||||
REDCapCAST::fct_drop(rv$data_filtered)
|
||||
}),
|
||||
palette.fun = FreesearchR_palette
|
||||
)
|
||||
|
||||
observeEvent(input$modal_visual_overview, {
|
||||
tryCatch(
|
||||
{
|
||||
modal_visual_missings(
|
||||
data = REDCapCAST::fct_drop(rv$data_filtered),
|
||||
modal_visual_summary(
|
||||
id = "visual_overview",
|
||||
footer = "Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias.",
|
||||
size = "xl"
|
||||
)
|
||||
|
|
@ -10756,7 +10935,6 @@ server <- function(input, output, session) {
|
|||
)
|
||||
})
|
||||
|
||||
|
||||
output$original_str <- renderPrint({
|
||||
str(rv$data_original)
|
||||
})
|
||||
|
|
@ -10779,7 +10957,6 @@ server <- function(input, output, session) {
|
|||
shiny::req(rv$data_filtered)
|
||||
|
||||
rv$list$table1 <- NULL
|
||||
# rv$regression <- NULL
|
||||
}
|
||||
)
|
||||
|
||||
|
|
@ -10904,7 +11081,7 @@ server <- function(input, output, session) {
|
|||
rv$list$table1 <- rlang::exec(create_baseline, !!!append_list(rv$list$data, parameters, "data"))
|
||||
})
|
||||
|
||||
rv$code$table1 <- glue::glue("FreesearchR::create_baseline(data,{list2str(parameters)})")
|
||||
rv$code$table1 <- glue::glue("FreesearchR::create_baseline(df,{list2str(parameters)})")
|
||||
}
|
||||
)
|
||||
|
||||
|
|
@ -10951,12 +11128,12 @@ server <- function(input, output, session) {
|
|||
label = "Select variable to stratify analysis",
|
||||
data = shiny::reactive({
|
||||
shiny::req(rv$data_filtered)
|
||||
rv$data_filtered[apply(rv$data_filtered,2,anyNA)]
|
||||
rv$data_filtered[apply(rv$data_filtered, 2, anyNA)]
|
||||
})()
|
||||
)
|
||||
})
|
||||
|
||||
data_missings_server(
|
||||
rv$missings <- data_missings_server(
|
||||
id = "missingness",
|
||||
data = shiny::reactive(rv$data_filtered),
|
||||
variable = shiny::reactive(input$missings_var)
|
||||
|
|
@ -10979,22 +11156,6 @@ server <- function(input, output, session) {
|
|||
|
||||
rv$regression <- regression_server("regression", data = shiny::reactive(rv$list$data))
|
||||
|
||||
# shiny::observeEvent(rv$regression, {
|
||||
# browser()
|
||||
# if (shiny::is.reactive(rv$regression)) {
|
||||
# rv$list$regression <- rv$regression()
|
||||
# } else {
|
||||
# rv$list$regression <- rv$regression
|
||||
# }
|
||||
# # rv$list$regression <- rv$regression()
|
||||
# })
|
||||
|
||||
# output$regression_models <- renderText({
|
||||
# req(rv$list$regression)
|
||||
# browser()
|
||||
# names(rv$list$regression)
|
||||
# })
|
||||
|
||||
##############################################################################
|
||||
#########
|
||||
######### Page navigation
|
||||
|
|
@ -11051,6 +11212,7 @@ server <- function(input, output, session) {
|
|||
format <- ifelse(type == "docx", "word_document", "odt_document")
|
||||
|
||||
rv$list$regression <- rv$regression()
|
||||
rv$list$missings <- rv$missings()
|
||||
|
||||
shiny::withProgress(message = "Generating the report. Hold on for a moment..", {
|
||||
tryCatch(
|
||||
|
|
|
|||
Binary file not shown.
Loading…
Add table
Add a link
Reference in a new issue