mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 12:37:30 +02:00
renaming to cut function to cut_var to distinct from the base-version - UI improvements - nice code formatting.
This commit is contained in:
parent
8469a5ca64
commit
361296531e
30 changed files with 1248 additions and 1686 deletions
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: 10085560
|
||||
bundleId: 10098670
|
||||
url: https://agdamsbo.shinyapps.io/freesearcheR/
|
||||
version: 1
|
||||
|
|
|
|||
|
|
@ -106,7 +106,7 @@ server <- function(input, output, session) {
|
|||
shiny::observeEvent(data_file$data(), {
|
||||
shiny::req(data_file$data())
|
||||
rv$data_temp <- data_file$data()
|
||||
rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import")
|
||||
rv$code <- modifyList(x = rv$code, list(import = data_file$code()))
|
||||
})
|
||||
|
||||
from_redcap <- m_redcap_readServer(
|
||||
|
|
@ -116,9 +116,10 @@ server <- function(input, output, session) {
|
|||
shiny::observeEvent(from_redcap$data(), {
|
||||
# rv$data_original <- purrr::pluck(data_redcap(), "data")()
|
||||
rv$data_temp <- from_redcap$data()
|
||||
rv$code <- append_list(data = from_redcap$code(), list = rv$code, index = "import")
|
||||
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),
|
||||
|
|
@ -140,7 +141,7 @@ server <- function(input, output, session) {
|
|||
shiny::req(from_env$data())
|
||||
|
||||
rv$data_temp <- from_env$data()
|
||||
rv$code <- append_list(data = from_env$name(),list = rv$code,index = "import")
|
||||
rv$code <- modifyList(x = rv$code, list(import = from_env$name()))
|
||||
})
|
||||
|
||||
output$import_var <- shiny::renderUI({
|
||||
|
|
@ -190,11 +191,12 @@ server <- function(input, output, session) {
|
|||
|
||||
rv$code$import <- list(
|
||||
rv$code$import,
|
||||
rlang::call2(.fn = "select", input$import_var, .ns = "dplyr"),
|
||||
rlang::expr(dplyr::select(dplyr::all_of(!!input$import_var))),
|
||||
rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
|
||||
) |>
|
||||
merge_expression() |>
|
||||
expression_string()
|
||||
lapply(expression_string) |>
|
||||
pipe_string() |>
|
||||
expression_string(assign.str = "df <-")
|
||||
|
||||
|
||||
# rv$code$import <- rv$code$import |>
|
||||
|
|
@ -217,12 +219,17 @@ server <- function(input, output, session) {
|
|||
data_description(rv$data_original)
|
||||
})
|
||||
|
||||
|
||||
## Activating action buttons on data imported
|
||||
shiny::observeEvent(rv$data_original, {
|
||||
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 = "act_eval", disabled = TRUE)
|
||||
|
||||
} else {
|
||||
shiny::updateActionButton(inputId = "act_start", disabled = FALSE)
|
||||
shiny::updateActionButton(inputId = "modal_browse", disabled = FALSE)
|
||||
shiny::updateActionButton(inputId = "act_eval", disabled = FALSE)
|
||||
}
|
||||
})
|
||||
|
||||
|
|
@ -386,6 +393,8 @@ server <- function(input, output, session) {
|
|||
rv$list$data <- data_filter() |>
|
||||
REDCapCAST::fct_drop()
|
||||
|
||||
## This looks messy!! But it works as intended for now
|
||||
|
||||
out <- gsub(
|
||||
"filter", "dplyr::filter",
|
||||
gsub(
|
||||
|
|
@ -400,7 +409,7 @@ server <- function(input, output, session) {
|
|||
out <- strsplit(out, "%>%") |>
|
||||
unlist() |>
|
||||
(\(.x){
|
||||
paste(c("data <- data", .x[-1], "REDCapCAST::fct_drop()"),
|
||||
paste(c("df <- df", .x[-1], "REDCapCAST::fct_drop()"),
|
||||
collapse = "|> \n "
|
||||
)
|
||||
})()
|
||||
|
|
@ -446,45 +455,37 @@ server <- function(input, output, session) {
|
|||
#########
|
||||
##############################################################################
|
||||
|
||||
output$code_import <- shiny::renderPrint({
|
||||
shiny::req(rv$code$import)
|
||||
cat(c("#Data import\n",rv$code$import))
|
||||
## This really should be collapsed to only one call, but I'll leave it for now
|
||||
## as a working example of dynamically defining outputs and rendering.
|
||||
|
||||
# output$code_import <- shiny::renderPrint({
|
||||
# shiny::req(rv$code$import)
|
||||
# cat(c("#Data import\n", rv$code$import))
|
||||
# })
|
||||
|
||||
output$code_import <- shiny::renderUI({
|
||||
prismCodeBlock(paste0("#Data import\n", rv$code$import))
|
||||
})
|
||||
|
||||
output$code_data <- shiny::renderPrint({
|
||||
output$code_data <- shiny::renderUI({
|
||||
shiny::req(rv$code$modify)
|
||||
# browser()
|
||||
ls <- rv$code$modify |> unique()
|
||||
out <- ls |>
|
||||
merge_expression() |>
|
||||
expression_string(assign.str = "data <- data |>\n")
|
||||
lapply(expression_string) |>
|
||||
pipe_string() |>
|
||||
expression_string(assign.str = "df <- df |>\n")
|
||||
|
||||
# out <- paste("data <- data |>",
|
||||
# sapply(ls, \(.x) paste(deparse(.x), collapse = ",")),
|
||||
# collapse = "|>"
|
||||
# ) |>
|
||||
# (\(.x){
|
||||
# gsub(
|
||||
# "\\|>", "\\|> \n",
|
||||
# gsub(
|
||||
# "%>%", "",
|
||||
# gsub(
|
||||
# "\\s{2,}", " ",
|
||||
# gsub(",\\s{,},", ", ", .x)
|
||||
# )
|
||||
# )
|
||||
# )
|
||||
# })()
|
||||
cat(c("#Data modifications\n",out))
|
||||
prismCodeBlock(paste0("#Data modifications\n", out))
|
||||
})
|
||||
|
||||
output$code_filter <- shiny::renderPrint({
|
||||
cat(c("#Data filter\n",rv$code$filter))
|
||||
output$code_filter <- shiny::renderUI({
|
||||
prismCodeBlock(paste0("#Data filter\n", rv$code$filter))
|
||||
})
|
||||
|
||||
output$code_table1 <- shiny::renderPrint({
|
||||
output$code_table1 <- shiny::renderUI({
|
||||
shiny::req(rv$code$table1)
|
||||
cat(c("#Data characteristics table\n",rv$code$table1))
|
||||
prismCodeBlock(paste0("#Data characteristics table\n", rv$code$table1))
|
||||
})
|
||||
|
||||
|
||||
|
|
@ -492,8 +493,8 @@ server <- function(input, output, session) {
|
|||
## This is a very rewarding couple of lines marking new insights to dynamically rendering code
|
||||
shiny::observe({
|
||||
rv$regression()$regression$models |> purrr::imap(\(.x, .i){
|
||||
output[[paste0("code_", tolower(.i))]] <- shiny::renderPrint({
|
||||
cat(.x$code_table)
|
||||
output[[paste0("code_", tolower(.i))]] <- shiny::renderUI({
|
||||
prismCodeBlock(paste0(paste("#",.i,"regression model\n"),.x$code_table))
|
||||
})
|
||||
})
|
||||
})
|
||||
|
|
|
|||
|
|
@ -70,37 +70,37 @@ ui_elements <- list(
|
|||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "output.data_loaded == true",
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::h5("Specify variables to include"),
|
||||
shiny::fluidRow(
|
||||
shiny::column(
|
||||
width = 6,
|
||||
shiny::br(),
|
||||
shiny::p("Filter by completeness threshold and manual selection:"),
|
||||
shiny::br(),
|
||||
shiny::br()
|
||||
),
|
||||
shiny::column(
|
||||
width = 6,
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = NULL,
|
||||
update_on = "end",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 5,
|
||||
value = 70,
|
||||
format = shinyWidgets::wNumbFormat(decimals = 0),
|
||||
color = datamods:::get_primary_color()
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::h5("Specify variables to include"),
|
||||
shiny::fluidRow(
|
||||
shiny::column(
|
||||
width = 6,
|
||||
shiny::br(),
|
||||
shiny::p("Filter by completeness threshold and manual selection:"),
|
||||
shiny::br(),
|
||||
shiny::br()
|
||||
),
|
||||
shiny::helpText("Exclude variables with completeness below the specified percentage."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::uiOutput(outputId = "import_var"),
|
||||
shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
|
||||
shiny::column(
|
||||
width = 6,
|
||||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = NULL,
|
||||
update_on = "end",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 5,
|
||||
value = 70,
|
||||
format = shinyWidgets::wNumbFormat(decimals = 0),
|
||||
color = datamods:::get_primary_color()
|
||||
),
|
||||
shiny::helpText("Exclude variables with completeness below the specified percentage."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::uiOutput(outputId = "import_var"),
|
||||
shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
|
|
@ -138,7 +138,7 @@ ui_elements <- list(
|
|||
width = 9,
|
||||
shiny::uiOutput(outputId = "data_info", inline = TRUE),
|
||||
shiny::tags$p(
|
||||
"Below is a short summary table, on the right you can create data filters."
|
||||
"Below is a short summary table, on the right you can click to browse data and create data filters."
|
||||
)
|
||||
)
|
||||
),
|
||||
|
|
@ -152,7 +152,8 @@ ui_elements <- list(
|
|||
shiny::actionButton(
|
||||
inputId = "modal_browse",
|
||||
label = "Browse data",
|
||||
width = "100%"
|
||||
width = "100%",
|
||||
disabled = TRUE
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
|
|
@ -172,8 +173,10 @@ ui_elements <- list(
|
|||
fluidRow(
|
||||
shiny::column(
|
||||
width = 9,
|
||||
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$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(),
|
||||
|
|
@ -291,7 +294,7 @@ ui_elements <- list(
|
|||
label = "Evaluate",
|
||||
width = "100%",
|
||||
icon = shiny::icon("calculator"),
|
||||
disabled = FALSE
|
||||
disabled = TRUE
|
||||
)
|
||||
),
|
||||
bslib::accordion_panel(
|
||||
|
|
@ -439,18 +442,16 @@ ui_elements <- list(
|
|||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::h4("Code snippets"),
|
||||
shiny::tags$p("Below are the code used to create the final data set. This can be saved for reproducibility. The code may not be 100 % correct, but kan be used for learning and example code to get started on coding yourself."),
|
||||
shiny::tagAppendChildren(
|
||||
shiny::tagList(
|
||||
shiny::verbatimTextOutput(outputId = "code_import"),
|
||||
shiny::verbatimTextOutput(outputId = "code_data"),
|
||||
shiny::verbatimTextOutput(outputId = "code_filter"),
|
||||
shiny::verbatimTextOutput(outputId = "code_table1")
|
||||
shiny::tags$p("Below are the code bits used to create the final data set and the main analyses."),
|
||||
shiny::tags$p("This can be used as a starting point for learning to code and for reproducibility."),
|
||||
shiny::tagList(
|
||||
lapply(
|
||||
paste0("code_", c(
|
||||
"import", "data", "filter", "table1", "univariable", "multivariable"
|
||||
)),
|
||||
\(.x)shiny::htmlOutput(outputId = .x)
|
||||
)
|
||||
),
|
||||
lapply(paste0("code_",c("univariable","multivariable")),
|
||||
\(.x)shiny::verbatimTextOutput(outputId = .x))
|
||||
)
|
||||
,
|
||||
shiny::tags$br(),
|
||||
shiny::br()
|
||||
),
|
||||
|
|
@ -489,6 +490,8 @@ dark <- custom_theme(
|
|||
# https://webdesignerdepot.com/17-open-source-fonts-youll-actually-love/
|
||||
|
||||
ui <- bslib::page_fixed(
|
||||
prismDependencies,
|
||||
prismRDependency,
|
||||
shiny::tags$head(includeHTML(("www/umami-app.html"))),
|
||||
shiny::tags$style(
|
||||
type = "text/css",
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue