mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 12:37:30 +02:00
Initial commit
This commit is contained in:
commit
ccab72aa0f
31 changed files with 6547 additions and 0 deletions
282
app/functions.R
Normal file
282
app/functions.R
Normal file
|
|
@ -0,0 +1,282 @@
|
|||
|
||||
|
||||
########
|
||||
#### Current file: R//baseline_table.R
|
||||
########
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary, vars = NULL) {
|
||||
if (!is.null(vars)) {
|
||||
data <- dplyr::select(dplyr::all_of(vars))
|
||||
}
|
||||
|
||||
out <- do.call(fun, c(list(data = data), fun.args))
|
||||
return(out)
|
||||
}
|
||||
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//helpers.R
|
||||
########
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
getfun <- function(x) {
|
||||
if("character" %in% class(x)){
|
||||
if (length(grep("::", x)) > 0) {
|
||||
parts <- strsplit(x, "::")[[1]]
|
||||
requireNamespace(parts[1])
|
||||
getExportedValue(parts[1], parts[2])
|
||||
}
|
||||
}else {
|
||||
x
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
write_quarto <- function(data,fileformat,qmd.file=here::here("analyses.qmd"),file=NULL,...){
|
||||
if (is.null(file)){
|
||||
file <- paste0("analyses.",fileformat)
|
||||
}
|
||||
temp <- tempfile(fileext = ".Rds")
|
||||
# write_rds(mtcars, temp)
|
||||
# read_rds(temp)
|
||||
web_data <- data
|
||||
saveRDS(web_data,file=temp)
|
||||
|
||||
quarto::quarto_render(qmd.file,
|
||||
output_file = file,
|
||||
execute_params = list(data.file=temp)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
file_extension <- function(filenames) {
|
||||
sub(
|
||||
pattern = "^(.*\\.|[^.]+)(?=[^.]*)", replacement = "",
|
||||
filenames,
|
||||
perl = TRUE
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
read_input <- function(file, consider.na = c("NA", '""', "")) {
|
||||
ext <- file_extension(file)
|
||||
|
||||
if (ext == "csv") {
|
||||
df <- readr::read_csv(file = file, na = consider.na)
|
||||
} else if (ext %in% c("xls", "xlsx")) {
|
||||
df <- openxlsx2::read_xlsx(file = file, na.strings = consider.na)
|
||||
} else if (ext == "dta") {
|
||||
df <- haven::read_dta(file = file)
|
||||
} else if (ext == "ods") {
|
||||
df <- readODS::read_ods(file = file)
|
||||
} else {
|
||||
stop("Input file format has to be on of:
|
||||
'.csv', '.xls', '.xlsx', '.dta' or '.ods'")
|
||||
}
|
||||
|
||||
df
|
||||
}
|
||||
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//regression_model.R
|
||||
########
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
regression_model <- function(data,
|
||||
outcome.str,
|
||||
auto.mode = TRUE,
|
||||
formula.str = NULL,
|
||||
args.list = NULL,
|
||||
fun = NULL,
|
||||
vars = NULL) {
|
||||
if (!is.null(formula.str)) {
|
||||
formula.str <- glue::glue(formula.str)
|
||||
} else {
|
||||
assertthat::assert_that(outcome.str %in% names(data),
|
||||
msg = "Outcome variable is not present in the provided dataset"
|
||||
)
|
||||
formula.str <- glue::glue("{outcome.str}~.")
|
||||
|
||||
if (!is.null(vars)) {
|
||||
if (outcome.str %in% vars){
|
||||
vars <- vars[vars %in% outcome.str]
|
||||
}
|
||||
data <- data |> dplyr::select(dplyr::all_of(c(vars,outcome.str)))
|
||||
}
|
||||
}
|
||||
|
||||
# Formatting character variables as factor
|
||||
# Improvement should add a missing vector to format as NA
|
||||
data <- data |> dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor))
|
||||
|
||||
# browser()
|
||||
if (auto.mode) {
|
||||
if (is.numeric(data[[outcome.str]])){
|
||||
fun <- "stats::lm"
|
||||
} else if (is.factor(data[[outcome.str]])){
|
||||
if (length(levels(data[[outcome.str]]))==2){
|
||||
fun <- "stats::glm"
|
||||
args.list = list(family = binomial(link = "logit"))
|
||||
|
||||
} else if (length(levels(data[[outcome.str]]))>2){
|
||||
fun <- "MASS::polr"
|
||||
args.list = list(
|
||||
Hess = TRUE,
|
||||
method = "logistic"
|
||||
)
|
||||
} else {
|
||||
stop("The provided output variable only has one level")
|
||||
}
|
||||
} else {
|
||||
stop("Output variable should be either numeric or factor for auto.mode")
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
assertthat::assert_that("character" %in% class(fun),
|
||||
msg = "Please provide the function as a character vector."
|
||||
)
|
||||
|
||||
out <- do.call(
|
||||
getfun(fun),
|
||||
c(
|
||||
list(data = data),
|
||||
list(formula = as.formula(formula.str)),
|
||||
args.list
|
||||
)
|
||||
)
|
||||
|
||||
# Recreating the call
|
||||
# out$call <- match.call(definition=eval(parse(text=fun)), call(fun, data = 'data',formula = as.formula(formula.str),args.list))
|
||||
|
||||
return(out)
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: R//regression_table.R
|
||||
########
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
regression_table <- function(data, args.list = NULL, fun = "gtsummary::tbl_regression") {
|
||||
|
||||
if (any(c(length(class(data))!=1, class(data)!="lm"))){
|
||||
args.list <- c(args.list,list(exponentiate=TRUE))
|
||||
}
|
||||
|
||||
out <- do.call(getfun(fun), c(list(x = data), args.list))
|
||||
return(out)
|
||||
}
|
||||
10
app/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf
Normal file
10
app/rsconnect/shinyapps.io/agdamsbo/webResearch.dcf
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
name: webResearch
|
||||
title:
|
||||
username: agdamsbo
|
||||
account: agdamsbo
|
||||
server: shinyapps.io
|
||||
hostUrl: https://api.shinyapps.io/v1
|
||||
appId: 13276335
|
||||
bundleId: 9334284
|
||||
url: https://agdamsbo.shinyapps.io/webResearch/
|
||||
version: 1
|
||||
116
app/server.R
Normal file
116
app/server.R
Normal file
|
|
@ -0,0 +1,116 @@
|
|||
# project.aid::merge_scripts(list.files("R/",full.names = TRUE),dest = here::here("app/functions.R"))
|
||||
source(here::here("app/functions.R"))
|
||||
|
||||
server <- function(input, output, session) {
|
||||
v <- shiny::reactiveValues(
|
||||
list = NULL,
|
||||
ds = NULL
|
||||
)
|
||||
|
||||
ds <- shiny::reactive({
|
||||
# input$file1 will be NULL initially. After the user selects
|
||||
# and uploads a file, head of that data file by default,
|
||||
# or all rows if selected, will be shown.
|
||||
|
||||
shiny::req(input$file)
|
||||
|
||||
v$ds <- "present"
|
||||
return(read_input(input$file$datapath))
|
||||
})
|
||||
|
||||
output$include_vars <- shiny::renderUI({
|
||||
selectizeInput(
|
||||
inputId = "include_vars",
|
||||
selected = NULL,
|
||||
label = "Covariables to include",
|
||||
choices = colnames(ds()),
|
||||
multiple = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
output$outcome_var <- shiny::renderUI({
|
||||
selectInput(
|
||||
inputId = "outcome_var",
|
||||
selected = NULL,
|
||||
label = "Select outcome variable",
|
||||
choices = colnames(ds()),
|
||||
multiple = FALSE
|
||||
)
|
||||
})
|
||||
|
||||
output$data.input <- shiny::renderTable({
|
||||
shiny::req(input$file)
|
||||
ds()
|
||||
})
|
||||
|
||||
shiny::observeEvent(
|
||||
{
|
||||
input$load
|
||||
},
|
||||
{
|
||||
shiny::req(input$outcome_var)
|
||||
|
||||
v$list <- ds() |>
|
||||
(\(data){
|
||||
# browser()
|
||||
list(
|
||||
data = data,
|
||||
table1 = data |> baseline_table(),
|
||||
table2 = 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, ")"))),
|
||||
vars = input$include_vars
|
||||
) |>
|
||||
regression_table()
|
||||
)
|
||||
})()
|
||||
|
||||
output$table1 <- gt::render_gt(
|
||||
v$list$table1 |>
|
||||
gtsummary::as_gt()
|
||||
)
|
||||
|
||||
output$table2 <- gt::render_gt(
|
||||
v$list$table2 |>
|
||||
gtsummary::as_gt()
|
||||
)
|
||||
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
output$uploaded <- shiny::reactive({
|
||||
if (is.null(v$ds)) {
|
||||
"no"
|
||||
} else {
|
||||
"yes"
|
||||
}
|
||||
})
|
||||
|
||||
shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE)
|
||||
|
||||
#####
|
||||
#### Generating output
|
||||
#####
|
||||
|
||||
# Downloadable csv of selected dataset ----
|
||||
# output$downloadData <- shiny::downloadHandler(
|
||||
# filename = "index_lookup.csv",
|
||||
# content = function(file) {
|
||||
# write.csv(v$index, file, row.names = FALSE)
|
||||
# }
|
||||
# )
|
||||
|
||||
output$report <- downloadHandler(
|
||||
filename = "analyses.html",
|
||||
content = function(file) {
|
||||
v$list |> write_quarto(file = file)
|
||||
}
|
||||
)
|
||||
|
||||
#
|
||||
}
|
||||
124
app/ui.R
Normal file
124
app/ui.R
Normal file
|
|
@ -0,0 +1,124 @@
|
|||
require(shiny)
|
||||
require(bslib)
|
||||
# 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")
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
ui <- bslib::page_sidebar(
|
||||
theme = bslib::bs_theme(bootswatch = "minty"),
|
||||
title = "webResearcher for easy data analysis",
|
||||
window_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(
|
||||
open = "open",
|
||||
h4("Upload your dataset"),
|
||||
|
||||
# Input: Select a file ----
|
||||
fileInput(
|
||||
inputId = "file",
|
||||
label = "Choose data file",
|
||||
multiple = FALSE,
|
||||
accept = c(
|
||||
"text/csv",
|
||||
"text/comma-separated-values,text/plain",
|
||||
".csv",
|
||||
".xlsx",
|
||||
".xls",
|
||||
".dta",
|
||||
".ods"
|
||||
)
|
||||
),
|
||||
conditionalPanel(
|
||||
condition = "output.uploaded=='yes'",
|
||||
h4("Parameter specifications"),
|
||||
radioButtons(
|
||||
inputId = "regression_auto",
|
||||
label = "Automatically choose function",
|
||||
inline = TRUE,
|
||||
choiceNames = c(
|
||||
"Yes",
|
||||
"No"
|
||||
),
|
||||
choiceValues = c(1, 2)
|
||||
),
|
||||
conditionalPanel(
|
||||
condition = "input.regression_auto==2",
|
||||
textInput(
|
||||
inputId = "regression_formula",
|
||||
label = "Formula string to render with 'glue::glue'",
|
||||
value = "{outcome.str}~."
|
||||
),
|
||||
textInput(
|
||||
inputId = "regression_fun",
|
||||
label = "Function to use for analysis (needs pasckage and name)",
|
||||
value = "stats::lm"
|
||||
),
|
||||
textInput(
|
||||
inputId = "regression_args",
|
||||
label = "Arguments to pass to the function (provided as a string)",
|
||||
value = ""
|
||||
)
|
||||
),
|
||||
helpText(em("Please specify relevant columns from your data, and press 'Load data'")),
|
||||
uiOutput("outcome_var"),
|
||||
radioButtons(
|
||||
inputId = "all",
|
||||
label = "Specify covariables",
|
||||
inline = TRUE, selected = 2,
|
||||
choiceNames = c(
|
||||
"Yes",
|
||||
"No"
|
||||
),
|
||||
choiceValues = c(1, 2)
|
||||
),
|
||||
conditionalPanel(
|
||||
condition = "input.all==1",
|
||||
uiOutput("include_vars")
|
||||
),
|
||||
actionButton("load", "Analyse", class = "btn-primary")
|
||||
)
|
||||
# ,
|
||||
|
||||
# Horizontal line ----
|
||||
# tags$hr(),
|
||||
# h4("Download results"),
|
||||
#
|
||||
# # Button
|
||||
# downloadButton(outputId="report",
|
||||
# label= "Download",
|
||||
# icon = shiny::icon("download"))
|
||||
),
|
||||
layout_columns(
|
||||
cards[[1]]
|
||||
),
|
||||
layout_columns(
|
||||
cards[[2]], cards[[3]]
|
||||
)
|
||||
)
|
||||
Loading…
Add table
Add a link
Reference in a new issue