mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 09:59:39 +02:00
added option to specify categorical variables and print input classes
This commit is contained in:
parent
9c0cb53862
commit
069d6d79fa
4 changed files with 75 additions and 4 deletions
22
R/helpers.R
22
R/helpers.R
|
@ -94,3 +94,25 @@ read_input <- function(file, consider.na = c("NA", '""', "")) {
|
||||||
argsstring2list <- function(string){
|
argsstring2list <- function(string){
|
||||||
eval(parse(text = paste0("list(", string, ")")))
|
eval(parse(text = paste0("list(", string, ")")))
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#' Factorize variables in data.frame
|
||||||
|
#'
|
||||||
|
#' @param data data.frame
|
||||||
|
#' @param vars variables to force factorize
|
||||||
|
#'
|
||||||
|
#' @return data.frame
|
||||||
|
#' @export
|
||||||
|
factorize <- function(data,vars){
|
||||||
|
if (!is.null(vars)) {
|
||||||
|
data |>
|
||||||
|
dplyr::mutate(
|
||||||
|
dplyr::across(
|
||||||
|
dplyr::all_of(vars),
|
||||||
|
REDCapCAST::as_factor
|
||||||
|
)
|
||||||
|
)
|
||||||
|
} else {
|
||||||
|
data
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
|
@ -5,6 +5,6 @@ account: agdamsbo
|
||||||
server: shinyapps.io
|
server: shinyapps.io
|
||||||
hostUrl: https://api.shinyapps.io/v1
|
hostUrl: https://api.shinyapps.io/v1
|
||||||
appId: 13276335
|
appId: 13276335
|
||||||
bundleId: 9397035
|
bundleId:
|
||||||
url: https://agdamsbo.shinyapps.io/webResearch/
|
url: https://agdamsbo.shinyapps.io/webResearch/
|
||||||
version: 1
|
version: 1
|
||||||
|
|
|
@ -19,6 +19,10 @@ library(quarto)
|
||||||
library(here)
|
library(here)
|
||||||
library(broom)
|
library(broom)
|
||||||
library(broom.helpers)
|
library(broom.helpers)
|
||||||
|
if (!requireNamespace("REDCapCAST")) {
|
||||||
|
devtools::install_github("agdamsbo/REDCapCAST", quiet = TRUE, upgrade = "never")
|
||||||
|
}
|
||||||
|
library(REDCapCAST)
|
||||||
if (!requireNamespace("webResearch")) {
|
if (!requireNamespace("webResearch")) {
|
||||||
devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never")
|
devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never")
|
||||||
}
|
}
|
||||||
|
@ -34,19 +38,27 @@ server <- function(input, output, session) {
|
||||||
ds = NULL,
|
ds = NULL,
|
||||||
input = exists("webResearch_data"),
|
input = exists("webResearch_data"),
|
||||||
local_temp = NULL,
|
local_temp = NULL,
|
||||||
quarto = NULL
|
quarto = NULL,
|
||||||
|
test = "no"
|
||||||
)
|
)
|
||||||
|
|
||||||
|
test_data <- shiny::eventReactive(input$test_data, {
|
||||||
|
v$test <- "test"
|
||||||
|
})
|
||||||
|
|
||||||
ds <- shiny::reactive({
|
ds <- shiny::reactive({
|
||||||
# input$file1 will be NULL initially. After the user selects
|
# input$file1 will be NULL initially. After the user selects
|
||||||
# and uploads a file, head of that data file by default,
|
# and uploads a file, head of that data file by default,
|
||||||
# or all rows if selected, will be shown.
|
# or all rows if selected, will be shown.
|
||||||
if (v$input) {
|
if (v$input) {
|
||||||
out <- webResearch_data
|
out <- webResearch_data
|
||||||
|
} else if (v$test=="test") {
|
||||||
|
out <- gtsummary::trial
|
||||||
} else {
|
} else {
|
||||||
shiny::req(input$file)
|
shiny::req(input$file)
|
||||||
out <- read_input(input$file$datapath)
|
out <- read_input(input$file$datapath)
|
||||||
}
|
}
|
||||||
|
|
||||||
v$ds <- "present"
|
v$ds <- "present"
|
||||||
return(out)
|
return(out)
|
||||||
})
|
})
|
||||||
|
@ -71,8 +83,24 @@ server <- function(input, output, session) {
|
||||||
)
|
)
|
||||||
})
|
})
|
||||||
|
|
||||||
|
output$factor_vars <- shiny::renderUI({
|
||||||
|
selectizeInput(
|
||||||
|
inputId = "factor_vars",
|
||||||
|
selected = colnames(ds())[sapply(ds(), is.factor)],
|
||||||
|
label = "Covariables to format as categorical",
|
||||||
|
choices = colnames(ds())[sapply(ds(), is.character)],
|
||||||
|
multiple = TRUE
|
||||||
|
)
|
||||||
|
})
|
||||||
|
|
||||||
output$data.input <- shiny::renderTable({
|
output$data.input <- shiny::renderTable({
|
||||||
ds()
|
utils::head(ds(),20)
|
||||||
|
})
|
||||||
|
|
||||||
|
output$data.classes <- shiny::renderTable({
|
||||||
|
shiny::req(input$file)
|
||||||
|
data.frame(matrix(sapply(ds(),\(.x){class(.x)[1]}),nrow=1)) |>
|
||||||
|
stats::setNames(names(ds()))
|
||||||
})
|
})
|
||||||
|
|
||||||
shiny::observeEvent(
|
shiny::observeEvent(
|
||||||
|
@ -86,6 +114,8 @@ server <- function(input, output, session) {
|
||||||
data <- ds() |>
|
data <- ds() |>
|
||||||
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor))
|
dplyr::mutate(dplyr::across(dplyr::where(is.character), as.factor))
|
||||||
|
|
||||||
|
data <- data |> factorize(vars = input$factor_vars)
|
||||||
|
|
||||||
if (is.factor(data[[input$outcome_var]])) {
|
if (is.factor(data[[input$outcome_var]])) {
|
||||||
by.var <- input$outcome_var
|
by.var <- input$outcome_var
|
||||||
} else {
|
} else {
|
||||||
|
|
|
@ -32,6 +32,7 @@ cards <- list(
|
||||||
panels <- list(
|
panels <- list(
|
||||||
bslib::nav_panel(
|
bslib::nav_panel(
|
||||||
title = "Data overview",
|
title = "Data overview",
|
||||||
|
shiny::uiOutput("data.classes"),
|
||||||
shiny::uiOutput("data.input")
|
shiny::uiOutput("data.input")
|
||||||
),
|
),
|
||||||
bslib::nav_panel(
|
bslib::nav_panel(
|
||||||
|
@ -54,6 +55,7 @@ ui <- bslib::page(
|
||||||
|
|
||||||
# sidebarPanel(
|
# sidebarPanel(
|
||||||
sidebar = bslib::sidebar(
|
sidebar = bslib::sidebar(
|
||||||
|
width = 300,
|
||||||
open = "open",
|
open = "open",
|
||||||
shiny::h4("Upload your dataset"),
|
shiny::h4("Upload your dataset"),
|
||||||
shiny::conditionalPanel(
|
shiny::conditionalPanel(
|
||||||
|
@ -76,7 +78,10 @@ ui <- bslib::page(
|
||||||
".ods",
|
".ods",
|
||||||
".rds"
|
".rds"
|
||||||
)
|
)
|
||||||
)
|
),
|
||||||
|
# Does not work??
|
||||||
|
# shiny::actionButton(inputId = "test_data",
|
||||||
|
# label = "Load test data", class = "btn-primary")
|
||||||
),
|
),
|
||||||
shiny::conditionalPanel(
|
shiny::conditionalPanel(
|
||||||
condition = "output.uploaded=='yes'",
|
condition = "output.uploaded=='yes'",
|
||||||
|
@ -125,6 +130,20 @@ ui <- bslib::page(
|
||||||
condition = "input.all==1",
|
condition = "input.all==1",
|
||||||
shiny::uiOutput("include_vars")
|
shiny::uiOutput("include_vars")
|
||||||
),
|
),
|
||||||
|
shiny::radioButtons(
|
||||||
|
inputId = "specify_factors",
|
||||||
|
label = "Specify categorical variables?",
|
||||||
|
selected = "no",
|
||||||
|
inline = TRUE,
|
||||||
|
choices = list(
|
||||||
|
"No" = "no",
|
||||||
|
"Yes" = "yes"
|
||||||
|
)
|
||||||
|
),
|
||||||
|
shiny::conditionalPanel(
|
||||||
|
condition = "input.specify_factors=='yes'",
|
||||||
|
shiny::uiOutput("factor_vars")
|
||||||
|
),
|
||||||
shiny::actionButton("load", "Analyse", class = "btn-primary"),
|
shiny::actionButton("load", "Analyse", class = "btn-primary"),
|
||||||
#
|
#
|
||||||
# # Horizontal line ----
|
# # Horizontal line ----
|
||||||
|
|
Loading…
Add table
Reference in a new issue