mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 12:37:30 +02:00
modifications to ui and using DT for tables
This commit is contained in:
parent
c06d887c24
commit
15fe4ca188
16 changed files with 567 additions and 128 deletions
|
|
@ -5,6 +5,6 @@ account: agdamsbo
|
|||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 13276335
|
||||
bundleId: 9425248
|
||||
bundleId: 9426438
|
||||
url: https://agdamsbo.shinyapps.io/webResearch/
|
||||
version: 1
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ server <- function(input, output, session) {
|
|||
# or all rows if selected, will be shown.
|
||||
if (v$input) {
|
||||
out <- webResearch_data
|
||||
} else if (v$test=="test") {
|
||||
} else if (v$test == "test") {
|
||||
out <- gtsummary::trial
|
||||
} else {
|
||||
shiny::req(input$file)
|
||||
|
|
@ -61,6 +61,15 @@ server <- function(input, output, session) {
|
|||
}
|
||||
|
||||
v$ds <- "present"
|
||||
if (input$factorize == "yes") {
|
||||
out <- out |>
|
||||
(\(.x){
|
||||
suppressWarnings(
|
||||
REDCapCAST::numchar2fct(.x)
|
||||
)
|
||||
})()
|
||||
|
||||
}
|
||||
return(out)
|
||||
})
|
||||
|
||||
|
|
@ -69,7 +78,7 @@ server <- function(input, output, session) {
|
|||
inputId = "include_vars",
|
||||
selected = NULL,
|
||||
label = "Covariables to include",
|
||||
choices = colnames(ds())[-match(input$outcome_var, colnames(ds()))],
|
||||
choices = colnames(ds()),
|
||||
multiple = TRUE
|
||||
)
|
||||
})
|
||||
|
|
@ -89,7 +98,7 @@ server <- function(input, output, session) {
|
|||
inputId = "strat_var",
|
||||
selected = "none",
|
||||
label = "Select variable to stratify baseline",
|
||||
choices = c("none" ,colnames(ds())),
|
||||
choices = c("none", colnames(ds()[base_vars()])),
|
||||
multiple = FALSE
|
||||
)
|
||||
})
|
||||
|
|
@ -99,21 +108,39 @@ server <- function(input, output, session) {
|
|||
inputId = "factor_vars",
|
||||
selected = colnames(ds())[sapply(ds(), is.factor)],
|
||||
label = "Covariables to format as categorical",
|
||||
choices = colnames(ds())[sapply(ds(), is.character)],
|
||||
choices = colnames(ds()),
|
||||
multiple = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
output$data.input <- shiny::renderTable({
|
||||
utils::head(ds(),20)
|
||||
base_vars <- shiny::reactive({
|
||||
if (is.null(input$include_vars)) {
|
||||
out <- colnames(ds())
|
||||
} else {
|
||||
out <- unique(c(input$include_vars, input$outcome_var))
|
||||
}
|
||||
return(out)
|
||||
})
|
||||
|
||||
output$data.classes <- shiny::renderTable({
|
||||
shiny::req(input$file)
|
||||
data.frame(matrix(sapply(ds(),\(.x){class(.x)[1]}),nrow=1)) |>
|
||||
stats::setNames(names(ds()))
|
||||
# output$data.input <- shiny::renderTable({
|
||||
# utils::head(ds(), 20)
|
||||
# })
|
||||
|
||||
output$data.input <- DT::renderDT({
|
||||
ds()[base_vars()]
|
||||
})
|
||||
|
||||
output$data.classes <- gt::render_gt({
|
||||
shiny::req(input$file)
|
||||
data.frame(matrix(sapply(ds(), \(.x){
|
||||
class(.x)[1]
|
||||
}), nrow = 1)) |>
|
||||
stats::setNames(names(ds())) |>
|
||||
gt::gt()
|
||||
})
|
||||
|
||||
|
||||
|
||||
shiny::observeEvent(
|
||||
{
|
||||
input$load
|
||||
|
|
@ -127,28 +154,45 @@ server <- function(input, output, session) {
|
|||
|
||||
data <- data |> factorize(vars = input$factor_vars)
|
||||
|
||||
if (is.factor(data[[input$strat_var]])) {
|
||||
by.var <- input$strat_var
|
||||
} else {
|
||||
# if (is.factor(data[[input$strat_var]])) {
|
||||
# by.var <- input$strat_var
|
||||
# } else {
|
||||
# by.var <- NULL
|
||||
# }
|
||||
|
||||
if (input$strat_var == "none") {
|
||||
by.var <- NULL
|
||||
}
|
||||
|
||||
if (is.null(input$include_vars)) {
|
||||
base_vars <- colnames(data)
|
||||
} else {
|
||||
base_vars <- c(input$include_vars, input$outcome_var)
|
||||
by.var <- input$strat_var
|
||||
}
|
||||
|
||||
data <- dplyr::select(data, dplyr::all_of(base_vars))
|
||||
data <- data[base_vars()]
|
||||
|
||||
model <- data |>
|
||||
regression_model(
|
||||
outcome.str = input$outcome_var,
|
||||
auto.mode = input$regression_auto == 1,
|
||||
formula.str = input$regression_formula,
|
||||
fun = input$regression_fun,
|
||||
args.list = eval(parse(text = paste0("list(", input$regression_args, ")")))
|
||||
)
|
||||
# model <- data |>
|
||||
# regression_model(
|
||||
# outcome.str = input$outcome_var,
|
||||
# auto.mode = input$regression_auto == 1,
|
||||
# formula.str = input$regression_formula,
|
||||
# fun = input$regression_fun,
|
||||
# args.list = eval(parse(text = paste0("list(", input$regression_args, ")")))
|
||||
# )
|
||||
|
||||
models <- list(
|
||||
"Univariable" = regression_model_uv,
|
||||
"Multivariable" = regression_model
|
||||
) |>
|
||||
lapply(\(.fun){
|
||||
do.call(
|
||||
.fun,
|
||||
c(
|
||||
list(data = data),
|
||||
list(outcome.str = input$outcome_var),
|
||||
list(formula.str = input$regression_formula),
|
||||
list(fun = input$regression_fun),
|
||||
list(args.list = eval(parse(text = paste0("list(", input$regression_args, ")"))))
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
|
||||
v$list <- list(
|
||||
|
|
@ -161,14 +205,24 @@ server <- function(input, output, session) {
|
|||
)
|
||||
) |>
|
||||
(\(.x){
|
||||
if (!is.null(by.var)){
|
||||
if (!is.null(by.var)) {
|
||||
.x |> gtsummary::add_overall()
|
||||
} else {
|
||||
.x
|
||||
}
|
||||
})() |>
|
||||
(\(.x){
|
||||
if (input$add_p == "yes") {
|
||||
.x |>
|
||||
gtsummary::add_p() |>
|
||||
gtsummary::bold_p()
|
||||
} else {
|
||||
.x
|
||||
}
|
||||
})(),
|
||||
table2 = model |>
|
||||
regression_table()
|
||||
table2 = models |>
|
||||
purrr::map(regression_table) |>
|
||||
tbl_merge()
|
||||
)
|
||||
|
||||
output$table1 <- gt::render_gt(
|
||||
|
|
@ -180,7 +234,6 @@ server <- function(input, output, session) {
|
|||
v$list$table2 |>
|
||||
gtsummary::as_gt()
|
||||
)
|
||||
|
||||
}
|
||||
)
|
||||
|
||||
|
|
@ -229,5 +282,4 @@ server <- function(input, output, session) {
|
|||
print(paste(.x, "deleted"))
|
||||
})
|
||||
})
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,39 +1,16 @@
|
|||
library(shiny)
|
||||
library(bslib)
|
||||
requireNamespace("gt")
|
||||
# require(ggplot2)
|
||||
# source("https://raw.githubusercontent.com/agdamsbo/cognitive.index.lookup/main/R/index_from_raw.R")
|
||||
# source("https://raw.githubusercontent.com/agdamsbo/cognitive.index.lookup/main/R/plot_index.R")
|
||||
# source(here::here("R/index_from_raw.R"))
|
||||
# source(here::here("R/plot_index.R"))
|
||||
|
||||
# ui <- fluidPage(
|
||||
|
||||
cards <- list(
|
||||
bslib::card(
|
||||
max_height = "200px",
|
||||
full_screen = TRUE,
|
||||
bslib::card_header("Data overview"),
|
||||
shiny::uiOutput("data.input")
|
||||
),
|
||||
bslib::card(
|
||||
# max_height = "200px",
|
||||
full_screen = TRUE,
|
||||
bslib::card_header("Baseline characteristics"),
|
||||
gt::gt_output(outputId = "table1")
|
||||
),
|
||||
bslib::card(
|
||||
full_screen = TRUE,
|
||||
bslib::card_header("Multivariable regression table"),
|
||||
gt::gt_output(outputId = "table2")
|
||||
)
|
||||
)
|
||||
|
||||
panels <- list(
|
||||
bslib::nav_panel(
|
||||
title = "Data overview",
|
||||
shiny::uiOutput("data.classes"),
|
||||
shiny::uiOutput("data.input")
|
||||
# shiny::uiOutput("data.classes"),
|
||||
# shiny::uiOutput("data.input"),
|
||||
shiny::p("Classes of uploaded data"),
|
||||
gt::gt_output("data.classes"),
|
||||
shiny::p("Subset data"),
|
||||
DT::DTOutput("data.input")
|
||||
),
|
||||
bslib::nav_panel(
|
||||
title = "Baseline characteristics",
|
||||
|
|
@ -47,25 +24,15 @@ panels <- list(
|
|||
|
||||
|
||||
ui <- bslib::page(
|
||||
theme = bslib::bs_theme(bootswatch = "minty",
|
||||
base_font = font_google("Inter"),
|
||||
code_font = font_google("JetBrains Mono")
|
||||
),
|
||||
# theme = bslib::bs_theme(
|
||||
# bg = "#101010",
|
||||
# fg = "#FFF",
|
||||
# primary = "#E69F00",
|
||||
# secondary = "#0072B2",
|
||||
# success = "#009E73",
|
||||
# base_font = font_google("Inter"),
|
||||
# code_font = font_google("JetBrains Mono")
|
||||
# ),
|
||||
theme = bslib::bs_theme(
|
||||
bootswatch = "minty",
|
||||
base_font = font_google("Inter"),
|
||||
code_font = font_google("JetBrains Mono")
|
||||
),
|
||||
title = "webResearcher for easy data analysis",
|
||||
bslib::page_navbar(
|
||||
title = "webResearcher",
|
||||
header = h6("Welcome to the webResearcher tool. This is an early alpha version to act as a proof-of-concept and in no way intended for wider public use."),
|
||||
|
||||
# sidebarPanel(
|
||||
sidebar = bslib::sidebar(
|
||||
width = 300,
|
||||
open = "open",
|
||||
|
|
@ -92,12 +59,22 @@ ui <- bslib::page(
|
|||
)
|
||||
),
|
||||
# Does not work??
|
||||
# shiny::actionButton(inputId = "test_data",
|
||||
# label = "Load test data", class = "btn-primary")
|
||||
# shiny::actionButton(inputId = "test_data",
|
||||
# label = "Load test data", class = "btn-primary")
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "output.uploaded=='yes'",
|
||||
shiny::h4("Parameter specifications"),
|
||||
shiny::radioButtons(
|
||||
inputId = "factorize",
|
||||
label = "Factorize variables with few levels?",
|
||||
selected = "yes",
|
||||
inline = TRUE,
|
||||
choices = list(
|
||||
"Yes" = "yes",
|
||||
"No" = "no"
|
||||
)
|
||||
),
|
||||
shiny::radioButtons(
|
||||
inputId = "regression_auto",
|
||||
label = "Automatically choose function",
|
||||
|
|
@ -126,9 +103,23 @@ ui <- bslib::page(
|
|||
value = ""
|
||||
)
|
||||
),
|
||||
shiny::helpText(em("Please specify relevant columns from your data, and press 'Load data'")),
|
||||
shiny::helpText(em("Please specify relevant settings for your data, and press 'Analyse'")),
|
||||
shiny::uiOutput("outcome_var"),
|
||||
shiny::uiOutput("strat_var"),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.strat_var!='none'",
|
||||
shiny::radioButtons(
|
||||
inputId = "add_p",
|
||||
label = "Compare strata?",
|
||||
selected = "no",
|
||||
inline = TRUE,
|
||||
choices = list(
|
||||
"No" = "no",
|
||||
"Yes" = "yes"
|
||||
)
|
||||
),
|
||||
shiny::helpText("Option to perform statistical comparisons between strata in baseline table.")
|
||||
),
|
||||
shiny::radioButtons(
|
||||
inputId = "all",
|
||||
label = "Specify covariables",
|
||||
|
|
@ -149,15 +140,27 @@ ui <- bslib::page(
|
|||
selected = "no",
|
||||
inline = TRUE,
|
||||
choices = list(
|
||||
"No" = "no",
|
||||
"Yes" = "yes"
|
||||
"Yes" = "yes",
|
||||
"No" = "no"
|
||||
)
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.specify_factors=='yes'",
|
||||
shiny::uiOutput("factor_vars")
|
||||
),
|
||||
shiny::actionButton("load", "Analyse", class = "btn-primary"),
|
||||
bslib::input_task_button(
|
||||
id = "load",
|
||||
label = "Analyse",
|
||||
icon = shiny::icon("pencil", lib = "glyphicon"),
|
||||
label_busy = "Working...",
|
||||
icon_busy = fontawesome::fa_i("arrows-rotate",
|
||||
class = "fa-spin",
|
||||
"aria-hidden" = "true"),
|
||||
type = "primary",
|
||||
auto_reset = TRUE
|
||||
),
|
||||
shiny::helpText("If you change the parameters, press 'Analyse' again to update the tables"),
|
||||
# shiny::actionButton("load", "Analyse", class = "btn-primary"),
|
||||
#
|
||||
# # Horizontal line ----
|
||||
tags$hr(),
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue