├── LICENSE ├── .Rbuildignore ├── R ├── ui_about.R ├── ui_results.R ├── logs.R ├── results.R ├── ui_logs.R ├── packages.R ├── ui.R ├── control.R ├── transient.R ├── pipeline.R ├── ui_control.R ├── process.R ├── process_sge.R ├── server.R └── project.R ├── NEWS.md ├── .lintr ├── tests └── mode │ ├── test-persistent.R │ └── test-transient.R ├── .gitignore ├── app.R ├── targets-shiny.Rproj ├── doc └── interpretation.md ├── .github ├── ISSUE_TEMPLATE │ ├── config.yml │ ├── feature.md │ ├── maintenance.md │ ├── performance.md │ └── bug.md └── PULL_REQUEST_TEMPLATE.md ├── LICENSE.md ├── DESCRIPTION ├── CONTRIBUTING.md ├── CODE_OF_CONDUCT.md └── README.md /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2021 2 | COPYRIGHT HOLDER: Eli Lilly and Company 3 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^LICENSE\.md$ 2 | ^.*\.Rproj$ 3 | ^\.Rproj\.user$ 4 | ^CODE_OF_CONDUCT\.md$ 5 | -------------------------------------------------------------------------------- /R/ui_about.R: -------------------------------------------------------------------------------- 1 | card_about <- card( 2 | id = "about", 3 | includeMarkdown("README.md") 4 | ) 5 | 6 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # targets-shiny 0.0.0.9000 2 | 3 | * Added a `NEWS.md` file to track changes to the package. 4 | -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | linters: with_defaults( 2 | cyclocomp_linter = NULL, 3 | object_length_linter = NULL, 4 | object_name_linter = NULL, 5 | object_usage_linter = NULL) 6 | -------------------------------------------------------------------------------- /R/ui_results.R: -------------------------------------------------------------------------------- 1 | card_interpretation <- card( 2 | id = "interpretation", 3 | includeMarkdown("doc/interpretation.md") 4 | ) 5 | 6 | card_association <- card( 7 | id = "association", 8 | plotOutput("plot") 9 | ) 10 | -------------------------------------------------------------------------------- /tests/mode/test-persistent.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | Sys.unsetenv("TARGETS_SHINY_HOME") 3 | Sys.setenv(TARGETS_SHINY_BACKEND = "") 4 | Sys.setenv(TARGETS_SHINY_TRANSIENT = "false") 5 | runApp() 6 | # Run a long pipeline, close the app, open it again, and verify 7 | # that the pipeline is still running. 8 | -------------------------------------------------------------------------------- /tests/mode/test-transient.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | Sys.unsetenv("TARGETS_SHINY_HOME") 3 | Sys.setenv(TARGETS_SHINY_BACKEND = "") 4 | Sys.setenv(TARGETS_SHINY_TRANSIENT = "true") 5 | runApp() 6 | # Run a long pipeline, close the app, open it again, and verify 7 | # that the pipeline stopped running. 8 | -------------------------------------------------------------------------------- /R/logs.R: -------------------------------------------------------------------------------- 1 | # Prep the contents of a stdout or stderr log for 2 | # renderText() and textOutput(). 3 | log_text <- function(path, tail_only) { 4 | if (!(length(path) && file.exists(path))) return() 5 | out <- readLines(path, warn = FALSE) 6 | if (tail_only) out <- tail(out, n = 25) 7 | paste0(out, collapse = "\n") 8 | } 9 | -------------------------------------------------------------------------------- /R/results.R: -------------------------------------------------------------------------------- 1 | results_plot <- function() { 2 | store <- project_path(project_get(), "_targets") 3 | if (tar_exist_objects("plot", store = store)) { 4 | return(tar_read(plot, store = store)) 5 | } 6 | ggplot() + 7 | geom_text(aes(label = "No results yet.", x = 0, y = 0), size = 16) + 8 | theme_void() 9 | } 10 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | _targets 3 | _targets.R 4 | .Rhistory 5 | .Rapp.history 6 | .RData 7 | .Ruserdata 8 | *-Ex.R 9 | /*.tar.gz 10 | /*.Rcheck/ 11 | .Rproj.user/ 12 | vignettes/*.html 13 | vignettes/*.pdf 14 | .httr-oauth 15 | *_cache/ 16 | /cache/ 17 | *.utf8.md 18 | *.knit.md 19 | .Renviron 20 | .Rprofile 21 | deploy.R 22 | rsconnect 23 | manifest.json 24 | -------------------------------------------------------------------------------- /app.R: -------------------------------------------------------------------------------- 1 | source("R/packages.R") 2 | source("R/ui.R") # Sources multiple UI helper scripts. 3 | source("R/server.R") 4 | source("R/control.R") 5 | source("R/project.R") 6 | source("R/pipeline.R") 7 | source("R/process.R") 8 | source("R/process_sge.R") 9 | source("R/results.R") 10 | source("R/logs.R") 11 | source("R/transient.R") 12 | shinyApp(ui = ui, server = server) 13 | -------------------------------------------------------------------------------- /targets-shiny.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: 2c99591b-4a2b-416e-94ce-30c0f5716194 3 | 4 | RestoreWorkspace: Default 5 | SaveWorkspace: Default 6 | AlwaysSaveHistory: Default 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: Sweave 14 | LaTeX: pdfLaTeX 15 | 16 | BuildType: Package 17 | PackageUseDevtools: Yes 18 | PackageInstallArgs: --no-multiarch --with-keep.source 19 | -------------------------------------------------------------------------------- /R/ui_logs.R: -------------------------------------------------------------------------------- 1 | card_stdout <- card( 2 | id = "stdout", 3 | tags$h3("Standard output"), 4 | tags$hr(), 5 | textOutput("stdout"), 6 | # Makes sure the stdout log has appropriate line breaks and scrolling: 7 | tags$head(tags$style("#stdout {white-space: pre-wrap}")) 8 | ) 9 | 10 | card_stderr <- card( 11 | id = "stderr", 12 | tags$h3("Standard error"), 13 | tags$hr(), 14 | textOutput("stderr"), 15 | tags$head(tags$style("#stderr {white-space: pre-wrap}")) 16 | ) 17 | -------------------------------------------------------------------------------- /R/packages.R: -------------------------------------------------------------------------------- 1 | library(bayesplot) 2 | library(bslib) 3 | library(callr) 4 | library(digest) 5 | library(dplyr) 6 | library(fs) 7 | library(fst) 8 | library(ggplot2) 9 | library(glue) 10 | library(gt) 11 | library(markdown) 12 | library(pingr) 13 | library(ps) 14 | library(qs) 15 | library(rstanarm) 16 | library(shiny) 17 | library(shinyalert) 18 | library(shinyjs) 19 | library(shinyWidgets) 20 | library(targets) 21 | library(tibble) 22 | library(tidyr) 23 | library(tools) 24 | library(visNetwork) 25 | -------------------------------------------------------------------------------- /doc/interpretation.md: -------------------------------------------------------------------------------- 1 | The density plots show the marginal posterior distribution of the [association parameter](https://mc-stan.org/rstanarm/articles/jm.html#association-structures) `alpha` of each of the univariate joint models. Each model uses the [current value association structure](https://mc-stan.org/rstanarm/articles/jm.html#association-structures), so `alpha` is the log fold change to the hazard rate of death for each unit increase of the biomarker. In other words, `alpha` is the increase in the log hazard of death per unit increase of the biomarker. `alpha` above 0 is evidence that the biomarker is positively associated with mortality. 2 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/config.yml: -------------------------------------------------------------------------------- 1 | lank_issues_enabled: true 2 | contact_links: 3 | - name: General 4 | url: https://github.com/wlandau/targets-shiny/discussions/categories/general 5 | about: Chat about targets-shiny. 6 | - name: Help 7 | url: https://github.com/wlandau/targets-shiny/discussions/categories/help 8 | about: Ask questions and get help. 9 | - name: Ideas 10 | url: https://github.com/wlandau/targets-shiny/discussions/categories/ideas 11 | about: Brainstorm ideas for new features or use cases. 12 | - name: Show and tell 13 | url: https://github.com/wlandau/targets-shiny/discussions/categories/show-and-tell 14 | about: Show off something you have made. 15 | -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | # Prework 2 | 3 | * [ ] I understand and agree to the [code of conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html) and the [contributing guidelines](https://github.com/wlandau/targets-shiny/blob/main/CONTRIBUTING.md). 4 | * [ ] I have already submitted a [discussion topic](https://github.com/wlandau/targets-shiny/discussions) or [issue](http://github.com/wlandau/targets-shiny/issues) to discuss my idea with the maintainer. 5 | * [ ] This pull request is not a [draft](https://github.blog/2019-02-14-introducing-draft-pull-requests). 6 | 7 | # Related GitHub issues and pull requests 8 | 9 | * Ref: # 10 | 11 | # Summary 12 | 13 | Please explain the purpose and scope of your contribution. 14 | -------------------------------------------------------------------------------- /R/ui.R: -------------------------------------------------------------------------------- 1 | source("R/ui_control.R") 2 | source("R/ui_results.R") 3 | source("R/ui_logs.R") 4 | source("R/ui_about.R") 5 | 6 | ui <- page_navbar( 7 | title = "App", 8 | 9 | nav_panel( 10 | title = "Controls", 11 | layout_columns( 12 | col_widths = 6, 13 | card_create, 14 | card_select, 15 | card_models, 16 | card_run 17 | ), 18 | shinyjs::useShinyjs() 19 | ), 20 | 21 | nav_panel( 22 | title = "About", 23 | card_about 24 | ), 25 | 26 | nav_panel( 27 | title = "Progress", 28 | tar_watch_ui("targets-shiny", seconds = 15, targets_only = TRUE) 29 | ), 30 | nav_panel( 31 | title = "Logs", 32 | layout_columns( 33 | col_widths = 6, 34 | card_stdout, 35 | card_stderr 36 | ) 37 | ), 38 | nav_panel( 39 | title = "Results", 40 | layout_columns( 41 | col_widths = 6, 42 | card_interpretation, 43 | card_association 44 | ) 45 | ) 46 | ) 47 | -------------------------------------------------------------------------------- /R/control.R: -------------------------------------------------------------------------------- 1 | # Show/hide the run buttons depending on whether the pipeline is running. 2 | control_set <- function() { 3 | if (process_running()) { 4 | control_running() 5 | } else { 6 | control_stopped() 7 | control_processed() 8 | } 9 | } 10 | 11 | # Allow the user to modify inputs and run a new pipeline. 12 | control_running <- function() { 13 | hide("run_start") 14 | disable("biomarkers") 15 | disable("iterations") 16 | show("run_cancel") 17 | } 18 | 19 | # Disable UI inputs and prevent new pipelines from starting 20 | # while a pipeline is already running. 21 | control_stopped <- function() { 22 | hide("run_cancel") 23 | enable("biomarkers") 24 | enable("iterations") 25 | show("run_start") 26 | } 27 | 28 | # Show a "Processing..." indicator while the app is cancelling jobs. 29 | control_processing <- function() { 30 | show("run_processing") 31 | } 32 | 33 | # Hide "Processing..." 34 | control_processed <- function() { 35 | hide("run_processing") 36 | } 37 | -------------------------------------------------------------------------------- /R/transient.R: -------------------------------------------------------------------------------- 1 | # Detect if storage is transient and projects will vanish on logout. 2 | # The app author needs to know this in advance and set the 3 | # TARGETS_SHINY_TRANSIENT environment variable. 4 | transient_active <- function() { 5 | env <- Sys.getenv("TARGETS_SHINY_TRANSIENT") 6 | identical(trimws(tolower(env)), "true") 7 | } 8 | 9 | # Alert the user if the project is transient 10 | transient_alert <- function() { 11 | if (!transient_active()) { 12 | return() 13 | } 14 | text <- paste( 15 | "This app is running in transient mode.", 16 | "When you log out, all your pipelines will stop", 17 | "and all your projects will vanish.", 18 | "In addition, depending on the platform,", 19 | "some processes may terminate if you spawn too many", 20 | "pipelines at a time.", 21 | "Visit the 'About' tab to learn how to create", 22 | "persistent projects and launch persistent jobs", 23 | "on supporting infrastructure. That way, the app", 24 | "can recover running jobs and saved data", 25 | "when the user logs back in." 26 | ) 27 | shinyalert("Transient mode", text = text, type = "info") 28 | } 29 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2021 Eli Lilly and Company 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/feature.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: New feature 3 | about: Suggest a new feature. 4 | title: "" 5 | labels: "type: new feature" 6 | assignees: wlandau 7 | --- 8 | 9 | ## Prework 10 | 11 | * [ ] Read and agree to the [code of conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html) and [contributing guidelines](https://github.com/wlandau/targets-shiny/blob/main/CONTRIBUTING.md). 12 | * [ ] If there is [already a relevant issue](https://github.com/wlandau/targets-shiny/issues), whether open or closed, comment on the existing thread instead of posting a new issue. 13 | * [ ] New features take time and effort to create, and they take even more effort to maintain. So if the purpose of the feature is to resolve a struggle you are encountering personally, please consider first posting a "trouble" or "other" issue so we can discuss your use case and search for existing solutions first. 14 | * [ ] Format your code according to the [tidyverse style guide](https://style.tidyverse.org/). 15 | 16 | ## Proposal 17 | 18 | Please describe the new feature. If applicable, write a minimal example in R code or pseudo-code to show input, usage, and desired output. 19 | 20 | To help us read any code you include (optional) please try to follow the [tidyverse style guide](https://style.tidyverse.org/). The `style_text()` and `style_file()` functions from the [`styler`](https://github.com/r-lib/styler) package make it easier. 21 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: targets.shiny 2 | Title: Shiny App with a Targets Pipeline 3 | Description: This DESCRIPTION file is for deployment purposes only 4 | and not to make the app into a formal R package. 5 | Version: 0.0.0.9000 6 | License: MIT + file LICENSE 7 | URL: https://github.com/wlandau/targets-shiny 8 | BugReports: https://github.com/wlandau/targets-shiny/issues 9 | Authors@R: c( 10 | person( 11 | given = c("William", "Michael"), 12 | family = "Landau", 13 | role = c("aut", "cre"), 14 | email = "will.landau.oss@gmail.com", 15 | comment = c(ORCID = "0000-0003-1878-3253") 16 | ), 17 | person( 18 | family = "Eli Lilly and Company", 19 | role = "cph" 20 | )) 21 | Depends: 22 | R (>= 3.5.0) 23 | Imports: 24 | bayesplot (>= 1.8.0), 25 | bs4Dash (>= 2.0.0), 26 | callr (>= 3.4.3), 27 | digest (>= 0.6.27), 28 | dplyr (>= 1.0.3), 29 | fs (>= 1.5.0), 30 | fst (>= 0.9.4), 31 | ggplot2 (>= 3.3.3), 32 | glue (>= 1.4.2), 33 | gt (>= 0.2.2), 34 | markdown (>= 1.1), 35 | pingr (>= 2.0.1), 36 | ps (>= 1.5.0), 37 | qs (>= 0.23.2), 38 | rstanarm (>= 2.21.1), 39 | shiny (>= 1.6.0), 40 | shinyalert (>= 2.0.0), 41 | shinybusy (>= 0.2.2), 42 | shinycssloaders (>= 1.0.0), 43 | shinyjs (>= 2.0.0), 44 | shinyWidgets (>= 0.5.7), 45 | targets (>= 0.2.0), 46 | tarchetypes (>= 0.1.0), 47 | tibble (>= 3.0.1), 48 | tidyr (>= 1.1.2), 49 | tools, 50 | visNetwork (>= 2.0.9) 51 | Remotes: 52 | RinteRface/bs4Dash 53 | Encoding: UTF-8 54 | Language: en-US 55 | VignetteBuilder: knitr 56 | Config/testthat/edition: 3 57 | Roxygen: list(markdown = TRUE) 58 | -------------------------------------------------------------------------------- /R/pipeline.R: -------------------------------------------------------------------------------- 1 | # Write the _targets.R script to the project directory. 2 | write_pipeline <- function( 3 | name, 4 | biomarkers = c("albumin", "log_bilirubin"), 5 | iterations = 1000 6 | ) { 7 | tar_helper(project_path(name, "_targets.R"), { 8 | suppressPackageStartupMessages({ 9 | library(dplyr) 10 | library(targets) 11 | library(tarchetypes) 12 | library(tidyr) 13 | }) 14 | options(cli.num_colors = 1) 15 | tar_option_set( 16 | packages = c("ggplot2", "rstanarm", "tibble"), 17 | memory = "transient", 18 | garbage_collection = TRUE 19 | ) 20 | get_data_biomarker <- function() { 21 | pbcLong %>% 22 | rename(log_bilirubin = logBili) %>% 23 | mutate(log_platelet = log(platelet)) 24 | } 25 | fit_model <- function(data_biomarker, biomarker, iterations) { 26 | model <- stan_jm( 27 | formulaLong = as.formula(paste(biomarker, "~ year + (1 | id)")), 28 | formulaEvent = Surv(futimeYears, death) ~ sex + trt, 29 | time_var = "year", 30 | dataLong = data_biomarker, 31 | dataEvent = pbcSurv, 32 | iter = iterations, 33 | refresh = min(iterations / 10, 50) 34 | ) 35 | tibble( 36 | alpha = as.data.frame(model)[["Assoc|Long1|etavalue"]], 37 | biomarker = biomarker 38 | ) 39 | } 40 | plot_samples <- function(samples) { 41 | ggplot(samples) + 42 | geom_density(aes(x = alpha, fill = biomarker), alpha = 0.5) + 43 | theme_gray(20) 44 | } 45 | models <- tar_map( 46 | values = list(biomarker = !!sort(biomarkers)), 47 | tar_fst_tbl(model, fit_model(data_biomarker, biomarker, !!iterations)) 48 | ) 49 | list( 50 | tar_target(data_biomarker, get_data_biomarker()), 51 | models, 52 | tar_combine(samples, models), 53 | tar_qs(plot, plot_samples(samples)) 54 | ) 55 | }) 56 | } 57 | -------------------------------------------------------------------------------- /R/ui_control.R: -------------------------------------------------------------------------------- 1 | card_create <- card( 2 | id = "project_create", 3 | textInput( 4 | inputId = "project_new", 5 | label = NULL, 6 | value = NULL, 7 | placeholder = "Name of new project" 8 | ), 9 | actionBttn( 10 | inputId = "project_create", 11 | label = "Create empty project", 12 | color = "primary", 13 | style = "simple" 14 | ), 15 | actionBttn( 16 | inputId = "project_copy", 17 | label = "Copy current project", 18 | color = "primary", 19 | style = "simple" 20 | ) 21 | ) 22 | 23 | card_select <- card( 24 | id = "project", 25 | pickerInput( 26 | inputId = "project", 27 | label = NULL, 28 | selected = character(0), 29 | choices = character(0), 30 | multiple = FALSE 31 | ), 32 | actionBttn( 33 | inputId = "project_delete", 34 | label = "Delete selected project", 35 | style = "simple", 36 | color = "royal" 37 | ) 38 | ) 39 | 40 | card_models <- card( 41 | id = "models", 42 | disabled( 43 | checkboxGroupInput( 44 | inputId = "biomarkers", 45 | label = "Biomarkers", 46 | choices = c("albumin", "log_bilirubin", "log_platelet"), 47 | selected = c("albumin", "log_bilirubin"), 48 | inline = TRUE 49 | ) 50 | ), 51 | disabled( 52 | sliderInput( 53 | inputId = "iterations", 54 | label = "Iterations", 55 | value = 1000, 56 | min = 100, 57 | max = 10000, 58 | step = 100, 59 | ticks = FALSE 60 | ) 61 | ) 62 | ) 63 | 64 | card_run <- card( 65 | id = "run", 66 | hidden( 67 | actionBttn( 68 | inputId = "run_start", 69 | label = "Run pipeline", 70 | style = "simple", 71 | color = "success" 72 | ) 73 | ), 74 | hidden( 75 | actionBttn( 76 | inputId = "run_cancel", 77 | label = "Cancel pipeline", 78 | style = "simple", 79 | color = "warning" 80 | ) 81 | ), 82 | hidden( 83 | actionBttn( 84 | inputId = "run_processing", 85 | label = "Processing...", 86 | style = "simple", 87 | color = "royal" 88 | ) 89 | ) 90 | ) 91 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/maintenance.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Maintenance 3 | about: "Something in targets needs work: updates, documentation, etc. Not a bug, performance issue, or new feature." 4 | title: "" 5 | labels: "type: new maintenance" 6 | assignees: "" 7 | --- 8 | 9 | ## Prework 10 | 11 | * [ ] Read and agree to the [code of conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html) and [contributing guidelines](https://github.com/wlandau/targets-shiny/blob/main/CONTRIBUTING.md). 12 | * [ ] If there is [already a relevant issue](https://github.com/wlandau/targets-shiny/issues), whether open or closed, comment on the existing thread instead of posting a new issue. 13 | * [ ] For any problems you identify, post a [minimal reproducible example](https://www.tidyverse.org/help/) like [this one](https://github.com/wlandau/targets-shiny/issues/256#issuecomment-754229683) so the maintainer can troubleshoot. A reproducible example is: 14 | * [ ] **Runnable**: post enough R code and data so any onlooker can create the error on their own computer. 15 | * [ ] **Minimal**: reduce runtime wherever possible and remove complicated details that are irrelevant to the issue at hand. 16 | * [ ] **Readable**: format your code according to the [tidyverse style guide](https://style.tidyverse.org/). 17 | 18 | ## Description 19 | 20 | Please describe the issue. 21 | 22 | To help us read any code you include (optional) please try to follow the [tidyverse style guide](https://style.tidyverse.org/). The `style_text()` and `style_file()` functions from the [`styler`](https://github.com/r-lib/styler) package make it easier. 23 | 24 | ## Reproducible example 25 | 26 | * [ ] For any problems you identify, post a [minimal reproducible example](https://www.tidyverse.org/help/) so the maintainer can troubleshoot. A reproducible example is: 27 | * [ ] **Runnable**: post enough R code and data so any onlooker can create the error on their own computer. 28 | * [ ] **Minimal**: reduce runtime wherever possible and remove complicated details that are irrelevant to the issue at hand. 29 | * [ ] **Readable**: format your code according to the [tidyverse style guide](https://style.tidyverse.org/). 30 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/performance.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Performance 3 | about: "Runtime, memory, or storage inefficiency" 4 | title: "" 5 | labels: "topic: performance" 6 | assignees: wlandau 7 | 8 | --- 9 | 10 | ## Prework 11 | 12 | * [ ] Read and agree to the [code of conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html) and [contributing guidelines](https://github.com/wlandau/targets-shiny/blob/main/CONTRIBUTING.md). 13 | * [ ] If there is [already a relevant issue](https://github.com/wlandau/targets-shiny/issues), whether open or closed, comment on the existing thread instead of posting a new issue. 14 | * [ ] Post a [minimal reproducible example](https://www.tidyverse.org/help/) like [this one](https://github.com/wlandau/targets-shiny/issues/256#issuecomment-754229683) so the maintainer can troubleshoot the problems you identify. A reproducible example is: 15 | * [ ] **Runnable**: post enough R code and data so any onlooker can create the error on their own computer. 16 | * [ ] **Minimal**: reduce runtime wherever possible and remove complicated details that are irrelevant to the issue at hand. 17 | * [ ] **Readable**: format your code according to the [tidyverse style guide](https://style.tidyverse.org/). 18 | 19 | ## Description 20 | 21 | Please describe the performance issue. 22 | 23 | ## Reproducible example 24 | 25 | * [ ] Post a [minimal reproducible example](https://www.tidyverse.org/help/) so the maintainer can troubleshoot the problems you identify. A reproducible example is: 26 | * [ ] **Runnable**: post enough R code and data so any onlooker can create the error on their own computer. 27 | * [ ] **Minimal**: reduce runtime wherever possible and remove complicated details that are irrelevant to the issue at hand. 28 | * [ ] **Readable**: format your code according to the [tidyverse style guide](https://style.tidyverse.org/). 29 | 30 | ## Benchmarks 31 | 32 | How poorly does `targets-shiny` perform? To find out, we recommend you use the [`proffer`](https://github.com/r-prof/proffer) package and take screenshots of the results displayed in your browser. 33 | 34 | ```r 35 | library(targets) 36 | library(proffer) 37 | px <- pprof({ 38 | # All your targets code goes here. 39 | }) 40 | ``` 41 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug 3 | about: Something is wrong with targets. 4 | title: "" 5 | labels: "type: bug" 6 | assignees: wlandau 7 | --- 8 | 9 | ## Prework 10 | 11 | * [ ] Read and agree to the [code of conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html) and [contributing guidelines](https://github.com/wlandau/targets-shiny/blob/main/CONTRIBUTING.md). 12 | * [ ] Confirm that your issue is most likely a genuine bug in the `targets` package itself and not a user error or known limitation. For usage issues and troubleshooting, please post to the [discussions](https://github.com/wlandau/targets-shiny/discussions) instead. 13 | * [ ] If there is [already a relevant issue](https://github.com/wlandau/targets-shiny/issues), whether open or closed, comment on the existing thread instead of posting a new issue. 14 | * [ ] Post a [minimal reproducible example](https://www.tidyverse.org/help/) like [this one](https://github.com/wlandau/targets-shiny/issues/256#issuecomment-754229683) so the maintainer can troubleshoot the problems you identify. A reproducible example is: 15 | * [ ] **Runnable**: post enough R code and data so any onlooker can create the error on their own computer. 16 | * [ ] **Minimal**: reduce runtime wherever possible and remove complicated details that are irrelevant to the issue at hand. 17 | * [ ] **Readable**: format your code according to the [tidyverse style guide](https://style.tidyverse.org/). 18 | 19 | ## Description 20 | 21 | Please describe the bug. 22 | 23 | ## Reproducible example 24 | 25 | * [ ] Post a [minimal reproducible example](https://www.tidyverse.org/help/) so the maintainer can troubleshoot the problems you identify. A reproducible example is: 26 | * [ ] **Runnable**: post enough R code and data so any onlooker can create the error on their own computer. 27 | * [ ] **Minimal**: reduce runtime wherever possible and remove complicated details that are irrelevant to the issue at hand. 28 | * [ ] **Readable**: format your code according to the [tidyverse style guide](https://style.tidyverse.org/). 29 | 30 | ## Expected result 31 | 32 | What should have happened? Please be as specific as possible. 33 | 34 | ## Diagnostic information 35 | 36 | * A [reproducible example](https://github.com/tidyverse/reprex). 37 | * Session info, available through `sessionInfo()` or [`reprex(si = TRUE)`](https://github.com/tidyverse/reprex). 38 | * A stack trace from `traceback()` or `rlang::trace_back()`. 39 | * The [SHA-1 hash](https://git-scm.com/book/en/v1/Getting-Started-Git-Basics#Git-Has-Integrity) of the GitHub commit of `targets` currently installed. `packageDescription("targets")$GithubSHA1` shows you this. 40 | -------------------------------------------------------------------------------- /R/process.R: -------------------------------------------------------------------------------- 1 | # The default behavior of the app is to run the pipeline 2 | # as a local background process on the Shiny server. 3 | if (identical(Sys.getenv("TARGETS_SHINY_BACKEND"), "")) { 4 | 5 | # Run the pipeline in a new background process if no such 6 | # process is already running in the current project. 7 | process_run <- function() { 8 | if (!project_exists()) return() 9 | if (process_running()) return() 10 | control_running() 11 | control_processing() 12 | on.exit(control_processed()) 13 | args <- list( 14 | # Important! Garbage collection should not terminate the process: 15 | cleanup = FALSE, 16 | supervise = transient_active(), # Otherwise, the process quits on logout. 17 | stdout = project_stdout(), 18 | stderr = project_stderr() 19 | ) 20 | script <- project_path(project_get(), "_targets.R") 21 | store <- project_path(project_get(), "_targets") 22 | # Here is where we actually run the pipeline: 23 | px <- tar_make( 24 | callr_function = r_bg, 25 | callr_arguments = args, 26 | script = script, 27 | store = store, 28 | reporter = "terse" 29 | ) 30 | # Do not give back control until the pipeline write a _targets/meta/process 31 | # file with the PID of the main process. 32 | while (process_not_done(px) && !tar_exist_process(store)) Sys.sleep(0.05) 33 | # Do not give back control until the PID in _targets/meta/process 34 | # agrees with the PID of the process handle we have in memory. 35 | while (process_not_done(px) && !process_agrees(px)) Sys.sleep(0.05) 36 | } 37 | 38 | # Cancel the process if it is running. 39 | process_cancel <- function() { 40 | if (!project_exists()) return() 41 | if (!process_running()) return() 42 | control_processing() 43 | ps_kill(ps_handle(tar_pid(project_path(project_get(), "_targets")))) 44 | } 45 | 46 | # Get the process ID of the pipeline if it exists 47 | process_id <- function() { 48 | store <- project_path(project_get(), "_targets") 49 | if (!project_exists() || !tar_exist_process(store)) return(NA_integer_) 50 | tar_pid(store) 51 | } 52 | 53 | # Read the _targets/meta/process file to get the PID of the pipeline 54 | # and check if it is running. 55 | process_running <- function() { 56 | store <- project_path(project_get(), "_targets") 57 | project_exists() && 58 | tar_exist_process(store) && 59 | (tar_pid(store) %in% ps_pids()) 60 | } 61 | 62 | # Check if the in-memory processx handle reported an exit status yet. 63 | process_not_done <- function(px) { 64 | is.null(px$get_exit_status()) 65 | } 66 | 67 | # Status indicator that changes whenever a pipeline starts or stops. 68 | # Useful as a reactive value to update the UI at the proper time. 69 | process_status <- function() { 70 | list(pid = process_id(), running = process_running()) 71 | } 72 | 73 | # The PID in _targets/meta/process must agree with the 74 | # in-memory handle we get when we first launch the pipeline. 75 | process_agrees <- function(px) { 76 | identical(px$get_pid(), tar_pid(project_path(project_get(), "_targets"))) 77 | } 78 | 79 | } 80 | -------------------------------------------------------------------------------- /R/process_sge.R: -------------------------------------------------------------------------------- 1 | # To run pipelines as jobs on a Sun Grid Engine (SGE) cluster, 2 | # Deploy the app with the TARGETS_SHINY_BACKEND environment variable 3 | # equal to "sge". Create an app-level .Renviron file for this. 4 | if (identical(tolower(Sys.getenv("TARGETS_SHINY_BACKEND")), "sge")) { 5 | 6 | # Run the pipeline in a new Sun Grid Engine (SGE) job 7 | # if no such job is already running in the current project. 8 | process_run <- function() { 9 | if (!project_exists()) return() 10 | if (process_running()) return() 11 | # Block the session while the job is being submitted. 12 | control_running() 13 | control_processing() 14 | on.exit(control_processed()) 15 | # Submit the job. 16 | process_submit() 17 | # Give time for the job to post. 18 | Sys.sleep(1) 19 | } 20 | 21 | # Cancel the process if it is running. 22 | process_cancel <- function() { 23 | if (!project_exists()) return() 24 | if (!process_running()) return() 25 | control_processing() 26 | system2("qdel", process_id()) 27 | } 28 | 29 | # Submit a pipeline as an SGE job. 30 | process_submit <- function() { 31 | # The process ID should be unique to the user and project name 32 | # and it should be short enough that all of it 33 | # shows up in qstat. 34 | id <- paste0("t", digest(project_path(project_get()), algo = "xxhash32")) 35 | # Define other parameters for the job script. 36 | # Do not save the SGE log in the project directory. 37 | # Otherwise, logs could get written after the project is deleted, 38 | # which could create corrupted projects that are not supposed to exist. 39 | log_sge <- project_path("_logs", project_get()) 40 | log_stdout <- project_stdout() 41 | log_stderr <- project_stderr() 42 | script <- project_path(project_get(), "_targets.R") 43 | store <- project_path(project_get(), "_targets") 44 | # Save files for the job shell script and the job ID. 45 | path_job <- project_path(project_get(), "job.sh") 46 | path_id <- project_path(project_get(), "id") 47 | writeLines(glue(process_script), path_job) 48 | writeLines(id, path_id) 49 | Sys.chmod(path_job, mode = "0744") 50 | # Submit the job. 51 | system2("qsub", path_job) 52 | } 53 | 54 | # The app passes this script to qsub when it submits the job. 55 | # The curly braces are glue patterns that the 56 | # process_submit() function populates. 57 | process_script <- "#!/bin/bash 58 | #$ -N {id} # Job name. Should be unique, short enough that qstat does not truncate it. 59 | #$ -j y # Combine SGE stdout and stderr into one log file. 60 | #$ -o {log_sge} # Log file. 61 | #$ -cwd # Submit from the current working directory. 62 | #$ -V # Use environment variables 63 | #$ -l h_rt=04:00:00 # Maximum runtime is 4 hours. 64 | module load R # Load R as an environment module on the cluster. Pick the right version if applicable. 65 | Rscript -e 'targets::tar_make(callr_arguments = list(stdout = \"{log_stdout}\", stderr = \"{log_stderr}\"), script = \"{script}\", store = \"{store}\")'" 66 | 67 | # Get the SGE job ID of the pipeline. 68 | process_id <- function() { 69 | path <- project_path(project_get(), "id") 70 | if (any(file.exists(path))) { 71 | readLines(path) 72 | } else { 73 | NA_character_ 74 | } 75 | } 76 | 77 | # Read the _targets/meta/process file to get the PID of the pipeline 78 | # and check if it is running. 79 | process_running <- function() { 80 | id <- process_id() 81 | project_exists() && 82 | !anyNA(id) && 83 | any(grepl(id, system2("qstat", stdout = TRUE))) 84 | } 85 | 86 | # Status indicator that changes whenever a pipeline starts or stops. 87 | # Useful as a reactive value to update the UI at the proper time. 88 | process_status <- function() { 89 | list(pid = process_id(), running = process_running()) 90 | } 91 | 92 | } 93 | -------------------------------------------------------------------------------- /R/server.R: -------------------------------------------------------------------------------- 1 | server <- function(input, output, session) { 2 | # Clear logs from deleted projects 3 | project_clear_logs() 4 | # Alert users if the app is in transient mode. 5 | transient_alert() 6 | # Load the saved settings of the project into the biomarker 7 | # dropdown and iterations slider. This is important to do 8 | # before project_select() because of the reactivity loop. 9 | project_load() 10 | # Identify the set project in the _project file 11 | # and populate the dropdown menu. 12 | project_select() 13 | # The tar_watch() module powers the "Progress" tab. 14 | # This is the server-side component. 15 | tar_watch_server("targets-shiny", config = project_config()) 16 | # Define a special reactive to invalidate contexts 17 | # when a pipeline starts or stops. 18 | process <- reactiveValues(status = process_status()) 19 | observe({ 20 | invalidateLater(millis = 5000) 21 | process$status <- process_status() 22 | }) 23 | # Refresh the UI to indicate whether the pipeline is running. 24 | observe({ 25 | process$status 26 | control_set() 27 | }) 28 | # Every time the user selects a project in the drop-down menu 29 | # of the "Control" tab, switch to that project and load the settings. 30 | observe({ 31 | req(input$project) 32 | project_set(input$project) 33 | project_load() 34 | }) 35 | # Every time the user tweaks the pipeline settings, 36 | # update the project's files settings.rds and _targets.R 37 | # The former ensures the project is recovered after a logout, 38 | # and the latter defines a pipeline with the user's new settings. 39 | observe({ 40 | req(input$biomarkers) 41 | req(input$iterations) 42 | project_save(input$biomarkers, input$iterations) 43 | }) 44 | # When the user presses the button to create a project, 45 | # create a new project folder, populate it with the required files, 46 | # and switch the app to the new project. 47 | # Settings revert to the global defaults. 48 | observeEvent(input$project_create, { 49 | req(input$project_new) 50 | project_create(input$project_new) 51 | }) 52 | # For copied projects, copy over all the project files except 53 | # _targets/meta/process (with the PID) and `id` (with the job ID). 54 | observeEvent(input$project_copy, { 55 | req(input$project_new) 56 | project_copy(input$project_new) 57 | }) 58 | # When the user presses the button to delete a project, 59 | # remove the current project's files and switch to the next 60 | # available project. Be sure to cancel the deleted project's pipeline 61 | # first. 62 | observeEvent(input$project_delete, { 63 | req(input$project) 64 | process_cancel() 65 | project_delete(input$project) 66 | }) 67 | # Run the pipeline if the user presses the appropriate button. 68 | observeEvent(input$run_start, process_run()) 69 | # Stop the pipeline if the user presses the appropriate button. 70 | observeEvent(input$run_cancel, process_cancel()) 71 | # Refresh the latest plot output when the pipeline starts or stops 72 | # or when the user switches the project. 73 | output$plot <- renderPlot({ 74 | req(input$project) 75 | process$status 76 | results_plot() 77 | }) 78 | # Continuously refresh the stdout log file while the pipeline is running. 79 | # Also refresh when the pipeline starts or stops 80 | # and when the user switches projects. 81 | output$stdout <- renderText({ 82 | req(input$project) 83 | process$status 84 | if (process$status$running) invalidateLater(millis = 250) 85 | log_text(project_stdout(), tail_only = FALSE) 86 | }) 87 | # Same for stderr. 88 | output$stderr <- renderText({ 89 | req(input$project) 90 | process$status 91 | if (process$status$running) invalidateLater(millis = 250) 92 | log_text(project_stderr(), tail_only = FALSE) 93 | }) 94 | } 95 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing 2 | 3 | Development is a community effort, and we welcome participation. 4 | 5 | ## Code of Conduct 6 | 7 | Please note that this package is released with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html). 8 | 9 | ## Discussions 10 | 11 | At , you can post general questions, brainstorm ideas, and ask for help. 12 | 13 | ## Issues 14 | 15 | is for bug reports, performance issues, maintenance tasks, and feature requests. When you post, please abide by the following guidelines. 16 | 17 | * Before posting a new issue or discussion topic, please take a moment to search for existing similar threads in order to avoid duplication. 18 | * For bug reports: if you can, please install the latest GitHub version of `targets` (i.e. `remotes::install_github("wlandau/targets-shiny")`) and verify that the issue still persists. 19 | * Describe your issue in prose as clearly and concisely as possible. 20 | * For any problem you identify, post a [minimal reproducible example](https://www.tidyverse.org/help/) like [this one](https://github.com/wlandau/targets-shiny/issues/256#issuecomment-754229683) so the maintainer can troubleshoot. A reproducible example is: 21 | * **Runnable**: post enough R code and data so any onlooker can create the error on their own computer. 22 | * **Minimal**: reduce runtime wherever possible and remove complicated details that are irrelevant to the issue at hand. 23 | * **Readable**: format your code according to the [tidyverse style guide](https://style.tidyverse.org/). 24 | 25 | ## Development 26 | 27 | External code contributions are extremely helpful in the right circumstances. Here are the recommended steps. 28 | 29 | 1. Prior to contribution, please propose your idea in a discussion topic or issue thread so you and the maintainer can define the intent and scope of your work. 30 | 2. [Fork the repository](https://help.github.com/articles/fork-a-repo/). 31 | 3. Follow the [GitHub flow](https://guides.github.com/introduction/flow/index.html) to create a new branch, add commits, and open a pull request. 32 | 4. Discuss your code with the maintainer in the pull request thread. 33 | 5. If everything looks good, the maintainer will merge your code into the project. 34 | 35 | Please also follow these additional guidelines. 36 | 37 | * Respect the architecture and reasoning of the package. Depending on the scope of your work, you may want to read the design documents (package vignettes). 38 | * If possible, keep contributions small enough to easily review manually. It is okay to split up your work into multiple pull requests. 39 | * Format your code according to the [tidyverse style guide](https://style.tidyverse.org/) and check your formatting with the `lint_package()` function from the [`lintr`](https://github.com/jimhester/lintr) package. 40 | * For new features or functionality, add tests in `tests`. Tests that can be automated should go in `tests/testthat/`. Tests that cannot be automated should go in `tests/interactive/`. For features affecting performance, it is good practice to add profiling studies to `tests/performance/`. 41 | * Check code coverage with `covr::package_coverage()`. Automated tests should cover all the new or changed functionality in your pull request. 42 | * Run overall package checks with `devtools::check()` and `goodpractice::gp()` 43 | * Describe your contribution in the project's [`NEWS.md`](https://github.com/wlandau/targets-shiny/blob/main/NEWS.md) file. Be sure to mention relevent GitHub issue numbers and your GitHub name as done in existing news entries. 44 | * If you feel contribution is substantial enough for official author or contributor status, please add yourself to the `Authors@R` field of the [`DESCRIPTION`](https://github.com/wlandau/targets-shiny/blob/main/DESCRIPTION) file. 45 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, religion, or sexual identity and 10 | orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the overall 26 | community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or 31 | advances of any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email 35 | address, without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards 42 | of acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies 54 | when an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail 56 | address, posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at [INSERT CONTACT 63 | METHOD]. All complaints will be reviewed and investigated promptly and fairly. 64 | 65 | All community leaders are obligated to respect the privacy and security of the 66 | reporter of any incident. 67 | 68 | ## Enforcement Guidelines 69 | 70 | Community leaders will follow these Community Impact Guidelines in determining 71 | the consequences for any action they deem in violation of this Code of Conduct: 72 | 73 | ### 1. Correction 74 | 75 | **Community Impact**: Use of inappropriate language or other behavior deemed 76 | unprofessional or unwelcome in the community. 77 | 78 | **Consequence**: A private, written warning from community leaders, providing 79 | clarity around the nature of the violation and an explanation of why the 80 | behavior was inappropriate. A public apology may be requested. 81 | 82 | ### 2. Warning 83 | 84 | **Community Impact**: A violation through a single incident or series of 85 | actions. 86 | 87 | **Consequence**: A warning with consequences for continued behavior. No 88 | interaction with the people involved, including unsolicited interaction with 89 | those enforcing the Code of Conduct, for a specified period of time. This 90 | includes avoiding interactions in community spaces as well as external channels 91 | like social media. Violating these terms may lead to a temporary or permanent 92 | ban. 93 | 94 | ### 3. Temporary Ban 95 | 96 | **Community Impact**: A serious violation of community standards, including 97 | sustained inappropriate behavior. 98 | 99 | **Consequence**: A temporary ban from any sort of interaction or public 100 | communication with the community for a specified period of time. No public or 101 | private interaction with the people involved, including unsolicited interaction 102 | with those enforcing the Code of Conduct, is allowed during this period. 103 | Violating these terms may lead to a permanent ban. 104 | 105 | ### 4. Permanent Ban 106 | 107 | **Community Impact**: Demonstrating a pattern of violation of community 108 | standards, including sustained inappropriate behavior, harassment of an 109 | individual, or aggression toward or disparagement of classes of individuals. 110 | 111 | **Consequence**: A permanent ban from any sort of public interaction within the 112 | community. 113 | 114 | ## Attribution 115 | 116 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 117 | version 2.0, 118 | available at https://www.contributor-covenant.org/version/2/0/ 119 | code_of_conduct.html. 120 | 121 | Community Impact Guidelines were inspired by [Mozilla's code of conduct 122 | enforcement ladder](https://github.com/mozilla/diversity). 123 | 124 | [homepage]: https://www.contributor-covenant.org 125 | 126 | For answers to common questions about this code of conduct, see the FAQ at 127 | https://www.contributor-covenant.org/faq. Translations are available at https:// 128 | www.contributor-covenant.org/translations. 129 | -------------------------------------------------------------------------------- /R/project.R: -------------------------------------------------------------------------------- 1 | # All the projects live in project_home(). tools::R_user_dir() 2 | # provides unobtrusive persistent user-specific storage for packages 3 | # and apps. If you are the administrator and need to change where 4 | # persistent user files are stored, this is the place to do so. 5 | # In transient mode, the app only writes to temporary storage. 6 | project_home <- function() { 7 | if (transient_active()) return(file.path(tempdir(), "targets-shiny")) 8 | home <- Sys.getenv("TARGETS_SHINY_HOME") 9 | if (identical(home, "")) { 10 | out <- R_user_dir("targets-shiny", "cache") 11 | } else { 12 | out <- file.path(home, Sys.getenv("USER"), ".targets-shiny") 13 | } 14 | path.expand(out) 15 | } 16 | 17 | # Identify the absolute file path of any file in a project 18 | # given the project's name. 19 | project_path <- function(name, ...) { 20 | file.path(project_home(), name, ...) 21 | } 22 | 23 | # Identify the path of the file that keeps track of the 24 | # currently selected project. 25 | project_marker <- function() { 26 | project_path("_project") 27 | } 28 | 29 | # Identify the path of the YAML config file. 30 | project_config <- function() { 31 | project_path("_targets.yaml") 32 | } 33 | 34 | # Identify the absolute path of the project's stdout log file. 35 | project_stdout <- function() { 36 | project_path(project_get(), "stdout.txt") 37 | } 38 | 39 | # Identify the absolute path of the project's stderr log file. 40 | project_stderr <- function() { 41 | project_path(project_get(), "stderr.txt") 42 | } 43 | 44 | # Identify all the instantiated projects of the current user. 45 | project_list <- function() { 46 | out <- list.dirs(project_home(), full.names = FALSE, recursive = FALSE) 47 | setdiff(out, "_logs") 48 | } 49 | 50 | # Identify the first project in the project list. 51 | # This is useful for finding out which project to switch to 52 | # when the current project is deleted. 53 | project_head <- function() { 54 | head(project_list(), 1) 55 | } 56 | 57 | # Identify the project currently loaded. 58 | project_get <- function() { 59 | path <- project_marker() 60 | if (file.exists(path)) readLines(path) 61 | } 62 | 63 | # Determine if the user is currently in a valid project. 64 | project_exists <- function() { 65 | name <- project_get() 66 | any(nzchar(name)) && file.exists(project_path(name)) 67 | } 68 | 69 | # Internally switch the app to the project with the given name. 70 | project_set <- function(name) { 71 | writeLines(as.character(name), project_marker()) 72 | project_config_set(name) 73 | control_set() 74 | } 75 | 76 | # Switch to the target script file and data store 77 | # of the project with the given name. 78 | project_config_set <- function(name) { 79 | targets::tar_config_set( 80 | config = project_config(), 81 | script = project_path(name, "_targets.R"), 82 | store = project_path(name, "_targets") 83 | ) 84 | } 85 | 86 | # Update the UI to reflect the identity of the current project. 87 | project_select <- function(name = project_get(), choices = project_list()) { 88 | session <- getDefaultReactiveDomain() 89 | updatePickerInput(session, "project", NULL, name, choices) 90 | } 91 | 92 | # Initialize a project but do not switch to it. 93 | # This function has some safety checks on the project name. 94 | project_init <- function(name) { 95 | name <- trimws(name) 96 | valid <- length(name) > 0L && 97 | nzchar(name) && 98 | !(name %in% project_list()) && 99 | identical(name, make.names(name)) 100 | if (!valid) { 101 | msg <- paste( 102 | "Project name must not conflict with other project names", 103 | "and must not contain spaces, leading underscores,", 104 | "or unsafe characters." 105 | ) 106 | shinyalert("Input error", msg) 107 | return(FALSE) 108 | } 109 | dir_create(project_path(name)) 110 | TRUE 111 | } 112 | 113 | # Create a directory for a new project and switch to it, 114 | # but do not fill the directory. 115 | # project_save() populates and refreshes a project's files. 116 | project_create <- function(name) { 117 | if (!project_init(name)) return() 118 | project_set(name) 119 | project_save(c("albumin", "log_bilirubin"), 1000L) 120 | project_select(name) 121 | } 122 | 123 | # Copy over all files from the current project (if it exists) 124 | # except _targets/meta/process (with the PID) and `id` (with the job ID). 125 | project_copy <- function(name) { 126 | old <- project_get() 127 | if (is.null(old)) { 128 | shinyalert("Cannot copy project.", "Select an active project first.") 129 | return() 130 | } 131 | if (!project_init(name)) return() 132 | show_modal_spinner(text = "Copying project...") 133 | on.exit(remove_modal_spinner()) 134 | files <- c( 135 | "_targets.R", 136 | "functions.R", 137 | "settings.rds", 138 | "stderr.txt", 139 | "stdout.txt" 140 | ) 141 | for (file in files) { 142 | if (file.exists(project_path(old, file))) { 143 | file_copy(project_path(old, file), project_path(name, file)) 144 | } 145 | } 146 | if (dir.exists(project_path(old, "_targets"))) { 147 | dir_copy(project_path(old, "_targets"), project_path(name, "_targets")) 148 | } 149 | unlink(project_path(name, "_targets", "meta", "process")) 150 | project_set(name) 151 | project_select(name) 152 | } 153 | 154 | # Delete a project but do not necessarily switch to another. 155 | project_delete <- function(name) { 156 | unlink(project_path(name), recursive = TRUE) 157 | if (!length(project_list())) unlink(project_marker()) 158 | project_select(project_head()) 159 | } 160 | 161 | # Populate or refresh a project's files. 162 | # This happens when a project is created or the user 163 | # changes settings that affect the pipeline. 164 | project_save <- function(biomarkers, iterations) { 165 | if (!project_exists()) return() 166 | name <- project_get() 167 | settings <- list(biomarkers = biomarkers, iterations = iterations) 168 | saveRDS(settings, project_path(name, "settings.rds")) 169 | write_pipeline(name, biomarkers, iterations) 170 | } 171 | 172 | # Load a project and handle errors gracefully. 173 | project_load <- function() { 174 | tryCatch(project_load_try(), error = project_error) 175 | } 176 | 177 | # Set the working directory to the current project, 178 | # read the settings file of the current project 179 | # and update the UI to reflect the project's last known settings. 180 | # Try to load the project. Assumes the project is uncorrupted. 181 | # Errors should be handled gracefully. 182 | project_load_try <- function() { 183 | if (!project_exists()) return() 184 | project_config_set(project_get()) 185 | session <- getDefaultReactiveDomain() 186 | settings <- readRDS(project_path(project_get(), "settings.rds")) 187 | updatePickerInput(session, "biomarkers", selected = settings$biomarkers) 188 | updateSliderInput(session, "iterations", value = settings$iterations) 189 | } 190 | 191 | # Handle a corrupted project. 192 | project_error <- function(error) { 193 | shinyalert( 194 | "Project is corrupted", 195 | conditionMessage(error), 196 | type = "error" 197 | ) 198 | } 199 | 200 | # With the SGE backend, a project may create logs 201 | # outside the project's file system 202 | # (to avoid accidentally creating corrupted projects). 203 | # This function clears out logs from deleted projects. 204 | # Happens once on startup. 205 | project_clear_logs <- function() { 206 | logs <- list.files(project_path("_logs")) 207 | projects <- project_list() 208 | delete <- setdiff(logs, projects) 209 | file_delete(project_path("_logs", delete)) 210 | } 211 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## About 2 | 3 | This prototype app demonstrates how to create powerful data analysis tools with Shiny and [`targets`](https://docs.ropensci.org/targets/). If deployed to appropriate infrastructure, it ensures that user storage and background processes persist after logout. The app recovers running jobs and saved data when the user logs back in. Because of [`targets`](https://docs.ropensci.org/targets/), subsequent runs skip computationally expensive steps that are already up to date. 4 | 5 | ## The case study 6 | 7 | Bayesian joint models of survival and longitudinal non-survival outcomes reduce bias and describe relationships among endpoints ([Gould et al. 2015](https://pubmed.ncbi.nlm.nih.gov/24634327/)). Statisticians routinely refine and explore such complicated models ([Gelman et al. 2020](https://arxiv.org/abs/2011.01808)), but the computation is so slow that routine changes are tedious to refresh. This app shows how [`targets`](https://docs.ropensci.org/targets/) can speed up iteration and Shiny can ease the burden of code development for established use cases. 8 | 9 | ## Usage 10 | 11 | First, install the R package listed in `R/packages.R`. Then, the app locally with `shiny::runApp()`. 12 | 13 | When you first open the app, create a new project to establish a data analysis pipeline. You can create, switch, and delete projects at any time. Next, select the biomarkers and number of Markov chain Monte Carlo iterations. The pipeline will run one [univariate joint model](https://mc-stan.org/rstanarm/articles/jm.html#univariate-joint-model-current-value-association-structure) on each biomarker for the number of iterations you select. Each model analyzes [`rstanarm`](https://mc-stan.org/rstanarm/) datasets [`pbcLong`](https://mc-stan.org/rstanarm/reference/rstanarm-datasets.html) and [`pbcSurv`](https://mc-stan.org/rstanarm/reference/rstanarm-datasets.html) to jointly model survival (time to event) and the biomarker (longitudinally). 14 | 15 | Click the "Run pipeline" button to run the correct models in the correct order. The app button replaces the "Run pipeline" button with the the "Cancel pipeline" button when the pipeline of the current project is running in the background. The pipeline will run to completion even if you switch projects, log out, or get disconnected for idleness. 16 | 17 | While the pipeline is running, the Progress and Logs tabs continuously refresh to monitor progress. The Progress tab uses the [`tar_watch()`](https://docs.ropensci.org/targets/reference/tar_watch.html) Shiny module, available through the functions [`tar_watch_ui()`](https://docs.ropensci.org/targets/reference/tar_watch_ui.html) and [`tar_watch_server()`](https://docs.ropensci.org/targets/reference/tar_watch_server.html). 18 | 19 | The Results tab refreshes the final plot every time the pipeline stops. The plot shows the marginal posterior distribution of the association parameter between mortality and the longitudinal biomarker. 20 | 21 | ## Administration 22 | 23 | 1. Optional: to customize the location of persistent storage, create an `.Renviron` file at the app root and set the `TARGETS_SHINY_HOME` environment variable. If you do, the app will store projects within `file.path(Sys.getenv("TARGETS_SHINY_HOME"), Sys.getenv("USER"), ".targets-shiny")`. Otherwise, storage will default to `tools::R_user_dir("targets-shiny", which = "cache")` 24 | 2. To support persistent pipelines, deploy the app to [Shiny Server](https://rstudio.com/products/shiny/shiny-server/), [RStudio Connect](https://rstudio.com/products/connect/), or other service that supports persistent server-side storage. Alternatively, if you just want to demo the app on a limited service such as [shinyapps.io](https://www.shinyapps.io), set the `TARGETS_SHINY_TRANSIENT` environment variable to `"true"` in the `.Renviron` file in the app root directory. That way, the UI alerts the users that their projects are transient, the app writes to temporary storage (overriding `TARGETS_TRANSIENT_HOME`), and background processes terminate when the app exits. 25 | 3. Require a login so the app knows the user name. 26 | 4. Run the app as the logged-in user, not the system administrator or default user. 27 | 5. If applicable, raise automatic timeout thresholds in [RStudio Connect](https://rstudio.com/products/connect/) so the background processes running pipelines remain alive long enough to finish. 28 | 29 | ## Development 30 | 31 | Shiny apps with [`targets`](https://docs.ropensci.org/targets/) require specialized techniques such as user storage and persistent background processes. 32 | 33 | ### User storage 34 | 35 | [`targets`](https://docs.ropensci.org/targets/) writes to storage to ensure the pipeline stays up to date after R exits. This storage must be persistent and user-specific. This particular app defaults to `tools::R_user_dir("app_name", which = "cache")` but uses `file.path(Sys.getenv("TARGETS_SHINY_HOME"), Sys.getenv("USER"))` if `TARGETS_SHINY_HOME` is defined in the `.Renviron` file at the app root directory. In addition, it is best to deploy to a service like [Shiny Server](https://rstudio.com/products/shiny/shiny-server/) or [RStudio Connect](https://rstudio.com/products/connect/) and provision enough space for the expected number of users. 36 | 37 | ### Multiple projects 38 | 39 | Projects manage multiple versions of the pipeline. In this app, each project is a directory inside user storage with app input settings, pipeline configuration, and results. A top-level `_project` file identifies the current active project. Functions in `R/project.R` configure, load, create, and destroy projects. The `update*()` functions in Shiny and `shinyWidgets`, such as `updateSliderInput()`, are particularly handy for restoring the input settings of a saved project. That is why this app does not need a single `renderUI()` or `uiOutput()`. 40 | 41 | ### Pipeline setup 42 | 43 | Every [`targets`](https://docs.ropensci.org/targets/) pipeline requires a `_targets.R` configuration file and R scripts with supporting functions if applicable. The [`tar_helper()`](https://docs.ropensci.org/targets/reference/tar_helper.html) function writes arbitrary R scripts to the location of your choice, and tidy evaluation with `!!` is a convenient templating mechanism that translates Shiny UI inputs into target definitions. In this app, the functions in `R/pipeline.R` demonstrate the technique. 44 | 45 | ### Persistent background processes 46 | 47 | This particular app runs pipelines as background processes that persist after the user logs out. Before you launch a new pipeline, first check if there is already an existing one running. [`tar_pid()`](https://docs.ropensci.org/targets/reference/tar_pid.html) retrieves the ID of the most recent process to run the pipeline, and [`ps::pid()`](https://ps.r-lib.org/reference/ps_pids.html) lists the IDs of all processes currently running. If no process is already running, start the [`targets`](https://docs.ropensci.org/targets/) pipeline in a persistent background process: 48 | 49 | ```r 50 | processx_handle <- tar_make( 51 | callr_function = r_bg, 52 | callr_arguments = list( 53 | cleanup = FALSE, 54 | supervise = FALSE, 55 | stdout = "/PATH/TO/USER/PROJECT/stdout.txt", 56 | stderr = "/PATH/TO/USER/PROJECT/stderr.txt" 57 | ) 58 | ) 59 | ``` 60 | 61 | `cleanup = FALSE` keeps the process alive after the [`processx`](https://processx.r-lib.org) handle is garbage collected, and `supervise = FALSE` keeps process alive after the app itself exits. As long as the server keeps running, the pipeline will keep running. To help manage resources, the UI should have an action button to cancel the current process, and the server should automatically cancel it when the user deletes the project. 62 | 63 | ### Monitor the background process 64 | 65 | The app should continuously check whether the process is running at any given moment: 66 | 67 | 1. Check if a process ID is available using `targets::tar_exist_process()`. 68 | 2. If possible, get the process ID of the most recent pipeline using `targets::tar_pid()`. 69 | 3. Check if the process ID is in `ps::ps_pids()` to see if the pipeline is running. 70 | 71 | This particular app implements a `process_status()` function to do this. 72 | 73 | ```r 74 | process_status() 75 | #> $pid 76 | #> [1] 19442 77 | #> 78 | #> $running 79 | #> [1] FALSE 80 | ``` 81 | 82 | Inside the Shiny server function, we continuously refresh the status in a reactive value. If polling is expensive (as on an SGE cluster, see below) then please be generous with `millis` in `invalidateLater()`. 83 | 84 | ```r 85 | process <- reactiveValues(status = process_status()) 86 | observe({ 87 | invalidateLater(millis = 5000) 88 | process$status <- process_status() 89 | }) 90 | ``` 91 | 92 | This reactive value helps us: 93 | 94 | 1. Only show certain UI elements if the pipeline is running. Use `process$status$running` to show activity or disable inputs when the pipeline is busy. Useful tools include [`show_spinner()`](https://dreamrs.github.io/shinybusy/reference/manual-spinner.html) from [`shinybusy`](/dreamrs.github.io/shinybusy/) and `show()`, `hide()`, `enable()`, and `disable()` from [`shinyjs`](https://deanattali.com/shinyjs/). 95 | 2. Refresh output and logs when the pipeline starts or stops. Simply write `process$status` inside a reactive context such as `observe()` or `renderPlot()`. 96 | 97 | ### Scaling out to many users 98 | 99 | Serious scalable apps in production should long background processes as jobs on a cluster like SLURM or a cloud computing platform like Amazon Web Services. The [existing high-performance computing capabilities in `targets`](https://books.ropensci.org/targets/hpc.html) alleviate some of this, but the main process of each pipeline still runs locally. If this becomes too burdensome for the server, consider distributing these main processes as well. 100 | 101 | In this app, the file `R/process_sge.R` has analogous functions to `R/process.R` for a Sun Grid Engine (SGE) cluster. The principles are similar to the ones described above for local processes. To configure the app for SGE, set the `TARGETS_SHINY_BACKEND` environment variable equal to `"sge"` in an app-level `.Renviron` file. You may also need to define an app-level `.Rprofile` file to load environment modules into R, e.g. if your cluster serves the `qsub` and `qstat` command line tools as environment modules. 102 | 103 | ### Transient mode 104 | 105 | For demonstration purposes, you may wish to deploy your app to a more limited service like [shinyapps.io](https://www.shinyapps.io). For these situations, consider implementing a transient mode to alert users and clean up resources. If this particular app is deployed with the `TARGETS_SHINY_TRANSIENT` environment variable equal to `"true"`, then: 106 | 107 | 1. `tar_make()` runs with `supervise = TRUE` in `callr_arguments` so that all pipelines terminate when the R session exits. 108 | 2. All user storage lives in a subdirectory of `tempdir()` so project files are automatically cleaned up. 109 | 3. When the app starts, the UI shows a `shinyalert` to warn users about the above. 110 | 111 | 112 | ### Progress 113 | 114 | The [`tar_watch()`](https://docs.ropensci.org/targets/reference/tar_watch.html) Shiny module is available through the functions [`tar_watch_ui()`](https://docs.ropensci.org/targets/reference/tar_watch_ui.html) and [`tar_watch_server()`](https://docs.ropensci.org/targets/reference/tar_watch_server.html). This module continuously refreshes the [`tar_visnetwork()`](https://docs.ropensci.org/targets/reference/tar_visnetwork.html) graph and the [`tar_progress_branches()`](https://docs.ropensci.org/targets/reference/tar_progress_branches.html) table to communicate the current status of the pipeline. Visit [this article](https://shiny.rstudio.com/articles/modules.html) for more information on Shiny modules. 115 | 116 | ### Logs 117 | 118 | The `stdout` and `stderr` log files provide cruder but more immediate information on the progress of the pipeline. To generate logs, set the `stdout` and `stderr` `callr` arguments as described previously. In the app server function, define text outputs that continuously refresh: every few milliseconds when the pipeline is running, once when the pipeline starts or stops, and once when the user switches projects. Below, you may wish to return just the last few lines instead of the full result of `readLines()`. And again, please be generous with `millis` in `invalidateLater()` to avoid overburdening the server. 119 | 120 | ```r 121 | output$stdout <- renderText({ 122 | req(input$project) 123 | process$status 124 | if (process$status$running) invalidateLater(millis = 1000) 125 | readLines("/PATH/TO/USER/PROJECT/stdout.txt") 126 | }) 127 | output$stderr <- renderText({ 128 | req(input$project) 129 | process$status 130 | if (process$status$running) invalidateLater(millis = 1000) 131 | readLines("/PATH/TO/USER/PROJECT/stderr.txt") 132 | }) 133 | ``` 134 | 135 | In the UI, define text outputs that display proper line breaks and enable scrolling: 136 | 137 | ```r 138 | fluidRow( 139 | textOutput("stdout"), 140 | textOutput("stderr"), 141 | tags$head(tags$style("#stdout {white-space: pre-wrap; overflow-y:scroll; max-height: 600px;}")), 142 | tags$head(tags$style("#stderr {white-space: pre-wrap; overflow-y:scroll; max-height: 600px;}")) 143 | ) 144 | ``` 145 | 146 | ### Results 147 | 148 | [`targets`](https://docs.ropensci.org/targets/) stores the output of the pipeline in a `_targets/` folder at the project root. Use [`tar_read()`](https://docs.ropensci.org/targets/reference/tar_read.html) to return a result. We use the `process$status` reactive value to refresh the data sparingly: once when the user switches projects and once when the pipeline starts or stops. 149 | 150 | ```r 151 | output$plot <- renderPlot({ 152 | req(input$project) 153 | process$running 154 | tar_read(final_plot) 155 | }) 156 | ``` 157 | 158 | ## Thanks 159 | 160 | For years, [Eric Nantz](https://shinydevseries.com/authors/admin/) has advanced the space of enterprise Shiny in the life sciences. The motivation for this app comes from his work, and it borrows many of his techniques. 161 | 162 | ## Code of Conduct 163 | 164 | Please note that the `targets-shiny` project is released with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms. 165 | 166 | ## References 167 | 168 | 1. Brilleman S. "Estimating Joint Models for Longitudinal and Time-to-Event Data with rstanarm." `rstanarm`, Stan Development Team, 2020. 169 | 2. Gelman A, Vehtari A, Simpson D, Margossian CC, Carpenter B, Yao Y, Kennedy L, Gabry J, Burkner PC, Modrak M. "Bayesian Workflow." *arXiv* 2020, arXiv:2011.01808, . 170 | 3. Gould AL, Boye ME, Crowther MJ, Ibrahim JG, Quartey G, Micallef S, et al. "Joint modeling of survival and longitudinal non-survival data: current methods and issues. Report of the DIA Bayesian joint modeling working group." *Stat Med.* 2015; 34(14): 2181-95. 171 | --------------------------------------------------------------------------------