experiments with teal. usage examples are sparse

This commit is contained in:
Andreas Gammelgaard Damsbo 2024-12-04 12:58:55 +01:00
parent 0c9c5d33a6
commit a5c0a01d8a
No known key found for this signature in database
14 changed files with 840 additions and 15 deletions

View file

@ -35,7 +35,11 @@ Imports:
qqplotr,
see,
patchwork,
easystats
easystats,
DHARMa,
teal,
IDEAFilter,
sparkline
Suggests:
styler,
devtools,

View file

@ -9,6 +9,7 @@ export(factorize)
export(format_writer)
export(getfun)
export(index_embed)
export(m_datafileUI)
export(modify_qmd)
export(read_input)
export(regression_model)

View file

@ -126,3 +126,27 @@ dummy_Imports <- function() {
)
#https://github.com/hadley/r-pkgs/issues/828
}
file_export <- function(data,output.format=c("df","teal"),filename){
output.format <- match.arg(output.format)
filename <- gsub("-","_",filename)
if (output.format=="teal"){
out <- within(
teal_data(),
{
assign(name, value |> dplyr::bind_cols())
},
value = data,
name = filename
)
datanames(out) <- filename
} else if (output.format=="df"){
out <- data
}
out
}

188
R/modules.R Normal file
View file

@ -0,0 +1,188 @@
#' Shiny UI module to load a data file
#'
#' @param id id
#'
#' @return shiny UI
#' @export
#'
m_datafileUI <- function(id) {
ns <- NS(id)
shiny::tagList(
shiny::fileInput(
inputId = ns("file"),
label = "Upload a file",
multiple = FALSE,
accept = c(
".csv",
".xlsx",
".xls",
".dta",
".ods",
".rds"
)
),
shiny::h4("Parameter specifications"),
shiny::helpText(em("Select the desired variables and press 'Submit'")),
shiny::uiOutput(ns("include_vars")),
DT::DTOutput(ns("data_input")),
shiny::actionButton(ns("submit"), "Submit")
)
}
m_datafileServer <- function(id, output.format = "df") {
ns <- shiny::NS(id)
shiny::moduleServer(id, function(input, output, session, ...) {
ns <- shiny::NS(id)
ds <- shiny::reactive({
REDCapCAST::read_input(input$file$datapath) |> REDCapCAST::parse_data()
})
output$include_vars <- shiny::renderUI({
shiny::req(input$file)
selectizeInput(
inputId = ns("include_vars"),
selected = NULL,
label = "Covariables to include",
choices = colnames(ds()),
multiple = TRUE
)
})
base_vars <- shiny::reactive({
if (is.null(input$include_vars)) {
out <- colnames(ds())
} else {
out <- input$include_vars
}
return(out)
})
output$data_input <-
DT::renderDT({
shiny::req(input$file)
ds()[base_vars()]
})
shiny::eventReactive(input$submit, {
shiny::req(input$file)
file_export(
data = ds()[base_vars()] |> REDCapCAST::numchar2fct(),
output.format = output.format,
filename = tools::file_path_sans_ext(input$file$name)
)
})
})
}
m_redcap_readUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
shiny::textInput(
inputId = ns("uri"),
label = "URI",
value = "https://redcap.your.institution/api/"
),
shiny::textInput(
inputId = ns("api"),
label = "API token",
value = ""
),
shiny::tableOutput(outputId = ns("table")),
shiny::uiOutput(outputId = ns("fields")),
shiny::uiOutput(outputId = ns("instruments")),
shiny::uiOutput(outputId = ns("arms")),
shiny::actionButton(inputId = ns("submit"), "Submit")
)
}
m_redcap_readServer <- function(id, output.format="df") {
ns <- shiny::NS(id)
shiny::moduleServer(
id,
function(input, output, session,...) {
ns <- shiny::NS(id)
instr <- shiny::reactive({
shiny::req(input$api)
shiny::req(input$uri)
REDCapR::redcap_instruments(redcap_uri = input$uri, token = input$api)
})
output$instruments <- shiny::renderUI({
shiny::selectizeInput(
inputId = ns("instruments"),
# inputId = "instruments",
selected = NULL,
label = "Instruments to include",
choices = instr()[["data"]][[1]],
multiple = TRUE
)
})
dd <- shiny::reactive({
shiny::req(input$api)
shiny::req(input$uri)
REDCapR::redcap_metadata_read(redcap_uri = input$uri, token = input$api)
})
output$fields <- shiny::renderUI({
shiny::selectizeInput(
# inputId = "fields",
inputId = ns("fields"),
selected = NULL,
label = "Fields/variables to include",
choices = dd()[["data"]][[1]],
multiple = TRUE
)
})
arms <- shiny::reactive({
shiny::req(input$api)
shiny::req(input$uri)
REDCapR::redcap_event_read(redcap_uri = input$uri, token = input$api)
})
output$arms <- shiny::renderUI({
shiny::selectizeInput(
# inputId = "arms",
inputId = ns("arms"),
selected = NULL,
label = "Arms/events to include",
choices = arms()[["data"]][[3]],
multiple = TRUE
)
})
output$table <- shiny::renderTable({
dd()[["data"]]
})
shiny::eventReactive(input$submit, {
shiny::req(input$api)
data <- REDCapCAST::read_redcap_tables(
uri = input$uri,
token = input$api,
fields = unique(c(dd()[["data"]][[1]][1], input$fields)),
forms = input$instruments,
events = input$arms,
raw_or_label = "both"
)
info <- REDCapR::redcap_project_info_read(redcap_uri = input$uri,
token = input$api)
data |>
REDCapCAST::redcap_wider() |>
REDCapCAST::suffix2label() |>
REDCapCAST::as_factor() |>
dplyr::select(-dplyr::ends_with("_complete")) |>
dplyr::select(-dplyr::any_of(dd()[["data"]][[1]][1])) |>
file_export(
output.format = output.format,
filename = info$data$project_title
)
})
}
)
}

View file

@ -5,6 +5,6 @@ account: agdamsbo
server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1
appId: 13276335
bundleId: 9433115
bundleId: 9436643
url: https://agdamsbo.shinyapps.io/webResearch/
version: 1

View file

@ -22,6 +22,8 @@ library(broom.helpers)
library(REDCapCAST)
library(easystats)
library(patchwork)
library(DHARMa)
library(IDEAFilter)
# if (!requireNamespace("webResearch")) {
# devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never")
# }
@ -123,11 +125,9 @@ server <- function(input, output, session) {
return(out)
})
# output$data.input <- shiny::renderTable({
# utils::head(ds(), 20)
# })
output$data.input <- DT::renderDT({
output$data.input <-
DT::renderDT({
shiny::req(input$file)
ds()[base_vars()]
})
@ -234,7 +234,8 @@ server <- function(input, output, session) {
})(),
table2 = models |>
purrr::map(regression_table) |>
tbl_merge()
tbl_merge(),
input = input
)
output$table1 <- gt::render_gt(

View file

@ -1,5 +1,7 @@
library(shiny)
library(bslib)
library(IDEAFilter)
library(teal)
requireNamespace("gt")
panels <- list(
@ -7,8 +9,8 @@ panels <- list(
title = "Data overview",
# shiny::uiOutput("data.classes"),
# shiny::uiOutput("data.input"),
shiny::p("Classes of uploaded data"),
gt::gt_output("data.classes"),
# shiny::p("Classes of uploaded data"),
# gt::gt_output("data.classes"),
shiny::p("Subset data"),
DT::DTOutput("data.input")
),
@ -159,7 +161,8 @@ ui <- bslib::page(
label_busy = "Working...",
icon_busy = fontawesome::fa_i("arrows-rotate",
class = "fa-spin",
"aria-hidden" = "true"),
"aria-hidden" = "true"
),
type = "primary",
auto_reset = TRUE
),

View file

@ -0,0 +1,103 @@
m_redcap_readUI <- function(id) {
ns <- NS(id)
tagList(
shiny::textInput(
inputId = "uri",
label = "URI",
value = "https://redcap.your.institution/api/"
),
shiny::textInput(
inputId = "api",
label = "API token",
value = ""
),
shiny::tableOutput(outputId = ns("table")),
shiny::uiOutput(outputId = ns("fields")),
shiny::uiOutput(outputId = ns("instruments")),
shiny::uiOutput(outputId = ns("arms")),
shiny::actionButton(inputId = ns("submit"), "Submit")
)
}
m_redcap_readServer <- function(id) {
ns <- NS(id)
moduleServer(
id,
function(input, output, session) {
ns <- NS(id)
instr <- shiny::reactive({
shiny::req(input$api)
shiny::req(input$uri)
REDCapR::redcap_instruments(redcap_uri = input$uri, token = input$api)
})
output$instruments <- shiny::renderUI({
shiny::selectizeInput(
inputId = ns("instruments"),
selected = NULL,
label = "Instruments to include",
choices = instr()[["data"]][[1]],
multiple = TRUE
)
})
dd <- shiny::reactive({
shiny::req(input$api)
shiny::req(input$uri)
REDCapR::redcap_metadata_read(redcap_uri = input$uri, token = input$api)
})
output$fields <- shiny::renderUI({
shiny::selectizeInput(
inputId = ns("fields"),
selected = NULL,
label = "Fields/variables to include",
choices = dd()[["data"]][[1]],
multiple = TRUE
)
})
arms <- shiny::reactive({
shiny::req(input$api)
shiny::req(input$uri)
REDCapR::redcap_event_read(redcap_uri = input$uri, token = input$api)
})
output$arms <- shiny::renderUI({
shiny::selectizeInput(
inputId = ns("arms"),
selected = NULL,
label = "Arms/events to include",
choices = arms()[["data"]][[3]],
multiple = TRUE
)
})
output$table <- shiny::renderTable({
dd()[["data"]]
})
shiny::eventReactive(input$submit, {
shiny::req(input$api)
data <- REDCapCAST::read_redcap_tables(
uri=input$uri,
token = input$api,
fields = unique(c(dd()[["data"]][[1]][1],input$fields)),
forms = input$instruments,
events = input$arms,
raw_or_label = "both"
)
info <- REDCapR::redcap_project_info_read(redcap_uri = input$uri, token = input$api)
filename <- info$data$project_title
data |>
REDCapCAST::redcap_wider() |>
REDCapCAST::suffix2label() |>
REDCapCAST::as_factor() |>
dplyr::select(-dplyr::ends_with("_complete")) |>
dplyr::select(-dplyr::any_of(dd()[["data"]][[1]][1]))
})
}
)
}

View file

@ -0,0 +1,91 @@
library(REDCapCAST)
library(REDCapR)
library(shiny)
# ns <- shiny::NS(id)
server <- function(input, output, session) {
# ns <- NS(id)
instr <- shiny::reactive({
shiny::req(input$api)
shiny::req(input$uri)
REDCapR::redcap_instruments(redcap_uri = input$uri, token = input$api)
})
output$instruments <- shiny::renderUI({
shiny::selectizeInput(
inputId = "instruments",
selected = NULL,
label = "Instruments to include",
choices = instr()[["data"]][[1]],
multiple = TRUE
)
})
dd <- shiny::reactive({
shiny::req(input$api)
shiny::req(input$uri)
REDCapR::redcap_metadata_read(redcap_uri = input$uri, token = input$api)
})
output$fields <- shiny::renderUI({
shiny::selectizeInput(
inputId = "fields",
selected = NULL,
label = "Fields/variables to include",
choices = dd()[["data"]][[1]],
multiple = TRUE
)
})
arms <- shiny::reactive({
shiny::req(input$api)
shiny::req(input$uri)
REDCapR::redcap_event_read(redcap_uri = input$uri, token = input$api)
})
output$arms <- shiny::renderUI({
shiny::selectizeInput(
inputId = "arms",
selected = NULL,
label = "Arms/events to include",
choices = arms()[["data"]][[3]],
multiple = TRUE
)
})
output$table <- shiny::renderTable({
dd()[["data"]]
})
data <- shiny::eventReactive(input$submit, {
browser()
shiny::req(input$api)
data <- REDCapCAST::read_redcap_tables(
uri = input$uri,
token = input$api,
fields = unique(c(dd()[["data"]][[1]][1], input$fields)),
forms = input$instruments,
events = input$arms,
raw_or_label = "both"
)
info <- REDCapR::redcap_project_info_read(redcap_uri = input$uri, token = input$api)
filename <- info$data$project_title
data |>
REDCapCAST::redcap_wider() |>
REDCapCAST::suffix2label() |>
REDCapCAST::as_factor() |>
dplyr::select(-dplyr::ends_with("_complete")) |>
dplyr::select(-dplyr::any_of(dd()[["data"]][[1]][1]))
})
output$export <- DT::renderDT({
data()
})
}

View file

@ -0,0 +1,23 @@
library(REDCapCAST)
library(REDCapR)
library(shiny)
ui <- shiny::fluidPage(
# shiny::helpText("Submit URL and API token to browse download options"),
shiny::textInput(
inputId = "uri",
label = "URI",
value = "https://redcap.your.institution/api/"
),
shiny::textInput(
inputId = "api",
label = "API token",
value = ""
),
shiny::tableOutput("table"),
shiny::uiOutput("fields"),
shiny::uiOutput("instruments"),
shiny::uiOutput("arms"),
shiny::actionButton("submit", "Submit"),
DT::DTOutput("export")
)

113
inst/apps/teal_test/app.R Normal file
View file

@ -0,0 +1,113 @@
library(teal)
library(teal.modules.general)
library(teal.widgets)
library(readr)
library(MASS)
library(stats)
library(gtsummary)
library(gt)
library(openxlsx2)
library(haven)
library(readODS)
library(shiny)
library(bslib)
library(assertthat)
library(dplyr)
library(quarto)
library(here)
library(broom)
library(broom.helpers)
library(REDCapCAST)
library(easystats)
library(patchwork)
library(DHARMa)
# library(IDEAFilter)
# if (!requireNamespace("webResearch")) {
# devtools::install_github("agdamsbo/webResearch", quiet = TRUE, upgrade = "never")
# }
# library(webResearch)
if (file.exists(here::here("functions.R"))) {
source(here::here("functions.R"))
}
data_upload <- teal_data_module(
ui <- function(id) {
ns <- NS(id)
shiny::fluidPage(
shiny::radioButtons(
inputId = "import",
label = "Specify categorical variables?",
selected = "no",
inline = TRUE,
choices = list(
"Upload file" = "file",
"Export from REDCap" = "redcap"
)
),
shiny::conditionalPanel(
condition = "input.import=='file'",
m_datafileUI(id)
),
shiny::conditionalPanel(
condition = "input.import=='redcap'",
m_redcap_readUI(id)
)
)
},
server = function(id) {
ns <- NS(id)
moduleServer(id, function(input, output, session) {
shiny::reactive({
if (input$import == "file") {
m_datafileServer(id, output.format = "teal")
} else {
m_redcap_readServer(id, output.format = "teal")
}
})
})
}
)
tm_variable_browser_module <- tm_variable_browser(
label = "Variable browser",
ggplot2_args = ggplot2_args(
labs = list(subtitle = "Plot generated by Variable Browser Module")
)
)
filters <- teal::teal_slices()
app_source <- "https://github.com/agdamsbo/webresearch"
gh_issues_page <- "https://github.com/agdamsbo/webresearch/issues"
header <- tags$span(
style = "display: flex; align-items: center; justify-content: space-between; margin: 10px 0 10px 0;",
tags$span("webResearch (teal)", style = "font-size: 30px;") # ,
# tags$span(
# style = "display: flex; align-items: center;",
# tags$img(src = nest_logo, alt = "NEST logo", height = "45px", style = "margin-right:10px;"),
# tags$span(style = "font-size: 24px;", "agdamsbo")
# )
)
footer <- tags$p(
"This teal app was developed by AGDamsbo using the {teal} framework for Shiny apps:",
tags$a(href = app_source, target = "_blank", "Source Code"), ", ",
tags$a(href = gh_issues_page, target = "_blank", "Report Issues")
)
app <- init(
data = data_upload,
filter = filters,
modules = modules(
tm_data_table("Data Table"),
tm_variable_browser_module
),
title = build_app_title("webResearch (teal)"),
header = header,
footer = footer
)
shinyApp(app$ui, app$server)

17
man/m_datafileUI.Rd Normal file
View file

@ -0,0 +1,17 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/modules.R
\name{m_datafileUI}
\alias{m_datafileUI}
\title{Shiny UI module to load a data file}
\usage{
m_datafileUI(id)
}
\arguments{
\item{id}{id}
}
\value{
shiny UI
}
\description{
Shiny UI module to load a data file
}

Binary file not shown.

Before

Width:  |  Height:  |  Size: 403 KiB

257
renv.lock
View file

@ -19,6 +19,27 @@
],
"Hash": "53a0299b56b4cbe418b12e3b65587211"
},
"DHARMa": {
"Package": "DHARMa",
"Version": "0.4.7",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"Matrix",
"R",
"ape",
"gap",
"grDevices",
"graphics",
"lme4",
"lmtest",
"parallel",
"qgam",
"stats",
"utils"
],
"Hash": "1ce015f138dd74b3695fc60a86fcce98"
},
"DT": {
"Package": "DT",
"Version": "0.33",
@ -160,6 +181,33 @@
],
"Hash": "6b868847b365672d6c1677b1608da9ed"
},
"RcppEigen": {
"Package": "RcppEigen",
"Version": "0.3.4.0.2",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"Rcpp",
"stats",
"utils"
],
"Hash": "4ac8e423216b8b70cb9653d1b3f71eb9"
},
"Rdpack": {
"Package": "Rdpack",
"Version": "2.6.2",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"methods",
"rbibutils",
"tools",
"utils"
],
"Hash": "a9e2118c664c2cd694f03de074e8d4b3"
},
"V8": {
"Package": "V8",
"Version": "6.0.0",
@ -173,6 +221,25 @@
],
"Hash": "6603bfcbc7883a5fed41fb13042a3899"
},
"ape": {
"Package": "ape",
"Version": "5.8",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"Rcpp",
"digest",
"graphics",
"lattice",
"methods",
"nlme",
"parallel",
"stats",
"utils"
],
"Hash": "16b5ff4dff0ead9ea955f62f794b1535"
},
"askpass": {
"Package": "askpass",
"Version": "1.2.1",
@ -270,6 +337,18 @@
"Repository": "CRAN",
"Hash": "d972ef991d58c19e6efa71b21f5e144b"
},
"boot": {
"Package": "boot",
"Version": "1.3-30",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"graphics",
"stats"
],
"Hash": "96abeed416a286d4a0f52e550b612343"
},
"broom": {
"Package": "broom",
"Version": "1.0.7",
@ -526,6 +605,17 @@
],
"Hash": "e8ba62486230951fcd2b881c5be23f96"
},
"data.table": {
"Package": "data.table",
"Version": "1.16.2",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"methods"
],
"Hash": "2e00b378fc3be69c865120d9f313039a"
},
"datawizard": {
"Package": "datawizard",
"Version": "0.13.0",
@ -724,6 +814,31 @@
],
"Hash": "7f48af39fa27711ea5fbd183b399920d"
},
"gap": {
"Package": "gap",
"Version": "1.6",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"Rdpack",
"dplyr",
"gap.datasets",
"ggplot2",
"plotly"
],
"Hash": "4db3fe42566c96213b8bcb7bf71a43f6"
},
"gap.datasets": {
"Package": "gap.datasets",
"Version": "0.0.6",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R"
],
"Hash": "779651ac2943370c5453c2d907429fc9"
},
"generics": {
"Package": "generics",
"Version": "0.1.3",
@ -1153,6 +1268,45 @@
],
"Hash": "b8552d117e1b808b09a832f589b79035"
},
"lme4": {
"Package": "lme4",
"Version": "1.1-35.5",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"MASS",
"Matrix",
"R",
"Rcpp",
"RcppEigen",
"boot",
"graphics",
"grid",
"lattice",
"methods",
"minqa",
"nlme",
"nloptr",
"parallel",
"splines",
"stats",
"utils"
],
"Hash": "16a08fc75007da0d08e0c0388c7c33e6"
},
"lmtest": {
"Package": "lmtest",
"Version": "0.9-40",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"graphics",
"stats",
"zoo"
],
"Hash": "c6fafa6cccb1e1dfe7f7d122efd6e6a7"
},
"magrittr": {
"Package": "magrittr",
"Version": "2.0.3",
@ -1214,6 +1368,16 @@
],
"Hash": "18e9c28c1d3ca1560ce30658b22ce104"
},
"minqa": {
"Package": "minqa",
"Version": "1.2.8",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"Rcpp"
],
"Hash": "785ef8e22389d4a7634c6c944f2dc07d"
},
"minty": {
"Package": "minty",
"Version": "0.0.4",
@ -1270,6 +1434,13 @@
],
"Hash": "ccbb8846be320b627e6aa2b4616a2ded"
},
"nloptr": {
"Package": "nloptr",
"Version": "2.1.1",
"Source": "Repository",
"Repository": "CRAN",
"Hash": "27550641889a3abf3aec4d91186311ec"
},
"opdisDownsampling": {
"Package": "opdisDownsampling",
"Version": "1.0.1",
@ -1418,6 +1589,49 @@
],
"Hash": "01f28d4278f15c76cddbea05899c5d6f"
},
"plotly": {
"Package": "plotly",
"Version": "4.10.4",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"RColorBrewer",
"base64enc",
"crosstalk",
"data.table",
"digest",
"dplyr",
"ggplot2",
"htmltools",
"htmlwidgets",
"httr",
"jsonlite",
"lazyeval",
"magrittr",
"promises",
"purrr",
"rlang",
"scales",
"tibble",
"tidyr",
"tools",
"vctrs",
"viridisLite"
],
"Hash": "a1ac5c03ad5ad12b9d1597e00e23c3dd"
},
"plyr": {
"Package": "plyr",
"Version": "1.8.9",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"Rcpp"
],
"Hash": "6b8177fd19982f0020743fadbfdbd933"
},
"pracma": {
"Package": "pracma",
"Version": "2.4.4",
@ -1511,6 +1725,22 @@
],
"Hash": "1cba04a4e9414bdefc9dcaa99649a8dc"
},
"qgam": {
"Package": "qgam",
"Version": "1.3.4",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"doParallel",
"grDevices",
"mgcv",
"parallel",
"plyr",
"shiny"
],
"Hash": "e3bd5ade848251657381d2a0668def59"
},
"qqconf": {
"Package": "qqconf",
"Version": "1.3.2",
@ -1570,6 +1800,18 @@
],
"Hash": "5e3c5dc0b071b21fa128676560dbe94d"
},
"rbibutils": {
"Package": "rbibutils",
"Version": "2.3",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"tools",
"utils"
],
"Hash": "dfc034a172fd88fc66b1a703894c4185"
},
"reactR": {
"Package": "reactR",
"Version": "0.6.1",
@ -2138,6 +2380,21 @@
"Source": "Repository",
"Repository": "CRAN",
"Hash": "fcc4bd8e6da2d2011eb64a5e5cc685ab"
},
"zoo": {
"Package": "zoo",
"Version": "1.8-12",
"Source": "Repository",
"Repository": "CRAN",
"Requirements": [
"R",
"grDevices",
"graphics",
"lattice",
"stats",
"utils"
],
"Hash": "5c715954112b45499fb1dadc6ee6ee3e"
}
}
}