├── doc ├── how-it-works.R ├── tips-and-tricks.R ├── how-it-works.Rmd └── tips-and-tricks.Rmd ├── .github ├── .gitignore ├── ISSUE_TEMPLATE │ └── issue_template.md ├── workflows │ ├── test-coverage.yaml │ └── R-CMD-check.yaml ├── CONTRIBUTING.md └── CODE_OF_CONDUCT.md ├── vignettes ├── .gitignore ├── how-it-works.Rmd └── tips-and-tricks.Rmd ├── tests ├── testthat │ ├── test-utilities-constants.R │ ├── demo-rmd-not-reactive.Rmd │ ├── demo-r-server-no-input-list.R │ ├── demo-rmd-no-input-list.Rmd │ ├── demo-r-server-some-inputs.R │ ├── demo-r-server-full.R │ ├── demo-rmd-some-inputs.Rmd │ ├── demo-rmd-full.Rmd │ ├── test-convert-selection.R │ ├── demo-r-runapp-shinyapp_embedded.R │ ├── demo-r-runapp-list.R │ ├── demo-r-runapp-shinyapp_assigned.R │ ├── test-utilities-restart-session.R │ ├── test-utilities-prompts.R │ ├── test-view-ui.R │ ├── test-utilities-find-server-code.R │ ├── test-load-reactive-objects.R │ ├── test-utilities-evaluation.R │ ├── test-utilities-input-code.R │ └── test-utilities-find-and-convert.R ├── testthat.R └── spelling.R ├── R ├── globals.R ├── utilities-constants.R ├── utilities-pipe.R ├── utilities-evaluation.R ├── convert-selection.R ├── utilities-prompts.R ├── view_ui.R ├── utilities-restart-session.R ├── load-reactive-objects.R ├── utilites-find-server-code.R ├── utilities-find-and-convert.R └── utilities-input-code.R ├── .gitignore ├── .gitattributes ├── docs ├── favicon.ico ├── favicon-16x16.png ├── favicon-32x32.png ├── apple-touch-icon.png ├── apple-touch-icon-60x60.png ├── apple-touch-icon-76x76.png ├── reference │ ├── figures │ │ ├── logo.png │ │ ├── view_ui.png │ │ ├── convert_selection.png │ │ ├── view_ui_selection.png │ │ ├── youtube_thumbnail.png │ │ ├── view_ui_after_output.png │ │ └── load_reactive_objects.png │ ├── strings_to_find.html │ ├── valid_assignments.html │ ├── code_to_df.html │ ├── deparse_server.html │ ├── extract_from_app_fn.html │ ├── find_all_assignments.html │ ├── find_all_assignments_r.html │ ├── find_all_assignments_rmd.html │ ├── inside_runapp.html │ ├── which_file.html │ ├── clear_environment.html │ ├── find_input_code.html │ └── input_usage.html ├── apple-touch-icon-120x120.png ├── apple-touch-icon-152x152.png ├── apple-touch-icon-180x180.png ├── pkgdown.yml ├── link.svg ├── bootstrap-toc.css ├── docsearch.js ├── pkgdown.js ├── bootstrap-toc.js └── authors.html ├── man ├── figures │ ├── logo.png │ ├── view_ui.png │ ├── convert_selection.png │ ├── view_ui_selection.png │ ├── youtube_thumbnail.png │ ├── load_reactive_objects.png │ └── view_ui_after_output.png ├── pipe.Rd ├── convert_selection.Rd ├── view_ui.Rd └── load_reactive_objects.Rd ├── pkgdown └── favicon │ ├── favicon.ico │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ ├── apple-touch-icon.png │ ├── apple-touch-icon-60x60.png │ ├── apple-touch-icon-76x76.png │ ├── apple-touch-icon-120x120.png │ ├── apple-touch-icon-152x152.png │ └── apple-touch-icon-180x180.png ├── codecov.yml ├── inst ├── WORDLIST ├── Rmd │ ├── rsconnect │ │ └── documents │ │ │ └── flexdashboard_demo.Rmd │ │ │ └── shinyapps.io │ │ │ └── rjake │ │ │ └── flexdashboard_demo.dcf │ ├── test_dashboard_not_reactive.Rmd │ ├── test_dashboard_no_inputs.Rmd │ ├── flexdashboard_demo.Rmd │ ├── test_dashboard_missing_inputs.Rmd │ └── test_dashboard.Rmd └── shiny │ ├── ui.R │ ├── app.R │ └── server.R ├── .Rbuildignore ├── shinyobjects.Rproj ├── cran-comments.md ├── DESCRIPTION ├── NEWS.md └── NAMESPACE /doc/how-it-works.R: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /tests/testthat/test-utilities-constants.R: -------------------------------------------------------------------------------- 1 | # strings_to_find() ---- 2 | -------------------------------------------------------------------------------- /R/globals.R: -------------------------------------------------------------------------------- 1 | utils::globalVariables( 2 | c(".data", ".", "!<-") 3 | ) 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | inst/doc 3 | .Rhistory 4 | 5 | Meta/vignette.rds 6 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /docs/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/favicon.ico -------------------------------------------------------------------------------- /docs/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/favicon-16x16.png -------------------------------------------------------------------------------- /docs/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/favicon-32x32.png -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/man/figures/logo.png -------------------------------------------------------------------------------- /man/figures/view_ui.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/man/figures/view_ui.png -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(shinyobjects) 3 | 4 | test_check("shinyobjects") 5 | -------------------------------------------------------------------------------- /docs/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/apple-touch-icon.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /docs/apple-touch-icon-60x60.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/apple-touch-icon-60x60.png -------------------------------------------------------------------------------- /docs/apple-touch-icon-76x76.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/apple-touch-icon-76x76.png -------------------------------------------------------------------------------- /docs/reference/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/reference/figures/logo.png -------------------------------------------------------------------------------- /docs/apple-touch-icon-120x120.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/apple-touch-icon-120x120.png -------------------------------------------------------------------------------- /docs/apple-touch-icon-152x152.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/apple-touch-icon-152x152.png -------------------------------------------------------------------------------- /docs/apple-touch-icon-180x180.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/apple-touch-icon-180x180.png -------------------------------------------------------------------------------- /docs/reference/figures/view_ui.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/reference/figures/view_ui.png -------------------------------------------------------------------------------- /man/figures/convert_selection.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/man/figures/convert_selection.png -------------------------------------------------------------------------------- /man/figures/view_ui_selection.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/man/figures/view_ui_selection.png -------------------------------------------------------------------------------- /man/figures/youtube_thumbnail.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/man/figures/youtube_thumbnail.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/pkgdown/favicon/favicon-16x16.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/pkgdown/favicon/favicon-32x32.png -------------------------------------------------------------------------------- /man/figures/load_reactive_objects.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/man/figures/load_reactive_objects.png -------------------------------------------------------------------------------- /man/figures/view_ui_after_output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/man/figures/view_ui_after_output.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | coverage: 2 | status: 3 | project: 4 | default: 5 | target: 100% 6 | comment: 7 | layout: "diff, files" 8 | -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-60x60.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/pkgdown/favicon/apple-touch-icon-60x60.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-76x76.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/pkgdown/favicon/apple-touch-icon-76x76.png -------------------------------------------------------------------------------- /docs/reference/figures/convert_selection.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/reference/figures/convert_selection.png -------------------------------------------------------------------------------- /docs/reference/figures/view_ui_selection.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/reference/figures/view_ui_selection.png -------------------------------------------------------------------------------- /docs/reference/figures/youtube_thumbnail.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/reference/figures/youtube_thumbnail.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-120x120.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/pkgdown/favicon/apple-touch-icon-120x120.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-152x152.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/pkgdown/favicon/apple-touch-icon-152x152.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-180x180.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/pkgdown/favicon/apple-touch-icon-180x180.png -------------------------------------------------------------------------------- /docs/reference/figures/view_ui_after_output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/reference/figures/view_ui_after_output.png -------------------------------------------------------------------------------- /docs/reference/figures/load_reactive_objects.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rjake/shinyobjects/HEAD/docs/reference/figures/load_reactive_objects.png -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | actionButton 2 | dev 3 | flexdashboard 4 | prepopulate 5 | RData 6 | Rmd 7 | RStudio 8 | selectInput 9 | ui 10 | UI 11 | valueBox 12 | -------------------------------------------------------------------------------- /tests/spelling.R: -------------------------------------------------------------------------------- 1 | if (requireNamespace("spelling", quietly = TRUE)) { 2 | spelling::spell_check_test( 3 | vignettes = TRUE, 4 | error = FALSE, 5 | skip_on_cran = TRUE 6 | ) 7 | } 8 | -------------------------------------------------------------------------------- /docs/pkgdown.yml: -------------------------------------------------------------------------------- 1 | pandoc: 2.7.3 2 | pkgdown: 1.5.1 3 | pkgdown_sha: ~ 4 | articles: 5 | how-it-works: how-it-works.html 6 | tips-and-tricks: tips-and-tricks.html 7 | last_built: 2020-12-07T03:37Z 8 | 9 | -------------------------------------------------------------------------------- /tests/testthat/demo-rmd-not-reactive.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Untitled" 3 | output: html_document 4 | --- 5 | 6 | ```{r} 7 | library(shiny) 8 | a <- 1 9 | a 10 | 11 | b = 2 12 | b 13 | ``` 14 | 15 | -------------------------------------------------------------------------------- /R/utilities-constants.R: -------------------------------------------------------------------------------- 1 | #' Valid strings for assignments/column names 2 | #' @noRd 3 | strings_to_find <- function() { 4 | paste0( 5 | "^((library|require)\\(|", 6 | "[\\w\\._\\$0:9]+", 7 | "(\\s)?(<-|=[^=]))" 8 | ) 9 | } 10 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^shinyobjects\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^LICENSE\.md$ 4 | ^README\.Rmd$ 5 | inst/Rmd/rsconnect/ 6 | ^_pkgdown\.yml$ 7 | ^docs$ 8 | ^pkgdown$ 9 | ^\.travis\.yml$ 10 | ^codecov\.yml$ 11 | ^cran-comments\.md$ 12 | ^CRAN-RELEASE$ 13 | ^doc$ 14 | ^Meta$ 15 | -------------------------------------------------------------------------------- /R/utilities-pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @export 9 | #' @importFrom magrittr %>% 10 | #' @usage lhs \%>\% rhs 11 | NULL 12 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities-pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \description{ 10 | See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /tests/testthat/demo-r-server-no-input-list.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | server <- function(input, output) { 4 | my_df <- reactive({ 5 | head(cars, input$x) 6 | }) 7 | 8 | about_df <- reactiveValues(n_obs = nrow(my_df()), len = length(my_df())) 9 | 10 | output$plot <- renderPlot( 11 | plot(my_df()) 12 | ) 13 | } -------------------------------------------------------------------------------- /tests/testthat/demo-rmd-no-input-list.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Untitled" 3 | output: html_document 4 | --- 5 | 6 | ```{r} 7 | library(shiny) 8 | 9 | my_df <- reactive({head(cars, input$x)}) 10 | 11 | about_df <- reactiveValues(n_obs = nrow(my_df()), len = length(my_df())) 12 | 13 | renderText(input$x) 14 | renderText(input$y) 15 | ``` 16 | 17 | -------------------------------------------------------------------------------- /tests/testthat/demo-r-server-some-inputs.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | server <- function(input, output) { 4 | my_df <- reactive({ 5 | head(cars, input$x) 6 | }) 7 | 8 | about_df <- reactiveValues(n_obs = nrow(my_df()), len = length(my_df())) 9 | 10 | output$plot <- renderPlot( 11 | plot(my_df(), main = input$y) 12 | ) 13 | } 14 | 15 | dummy_input <- list(x = 10) 16 | -------------------------------------------------------------------------------- /shinyobjects.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | -------------------------------------------------------------------------------- /tests/testthat/demo-r-server-full.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | server <- function(input, output) { 4 | my_df <- reactive({ 5 | head(cars, input$x) 6 | }) 7 | 8 | about_df <- reactiveValues(n_obs = nrow(my_df()), len = length(my_df())) 9 | 10 | output$plot <- renderPlot( 11 | plot(my_df()) 12 | ) 13 | } 14 | 15 | dummy_input <- list( 16 | x = 10, 17 | y = "Hello" 18 | ) 19 | -------------------------------------------------------------------------------- /inst/Rmd/rsconnect/documents/flexdashboard_demo.Rmd/shinyapps.io/rjake/flexdashboard_demo.dcf: -------------------------------------------------------------------------------- 1 | name: flexdashboard_demo 2 | title: flexdashboard_demo 3 | username: 4 | account: rjake 5 | server: shinyapps.io 6 | hostUrl: https://api.shinyapps.io/v1 7 | appId: 1066392 8 | bundleId: 2288484 9 | url: https://rjake.shinyapps.io/flexdashboard_demo/ 10 | when: 1564853424.07289 11 | asMultiple: FALSE 12 | asStatic: FALSE 13 | -------------------------------------------------------------------------------- /tests/testthat/demo-rmd-some-inputs.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Untitled" 3 | output: html_document 4 | --- 5 | 6 | ```{r, input_demo, eval = FALSE} 7 | input <- 8 | list(x = 10) 9 | ``` 10 | 11 | ```{r} 12 | library(shiny) 13 | renderText(input$x) 14 | renderText(input$y) 15 | my_df <- reactive({ 16 | head(cars, input$x) 17 | }) 18 | 19 | about_df <- reactiveValues(n_obs = nrow(my_df()), len = length(my_df())) 20 | ``` 21 | 22 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Test environments 2 | * local R installation, R 3.6.3 3 | * ubuntu 16.04 (on travis-ci), R 3.6.3 4 | * win-builder (devel) 5 | 6 | ## R CMD check results 7 | 8 | 0 errors | 0 warnings | 0 notes 9 | 10 | * This iteration returns more reactive objects than v 0.1.1 This version gives the user access to output$... objects and the results of eventReactive() and reactiveValues(). There is a bit of refactored code for more robust logic and bug fixes for the objects returned to the user. 11 | -------------------------------------------------------------------------------- /tests/testthat/demo-rmd-full.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Untitled" 3 | output: html_document 4 | --- 5 | 6 | ```{r, input_demo, eval = FALSE} 7 | input <- 8 | list( 9 | x = 10, 10 | y = "Hello" 11 | ) 12 | ``` 13 | 14 | ```{r} 15 | library(shiny) 16 | 17 | a <- 1 18 | a 19 | 20 | b = 2 21 | b 22 | ``` 23 | 24 | ```{r} 25 | my_df <- reactive({ 26 | head(cars, input$x) 27 | }) 28 | 29 | about_df <- reactiveValues(n_obs = nrow(my_df()), len = length(my_df())) 30 | renderText(input$x) 31 | renderText(input$y) 32 | ``` 33 | 34 | -------------------------------------------------------------------------------- /tests/testthat/test-convert-selection.R: -------------------------------------------------------------------------------- 1 | suppressWarnings(library(mockery)) 2 | suppressWarnings(library(shiny)) 3 | 4 | 5 | mock_text <- list( 6 | selection = list( 7 | x = list( 8 | text = "x <- reactive(1+1)\n 9 | y <- reactiveValues(a = 1, b = 2)" 10 | ) 11 | ) 12 | ) 13 | 14 | test_that("convert_selection uses provided environment - R", { 15 | e <- new.env() 16 | stub(convert_selection, "getSourceEditorContext", mock_text) 17 | convert_selection(envir = e) 18 | expect_true(class(e$x) == "function") 19 | }) 20 | 21 | rm(mock_text) 22 | -------------------------------------------------------------------------------- /tests/testthat/demo-r-runapp-shinyapp_embedded.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | # Apps can be run without a server.r and ui.r file 4 | runApp(shinyApp( 5 | ui = fluidPage( 6 | numericInput("x", "# of obs.", 20), 7 | plotOutput("plot") 8 | ), 9 | server = function(input, output) { 10 | my_df <- reactive({ 11 | head(cars, input$x) 12 | }) 13 | 14 | about_df <- reactiveValues(n_obs = nrow(my_df()), len = length(my_df())) 15 | 16 | output$plot <- renderPlot( 17 | plot(my_df()) 18 | ) 19 | } 20 | )) 21 | 22 | dummy_input <- list(x = 10, y = "Hello") 23 | -------------------------------------------------------------------------------- /tests/testthat/demo-r-runapp-list.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | print(getwd()) 4 | # Apps can be run without a server.r and ui.r file 5 | runApp( 6 | list( 7 | ui = fluidPage( 8 | numericInput("x", "# of obs.", 20), 9 | tableOutput("df") 10 | ), 11 | server = function(input, output) { 12 | my_df <- reactive({ 13 | head(cars, input$x) 14 | }) 15 | 16 | about_df <- reactiveValues(n_obs = nrow(my_df()), len = length(my_df())) 17 | 18 | 19 | output$df <- renderTable( 20 | my_df() 21 | ) 22 | } 23 | )) 24 | 25 | dummy_input <- list(x = 10, y = "Hello") 26 | -------------------------------------------------------------------------------- /tests/testthat/demo-r-runapp-shinyapp_assigned.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | # Apps can be run without a server.r and ui.r file 4 | app = shinyApp( 5 | ui = fluidPage( 6 | numericInput("x", "# of obs.", 20), 7 | plotOutput("plot") 8 | ), 9 | server = function(input, output) { 10 | my_df <- reactive({ 11 | head(cars, input$x) 12 | }) 13 | 14 | about_df <- reactiveValues(n_obs = nrow(my_df()), len = length(my_df())) 15 | 16 | output$plot <- renderPlot( 17 | plot(my_df()) 18 | ) 19 | } 20 | ) 21 | 22 | runApp(app) 23 | 24 | dummy_input <- list(x = 10, y = "Hello") 25 | -------------------------------------------------------------------------------- /man/convert_selection.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/convert-selection.R 3 | \name{convert_selection} 4 | \alias{convert_selection} 5 | \title{Convert and load the highlighted assignment to your environment} 6 | \usage{ 7 | convert_selection(envir = NULL) 8 | } 9 | \arguments{ 10 | \item{envir}{the environment shinyobjects should the load the objects into.} 11 | } 12 | \description{ 13 | After highlighting the assignment in the source editor, go to 14 | the console and run this function. The selected code will be run 15 | and if it is reactive, it will be loaded as a function. 16 | } 17 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/issue_template.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report or feature request 3 | about: Describe a bug you've seen or make a case for a new feature 4 | --- 5 | 6 | Please briefly describe your problem and what output you expect. If you have a question, please don't use this form. Instead, ask on or . 7 | 8 | Please include a minimal reproducible example (AKA a reprex). If you've never heard of a [reprex](http://reprex.tidyverse.org/) before, start by reading . 9 | 10 | Brief description of the problem 11 | 12 | ```r 13 | # insert reprex here 14 | ``` 15 | -------------------------------------------------------------------------------- /R/utilities-evaluation.R: -------------------------------------------------------------------------------- 1 | #' tryCatch eval 2 | #' 3 | #' @noRd 4 | #' 5 | eval_code <- function(x, envir = NULL) { 6 | as_char_x <- as.character(x) 7 | 8 | tryCatch( 9 | eval(x, envir = envir), 10 | error = function(e) { 11 | message("there was an error") 12 | print(glue::glue(as_char_x)) 13 | }, 14 | warning = function(w) { 15 | message("there was a warning") 16 | print(glue::glue(as_char_x)) 17 | } 18 | ) 19 | } 20 | 21 | 22 | #' Confirm that function is shiny version of function 23 | #' See tests 24 | #' @noRd 25 | #' @importFrom rlang eval_bare 26 | #' 27 | confirm_function <- function(expr, fun) { 28 | identical(eval_bare(expr), fun) 29 | } 30 | -------------------------------------------------------------------------------- /docs/link.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5 | 8 | 12 | 13 | -------------------------------------------------------------------------------- /R/convert-selection.R: -------------------------------------------------------------------------------- 1 | #' Convert and load the highlighted assignment to your environment 2 | #' 3 | #' After highlighting the assignment in the source editor, go to 4 | #' the console and run this function. The selected code will be run 5 | #' and if it is reactive, it will be loaded as a function. 6 | #' @param envir the environment shinyobjects should the load the objects into. 7 | #' @importFrom rlang parse_exprs 8 | #' @export 9 | #' 10 | #' @importFrom rstudioapi getSourceEditorContext 11 | #' 12 | convert_selection <- function(envir = NULL) { 13 | if (missing(envir)) { 14 | envir <- ask_for_environment() 15 | } 16 | 17 | orig_code <- getSourceEditorContext()$selection[[1]]$text 18 | new_code <- convert_assignments(parse_exprs(orig_code)) 19 | 20 | for (i in seq_along(new_code)) { 21 | eval(new_code[[i]], envir = envir) 22 | } 23 | } 24 | 25 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | 17 | steps: 18 | - uses: actions/checkout@v2 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::covr 27 | needs: coverage 28 | 29 | - name: Test coverage 30 | run: covr::codecov(quiet = FALSE) 31 | shell: Rscript {0} 32 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: shinyobjects 2 | Title: Access Reactive Data Interactively 3 | Version: 0.2.0 4 | Authors@R: person("Jake", "Riley", email = "rjake@sas.upenn.edu", role = c("aut", "cre")) 5 | Description: Troubleshooting reactive data in 'shiny' can be difficult. These functions will convert reactive data frames into functions and load all assigned objects into your local environment. If you create a dummy input object, as the function will suggest, you will be able to test your server and ui functions interactively. 6 | BugReports: https://github.com/rjake/shinyobjects/issues 7 | License: GPL-3 8 | Encoding: UTF-8 9 | LazyData: true 10 | RoxygenNote: 7.1.1 11 | Imports: 12 | dplyr, 13 | glue, 14 | knitr, 15 | magrittr, 16 | methods, 17 | pander, 18 | purrr, 19 | readr, 20 | rlang, 21 | rstudioapi, 22 | shiny, 23 | stringr, 24 | styler, 25 | tibble, 26 | tidyr 27 | VignetteBuilder: knitr 28 | Suggests: 29 | rmarkdown, 30 | testthat, 31 | mockery, 32 | spelling, 33 | covr 34 | Language: en-US 35 | -------------------------------------------------------------------------------- /man/view_ui.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/view_ui.R 3 | \name{view_ui} 4 | \alias{view_ui} 5 | \title{Show UI output in viewer pane} 6 | \usage{ 7 | view_ui(x, close_after = 5) 8 | } 9 | \arguments{ 10 | \item{x}{ui content (actionButton, selectInput, valueBox), if x is not provided, \code{view_ui()} will look for selected text in the source pane or the last output from running the UI code. In the latter case, it expects an object with class "shiny.tag" or "shiny.tag.list"} 11 | 12 | \item{close_after}{number of seconds to display UI in Viewer panel. If NULL, app must be stopped manually before more code can be run.} 13 | } 14 | \description{ 15 | Show UI output in viewer pane 16 | } 17 | \examples{ 18 | if (interactive()) { 19 | # run this line 20 | shiny::selectInput( 21 | "state", 22 | "Choose a state:", 23 | list( 24 | `East Coast` = list("NY", "NJ", "CT"), 25 | `West Coast` = list("WA", "OR", "CA"), 26 | `Midwest` = list("MN", "WI", "IA") 27 | ) 28 | ) 29 | # the output will automatically be used here 30 | view_ui(close_after = 6) 31 | } 32 | 33 | } 34 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # shinyobjects 0.2.0 2 | ### New Features 3 | * `eventReactive()` now parsed to return a function (#55) 4 | * `output$plot <- renderPlot(plot(x))` transformed to `output$plot <- (plot(x))` (#45) 5 | * `reactiveValues()` now converted to `list()` (#29) 6 | ### Bug fixes 7 | * Multi-line `x <- reactive({\n...\n...\n})` statements weren't evaluating inside `runApp()` or `shinyApp()` (#24) 8 | * `dummy_input` removed from objects returned (#50) 9 | * Don't add empty input list unless dummy list in code (#31) 10 | * Rmd evaluated with or without spaces (`eval=F(ALSE)` or `eval = F(ALSE)`) (#26) 11 | ### Other 12 | * Logic for extracting `server` code uses call names instead of indexing (#52, 54) 13 | * Underlying code parses expressions instead of strings (#41) 14 | * Reorganize code (renamed files/functions) (#36 #25) 15 | 16 | # shinyobjects 0.1.1 17 | ### New Features 18 | * `view_ui()` can now run from selected text in the source editor (#19) 19 | ### Bug Fixes 20 | * `convert_selection()` now prompts user for environment if not entered (#16) 21 | ### Other 22 | * New logo (#21) 23 | 24 | # shinyobjects 0.1.0 25 | Initial release 26 | -------------------------------------------------------------------------------- /doc/tips-and-tricks.R: -------------------------------------------------------------------------------- 1 | ## ---- include = FALSE--------------------------------------------------------- 2 | knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE, eval = FALSE) 3 | 4 | input <-list( 5 | displ = 1.8, 6 | year = 2008, 7 | drv = "f" 8 | ) 9 | 10 | ## ----show_plot---------------------------------------------------------------- 11 | # library(tidyverse) 12 | # library(shiny) 13 | # 14 | # raw_data <- mpg 15 | # 16 | # renderPlot({ 17 | # df <- 18 | # raw_data %>% 19 | # filter( 20 | # displ >= input$displ, 21 | # year == input$year, 22 | # drv == input$drv 23 | # ) 24 | # 25 | # ggplot(df, aes(class)) + 26 | # geom_bar() 27 | # }) 28 | 29 | ## ----------------------------------------------------------------------------- 30 | # reactive_df <- reactive( 31 | # raw_data %>% 32 | # filter(displ >= input$displ) 33 | # ) 34 | # 35 | # renderPlot( 36 | # ggplot(reactive_df(), aes(class)) + 37 | # geom_bar() 38 | # ) 39 | 40 | ## ----------------------------------------------------------------------------- 41 | # renderPlot({ 42 | # df <- 43 | # raw_data %>% 44 | # filter(displ >= input$displ) 45 | # 46 | # ggplot(df, aes(class)) + geom_bar() 47 | # }) 48 | 49 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export("%>%") 4 | export(convert_selection) 5 | export(load_reactive_objects) 6 | export(view_ui) 7 | importFrom(dplyr,arrange) 8 | importFrom(dplyr,distinct) 9 | importFrom(dplyr,filter) 10 | importFrom(dplyr,group_by) 11 | importFrom(dplyr,mutate) 12 | importFrom(dplyr,n) 13 | importFrom(dplyr,row_number) 14 | importFrom(dplyr,select) 15 | importFrom(dplyr,summarise) 16 | importFrom(dplyr,ungroup) 17 | importFrom(glue,glue) 18 | importFrom(glue,glue_collapse) 19 | importFrom(knitr,purl) 20 | importFrom(magrittr,"%>%") 21 | importFrom(pander,pandoc.table) 22 | importFrom(readr,read_file) 23 | importFrom(readr,read_lines) 24 | importFrom(rlang,call_standardise) 25 | importFrom(rlang,eval_bare) 26 | importFrom(rlang,expr) 27 | importFrom(rlang,exprs) 28 | importFrom(rlang,parse_exprs) 29 | importFrom(rstudioapi,getSourceEditorContext) 30 | importFrom(rstudioapi,restartSession) 31 | importFrom(rstudioapi,viewer) 32 | importFrom(shiny,fluidPage) 33 | importFrom(shiny,runApp) 34 | importFrom(shiny,shinyApp) 35 | importFrom(shiny,stopApp) 36 | importFrom(stringr,str_detect) 37 | importFrom(stringr,str_extract_all) 38 | importFrom(stringr,str_remove) 39 | importFrom(stringr,str_replace_all) 40 | importFrom(styler,style_text) 41 | importFrom(tibble,tibble) 42 | importFrom(tidyr,unnest) 43 | importFrom(utils,menu) 44 | -------------------------------------------------------------------------------- /R/utilities-prompts.R: -------------------------------------------------------------------------------- 1 | #' Select file to use 2 | #' 3 | #' @param file path to file. 4 | #' 5 | #' @description If the file is not specified, a menu will appear asking the 6 | #' user if they want to use the active source file loaded in RStudio or if they 7 | #' want to select the file (opens a new window). 8 | #' @importFrom utils menu 9 | #' @noRd 10 | which_file <- function(file) { 11 | if (!missing(file)) { 12 | file_to_parse <- file 13 | } else { 14 | current_source <- rstudioapi::getSourceEditorContext()$path 15 | if (is.null(current_source)) { 16 | file_to_parse <- file.choose() 17 | } else { 18 | current_text <- basename(current_source) 19 | find_file <- 20 | menu(c( 21 | paste("Use current file:", current_text), 22 | "Choose file in browser" 23 | )) 24 | if (find_file == 1) { 25 | file_to_parse <- current_source 26 | } else { 27 | file_to_parse <- file.choose() 28 | } 29 | } 30 | } 31 | 32 | file_to_parse 33 | } 34 | 35 | 36 | #' Ask user which environment to use 37 | #' 38 | #' @importFrom utils menu 39 | #' @noRd 40 | ask_for_environment <- function() { 41 | res <- 42 | menu( 43 | choices = c("Global", "New", "Cancel"), 44 | title = "WARNING: Which environment do you want to use?" 45 | ) 46 | 47 | switch( 48 | res, 49 | "1" = .GlobalEnv, 50 | "2" = new.env(), 51 | "3" = stop("Canceled", call. = FALSE) 52 | ) 53 | } -------------------------------------------------------------------------------- /tests/testthat/test-utilities-restart-session.R: -------------------------------------------------------------------------------- 1 | suppressWarnings(library(mockery)) 2 | 3 | e <- new.env() 4 | 5 | items <- 6 | list( 7 | df = iris, 8 | df2 = iris, 9 | x = runif(10) 10 | ) 11 | 12 | 13 | test_that("remove_objects() keeps objects", { 14 | 15 | stub(remove_objects, "menu", 1) 16 | 17 | # only keep items starting with "df" 18 | remove_objects(keep = "^df", envir = list2env(items, e)) 19 | expect_equal( 20 | object = ls(e), 21 | expected = c("df", "df2") 22 | ) 23 | 24 | # confirm output lists items being removed 25 | x <- 26 | capture_message( 27 | remove_objects( 28 | keep = "^df", 29 | envir = list2env(items, envir = e) 30 | ) 31 | ) 32 | 33 | expect_true(grepl("these items will be removed.*- x", x)) 34 | # then drop everything 35 | list2env(items, envir = e) 36 | remove_objects(envir = e) 37 | expect_equal( 38 | object = length(ls(e)), 39 | expected = 0 40 | ) 41 | 42 | # no more items 43 | expect_message(remove_objects(envir = e), "No items to remove") 44 | }) 45 | 46 | 47 | test_that("messages when remove_objects() is canceled", { 48 | stub(remove_objects, "menu", 2) 49 | 50 | keep_none <- remove_objects(envir = list2env(items, envir = e)) 51 | expect_true(grepl("Please specify", keep_none)) 52 | 53 | keep_some <- remove_objects(keep = "x", envir = list2env(items, envir = e)) 54 | expect_true(grepl("Please update", keep_some)) 55 | }) 56 | -------------------------------------------------------------------------------- /tests/testthat/test-utilities-prompts.R: -------------------------------------------------------------------------------- 1 | suppressWarnings(library(mockery)) 2 | 3 | # ask_for_environment() ---- 4 | #test_that("ask_for_environment", TRUE) 5 | 6 | 7 | # which_file()---- 8 | test_that("file name used", { 9 | expected <- "test.R" 10 | actual <- which_file(expected) 11 | expect_equal(actual, expected) 12 | }) 13 | 14 | 15 | test_that("current source editor used", { 16 | expected <- "test.R" 17 | stub( 18 | which_file, 19 | "rstudioapi::getSourceEditorContext", 20 | list(path = expected) 21 | ) 22 | stub(which_file, "is.null", FALSE) 23 | stub(which_file, "menu", 1) 24 | 25 | actual <- which_file() 26 | 27 | expect_equal(actual, expected) 28 | }) 29 | 30 | 31 | test_that("file.choose used bc missing source context", { 32 | expected <- "test.R" 33 | file_choose_mock <- mock() 34 | stub( 35 | which_file, 36 | "rstudioapi::getSourceEditorContext", 37 | NULL 38 | ) 39 | stub(which_file, "file.choose", expected) #file_choose_mock) 40 | actual <- which_file() 41 | expect_equal(actual, expected) 42 | # which_file() 43 | # expect_called(file_choose_mock, n = 1) 44 | }) 45 | 46 | 47 | test_that("file.choose used because selected in menu", { 48 | expected <- "test.R" 49 | stub( 50 | which_file, 51 | "rstudioapi::getSourceEditorContext", 52 | list(path = expected) 53 | ) 54 | stub(which_file, "is.null", FALSE) 55 | stub(which_file, "menu", 2) 56 | stub(which_file, "file.choose", expected, depth = 2) 57 | actual <- which_file() 58 | expect_equal(actual, expected) 59 | }) 60 | 61 | -------------------------------------------------------------------------------- /tests/testthat/test-view-ui.R: -------------------------------------------------------------------------------- 1 | suppressWarnings(library(mockery)) 2 | suppressWarnings(library(shiny)) 3 | 4 | test_that("message if not shiny.tag", { 5 | run_app_mock <- mock() 6 | 7 | stub( 8 | where = view_ui, 9 | what = "shinyApp", 10 | how = "test app" 11 | ) 12 | 13 | stub( 14 | where = view_ui, 15 | what = "runApp", 16 | how = run_app_mock 17 | ) 18 | 19 | x <- "" 20 | 21 | expect_message(view_ui(x)) 22 | }) 23 | 24 | 25 | test_that("parameters were appropriately passed", { 26 | run_app_mock <- mock() 27 | 28 | stub( 29 | where = view_ui, 30 | what = "shinyApp", 31 | how = "test app" 32 | ) 33 | 34 | stub( 35 | where = view_ui, 36 | what = "runApp", 37 | how = run_app_mock 38 | ) 39 | 40 | x <- 41 | tagList( 42 | h4("A header"), 43 | selectInput("select", "Select here", choices = 1:10) 44 | ) 45 | 46 | view_ui(x) 47 | 48 | expect_called(run_app_mock, n = 1) 49 | 50 | expect_args( 51 | mock_object = run_app_mock, 52 | n = 1, 53 | appDir = "test app", 54 | launch.browser = rstudioapi::viewer 55 | ) 56 | }) 57 | 58 | 59 | # test_that("Last.value used if missing", { 60 | # fluid_page_mock <- mock() 61 | # 62 | # stub( 63 | # where = view_ui, 64 | # what = "fluidPage", 65 | # how = fluid_page_mock 66 | # ) 67 | # 68 | # tagList(h4("A header")) 69 | # 70 | # view_ui() 71 | # 72 | # expect_args( 73 | # fluid_page_mock, 74 | # x = tagList(h4("A header")), 75 | # n = 1 76 | # ) 77 | # }) 78 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # added via usethis::use_github_action_check_standard() 2 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 3 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 4 | on: 5 | push: 6 | branches: [main, master] 7 | pull_request: 8 | branches: [main, master] 9 | 10 | name: R-CMD-check 11 | 12 | jobs: 13 | R-CMD-check: 14 | runs-on: ${{ matrix.config.os }} 15 | 16 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 17 | 18 | strategy: 19 | fail-fast: false 20 | matrix: 21 | config: 22 | - {os: macOS-latest, r: 'release'} 23 | - {os: windows-latest, r: 'release'} 24 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 25 | - {os: ubuntu-latest, r: 'release'} 26 | - {os: ubuntu-latest, r: 'oldrel-1'} 27 | 28 | env: 29 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 30 | R_KEEP_PKG_SOURCE: yes 31 | 32 | steps: 33 | - uses: actions/checkout@v2 34 | 35 | - uses: r-lib/actions/setup-pandoc@v2 36 | 37 | - uses: r-lib/actions/setup-r@v2 38 | with: 39 | r-version: ${{ matrix.config.r }} 40 | http-user-agent: ${{ matrix.config.http-user-agent }} 41 | use-public-rspm: true 42 | 43 | - uses: r-lib/actions/setup-r-dependencies@v2 44 | with: 45 | extra-packages: any::rcmdcheck 46 | needs: check 47 | 48 | - uses: r-lib/actions/check-r-package@v2 49 | with: 50 | upload-snapshots: true 51 | -------------------------------------------------------------------------------- /tests/testthat/test-utilities-find-server-code.R: -------------------------------------------------------------------------------- 1 | # breakout_server_code() ---- 2 | test_that("warn if multiple server <- ", { 3 | code <- "server <- 1; server <- 2;" 4 | tmp <- tempfile("data") 5 | write(code, tmp) 6 | expect_warning(breakout_server_code(file = tmp)) 7 | unlink(tmp) 8 | }) 9 | 10 | 11 | test_that("use everything when missing server <- ", { 12 | code <- "a <- 1; b <- 2;" 13 | expected <- parse_exprs("a <- 1; b <- 2") 14 | 15 | tmp <- tempfile("data") 16 | write(code, tmp) 17 | actual <- breakout_server_code(file = tmp) 18 | unlink(tmp) 19 | 20 | expect_equal( 21 | deparse(expected), 22 | deparse(actual) 23 | ) 24 | }) 25 | 26 | test_that("finds all assignments", { 27 | assignments <- 28 | breakout_server_code("demo-r-runapp-list.R") %>% 29 | find_all_assignments_r() %>% 30 | convert_assignments() 31 | 32 | expect_equal(length(assignments), 4) 33 | }) 34 | 35 | 36 | test_that("find all assignments r", { 37 | assignments <- 38 | breakout_server_code("demo-r-server-some-inputs.R") %>% 39 | find_all_assignments_r() 40 | 41 | expect_equal(length(assignments), 4) 42 | }) 43 | 44 | 45 | # extract_from_server_assignment() ---- 46 | 47 | 48 | # extract_from_server_file() ---- 49 | 50 | 51 | # extract_from_app() ---- 52 | 53 | 54 | # update_code() ---- 55 | test_that("update code works", { 56 | x <- list(1, 2, 3) 57 | actual <- update_code(x, c(4, 4), 2) 58 | expected <- list(1, 4, 4, 3) 59 | expect_equal(actual, expected) 60 | }) 61 | 62 | 63 | # is_server_file() ---- 64 | 65 | 66 | # server_is_assigned() ---- 67 | 68 | -------------------------------------------------------------------------------- /tests/testthat/test-load-reactive-objects.R: -------------------------------------------------------------------------------- 1 | # suppressWarnings(library(rlang)) 2 | # suppressWarnings(library(shiny)) 3 | suppressWarnings(library(mockery)) 4 | 5 | test_that("uses provided environment - R", { 6 | e <- new.env() 7 | stub(load_reactive_objects, "interactive", TRUE) 8 | load_reactive_objects(file = "demo-r-runapp-list.R", envir = e) 9 | expect_true(length(ls(e)) == 5) 10 | }) 11 | 12 | 13 | test_that("uses provided environment - Rmd", { 14 | e <- new.env() 15 | stub(load_reactive_objects, "interactive", TRUE) 16 | load_reactive_objects(file = "demo-rmd-full.Rmd", envir = e) 17 | expect_true(length(ls(e)) == 7) 18 | }) 19 | 20 | 21 | 22 | # test_that("uses global environment", { 23 | # stub(load_reactive_objects, "interactive", TRUE) 24 | # stub(ask_for_environment, "menu", 1, 2) 25 | # load_reactive_objects(file = "demo-r-runapp-list.R") 26 | # # print(length(ls(.GlobalEnv))) 27 | # expect_true(length(ls(.GlobalEnv)) == 5) 28 | # }) 29 | 30 | 31 | test_that("uses selected file", { 32 | e <- new.env() 33 | stub(load_reactive_objects, "interactive", TRUE) 34 | stub(load_reactive_objects, "which_file", "demo-r-runapp-list.R") 35 | load_reactive_objects(envir = e) 36 | expect_true(length(ls(e)) == 5) 37 | }) 38 | 39 | 40 | test_that("clears environment", { 41 | e <- test_env() 42 | list2env(list(df1 = iris, df2 = iris3, x = runif(10)), envir = e) 43 | stub(load_reactive_objects, "interactive", TRUE) 44 | stub(remove_objects, "menu", 1) 45 | load_reactive_objects( 46 | file = "demo-r-runapp-list.R", 47 | clear_environment = F, 48 | keep = "x", 49 | envir = e 50 | ) 51 | expect_true(length(ls(e)) == 8) 52 | }) 53 | 54 | -------------------------------------------------------------------------------- /tests/testthat/test-utilities-evaluation.R: -------------------------------------------------------------------------------- 1 | suppressWarnings(library(rlang)) 2 | suppressWarnings(library(shiny)) 3 | 4 | # eval_code() ---- 5 | test_that("eval_code() works", { 6 | x <- eval_code(expr(1 + 1)) 7 | 8 | expect_equal(x, 2) 9 | 10 | expect_message(eval_code(expr(stop())), "there was an error") 11 | expect_message(eval_code(expr(warning())), "there was a warning") 12 | }) 13 | 14 | 15 | 16 | # confirm_function() ---- 17 | test_that("confirm_function works", { 18 | code <- 19 | rlang::parse_exprs( 20 | "n_obs <- reactive(nrow(df())) 21 | 22 | df = shiny::reactive({ 23 | x <- input$cty 24 | mpg %>% filter(cty < x) 25 | }) 26 | 27 | this_is_crazy <- shiny::reactive 28 | #df_head <- this_is_crazy(head(df())) 29 | 30 | runApp(list(ui = NULL, server = function(input, output) {NULL})) 31 | shiny::runApp(list(ui = NULL, server = function(input, output) {NULL})) 32 | 33 | shinyApp(ui = NULL, server = function(input, output) {NULL}) 34 | " 35 | ) 36 | 37 | expect_true(confirm_function(code[[1]][[3]][[1]], shiny::reactive)) 38 | expect_true(confirm_function(code[[2]][[3]][[1]], shiny::reactive)) 39 | expect_true(confirm_function(code[[3]][[3]][[3]], shiny::reactive)) 40 | expect_true(confirm_function(code[[4]][[1]], shiny::runApp)) 41 | expect_true(confirm_function(code[[5]][[1]], shiny::runApp)) 42 | expect_true(confirm_function(code[[6]][[1]], shiny::shinyApp)) 43 | 44 | # e <- new.env() 45 | # for (expr in code) eval(expr, e) 46 | #confirm_function(code[[4]][[3]][[1]], shiny::reactive) 47 | }) 48 | 49 | 50 | 51 | # full_argument_names() ---- 52 | 53 | -------------------------------------------------------------------------------- /inst/shiny/ui.R: -------------------------------------------------------------------------------- 1 | ui <- fluidPage( 2 | 3 | tabsetPanel( 4 | 5 | # OPCIONES 6 | tabPanel( 7 | 8 | "1. Opciones", 9 | br(), 10 | h2("Selecciona los datos que quieres representar"), 11 | selectInput( 12 | inputId = "iris.species", 13 | label = "Especies", 14 | choices = c() 15 | ), 16 | 17 | hr(), 18 | h2("Datos a comparar"), 19 | fluidRow( 20 | column( 21 | 6, 22 | selectInput( 23 | inputId = "iris.section.1", 24 | label = "Eje X", 25 | choices = c() 26 | ) 27 | ), 28 | column( 29 | 6, 30 | selectInput( 31 | inputId = "iris.section.2", 32 | label = "Eje Y", 33 | choices = c() 34 | ) 35 | ) 36 | 37 | ) 38 | ), 39 | 40 | # GRÁFICO 41 | tabPanel( 42 | "2. Gráfico", 43 | h2("Selecciona en el gráfico el rango de datos que quieres ver con más detalles"), 44 | plotOutput( 45 | outputId = "iris.plot", 46 | brush = brushOpts( 47 | id = "iris.plot.brush", 48 | fill = "#9cf", 49 | stroke = "#036", 50 | opacity = 0.25, 51 | delay = 300, 52 | delayType = "debounce", 53 | clip = TRUE, 54 | direction = "xy", 55 | resetOnNew = FALSE 56 | ) 57 | ) 58 | ), 59 | 60 | # DATOS 61 | tabPanel( 62 | "3. Datos", 63 | h2("Datos seleccionados mediante los filtros anteriores"), 64 | dataTableOutput( 65 | outputId = "iris.table" 66 | ) 67 | ) 68 | 69 | ) 70 | 71 | ) -------------------------------------------------------------------------------- /man/load_reactive_objects.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/load-reactive-objects.R 3 | \name{load_reactive_objects} 4 | \alias{load_reactive_objects} 5 | \title{Load inputs and convert reactive functions from an R/Rmd script to your environment} 6 | \usage{ 7 | load_reactive_objects( 8 | file, 9 | restart = FALSE, 10 | envir = NULL, 11 | clear_environment = FALSE, 12 | keep = NULL 13 | ) 14 | } 15 | \arguments{ 16 | \item{file}{Rmd to be evaluated and loaded into your environment} 17 | 18 | \item{restart}{When \code{TRUE}, will restart the current R session. If you have R default to restore RData by default, you will need to use the \code{clear_environment} argument as well} 19 | 20 | \item{envir}{the environment shinyobjects should the load the objects into.} 21 | 22 | \item{clear_environment}{When \code{TRUE}, will remove objects not named in \code{...}} 23 | 24 | \item{keep}{a regular expression of objects to keep when \code{clear_environment = TRUE}} 25 | } 26 | \description{ 27 | This function will run all assignments of your R or Rmd. file In the process, this function will encourage the creation of a dummy \code{input} list that will mimic user input and allow your code to run. Lastly, reactive objects are converted to functions so they can still be called as \code{df()} etc. 28 | } 29 | \section{Warning}{ 30 | 31 | This function has the ability to overwrite your objects in your environment. Make sure you understand how this function works before moving forward. 32 | } 33 | 34 | \examples{ 35 | if (interactive()) { 36 | system.file(package = "shinyobjects", "Rmd/test_dashboard.Rmd") \%>\% 37 | load_reactive_objects() 38 | 39 | system.file(package = "shinyobjects", "Rmd/test_dashboard_no_inputs.Rmd") \%>\% 40 | load_reactive_objects() 41 | 42 | system.file(package = "shinyobjects", "Rmd/test_dashboard_missing_inputs.Rmd") \%>\% 43 | load_reactive_objects() 44 | } 45 | } 46 | -------------------------------------------------------------------------------- /docs/bootstrap-toc.css: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | 6 | /* modified from https://github.com/twbs/bootstrap/blob/94b4076dd2efba9af71f0b18d4ee4b163aa9e0dd/docs/assets/css/src/docs.css#L548-L601 */ 7 | 8 | /* All levels of nav */ 9 | nav[data-toggle='toc'] .nav > li > a { 10 | display: block; 11 | padding: 4px 20px; 12 | font-size: 13px; 13 | font-weight: 500; 14 | color: #767676; 15 | } 16 | nav[data-toggle='toc'] .nav > li > a:hover, 17 | nav[data-toggle='toc'] .nav > li > a:focus { 18 | padding-left: 19px; 19 | color: #563d7c; 20 | text-decoration: none; 21 | background-color: transparent; 22 | border-left: 1px solid #563d7c; 23 | } 24 | nav[data-toggle='toc'] .nav > .active > a, 25 | nav[data-toggle='toc'] .nav > .active:hover > a, 26 | nav[data-toggle='toc'] .nav > .active:focus > a { 27 | padding-left: 18px; 28 | font-weight: bold; 29 | color: #563d7c; 30 | background-color: transparent; 31 | border-left: 2px solid #563d7c; 32 | } 33 | 34 | /* Nav: second level (shown on .active) */ 35 | nav[data-toggle='toc'] .nav .nav { 36 | display: none; /* Hide by default, but at >768px, show it */ 37 | padding-bottom: 10px; 38 | } 39 | nav[data-toggle='toc'] .nav .nav > li > a { 40 | padding-top: 1px; 41 | padding-bottom: 1px; 42 | padding-left: 30px; 43 | font-size: 12px; 44 | font-weight: normal; 45 | } 46 | nav[data-toggle='toc'] .nav .nav > li > a:hover, 47 | nav[data-toggle='toc'] .nav .nav > li > a:focus { 48 | padding-left: 29px; 49 | } 50 | nav[data-toggle='toc'] .nav .nav > .active > a, 51 | nav[data-toggle='toc'] .nav .nav > .active:hover > a, 52 | nav[data-toggle='toc'] .nav .nav > .active:focus > a { 53 | padding-left: 28px; 54 | font-weight: 500; 55 | } 56 | 57 | /* from https://github.com/twbs/bootstrap/blob/e38f066d8c203c3e032da0ff23cd2d6098ee2dd6/docs/assets/css/src/docs.css#L631-L634 */ 58 | nav[data-toggle='toc'] .nav > .active > ul { 59 | display: block; 60 | } 61 | -------------------------------------------------------------------------------- /R/view_ui.R: -------------------------------------------------------------------------------- 1 | #' Show UI output in viewer pane 2 | #' 3 | #' @param x ui content (actionButton, selectInput, valueBox), if x is not provided, \code{view_ui()} will look for selected text in the source pane or the last output from running the UI code. In the latter case, it expects an object with class "shiny.tag" or "shiny.tag.list" 4 | #' @param close_after number of seconds to display UI in Viewer panel. If NULL, app must be stopped manually before more code can be run. 5 | #' @importFrom shiny shinyApp fluidPage runApp stopApp 6 | #' @importFrom rstudioapi viewer getSourceEditorContext 7 | #' @importFrom utils menu 8 | #' @export 9 | #' @examples 10 | #' if (interactive()) { 11 | #' # run this line 12 | #' shiny::selectInput( 13 | #' "state", 14 | #' "Choose a state:", 15 | #' list( 16 | #' `East Coast` = list("NY", "NJ", "CT"), 17 | #' `West Coast` = list("WA", "OR", "CA"), 18 | #' `Midwest` = list("MN", "WI", "IA") 19 | #' ) 20 | #' ) 21 | #' # the output will automatically be used here 22 | #' view_ui(close_after = 6) 23 | #' } 24 | #' 25 | view_ui <- function(x, close_after = 5) { 26 | # nocov start 27 | if (missing(x)) { 28 | selected_text <- rstudioapi::getSourceEditorContext()$selection[[1]]$text 29 | if (nchar(selected_text) > 1) { 30 | res <- 31 | menu( 32 | choices = c("Yes", "No"), 33 | title = "Do you want to use the selected text from the source pane?" 34 | ) 35 | if (res == 1) x <- eval(parse(text = selected_text)) 36 | if (res == 2) x <- .Last.value 37 | } else { 38 | x <- .Last.value 39 | } 40 | } 41 | # nocov end 42 | 43 | if (!class(x)[1] %in% c("shiny.tag", "shiny.tag.list")) { 44 | message( 45 | paste( 46 | 'if output is not what you expected, view_ui() expects', 47 | '"shiny.tag" or "shiny.tag.list"' 48 | ) 49 | ) 50 | } 51 | 52 | ui <- fluidPage(x) 53 | 54 | server <- function(input, output) { 55 | # nocov start 56 | if (!is.null(close_after)) { 57 | Sys.sleep(close_after) 58 | stopApp() 59 | } 60 | # nocov end 61 | } 62 | 63 | app <- shinyApp(ui, server) 64 | 65 | runApp( 66 | appDir = app, 67 | launch.browser = rstudioapi::viewer 68 | ) 69 | } 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /inst/shiny/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(datasets) 3 | 4 | # Data pre-processing ---- 5 | # Tweak the "am" variable to have nicer factor labels -- since this 6 | # doesn't rely on any user inputs, we can do this once at startup 7 | # and then use the value throughout the lifetime of the app 8 | mpgData <- mtcars 9 | mpgData$am <- factor(mpgData$am, labels = c("Automatic", "Manual")) 10 | 11 | 12 | # Define UI for miles per gallon app ---- 13 | ui <- fluidPage( 14 | 15 | # App title ---- 16 | titlePanel("Miles Per Gallon"), 17 | 18 | # Sidebar layout with input and output definitions ---- 19 | sidebarLayout( 20 | 21 | # Sidebar panel for inputs ---- 22 | sidebarPanel( 23 | 24 | # Input: Selector for variable to plot against mpg ---- 25 | selectInput("variable", "Variable:", 26 | c("Cylinders" = "cyl", 27 | "Transmission" = "am", 28 | "Gears" = "gear")), 29 | 30 | # Input: Checkbox for whether outliers should be included ---- 31 | checkboxInput("outliers", "Show outliers", TRUE) 32 | 33 | ), 34 | 35 | # Main panel for displaying outputs ---- 36 | mainPanel( 37 | 38 | # Output: Formatted text for caption ---- 39 | h3(textOutput("caption")), 40 | 41 | # Output: Plot of the requested variable against mpg ---- 42 | plotOutput("mpgPlot") 43 | 44 | ) 45 | ) 46 | ) 47 | 48 | # Define server logic to plot various variables against mpg ---- 49 | server <- function(input, output) { 50 | 51 | # Compute the formula text ---- 52 | # This is in a reactive expression since it is shared by the 53 | # output$caption and output$mpgPlot functions 54 | formulaText <- reactive({ 55 | paste("mpg ~", input$variable) 56 | }) 57 | 58 | # Return the formula text for printing as a caption ---- 59 | output$caption <- renderText({ 60 | formulaText() 61 | }) 62 | 63 | # Generate a plot of the requested variable against mpg ---- 64 | # and only exclude outliers if requested 65 | output$mpgPlot <- renderPlot({ 66 | boxplot(as.formula(formulaText()), 67 | data = mpgData, 68 | outline = input$outliers, 69 | col = "#75AADB", pch = 19) 70 | }) 71 | 72 | } 73 | 74 | # Create Shiny app ---- 75 | shinyApp(ui, server) 76 | -------------------------------------------------------------------------------- /tests/testthat/test-utilities-input-code.R: -------------------------------------------------------------------------------- 1 | # input_usage()---- 2 | test_that("R files look for dummy_input list", { 3 | code <- "x <- input$a;" 4 | expected <- 5 | tibble::tibble( 6 | input_name = "a", 7 | times_used = 1L, 8 | lines = glue::glue("1") 9 | ) 10 | 11 | tmp <- tempfile("data") 12 | write(code, tmp) 13 | actual <- input_usage(file = tmp) 14 | unlink(tmp) 15 | 16 | expect_equal(actual, expected) 17 | }) 18 | 19 | 20 | # find_input_code() ---- 21 | test_that("R files look for dummy_input list", { 22 | code <- "dummy_input <- list(x = 1); y = 2;" 23 | expected <- "input <- list(x = 1)" 24 | 25 | tmp <- tempfile("data", fileext = ".R") 26 | write(code, tmp) 27 | actual <- find_input_code(file = tmp) 28 | unlink(tmp) 29 | 30 | expect_equal(actual, expected) 31 | }) 32 | 33 | 34 | # validate_inputs()---- 35 | test_that("prompt to add dummy input list", { 36 | x_rmd <- 37 | capture_messages( 38 | validate_inputs("demo-rmd-no-input-list.Rmd") 39 | ) 40 | 41 | x_r <- 42 | capture_messages( 43 | validate_inputs("demo-r-server-no-input-list.R") 44 | ) 45 | 46 | expect_true(grepl("Add this code chunk", x_rmd[2])) 47 | expect_true(grepl("Add this code to your R file", x_r[2])) 48 | }) 49 | 50 | 51 | test_that("prompts to update input list", { 52 | x_rmd <- 53 | capture_messages( 54 | validate_inputs("demo-rmd-some-inputs.Rmd") 55 | ) 56 | 57 | x_r <- 58 | capture_messages( 59 | validate_inputs("demo-r-server-some-inputs.R") 60 | ) 61 | 62 | expect_equal(x_rmd, x_r) 63 | expect_true(grepl("Update code", x_rmd[2])) 64 | expect_true(grepl("Update code", x_r[2])) 65 | }) 66 | 67 | 68 | test_that("no prompt for input list because it already exists", { 69 | expect_message( 70 | capture_message( 71 | validate_inputs("demo-r-runapp-list.R") 72 | ), 73 | regexp = NA 74 | ) 75 | expect_message( 76 | capture_message( 77 | validate_inputs("demo-rmd-full.Rmd") 78 | ), 79 | regexp = NA 80 | ) 81 | }) 82 | 83 | 84 | test_that("no prompt for input list because not reactive", { 85 | expect_message( 86 | capture_message( 87 | validate_inputs("demo-rmd-not-reactive.Rmd") 88 | ), 89 | regexp = NA 90 | ) 91 | }) 92 | -------------------------------------------------------------------------------- /docs/docsearch.js: -------------------------------------------------------------------------------- 1 | $(function() { 2 | 3 | // register a handler to move the focus to the search bar 4 | // upon pressing shift + "/" (i.e. "?") 5 | $(document).on('keydown', function(e) { 6 | if (e.shiftKey && e.keyCode == 191) { 7 | e.preventDefault(); 8 | $("#search-input").focus(); 9 | } 10 | }); 11 | 12 | $(document).ready(function() { 13 | // do keyword highlighting 14 | /* modified from https://jsfiddle.net/julmot/bL6bb5oo/ */ 15 | var mark = function() { 16 | 17 | var referrer = document.URL ; 18 | var paramKey = "q" ; 19 | 20 | if (referrer.indexOf("?") !== -1) { 21 | var qs = referrer.substr(referrer.indexOf('?') + 1); 22 | var qs_noanchor = qs.split('#')[0]; 23 | var qsa = qs_noanchor.split('&'); 24 | var keyword = ""; 25 | 26 | for (var i = 0; i < qsa.length; i++) { 27 | var currentParam = qsa[i].split('='); 28 | 29 | if (currentParam.length !== 2) { 30 | continue; 31 | } 32 | 33 | if (currentParam[0] == paramKey) { 34 | keyword = decodeURIComponent(currentParam[1].replace(/\+/g, "%20")); 35 | } 36 | } 37 | 38 | if (keyword !== "") { 39 | $(".contents").unmark({ 40 | done: function() { 41 | $(".contents").mark(keyword); 42 | } 43 | }); 44 | } 45 | } 46 | }; 47 | 48 | mark(); 49 | }); 50 | }); 51 | 52 | /* Search term highlighting ------------------------------*/ 53 | 54 | function matchedWords(hit) { 55 | var words = []; 56 | 57 | var hierarchy = hit._highlightResult.hierarchy; 58 | // loop to fetch from lvl0, lvl1, etc. 59 | for (var idx in hierarchy) { 60 | words = words.concat(hierarchy[idx].matchedWords); 61 | } 62 | 63 | var content = hit._highlightResult.content; 64 | if (content) { 65 | words = words.concat(content.matchedWords); 66 | } 67 | 68 | // return unique words 69 | var words_uniq = [...new Set(words)]; 70 | return words_uniq; 71 | } 72 | 73 | function updateHitURL(hit) { 74 | 75 | var words = matchedWords(hit); 76 | var url = ""; 77 | 78 | if (hit.anchor) { 79 | url = hit.url_without_anchor + '?q=' + escape(words.join(" ")) + '#' + hit.anchor; 80 | } else { 81 | url = hit.url + '?q=' + escape(words.join(" ")); 82 | } 83 | 84 | return url; 85 | } 86 | -------------------------------------------------------------------------------- /inst/Rmd/test_dashboard_not_reactive.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Flexdashboard Demo" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: columns 6 | source_code: embed 7 | theme: lumen 8 | vertical_layout: fill 9 | runtime: shiny 10 | --- 11 | 12 | ```{r setup} 13 | library(tidyverse) 14 | library(shiny) #renderPlot, renderTable, sliderInput 15 | library(shinyWidgets) #radioGroupButtons 16 | get_data <- mpg 17 | ``` 18 | MPG Example 19 | ===================================== 20 | Column {.sidebar data-width=200} 21 | ------------------------------------- 22 | Filter the data: 23 | ```{r filters} 24 | #You can make this sidebar global by putting it ahead of Tab 1 25 | #below are 2 input options: a gorup of buttons, and a slider 26 | radioGroupButtons(#for categorical variables 27 | inputId = "year", #this will allow the selection to be referenced as input$cyl 28 | label = "Select Year of Vehicle", #NULL if you don't want a header 29 | choiceNames = c("All", sort(unique(get_data$year))), #can use paste, etc to make nicer display 30 | choiceValues = c("All", sort(unique(get_data$year))), #values in the data, need to line up with above 31 | justified = T, #will fill the width of the container it sits in (sidebar) 32 | status = "primary") 33 | sliderInput( 34 | inputId = "displ", #referenced as input$displ 35 | label = "Select Weight:", 36 | value = range(get_data$displ), #default selection, you can move the range around 37 | min = (min(get_data$displ)), 38 | max = (max(get_data$displ)), 39 | step = .1) 40 | #This will build a dataframe to use throughout the dashboard. To reference this dataframe, you will need to be in some reactive element ex: renderText({nrow(use_data())}). This is essentially a function and so you will need to use parentheses at the end like this: use_data() 41 | ``` 42 | 43 | Column {data-width=450} 44 | ----------------------------------------------------------------------- 45 | ### Highway MPG by Engine Displacement 46 | ```{r mpg_plot} 47 | renderPlot({ #renderPlot is only required becuase we are referencing someting reactive: use_data(). Otherwise we could just use ggplot(get_data,...) 48 | ggplot(get_data, aes(displ, hwy)) + 49 | geom_smooth(color = "grey65") + 50 | geom_point(aes(color = factor(cyl))) + 51 | ylim(0, 45) + 52 | labs(color = "Cylinder") + 53 | theme(legend.position = "bottom") 54 | }) 55 | ``` 56 | -------------------------------------------------------------------------------- /R/utilities-restart-session.R: -------------------------------------------------------------------------------- 1 | #' Clear all objects in environment 2 | #' 3 | #' @param keep A regular expression of objects in environment to keep 4 | #' 5 | #' @importFrom glue glue 6 | #' @importFrom utils menu 7 | #' @noRd 8 | #' @examples 9 | #' if (interactive()) { 10 | #' e <- new.env() 11 | #' list2env( 12 | #' list( 13 | #' df = iris, 14 | #' df2 = iris, 15 | #' x = runif(10) 16 | #' ), 17 | #' envir = e 18 | #' ) 19 | #' remove_objects(keep = "^df", envir = e) 20 | #' } 21 | remove_objects <- function(keep = NULL, envir = NULL) { 22 | 23 | all_objects <- ls(envir = envir) 24 | base_regex <- "temp_|final_code" 25 | 26 | final_regex <- 27 | ifelse( 28 | missing(keep), 29 | base_regex, 30 | paste(c(base_regex, keep), collapse = "|") 31 | ) %>% 32 | gsub(pattern = "(\\|\\|)+", replacement = "") %>% 33 | gsub(pattern = "\\|$", replacement = "") # ends with |, if keep = "" 34 | 35 | identify_objects <- !grepl(final_regex, all_objects) 36 | remove_objects <- all_objects[identify_objects] 37 | 38 | # list items to be removed and then remove them 39 | if (length(remove_objects) == 0) { 40 | final_result <- "No items to remove" 41 | message(final_result) 42 | 43 | } else { 44 | # list items to be removed 45 | message( 46 | paste( 47 | "these items will be removed or replaced when data is loaded:\n -", 48 | paste(remove_objects, collapse = "\n - ") 49 | ) 50 | ) 51 | 52 | # list items to be kept 53 | if (length(remove_objects) != length(all_objects)) { 54 | message( 55 | paste( 56 | "\nthese items will be kept:\n -", 57 | paste(all_objects[!identify_objects], collapse = "\n - ") 58 | ) 59 | ) 60 | 61 | regex_phrase <- glue('update this argument: keep = "{keep}"') 62 | } else { 63 | regex_phrase <- 'specify objects using the (keep = "") argument' 64 | } 65 | 66 | # confirm selections 67 | confirm <- 68 | menu( 69 | choices = c("Looks good to me", "I need to edit this list"), 70 | title = "Do you want to continue? (Press 0 to exit)" 71 | ) 72 | 73 | # clear environment if enter is used 74 | if (confirm == 1) { 75 | rm(list = remove_objects, envir = envir) 76 | final_result <- "cleared" 77 | } else { 78 | final_result <- glue('Please {regex_phrase}') 79 | } 80 | 81 | final_result 82 | } 83 | } 84 | -------------------------------------------------------------------------------- /inst/shiny/server.R: -------------------------------------------------------------------------------- 1 | dummy_input <- 2 | list( 3 | #iris.plot.brush = , 4 | iris.section.1 = "Petal.Length", 5 | iris.section.2 = "Sepal.Length", 6 | iris.species = "virginica" 7 | ) 8 | # input <- dummy_input 9 | 10 | server <- function(input, output, session) { 11 | 12 | # Especies 13 | observe({ 14 | updateSelectizeInput( 15 | session, 16 | inputId = "iris.species", 17 | choices = sort(iris$Species) 18 | ) 19 | }) 20 | 21 | # Eje X 22 | observe({ 23 | iris.names <- head(names(iris), -1) 24 | updateSelectizeInput( 25 | session, 26 | inputId = "iris.section.1", 27 | choices = sort(iris.names) 28 | ) 29 | }) 30 | 31 | # Eje Y 32 | observe({ 33 | 34 | iris.names <- head(names(iris), -1) 35 | iris.names.selected <- strsplit(input$iris.section.1, split = "[.]")[[1]][1] 36 | iris.type.selected <- strsplit(input$iris.section.1, split = "[.]")[[1]][2] 37 | 38 | iris.names.output <- NA 39 | if (!is.na(iris.type.selected)) { 40 | if (iris.type.selected == "Width") { 41 | iris.names.output <- paste0(iris.names.selected, ".Length") 42 | } else { 43 | iris.names.output <- paste0(iris.names.selected, ".Width") 44 | } 45 | } 46 | 47 | updateSelectizeInput( 48 | session, 49 | inputId = "iris.section.2", 50 | choices = sort(iris.names.output) 51 | ) 52 | 53 | }) 54 | 55 | output$iris.plot <- renderPlot({ 56 | 57 | if ((!is.na(input$iris.section.1)) && (!is.na(input$iris.section.2))) { 58 | iris.data <- iris[iris$Species == input$iris.species,] 59 | with( 60 | iris[iris$Species == input$iris.species,], 61 | plot( 62 | iris.data[,input$iris.section.1], 63 | iris.data[,input$iris.section.2], 64 | main = paste("Iris dataset from", input$iris.species), 65 | xlab = input$iris.section.1, 66 | ylab = input$iris.section.2 67 | ) 68 | ) 69 | } 70 | 71 | }) 72 | 73 | # Obtener datos seleccionados en el gráfico 74 | brushed_data <- reactive({ 75 | brushedPoints( 76 | df = iris[iris$Species == input$iris.species,], 77 | brush = input$iris.plot.brush, 78 | xvar = input$iris.section.1, 79 | yvar = input$iris.section.2, 80 | allRows = FALSE 81 | ) 82 | }) 83 | 84 | output$iris.table <- renderDataTable( 85 | brushed_data() 86 | ) 87 | 88 | } 89 | 90 | a <- stop(error) 91 | b <- warning("test") 92 | -------------------------------------------------------------------------------- /doc/how-it-works.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "How it Works" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{How it Works} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | Under the hood, `shinyobjects` parses your code and moves around the arguments of reactive and rendered objects so that you can interact with them from the global environment. While not required, this workflow works best with a static `input` list that `shinyobjects` can help create. You can read more about the benefits of creating a dummy `input` list [here](https://rjake.github.io/shinyobjects/articles/tips-and-tricks.html#create-a-chunk-to-hold-dummy-input-values) 11 | 12 | ### So what happens? 13 | 14 | The main function, `load_reactive_objects()` takes the following steps: 15 | 16 | * **parse the code** that is active in the source pane or otherwise specified 17 | * can parse `.Rmd` files, apps with a `server.R` file, or files using `shinyServer()`, `runApp()`, or `shinyApp()` 18 | 19 | * **keep** `library()`, `load()`, and assignment calls (`<-` or `=`), everything else is discarded 20 | 21 | * **rewrite the expressions**: 22 | * for `reactive(x = ...)`, the `x` argument is moved to the body of a function. For `eventReactive(event, valueExpr = ...)` it uses the `valueExpr` argument. Thus 23 | ```r 24 | reactive_df <- reactive({ 25 | mtcars %>% 26 | head(input$n) 27 | }) 28 | ``` 29 | becomes 30 | ```r 31 | reactive_df <- function() { 32 | mtcars %>% 33 | head(input$n) 34 | } 35 | ``` 36 | Now that it is a function, you can view and manipulate `reactive_df()` 37 |
38 |
39 | * for `reactiveValues()` 40 | 41 | `x <- reactiveValues(n = input$n)` 42 | 43 | becomes 44 | 45 | `x <- list(n = input$n)` 46 |
47 |
48 | * for `output` assignments 49 | * `output$x <- renderPlot(expr)` 50 | 51 | becomes 52 | 53 | `output$x <- recordPlot(expr)` 54 |
55 |
56 | * for all other `output` assignments, the `expr` arguments are directly assigned 57 | 58 | `output$text <- renderText(paste("there are", input$n, "observations))` 59 | 60 | becomes 61 | 62 | `output$text <- (paste("there are", input$n, "observations))` 63 | 64 | * **evaluate the modified expressions** into the specified environment, usually, the global environment 65 | 66 | 67 | ### Also... 68 | 69 | * `load_reactive_objects()` has options to restart your R session and/or clear out your environment 70 |
71 |
72 | * There are two other functions: 73 | 74 | * `convert_selection()` does a shorter version of these steps using the code highlighted in the source pane 75 |
76 |
77 | * `view_ui()` works with UI components. It takes either the html output in the console or selected code in the source pane and runs a shiny app of just that object. 78 | -------------------------------------------------------------------------------- /vignettes/how-it-works.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "How it Works" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{How it Works} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | Under the hood, `shinyobjects` parses your code and moves around the arguments of reactive and rendered objects so that you can interact with them from the global environment. While not required, this workflow works best with a static `input` list that `shinyobjects` can help create. You can read more about the benefits of creating a dummy `input` list [here](https://rjake.github.io/shinyobjects/articles/tips-and-tricks.html#create-a-chunk-to-hold-dummy-input-values) 11 | 12 | ### So what happens? 13 | 14 | The main function, `load_reactive_objects()` takes the following steps: 15 | 16 | * **parse the code** that is active in the source pane or otherwise specified 17 | * can parse `.Rmd` files, apps with a `server.R` file, or files using `shinyServer()`, `runApp()`, or `shinyApp()` 18 | 19 | * **keep** `library()`, `load()`, and assignment calls (`<-` or `=`), everything else is discarded 20 | 21 | * **rewrite the expressions**: 22 | * for `reactive(x = ...)`, the `x` argument is moved to the body of a function. For `eventReactive(event, valueExpr = ...)` it uses the `valueExpr` argument. Thus 23 | ```r 24 | reactive_df <- reactive({ 25 | mtcars %>% 26 | head(input$n) 27 | }) 28 | ``` 29 | becomes 30 | ```r 31 | reactive_df <- function() { 32 | mtcars %>% 33 | head(input$n) 34 | } 35 | ``` 36 | Now that it is a function, you can view and manipulate `reactive_df()` 37 |
38 |
39 | * for `reactiveValues()` 40 | 41 | `x <- reactiveValues(n = input$n)` 42 | 43 | becomes 44 | 45 | `x <- list(n = input$n)` 46 |
47 |
48 | * for `output` assignments 49 | * `output$x <- renderPlot(expr)` 50 | 51 | becomes 52 | 53 | `output$x <- recordPlot(expr)` 54 |
55 |
56 | * for all other `output` assignments, the `expr` arguments are directly assigned 57 | 58 | `output$text <- renderText(paste("there are", input$n, "observations))` 59 | 60 | becomes 61 | 62 | `output$text <- (paste("there are", input$n, "observations))` 63 | 64 | * **evaluate the modified expressions** into the specified environment, usually, the global environment 65 | 66 | 67 | ### Also... 68 | 69 | * `load_reactive_objects()` has options to restart your R session and/or clear out your environment 70 |
71 |
72 | * There are two other functions: 73 | 74 | * `convert_selection()` does a shorter version of these steps using the code highlighted in the source pane 75 |
76 |
77 | * `view_ui()` works with UI components. It takes either the html output in the console or selected code in the source pane and runs a shiny app of just that object. 78 | -------------------------------------------------------------------------------- /.github/CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to shinyobjects 2 | 3 | This outlines how to propose a change to shinyobjects. 4 | For more detailed info about contributing to this, and other tidyverse packages, please see the 5 | [**development contributing guide**](https://rstd.io/tidy-contrib). 6 | 7 | ## Fixing typos 8 | 9 | You can fix typos, spelling mistakes, or grammatical errors in the documentation directly using the GitHub web interface, as long as the changes are made in the _source_ file. 10 | This generally means you'll need to edit [roxygen2 comments](https://roxygen2.r-lib.org/articles/roxygen2.html) in an `.R`, not a `.Rd` file. 11 | You can find the `.R` file that generates the `.Rd` by reading the comment in the first line. 12 | 13 | ## Bigger changes 14 | 15 | If you want to make a bigger change, it's a good idea to first file an issue and make sure someone from the team agrees that it’s needed. 16 | If you’ve found a bug, please file an issue that illustrates the bug with a minimal 17 | [reprex](https://www.tidyverse.org/help/#reprex) (this will also help you write a unit test, if needed). 18 | 19 | ### Pull request process 20 | 21 | * Fork the package and clone onto your computer. If you haven't done this before, we recommend using `usethis::create_from_github("", fork = TRUE)`. 22 | 23 | * Install all development dependences with `devtools::install_dev_deps()`, and then make sure the package passes R CMD check by running `devtools::check()`. 24 | If R CMD check doesn't pass cleanly, it's a good idea to ask for help before continuing. 25 | * Create a Git branch for your pull request (PR). We recommend using `usethis::pr_init("brief-description-of-change")`. 26 | 27 | * Make your changes, commit to git, and then create a PR by running `usethis::pr_push()`, and following the prompts in your browser. 28 | The title of your PR should briefly describe the change. 29 | The body of your PR should contain `Fixes #issue-number`. 30 | 31 | * For user-facing changes, add a bullet to the top of `NEWS.md` (i.e. just below the first header). Follow the style described in . 32 | 33 | ### Code style 34 | 35 | * New code should follow the tidyverse [style guide](https://style.tidyverse.org). 36 | You can use the [styler](https://CRAN.R-project.org/package=styler) package to apply these styles, but please don't restyle code that has nothing to do with your PR. 37 | 38 | * We use [roxygen2](https://cran.r-project.org/package=roxygen2), with [Markdown syntax](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd-formatting.html), for documentation. 39 | 40 | * We use [testthat](https://cran.r-project.org/package=testthat) for unit tests. 41 | Contributions with test cases included are easier to accept. 42 | 43 | ## Code of Conduct 44 | 45 | Please note that the shinyobjects project is released with a 46 | [Contributor Code of Conduct](CODE_OF_CONDUCT.md). By contributing to this 47 | project you agree to abide by its terms. 48 | -------------------------------------------------------------------------------- /doc/tips-and-tricks.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Tips and Tricks" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Tips and Tricks} 6 | %\VignetteEncoding{UTF-8} 7 | %\VignetteEngine{knitr::rmarkdown} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE, eval = FALSE) 12 | 13 | input <-list( 14 | displ = 1.8, 15 | year = 2008, 16 | drv = "f" 17 | ) 18 | ``` 19 | 20 | It can be challenging to troubleshoot or design the output of reactive data elements in a flexdashboard. Very often, to see a change, the builder has to run the dashboard in order to see the output. This package is designed to alleviate this challenge by turning your reactive objects into functions you can interact with in the console. Here are a few tips that will help you (and others) troubleshoot your code: 21 | 22 | ## Create a chunk to hold dummy input values 23 | If you create a chunk like the code below, you will be able to simulate reactive values like `input$displ` and `input$year` without having to run the whole dashboard. The `input` object created here is a list containing 3 elements (`displ`, `year`, and `drv`). By creating the list named `input` in a chunk of your code, you can simulate the way the values will work when it actually runs. Do note, you will need to use `eval = FALSE` in the chunk so this part of your code will be ignored when the dashboard is run. 24 | 25 | ````r 26 | `r ''````{r input_demo, eval = FALSE} 27 | input <-list( 28 | displ = 1.8, 29 | year = 2008, 30 | drv = "f" 31 | ) 32 | 33 | ``` 34 | ```` 35 | 36 | With the dummy `input` object created earlier, I am able to run the `df` and subsequent `ggplot()` code locally in the console. As a note, running all of `renderPlot()` will only show text in the console but if you run the `df <-` section and the `ggplot()` section, you will have access to `df` in your environment and see the bar chart in the plot pane of RStudio. 37 | 38 | ```{r show_plot} 39 | library(tidyverse) 40 | library(shiny) 41 | 42 | raw_data <- mpg 43 | 44 | renderPlot({ 45 | df <- 46 | raw_data %>% 47 | filter( 48 | displ >= input$displ, 49 | year == input$year, 50 | drv == input$drv 51 | ) 52 | 53 | ggplot(df, aes(class)) + 54 | geom_bar() 55 | }) 56 | ``` 57 | 58 | 59 | ## Put reactive objects within their reactive outputs 60 | I often see something like the code below. Notice that there are two reactive steps: `reactive()` to create the reactive data frame and then `renderPlot()`. 61 | ```{r} 62 | reactive_df <- reactive( 63 | raw_data %>% 64 | filter(displ >= input$displ) 65 | ) 66 | 67 | renderPlot( 68 | ggplot(reactive_df(), aes(class)) + 69 | geom_bar() 70 | ) 71 | ``` 72 | 73 | If this reactive data frame is created *only* for this one plot, you can embed the data manipulation within the `renderPlot()` function. If this data will be used thin two or more outputs in the dashboard and has a lot of data manipulation, a reactive dataframe is a good idea. 74 | 75 | ```{r} 76 | renderPlot({ 77 | df <- 78 | raw_data %>% 79 | filter(displ >= input$displ) 80 | 81 | ggplot(df, aes(class)) + geom_bar() 82 | }) 83 | ``` 84 | 85 | 86 | When you add curly braces `{...}` inside the `renderPlot()` it creates a mini environment where you can create multiple objects. This is similar to how you might do the same in a `function() {...}` or a loop `for(i in 1:10) {...}` 87 | 88 | 89 | ## In summary 90 | * Try to design your code so you can troubleshoot it without having to run it 91 | * Use the curly braces inside your `render*({...})` functions if you need to do data manipulation in order to create an output 92 | -------------------------------------------------------------------------------- /vignettes/tips-and-tricks.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Tips and Tricks" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Tips and Tricks} 6 | %\VignetteEncoding{UTF-8} 7 | %\VignetteEngine{knitr::rmarkdown} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE, eval = FALSE) 12 | 13 | input <-list( 14 | displ = 1.8, 15 | year = 2008, 16 | drv = "f" 17 | ) 18 | ``` 19 | 20 | It can be challenging to troubleshoot or design the output of reactive data elements in a flexdashboard. Very often, to see a change, the builder has to run the dashboard in order to see the output. This package is designed to alleviate this challenge by turning your reactive objects into functions you can interact with in the console. Here are a few tips that will help you (and others) troubleshoot your code: 21 | 22 | ## Create a chunk to hold dummy input values 23 | If you create a chunk like the code below, you will be able to simulate reactive values like `input$displ` and `input$year` without having to run the whole dashboard. The `input` object created here is a list containing 3 elements (`displ`, `year`, and `drv`). By creating the list named `input` in a chunk of your code, you can simulate the way the values will work when it actually runs. Do note, you will need to use `eval = FALSE` in the chunk so this part of your code will be ignored when the dashboard is run. 24 | 25 | ````r 26 | `r ''````{r input_demo, eval = FALSE} 27 | input <-list( 28 | displ = 1.8, 29 | year = 2008, 30 | drv = "f" 31 | ) 32 | 33 | ``` 34 | ```` 35 | 36 | With the dummy `input` object created earlier, I am able to run the `df` and subsequent `ggplot()` code locally in the console. As a note, running all of `renderPlot()` will only show text in the console but if you run the `df <-` section and the `ggplot()` section, you will have access to `df` in your environment and see the bar chart in the plot pane of RStudio. 37 | 38 | ```{r show_plot} 39 | library(tidyverse) 40 | library(shiny) 41 | 42 | raw_data <- mpg 43 | 44 | renderPlot({ 45 | df <- 46 | raw_data %>% 47 | filter( 48 | displ >= input$displ, 49 | year == input$year, 50 | drv == input$drv 51 | ) 52 | 53 | ggplot(df, aes(class)) + 54 | geom_bar() 55 | }) 56 | ``` 57 | 58 | 59 | ## Put reactive objects within their reactive outputs 60 | I often see something like the code below. Notice that there are two reactive steps: `reactive()` to create the reactive data frame and then `renderPlot()`. 61 | ```{r} 62 | reactive_df <- reactive( 63 | raw_data %>% 64 | filter(displ >= input$displ) 65 | ) 66 | 67 | renderPlot( 68 | ggplot(reactive_df(), aes(class)) + 69 | geom_bar() 70 | ) 71 | ``` 72 | 73 | If this reactive data frame is created *only* for this one plot, you can embed the data manipulation within the `renderPlot()` function. If this data will be used thin two or more outputs in the dashboard and has a lot of data manipulation, a reactive dataframe is a good idea. 74 | 75 | ```{r} 76 | renderPlot({ 77 | df <- 78 | raw_data %>% 79 | filter(displ >= input$displ) 80 | 81 | ggplot(df, aes(class)) + geom_bar() 82 | }) 83 | ``` 84 | 85 | 86 | When you add curly braces `{...}` inside the `renderPlot()` it creates a mini environment where you can create multiple objects. This is similar to how you might do the same in a `function() {...}` or a loop `for(i in 1:10) {...}` 87 | 88 | 89 | ## In summary 90 | * Try to design your code so you can troubleshoot it without having to run it 91 | * Use the curly braces inside your `render*({...})` functions if you need to do data manipulation in order to create an output 92 | -------------------------------------------------------------------------------- /tests/testthat/test-utilities-find-and-convert.R: -------------------------------------------------------------------------------- 1 | suppressWarnings(library(shiny)) 2 | suppressWarnings(library(rlang)) 3 | 4 | # find_all_assignments_r() ---- 5 | 6 | 7 | # find_all_assignments_rmd() ---- 8 | test_that("find all assignments rmd", { 9 | assignments <- find_all_assignments_rmd("demo-rmd-full.Rmd") 10 | expect_equal(length(assignments), 5) 11 | }) 12 | 13 | 14 | 15 | # update_expressions() ---- 16 | if (interactive()) { 17 | test_that("output list renderPlot", { 18 | e <- new.env() 19 | e$output <- list() 20 | 21 | x <- expr(output$plot <- renderPlot({plot(cars)})) 22 | 23 | plot(cars) 24 | 25 | eval(update_expressions(x), envir = e) 26 | 27 | expect_equal( 28 | object = class(e$output$plot), 29 | expected = "recordedplot" 30 | ) 31 | }) 32 | } 33 | 34 | test_that("output list renderTable", { 35 | e <- new.env() 36 | e$output <- list() 37 | 38 | x <- expr(output$table <- renderTable({invisible(head(cars))})) 39 | eval(update_expressions(x), envir = e) 40 | 41 | expect_equal( 42 | object = class(e$output$table), 43 | expected = "data.frame" 44 | ) 45 | }) 46 | 47 | 48 | 49 | test_that("updates reactiveValues to list", { 50 | code <- expr(y <- reactiveValues(a = 1, b = 2)) 51 | new_code <- update_expressions(code) 52 | expect_equal( 53 | object = deparse(new_code), 54 | expected = "y <- list(a = 1, b = 2)" 55 | ) 56 | }) 57 | 58 | 59 | 60 | test_that("updates reactive to function", { 61 | testthat::skip_if_not(interactive()) 62 | 63 | code <- expr(y <- reactive({print(input$n)})) 64 | new_code <- update_expressions(code) 65 | actual <- paste(trimws(deparse(new_code)), collapse = "") 66 | expect_equal( 67 | object = actual, 68 | expected = "y <- function() {{print(input$n)}}" 69 | ) 70 | }) 71 | 72 | 73 | 74 | test_that("updates eventReactive to function", { 75 | testthat::skip_if_not(interactive()) 76 | 77 | code <- expr(y <- eventReactive(input$button, {print(input$n)})) 78 | new_code <- update_expressions(code) 79 | actual <- paste(trimws(deparse(new_code)), collapse = "") 80 | expect_equal( 81 | object = actual, 82 | expected = "y <- function() {{print(input$n)}}" 83 | ) 84 | }) 85 | 86 | 87 | 88 | # convert_assignments() ---- 89 | test_that("shiny::reactive() and reactive() both work", { 90 | no_namespace <- exprs(test <- shiny::reactive(123)) 91 | with_namespace <- exprs(test <- reactive(123)) 92 | 93 | expect_equal( 94 | convert_assignments(no_namespace), 95 | convert_assignments(with_namespace) 96 | ) 97 | }) 98 | 99 | 100 | test_that("shiny::reactiveValues() and reactiveValues() both work", { 101 | no_namespace <- exprs(test <- shiny::reactiveValues(a = 1, b = 2)) 102 | with_namespace <- exprs(test <- reactiveValues(a = 1, b = 2)) 103 | 104 | expect_equal( 105 | convert_assignments(no_namespace), 106 | convert_assignments(with_namespace) 107 | ) 108 | }) 109 | 110 | 111 | test_that("assignments can be = or <-", { 112 | x <- c("a", "a = 1", "b == 2", "c <- 3") 113 | expect_equal( 114 | find_all_assignments_r(x), 115 | x[c(2,4)] 116 | ) 117 | }) 118 | 119 | 120 | 121 | 122 | 123 | test_that("find input code", { 124 | inputs_rmd <- find_input_code("demo-rmd-full.Rmd") 125 | inputs_r_runapp <- find_input_code("demo-r-runapp-list.R") 126 | inputs_r_server <- find_input_code("demo-r-server-full.R") 127 | 128 | expect_equal( 129 | inputs_rmd, 130 | inputs_r_runapp, 131 | inputs_r_server, 132 | "input <- list(x = 1, y = 2)" 133 | ) 134 | }) 135 | 136 | 137 | -------------------------------------------------------------------------------- /R/load-reactive-objects.R: -------------------------------------------------------------------------------- 1 | #' Load inputs and convert reactive functions from an R/Rmd script to your environment 2 | #' 3 | #' @description This function will run all assignments of your R or Rmd. file In the process, this function will encourage the creation of a dummy \code{input} list that will mimic user input and allow your code to run. Lastly, reactive objects are converted to functions so they can still be called as \code{df()} etc. 4 | #' @section Warning: 5 | #' This function has the ability to overwrite your objects in your environment. Make sure you understand how this function works before moving forward. 6 | #' 7 | #' @param file Rmd to be evaluated and loaded into your environment 8 | #' @param clear_environment When \code{TRUE}, will remove objects not named in \code{...} 9 | #' @param restart When \code{TRUE}, will restart the current R session. If you have R default to restore RData by default, you will need to use the \code{clear_environment} argument as well 10 | #' @param keep a regular expression of objects to keep when \code{clear_environment = TRUE} 11 | #' @param envir the environment shinyobjects should the load the objects into. 12 | #' 13 | #' @export 14 | #' @importFrom readr read_lines 15 | #' @importFrom rstudioapi restartSession 16 | #' @importFrom rlang parse_exprs 17 | #' 18 | #' @examples 19 | #' if (interactive()) { 20 | #' system.file(package = "shinyobjects", "Rmd/test_dashboard.Rmd") %>% 21 | #' load_reactive_objects() 22 | #' 23 | #' system.file(package = "shinyobjects", "Rmd/test_dashboard_no_inputs.Rmd") %>% 24 | #' load_reactive_objects() 25 | #' 26 | #' system.file(package = "shinyobjects", "Rmd/test_dashboard_missing_inputs.Rmd") %>% 27 | #' load_reactive_objects() 28 | #' } 29 | load_reactive_objects <- function(file, 30 | restart = FALSE, 31 | envir = NULL, 32 | clear_environment = FALSE, 33 | keep = NULL) { 34 | # nocov start 35 | stopifnot(interactive()) 36 | # nocov end 37 | 38 | # confirm environment 39 | if (missing(envir)) { 40 | envir <- ask_for_environment() 41 | } 42 | 43 | # select file if not provided 44 | file_to_parse <- which_file(file) 45 | 46 | # check if Rmd or R 47 | is_rmd <- str_detect(file_to_parse, "[rR]md$") 48 | 49 | # make sure demo inputs exist (if required) 50 | inputs <- validate_inputs(file_to_parse) 51 | 52 | # nocov start 53 | if (restart) { 54 | rstudioapi::restartSession() 55 | } 56 | 57 | if (clear_environment) { 58 | # remove_object will return "cleared" if successful 59 | result <- remove_objects(keep, envir = envir) 60 | if (result != "cleared") { 61 | stop(result, call. = FALSE) 62 | } 63 | } else { 64 | result <- "proceed" 65 | } 66 | # nocov end 67 | 68 | if (result %in% c("cleared", "proceed")) { 69 | # find all libraries and functions ---- 70 | 71 | if (is_rmd) { 72 | # code as tibble (orig + converted functions) 73 | code_to_use <- 74 | find_all_assignments_rmd(file_to_parse) 75 | } else { 76 | # parsed code 77 | code_to_use <- 78 | breakout_server_code(file_to_parse) %>% 79 | find_all_assignments_r() 80 | } 81 | 82 | final_code <- convert_assignments(code_to_use) 83 | 84 | # create ouput & session lists so assignments don't break 85 | if (nchar(inputs) > 0) { 86 | eval_code(parse_exprs(inputs)[[1]], envir = envir) 87 | } 88 | 89 | assign("output", list(), envir) 90 | assign("session", list(), envir) 91 | 92 | # final evaluation 93 | for (i in seq_along(final_code)) { 94 | eval_code(final_code[[i]], envir = envir) 95 | } 96 | } 97 | } 98 | -------------------------------------------------------------------------------- /R/utilites-find-server-code.R: -------------------------------------------------------------------------------- 1 | # Main function ---- 2 | 3 | #' Parse server file for assignments & inputst 4 | #' 5 | #' @param file file to parse 6 | #' @noRd 7 | #' @importFrom rlang parse_exprs 8 | #' @examples 9 | #' if (interactive()) { 10 | #' breakout_server_code(file = "inst/shiny/server.R") %>% 11 | #' substr(1, 30) 12 | #' } 13 | breakout_server_code <- function(file) { 14 | # file <- "tests/testthat/demo-r-runapp-shinyapp_assigned.R" 15 | 16 | code <- parse_exprs(file(file)) 17 | char_code <- as.character(code) 18 | 19 | if (!any(grep("server.*(=|<-)", char_code))) { 20 | code 21 | 22 | } else if (any(server_is_assigned(char_code))) { 23 | extract_from_server_assignment(code) 24 | 25 | } else if (is_server_file(file)) { 26 | extract_from_server_file(code) 27 | 28 | } else { 29 | extract_from_app(code) 30 | } 31 | } 32 | 33 | 34 | # Extract ---- 35 | extract_from_server_assignment <- function(code) { 36 | server_line <- which(server_is_assigned(code)) 37 | 38 | if (length(server_line) > 1) { 39 | server_line <- server_line[1] 40 | warning( 41 | "'server' was assigned twice, only the first instance will be used", 42 | call. = FALSE 43 | ) 44 | } 45 | 46 | server_code <- code[server_line][[1]][[3]] 47 | 48 | if (length(server_code) >= 3) { # confirm it is a function 49 | 50 | # alternative: return(body(eval(code[server_line]))[-1]) 51 | update_code( 52 | code = code, 53 | server_code = server_code[[3]][-1], # -1 removes "{" from expression 54 | replace_line = server_line 55 | ) 56 | } 57 | } 58 | 59 | 60 | extract_from_server_file <- function(code) { 61 | char_code <- code 62 | 63 | if (!any(server_is_assigned(char_code))) { 64 | code 65 | } else { 66 | extract_from_server_assignment(code) 67 | } 68 | } 69 | 70 | 71 | extract_from_app <- function(code) { 72 | # expressions are essentially lists, you can use View() to explore 73 | # ...[-1] removes "{" from expression structure 74 | 75 | # fild line that has server, has to have '...App(..., server = ...)' 76 | app_line <- 77 | which(grepl( 78 | pattern = "(run|shiny)App\\(.*server(\\s)?=", 79 | x = as.character(code) 80 | )) 81 | 82 | orig_code <- code[app_line] 83 | 84 | # confirm type 85 | is_assigned <- as.character(orig_code[[1]][[1]]) %in% c("=", "<-") 86 | is_shinyapp <- confirm_function(orig_code[[1]][[1]], shiny::shinyApp) 87 | is_runapp <- confirm_function(orig_code[[1]][[1]], shiny::runApp) 88 | 89 | if (is_assigned) { 90 | server_code <- orig_code[[1]][[3]] 91 | } else if (is_shinyapp) { 92 | server_code <- orig_code[[1]] # w/in 1 function 93 | } else if (is_runapp) { 94 | server_code <- orig_code[[1]][[2]] # w/in 2 functions 95 | } 96 | 97 | update_code( 98 | code = code, 99 | server_code = server_code[["server"]][[3]][-1], # -1 removes "{" from expression 100 | replace_line = app_line 101 | ) 102 | } 103 | 104 | 105 | # Update code ---- 106 | update_code <- function(code, server_code, replace_line){ 107 | append( 108 | x = code, 109 | values = as.list(server_code), 110 | after = replace_line 111 | )[-replace_line] 112 | } 113 | 114 | 115 | # Test T / F ---- 116 | # Find location of server logic 117 | 118 | is_server_file <- function(file) { 119 | grepl( 120 | pattern = "server.r", 121 | x = file, 122 | ignore.case = TRUE 123 | ) 124 | } 125 | 126 | 127 | server_is_assigned <- function(code) { 128 | grepl( 129 | pattern = "^(shiny::)?(shiny)?server(\\s)*(=|<-)", 130 | x = as.character(code), 131 | ignore.case = TRUE 132 | ) 133 | } 134 | -------------------------------------------------------------------------------- /docs/pkgdown.js: -------------------------------------------------------------------------------- 1 | /* http://gregfranko.com/blog/jquery-best-practices/ */ 2 | (function($) { 3 | $(function() { 4 | 5 | $('.navbar-fixed-top').headroom(); 6 | 7 | $('body').css('padding-top', $('.navbar').height() + 10); 8 | $(window).resize(function(){ 9 | $('body').css('padding-top', $('.navbar').height() + 10); 10 | }); 11 | 12 | $('[data-toggle="tooltip"]').tooltip(); 13 | 14 | var cur_path = paths(location.pathname); 15 | var links = $("#navbar ul li a"); 16 | var max_length = -1; 17 | var pos = -1; 18 | for (var i = 0; i < links.length; i++) { 19 | if (links[i].getAttribute("href") === "#") 20 | continue; 21 | // Ignore external links 22 | if (links[i].host !== location.host) 23 | continue; 24 | 25 | var nav_path = paths(links[i].pathname); 26 | 27 | var length = prefix_length(nav_path, cur_path); 28 | if (length > max_length) { 29 | max_length = length; 30 | pos = i; 31 | } 32 | } 33 | 34 | // Add class to parent
  • , and enclosing
  • if in dropdown 35 | if (pos >= 0) { 36 | var menu_anchor = $(links[pos]); 37 | menu_anchor.parent().addClass("active"); 38 | menu_anchor.closest("li.dropdown").addClass("active"); 39 | } 40 | }); 41 | 42 | function paths(pathname) { 43 | var pieces = pathname.split("/"); 44 | pieces.shift(); // always starts with / 45 | 46 | var end = pieces[pieces.length - 1]; 47 | if (end === "index.html" || end === "") 48 | pieces.pop(); 49 | return(pieces); 50 | } 51 | 52 | // Returns -1 if not found 53 | function prefix_length(needle, haystack) { 54 | if (needle.length > haystack.length) 55 | return(-1); 56 | 57 | // Special case for length-0 haystack, since for loop won't run 58 | if (haystack.length === 0) { 59 | return(needle.length === 0 ? 0 : -1); 60 | } 61 | 62 | for (var i = 0; i < haystack.length; i++) { 63 | if (needle[i] != haystack[i]) 64 | return(i); 65 | } 66 | 67 | return(haystack.length); 68 | } 69 | 70 | /* Clipboard --------------------------*/ 71 | 72 | function changeTooltipMessage(element, msg) { 73 | var tooltipOriginalTitle=element.getAttribute('data-original-title'); 74 | element.setAttribute('data-original-title', msg); 75 | $(element).tooltip('show'); 76 | element.setAttribute('data-original-title', tooltipOriginalTitle); 77 | } 78 | 79 | if(ClipboardJS.isSupported()) { 80 | $(document).ready(function() { 81 | var copyButton = ""; 82 | 83 | $(".examples, div.sourceCode").addClass("hasCopyButton"); 84 | 85 | // Insert copy buttons: 86 | $(copyButton).prependTo(".hasCopyButton"); 87 | 88 | // Initialize tooltips: 89 | $('.btn-copy-ex').tooltip({container: 'body'}); 90 | 91 | // Initialize clipboard: 92 | var clipboardBtnCopies = new ClipboardJS('[data-clipboard-copy]', { 93 | text: function(trigger) { 94 | return trigger.parentNode.textContent; 95 | } 96 | }); 97 | 98 | clipboardBtnCopies.on('success', function(e) { 99 | changeTooltipMessage(e.trigger, 'Copied!'); 100 | e.clearSelection(); 101 | }); 102 | 103 | clipboardBtnCopies.on('error', function() { 104 | changeTooltipMessage(e.trigger,'Press Ctrl+C or Command+C to copy'); 105 | }); 106 | }); 107 | } 108 | })(window.jQuery || window.$) 109 | -------------------------------------------------------------------------------- /R/utilities-find-and-convert.R: -------------------------------------------------------------------------------- 1 | # Find ---- 2 | 3 | #' Find all libraries and assignments for R files 4 | #' 5 | #' @param x code to evaluate 6 | #' 7 | #' @description A data frame of all assignments and libraries 8 | #' @importFrom knitr purl 9 | #' @importFrom stringr str_detect 10 | #' @noRd 11 | find_all_assignments_r <- function(x) { 12 | keep_x <- 13 | str_detect(as.character(x), strings_to_find()) & 14 | !str_detect(as.character(x), "^dummy_(input|output|session)\\b") 15 | 16 | x[keep_x] 17 | } 18 | 19 | 20 | #' Find all libraries and assignments for rmd 21 | #' 22 | #' @param file to evaluate 23 | #' 24 | #' @description A data frame of all assignments and libraries 25 | #' @importFrom knitr purl 26 | #' @importFrom stringr str_detect 27 | #' @importFrom rlang parse_exprs 28 | #' @noRd 29 | find_all_assignments_rmd <- function(file) { 30 | tmp <- purl(file, output = tempfile(), quiet = TRUE) 31 | x <- parse_exprs(file(tmp)) 32 | find_all_assignments_r(x) 33 | } 34 | 35 | 36 | # Convert ---- 37 | 38 | # see notes from Garrick Aden-Buie 39 | # https://gist.github.com/gadenbuie/cc386bdc6a636ba592c520d96af82e3f 40 | 41 | #' Update expressions to be non-reactive 42 | #' @param x code to evaluate 43 | #' @noRd 44 | #' @importFrom rlang expr call_standardise 45 | #' @examples 46 | #' update_expressions( 47 | #' x = expr(y <- eventReactive(input$button, {print(input$n)})) 48 | #' ) 49 | #' update_expressions( 50 | #' x = expr(output$plot <- renderPlot(plot(1, 1))) 51 | #' ) 52 | #' update_expressions( 53 | #' x = expr(output$plot <- shiny::renderPlot(plot(1, 1))) 54 | #' ) 55 | update_expressions <- function(x){ 56 | #char_code <- as.character(as.expression(x)) 57 | # code_as_call <- as.call(x) 58 | 59 | # if not assigned (ex: library(...)) 60 | if ( 61 | x[[1]] != as.symbol("<-") & 62 | x[[1]] != as.symbol("=") & 63 | length(x) != 3 64 | ) { 65 | return(x) 66 | } 67 | 68 | # if no function involved 69 | if (length(x[[3]]) == 1) { 70 | return(x) 71 | } 72 | 73 | # otherwise rearrange 74 | get_symbol <- x[[2]] 75 | get_identity <- x[[3]] 76 | get_fn <- get_identity[[1]] 77 | get_formals <- get_identity[[2]] 78 | 79 | # reactive(...) -> function() {...} 80 | if (confirm_function(get_fn, shiny::reactive)) { 81 | new_expr <- expr(!!get_symbol <- function() { 82 | !!get_formals 83 | }) 84 | 85 | return(new_expr) 86 | } 87 | 88 | # nocov start 89 | # eventReactive(...) -> function() {...} 90 | if (confirm_function(get_fn, shiny::eventReactive)) { 91 | new_expr <- expr(!!get_symbol <- function() { 92 | !!call_standardise(get_identity)[["valueExpr"]] 93 | }) 94 | 95 | return(new_expr) 96 | } 97 | 98 | # reactiveValues(...) -> list(...) 99 | if (confirm_function(get_fn, shiny::reactiveValues)) { 100 | x[[3]][[1]] <- as.symbol("list") 101 | return(x) 102 | } 103 | 104 | # if not an x$y or x[[y]] object 105 | if (length(get_symbol) == 1) { 106 | return(x) 107 | } 108 | 109 | # if not output$x 110 | if (get_symbol[[2]] != as.symbol("output")) { 111 | return(x) 112 | } 113 | 114 | # renderPlot(...) -> recordPlot(...) 115 | if (confirm_function(get_fn, shiny::renderPlot)) { 116 | new_exp <- expr(!!get_symbol <- grDevices::recordPlot(!!get_formals)) 117 | 118 | return(new_exp) 119 | } 120 | 121 | #nocov end 122 | new_exp <- expr(!!get_symbol <- !!get_formals) 123 | 124 | return(new_exp) 125 | } 126 | 127 | 128 | #' Convert reactive dataframes to functions 129 | #' 130 | #' @param x text to be converted 131 | #' @importFrom rlang exprs 132 | #' @noRd 133 | #' @examples 134 | #' convert_assignments( 135 | #' x = exprs(a <- reactive(123), output$x <- renderTable(mtcars)) 136 | #' ) 137 | convert_assignments <- function(x) { 138 | 139 | exp_list <- exprs() 140 | 141 | for (i in seq_along(x)) { 142 | new_code <- 143 | tryCatch( 144 | update_expressions(x[[i]]), 145 | error = function(e) { 146 | message("there was an error") 147 | print(glue::glue(as.character(x))) 148 | } 149 | ) 150 | 151 | exp_list <- 152 | append( 153 | exp_list, 154 | new_code, 155 | after = i - 1 156 | ) 157 | } 158 | 159 | exp_list 160 | } 161 | -------------------------------------------------------------------------------- /inst/Rmd/test_dashboard_no_inputs.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Flexdashboard Demo" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: columns 6 | source_code: embed 7 | theme: lumen 8 | vertical_layout: fill 9 | runtime: shiny 10 | --- 11 | 12 | ```{r setup} 13 | library(tidyverse) 14 | library(shiny) #renderPlot, renderTable, sliderInput 15 | library(shinyWidgets) #radioGroupButtons 16 | get_data <- mpg 17 | ``` 18 | MPG Example 19 | ===================================== 20 | Column {.sidebar data-width=200} 21 | ------------------------------------- 22 | Filter the data: 23 | ```{r filters} 24 | #You can make this sidebar global by putting it ahead of Tab 1 25 | #below are 2 input options: a gorup of buttons, and a slider 26 | radioGroupButtons(#for categorical variables 27 | inputId = "year", #this will allow the selection to be referenced as input$cyl 28 | label = "Select Year of Vehicle", #NULL if you don't want a header 29 | choiceNames = c("All", sort(unique(get_data$year))), #can use paste, etc to make nicer display 30 | choiceValues = c("All", sort(unique(get_data$year))), #values in the data, need to line up with above 31 | justified = T, #will fill the width of the container it sits in (sidebar) 32 | status = "primary") 33 | sliderInput( 34 | inputId = "displ", #referenced as input$displ 35 | label = "Select Weight:", 36 | value = range(get_data$displ), #default selection, you can move the range around 37 | min = (min(get_data$displ)), 38 | max = (max(get_data$displ)), 39 | step = .1) 40 | #This will build a dataframe to use throughout the dashboard. To reference this dataframe, you will need to be in some reactive element ex: renderText({nrow(use_data())}). This is essentially a function and so you will need to use parentheses at the end like this: use_data() 41 | use_data <- 42 | reactive({ 43 | df <- 44 | get_data %>% 45 | filter(between(displ, min(input$displ), max(input$displ))) 46 | 47 | #this if statements will filter for the selection of the radioGroupButtons 48 | if (input$year != "All") { 49 | df <- df %>% filter(year == input$year) 50 | } 51 | 52 | df 53 | }) 54 | ``` 55 | Column {data-width=450} 56 | ----------------------------------------------------------------------- 57 | ### Highway MPG by Engine Displacement 58 | ```{r mpg_plot} 59 | renderPlot({ #renderPlot is only required becuase we are referencing someting reactive: use_data(). Otherwise we could just use ggplot(get_data,...) 60 | ggplot(use_data(), aes(displ, hwy)) + 61 | geom_smooth(color = "grey65") + 62 | geom_point(aes(color = factor(cyl))) + 63 | ylim(0, 45) + 64 | labs(color = "Cylinder") + 65 | theme(legend.position = "bottom") 66 | }) 67 | ``` 68 | Column 69 | ----------------------------------------------------------------------- 70 | ### Top 10 by hwy 71 | ```{r top_10, fig.height = 5.5} 72 | #this will display a top 10 table that is filtered based on the selections above 73 | renderTable(expr = {# use {...} section to create table 74 | use_data() %>% 75 | arrange(desc(hwy)) %>% 76 | slice(1:10) %>% 77 | mutate(Rank = row_number()) %>% 78 | select(Rank, year, manufacturer, model, trans, hwy, fl, class) 79 | }, 80 | spacing = "xs", 81 | align = "l", 82 | bordered = T) 83 | ``` 84 | ### `r renderText({paste("Max Highway MPG by Class in Year:", input$year)})` 85 | ```{r by_class, fig.height = 4.5} 86 | renderTable( 87 | {#you can make separate objects (similar to in a function) 88 | count_n <- 89 | use_data() %>% 90 | count(class) 91 | 92 | max_value <- #this could have been done above, broken into different steps to show how it works 93 | use_data() %>% 94 | group_by(class) %>% 95 | summarise(hwy = max(hwy)) %>% 96 | ungroup() 97 | 98 | #and then add them together for the final product 99 | count_n %>% 100 | left_join(max_value) %>% 101 | arrange(desc(hwy)) %>% 102 | select(hwy, class, `#` = n) 103 | }, 104 | spacing = "xs", 105 | align = "l", 106 | bordered = T) 107 | ``` 108 | Blank Page 109 | ===================================== 110 | Column 111 | ------------------------------------- 112 | ### Box 1 113 | * Find more information about flexdashboards here: 114 | https://rmarkdown.rstudio.com/flexdashboard/using.html#overview 115 | * The `shinyWidgets` gallery has some nice widgets for filtering: 116 | https://dreamrs-vic.shinyapps.io/shinyWidgets/ 117 | The gallery isn't always available. Another overview can be found here: 118 | https://dreamrs.github.io/shinyWidgets/index.html 119 | ```{r box_1} 120 | ``` 121 | 122 | Column {.tabset} 123 | ------------------------------------- 124 | 125 | ### Tab 1 126 | ```{r tab_1} 127 | ``` 128 | 129 | ### Tab 2 130 | ```{r tab_2} 131 | ``` -------------------------------------------------------------------------------- /inst/Rmd/flexdashboard_demo.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Flexdashboard Demo" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: columns 6 | source_code: embed 7 | theme: lumen 8 | vertical_layout: fill 9 | runtime: shiny 10 | --- 11 | 12 | ```{r input_demo, eval = FALSE} 13 | input <- list( 14 | displ = c(2.4, 4.6), 15 | year = 2008 16 | ) 17 | ``` 18 | 19 | 20 | ```{r setup} 21 | library(tidyverse) 22 | #library(shiny) #renderPlot, renderTable, sliderInput 23 | library(shinyWidgets) #radioGroupButtons 24 | 25 | raw_data <- mpg 26 | ``` 27 | 28 | MPG Example 29 | ===================================== 30 | Column {.sidebar data-width=200} 31 | ------------------------------------- 32 | 33 | Filter the data: 34 | 35 | ```{r filters} 36 | #You can make this sidebar global by putting it ahead of Tab 1 37 | 38 | #below are 2 input options: a gorup of buttons, and a slider 39 | radioGroupButtons( # for categorical variables 40 | inputId = "year", # this will allow the selection to be referenced as input$cyl 41 | label = "Select Year of Vehicle", # NULL if you don't want a header 42 | choiceNames = c("All", sort(unique(raw_data$year))), # can use paste, etc to make nicer display 43 | choiceValues = c("All", sort(unique(raw_data$year))), # values in the data, need to line up with above 44 | justified = T, # will fill the width of the container it sits in (sidebar) 45 | status = "primary" 46 | ) 47 | 48 | sliderInput( 49 | inputId = "displ", # referenced as input$displ 50 | label = "Select Engine Displacement:", 51 | value = range(raw_data$displ), # default selection, you can move the range around 52 | min = (min(raw_data$displ)), 53 | max = (max(raw_data$displ)), 54 | step = .1 55 | ) 56 | 57 | # This will build a dataframe to use throughout the dashboard. To reference this dataframe, you will need to be in some reactive element ex: renderText({nrow(use_data())}). This is essentially a function and so you will need to use parentheses at the end like this: use_data() 58 | use_data <- reactive({ 59 | df <- 60 | raw_data %>% 61 | filter(between(displ, min(input$displ), max(input$displ))) 62 | 63 | # this if statements will filter for the selection of the radioGroupButtons 64 | if (input$year != "All") { 65 | df <- df %>% filter(year == input$year) 66 | } 67 | 68 | df 69 | }) 70 | ``` 71 | 72 | 73 | Column {data-width=450} 74 | ----------------------------------------------------------------------- 75 | 76 | ### Highway MPG by Engine Displacement 77 | ```{r mpg_plot} 78 | renderPlot({ # renderPlot is only required becuase we are referencing someting reactive: use_data(). Otherwise we could just use ggplot(raw_data,...) 79 | ggplot(use_data(), aes(displ, hwy)) + 80 | geom_smooth(color = "grey65") + 81 | geom_point(aes(color = factor(cyl))) + 82 | ylim(0, 45) + 83 | labs(color = "Cylinder") + 84 | theme(legend.position = "bottom") 85 | }) 86 | ``` 87 | 88 | Column 89 | ----------------------------------------------------------------------- 90 | 91 | ### Top 10 by hwy 92 | 93 | ```{r top_10, fig.height = 5.5} 94 | #this will display a top 10 table that is filtered based on the selections above 95 | renderTable( 96 | expr = {# use {...} section to create table 97 | use_data() %>% 98 | arrange(desc(hwy)) %>% 99 | slice(1:10) %>% 100 | mutate(Rank = row_number()) %>% 101 | select(Rank, year, manufacturer, model, trans, hwy, fl, class) 102 | }, 103 | # additional arguments for renderTable 104 | spacing = "xs", 105 | align = "l", 106 | bordered = T 107 | ) 108 | ``` 109 | 110 | ### `r renderText({paste("Max Highway MPG by Class in Year:", input$year)})` 111 | ```{r by_class, fig.height = 4.5} 112 | renderTable({ # you can make separate objects (similar to in a function) 113 | count_n <- 114 | use_data() %>% 115 | count(class) 116 | 117 | max_value <- # this could have been done above, but I broke into different steps to show how it works 118 | use_data() %>% 119 | group_by(class) %>% 120 | summarise(hwy = max(hwy)) %>% 121 | ungroup() 122 | 123 | # and then add them together for the final product 124 | count_n %>% 125 | left_join(max_value) %>% 126 | arrange(desc(hwy)) %>% 127 | select(hwy, class, `#` = n) 128 | }, 129 | spacing = "xs", 130 | align = "l", 131 | bordered = T 132 | ) 133 | ``` 134 | 135 | Blank Page 136 | ===================================== 137 | Column 138 | ------------------------------------- 139 | ### Box 1 140 | 141 | * Find more information about flexdashboards here: 142 | https://rmarkdown.rstudio.com/flexdashboard/using.html#overview 143 | 144 | * The `shinyWidgets` gallery has some nice widgets for filtering: 145 | https://dreamrs-vic.shinyapps.io/shinyWidgets/ 146 | The gallery isn't always available. Another overview can be found here: 147 | https://dreamrs.github.io/shinyWidgets/index.html 148 | 149 | ```{r box_1} 150 | 151 | ``` 152 | 153 | Column {.tabset} 154 | ------------------------------------- 155 | 156 | ### Tab 1 157 | ```{r tab_1} 158 | 159 | ``` 160 | 161 | ### Tab 2 162 | ```{r tab_2} 163 | 164 | ``` 165 | -------------------------------------------------------------------------------- /inst/Rmd/test_dashboard_missing_inputs.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Flexdashboard Demo" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: columns 6 | source_code: embed 7 | theme: lumen 8 | vertical_layout: fill 9 | runtime: shiny 10 | --- 11 | 12 | ```{r input_demo, eval = FALSE} 13 | input <- list( 14 | displ = 1.8 15 | ) 16 | ``` 17 | 18 | 19 | ```{r setup} 20 | library(tidyverse) 21 | library(shiny) #renderPlot, renderTable, sliderInput 22 | library(shinyWidgets) #radioGroupButtons 23 | get_data <- mpg 24 | ``` 25 | MPG Example 26 | ===================================== 27 | Column {.sidebar data-width=200} 28 | ------------------------------------- 29 | Filter the data: 30 | ```{r filters} 31 | #You can make this sidebar global by putting it ahead of Tab 1 32 | #below are 2 input options: a gorup of buttons, and a slider 33 | radioGroupButtons(#for categorical variables 34 | inputId = "year", #this will allow the selection to be referenced as input$cyl 35 | label = "Select Year of Vehicle", #NULL if you don't want a header 36 | choiceNames = c("All", sort(unique(get_data$year))), #can use paste, etc to make nicer display 37 | choiceValues = c("All", sort(unique(get_data$year))), #values in the data, need to line up with above 38 | justified = T, #will fill the width of the container it sits in (sidebar) 39 | status = "primary") 40 | sliderInput( 41 | inputId = "displ", #referenced as input$displ 42 | label = "Select Weight:", 43 | value = range(get_data$displ), #default selection, you can move the range around 44 | min = (min(get_data$displ)), 45 | max = (max(get_data$displ)), 46 | step = .1) 47 | #This will build a dataframe to use throughout the dashboard. To reference this dataframe, you will need to be in some reactive element ex: renderText({nrow(use_data())}). This is essentially a function and so you will need to use parentheses at the end like this: use_data() 48 | use_data <- 49 | reactive({ 50 | df <- 51 | get_data %>% 52 | filter(between(displ, min(input$displ), max(input$displ))) 53 | 54 | #this if statements will filter for the selection of the radioGroupButtons 55 | if (input$year != "All") { 56 | df <- df %>% filter(year == input$year) 57 | } 58 | 59 | df 60 | }) 61 | ``` 62 | Column {data-width=450} 63 | ----------------------------------------------------------------------- 64 | ### Highway MPG by Engine Displacement 65 | ```{r mpg_plot} 66 | renderPlot({ #renderPlot is only required becuase we are referencing someting reactive: use_data(). Otherwise we could just use ggplot(get_data,...) 67 | ggplot(use_data(), aes(displ, hwy)) + 68 | geom_smooth(color = "grey65") + 69 | geom_point(aes(color = factor(cyl))) + 70 | ylim(0, 45) + 71 | labs(color = "Cylinder") + 72 | theme(legend.position = "bottom") 73 | }) 74 | ``` 75 | Column 76 | ----------------------------------------------------------------------- 77 | ### Top 10 by hwy 78 | ```{r top_10, fig.height = 5.5} 79 | #this will display a top 10 table that is filtered based on the selections above 80 | renderTable(expr = {# use {...} section to create table 81 | use_data() %>% 82 | arrange(desc(hwy)) %>% 83 | slice(1:10) %>% 84 | mutate(Rank = row_number()) %>% 85 | select(Rank, year, manufacturer, model, trans, hwy, fl, class) 86 | }, 87 | spacing = "xs", 88 | align = "l", 89 | bordered = T) 90 | ``` 91 | ### `r renderText({paste("Max Highway MPG by Class in Year:", input$year)})` 92 | ```{r by_class, fig.height = 4.5} 93 | renderTable( 94 | {#you can make separate objects (similar to in a function) 95 | count_n <- 96 | use_data() %>% 97 | count(class) 98 | 99 | max_value <- #this could have been done above, broken into different steps to show how it works 100 | use_data() %>% 101 | group_by(class) %>% 102 | summarise(hwy = max(hwy)) %>% 103 | ungroup() 104 | 105 | #and then add them together for the final product 106 | count_n %>% 107 | left_join(max_value) %>% 108 | arrange(desc(hwy)) %>% 109 | select(hwy, class, `#` = n) 110 | }, 111 | spacing = "xs", 112 | align = "l", 113 | bordered = T) 114 | ``` 115 | Blank Page 116 | ===================================== 117 | Column 118 | ------------------------------------- 119 | ### Box 1 120 | * Find more information about flexdashboards here: 121 | https://rmarkdown.rstudio.com/flexdashboard/using.html#overview 122 | * The `shinyWidgets` gallery has some nice widgets for filtering: 123 | https://dreamrs-vic.shinyapps.io/shinyWidgets/ 124 | The gallery isn't always available. Another overview can be found here: 125 | https://dreamrs.github.io/shinyWidgets/index.html 126 | ```{r box_1} 127 | ``` 128 | 129 | Column {.tabset} 130 | ------------------------------------- 131 | 132 | ### Tab 1 133 | ```{r tab_1} 134 | ``` 135 | 136 | ### Tab 2 137 | ```{r tab_2} 138 | ``` -------------------------------------------------------------------------------- /inst/Rmd/test_dashboard.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Flexdashboard Demo" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: columns 6 | source_code: embed 7 | theme: lumen 8 | vertical_layout: fill 9 | runtime: shiny 10 | --- 11 | 12 | ```{r input_demo, eval = FALSE} 13 | input <- list( 14 | displ = 1.8, 15 | year = 2008 16 | ) 17 | ``` 18 | 19 | 20 | ```{r setup} 21 | library(tidyverse) 22 | library(shiny) #renderPlot, renderTable, sliderInput 23 | library(shinyWidgets) #radioGroupButtons 24 | get_data <- mpg 25 | ``` 26 | MPG Example 27 | ===================================== 28 | Column {.sidebar data-width=200} 29 | ------------------------------------- 30 | Filter the data: 31 | ```{r filters} 32 | #You can make this sidebar global by putting it ahead of Tab 1 33 | #below are 2 input options: a gorup of buttons, and a slider 34 | radioGroupButtons(#for categorical variables 35 | inputId = "year", #this will allow the selection to be referenced as input$cyl 36 | label = "Select Year of Vehicle", #NULL if you don't want a header 37 | choiceNames = c("All", sort(unique(get_data$year))), #can use paste, etc to make nicer display 38 | choiceValues = c("All", sort(unique(get_data$year))), #values in the data, need to line up with above 39 | justified = T, #will fill the width of the container it sits in (sidebar) 40 | status = "primary") 41 | sliderInput( 42 | inputId = "displ", #referenced as input$displ 43 | label = "Select Weight:", 44 | value = range(get_data$displ), #default selection, you can move the range around 45 | min = (min(get_data$displ)), 46 | max = (max(get_data$displ)), 47 | step = .1) 48 | #This will build a dataframe to use throughout the dashboard. To reference this dataframe, you will need to be in some reactive element ex: renderText({nrow(use_data())}). This is essentially a function and so you will need to use parentheses at the end like this: use_data() 49 | use_data <- 50 | reactive({ 51 | df <- 52 | get_data %>% 53 | filter(between(displ, min(input$displ), max(input$displ))) 54 | 55 | #this if statements will filter for the selection of the radioGroupButtons 56 | if (input$year != "All") { 57 | df <- df %>% filter(year == input$year) 58 | } 59 | 60 | df 61 | }) 62 | ``` 63 | Column {data-width=450} 64 | ----------------------------------------------------------------------- 65 | ### Highway MPG by Engine Displacement 66 | ```{r mpg_plot} 67 | renderPlot({ #renderPlot is only required becuase we are referencing someting reactive: use_data(). Otherwise we could just use ggplot(get_data,...) 68 | ggplot(use_data(), aes(displ, hwy)) + 69 | geom_smooth(color = "grey65") + 70 | geom_point(aes(color = factor(cyl))) + 71 | ylim(0, 45) + 72 | labs(color = "Cylinder") + 73 | theme(legend.position = "bottom") 74 | }) 75 | ``` 76 | Column 77 | ----------------------------------------------------------------------- 78 | ### Top 10 by hwy 79 | ```{r top_10, fig.height = 5.5} 80 | #this will display a top 10 table that is filtered based on the selections above 81 | renderTable(expr = {# use {...} section to create table 82 | use_data() %>% 83 | arrange(desc(hwy)) %>% 84 | slice(1:10) %>% 85 | mutate(Rank = row_number()) %>% 86 | select(Rank, year, manufacturer, model, trans, hwy, fl, class) 87 | }, 88 | spacing = "xs", 89 | align = "l", 90 | bordered = T) 91 | ``` 92 | ### `r renderText({paste("Max Highway MPG by Class in Year:", input$year)})` 93 | ```{r by_class, fig.height = 4.5} 94 | renderTable( 95 | {#you can make separate objects (similar to in a function) 96 | count_n <- 97 | use_data() %>% 98 | count(class) 99 | 100 | max_value <- #this could have been done above, broken into different steps to show how it works 101 | use_data() %>% 102 | group_by(class) %>% 103 | summarise(hwy = max(hwy)) %>% 104 | ungroup() 105 | 106 | #and then add them together for the final product 107 | count_n %>% 108 | left_join(max_value) %>% 109 | arrange(desc(hwy)) %>% 110 | select(hwy, class, `#` = n) 111 | }, 112 | spacing = "xs", 113 | align = "l", 114 | bordered = T) 115 | ``` 116 | Blank Page 117 | ===================================== 118 | Column 119 | ------------------------------------- 120 | ### Box 1 121 | * Find more information about flexdashboards here: 122 | https://rmarkdown.rstudio.com/flexdashboard/using.html#overview 123 | * The `shinyWidgets` gallery has some nice widgets for filtering: 124 | https://dreamrs-vic.shinyapps.io/shinyWidgets/ 125 | The gallery isn't always available. Another overview can be found here: 126 | https://dreamrs.github.io/shinyWidgets/index.html 127 | ```{r box_1} 128 | ``` 129 | 130 | Column {.tabset} 131 | ------------------------------------- 132 | 133 | ### Tab 1 134 | ```{r tab_1} 135 | ``` 136 | 137 | ### Tab 2 138 | ```{r tab_2} 139 | ``` -------------------------------------------------------------------------------- /docs/bootstrap-toc.js: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | (function() { 6 | 'use strict'; 7 | 8 | window.Toc = { 9 | helpers: { 10 | // return all matching elements in the set, or their descendants 11 | findOrFilter: function($el, selector) { 12 | // http://danielnouri.org/notes/2011/03/14/a-jquery-find-that-also-finds-the-root-element/ 13 | // http://stackoverflow.com/a/12731439/358804 14 | var $descendants = $el.find(selector); 15 | return $el.filter(selector).add($descendants).filter(':not([data-toc-skip])'); 16 | }, 17 | 18 | generateUniqueIdBase: function(el) { 19 | var text = $(el).text(); 20 | var anchor = text.trim().toLowerCase().replace(/[^A-Za-z0-9]+/g, '-'); 21 | return anchor || el.tagName.toLowerCase(); 22 | }, 23 | 24 | generateUniqueId: function(el) { 25 | var anchorBase = this.generateUniqueIdBase(el); 26 | for (var i = 0; ; i++) { 27 | var anchor = anchorBase; 28 | if (i > 0) { 29 | // add suffix 30 | anchor += '-' + i; 31 | } 32 | // check if ID already exists 33 | if (!document.getElementById(anchor)) { 34 | return anchor; 35 | } 36 | } 37 | }, 38 | 39 | generateAnchor: function(el) { 40 | if (el.id) { 41 | return el.id; 42 | } else { 43 | var anchor = this.generateUniqueId(el); 44 | el.id = anchor; 45 | return anchor; 46 | } 47 | }, 48 | 49 | createNavList: function() { 50 | return $(''); 51 | }, 52 | 53 | createChildNavList: function($parent) { 54 | var $childList = this.createNavList(); 55 | $parent.append($childList); 56 | return $childList; 57 | }, 58 | 59 | generateNavEl: function(anchor, text) { 60 | var $a = $(''); 61 | $a.attr('href', '#' + anchor); 62 | $a.text(text); 63 | var $li = $('
  • '); 64 | $li.append($a); 65 | return $li; 66 | }, 67 | 68 | generateNavItem: function(headingEl) { 69 | var anchor = this.generateAnchor(headingEl); 70 | var $heading = $(headingEl); 71 | var text = $heading.data('toc-text') || $heading.text(); 72 | return this.generateNavEl(anchor, text); 73 | }, 74 | 75 | // Find the first heading level (`

    `, then `

    `, etc.) that has more than one element. Defaults to 1 (for `

    `). 76 | getTopLevel: function($scope) { 77 | for (var i = 1; i <= 6; i++) { 78 | var $headings = this.findOrFilter($scope, 'h' + i); 79 | if ($headings.length > 1) { 80 | return i; 81 | } 82 | } 83 | 84 | return 1; 85 | }, 86 | 87 | // returns the elements for the top level, and the next below it 88 | getHeadings: function($scope, topLevel) { 89 | var topSelector = 'h' + topLevel; 90 | 91 | var secondaryLevel = topLevel + 1; 92 | var secondarySelector = 'h' + secondaryLevel; 93 | 94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector); 95 | }, 96 | 97 | getNavLevel: function(el) { 98 | return parseInt(el.tagName.charAt(1), 10); 99 | }, 100 | 101 | populateNav: function($topContext, topLevel, $headings) { 102 | var $context = $topContext; 103 | var $prevNav; 104 | 105 | var helpers = this; 106 | $headings.each(function(i, el) { 107 | var $newNav = helpers.generateNavItem(el); 108 | var navLevel = helpers.getNavLevel(el); 109 | 110 | // determine the proper $context 111 | if (navLevel === topLevel) { 112 | // use top level 113 | $context = $topContext; 114 | } else if ($prevNav && $context === $topContext) { 115 | // create a new level of the tree and switch to it 116 | $context = helpers.createChildNavList($prevNav); 117 | } // else use the current $context 118 | 119 | $context.append($newNav); 120 | 121 | $prevNav = $newNav; 122 | }); 123 | }, 124 | 125 | parseOps: function(arg) { 126 | var opts; 127 | if (arg.jquery) { 128 | opts = { 129 | $nav: arg 130 | }; 131 | } else { 132 | opts = arg; 133 | } 134 | opts.$scope = opts.$scope || $(document.body); 135 | return opts; 136 | } 137 | }, 138 | 139 | // accepts a jQuery object, or an options object 140 | init: function(opts) { 141 | opts = this.helpers.parseOps(opts); 142 | 143 | // ensure that the data attribute is in place for styling 144 | opts.$nav.attr('data-toggle', 'toc'); 145 | 146 | var $topContext = this.helpers.createChildNavList(opts.$nav); 147 | var topLevel = this.helpers.getTopLevel(opts.$scope); 148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel); 149 | this.helpers.populateNav($topContext, topLevel, $headings); 150 | } 151 | }; 152 | 153 | $(function() { 154 | $('nav[data-toggle="toc"]').each(function(i, el) { 155 | var $nav = $(el); 156 | Toc.init($nav); 157 | }); 158 | }); 159 | })(); 160 | -------------------------------------------------------------------------------- /docs/reference/strings_to_find.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Valid strings for assignments/column names — strings_to_find • shinysim 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 51 | 52 | 53 | 54 | 55 | 56 |
    57 |
    58 | 104 | 105 | 106 |
    107 | 108 |
    109 |
    110 | 115 | 116 |
    117 |

    Valid strings for assignments/column names

    118 |
    119 | 120 |
    strings_to_find()
    121 | 122 | 123 | 124 |
    125 | 131 |
    132 | 133 |
    134 | 137 | 138 |
    139 |

    Site built with pkgdown 1.3.0.

    140 |
    141 |
    142 |
    143 | 144 | 145 | 146 | 147 | 148 | 149 | -------------------------------------------------------------------------------- /docs/reference/valid_assignments.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Valid strings for assignments/column names — valid_assignments • shinysim 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 51 | 52 | 53 | 54 | 55 | 56 |
    57 |
    58 | 104 | 105 | 106 |
    107 | 108 |
    109 |
    110 | 115 | 116 |
    117 |

    Valid strings for assignments/column names

    118 |
    119 | 120 |
    valid_assignments()
    121 | 122 | 123 | 124 |
    125 | 131 |
    132 | 133 |
    134 | 137 | 138 |
    139 |

    Site built with pkgdown 1.3.0.

    140 |
    141 |
    142 |
    143 | 144 | 145 | 146 | 147 | 148 | 149 | -------------------------------------------------------------------------------- /R/utilities-input-code.R: -------------------------------------------------------------------------------- 1 | 2 | #' Look for input <- demo 3 | #' 4 | #' @param file to evaluate 5 | #' 6 | #' @importFrom readr read_file 7 | #' @importFrom stringr str_replace_all 8 | #' @importFrom knitr purl 9 | #' @noRd 10 | #' @examples 11 | #' if (interactive()) { 12 | #' find_input_code("inst/shiny/server.R") 13 | #' find_input_code("inst/Rmd/flexdashboard_demo.Rmd") 14 | #' } 15 | find_input_code <- function(file){ 16 | # if an R file just parse 17 | if (grepl("\\.R$", file, ignore.case = TRUE)) { 18 | parsed <- parse(file) 19 | 20 | } else {# if an Rmd, convert eval = F statement to T to see if "input <-" exists 21 | replace_evals <- 22 | read_file(file) %>% 23 | str_replace_all("eval( )?=( )?F(ALSE)?", "eval = TRUE") 24 | 25 | output = tempfile() 26 | # create R doc from Rmd 27 | knitr::purl(text = replace_evals, output = output, quiet = TRUE) 28 | 29 | parsed <- parse(output) 30 | } 31 | 32 | # R files should use "dummy_input <-", Rmd should use "input <-" 33 | input_code <- parsed[grepl("^(dummy_)?input(\\s)?(<-|=[^=])", parsed)] 34 | 35 | ifelse( 36 | length(input_code) > 0, 37 | as.character(gsub("dummy_", "", input_code)), 38 | "" 39 | ) 40 | } 41 | 42 | 43 | 44 | #' Look for input usage 45 | #' 46 | #' @param file file to evaluate 47 | #' 48 | #' @description Prints a statement about the inputs that are either listed or missing 49 | #' @importFrom stringr str_extract_all str_remove 50 | #' @importFrom readr read_lines 51 | #' @importFrom tibble tibble 52 | #' @importFrom dplyr mutate row_number filter distinct group_by summarise n ungroup 53 | #' @importFrom tidyr unnest 54 | #' @importFrom glue glue glue_collapse 55 | #' @noRd 56 | #' @examples 57 | #' if (interactive()) { 58 | #' input_usage(file = "inst/shiny/server.R") 59 | #' input_usage(file = "inst/Rmd/flexdashboard_demo.Rmd") 60 | #' } 61 | #' 62 | input_usage <- function(file) { 63 | df <- 64 | tibble(text = trimws(read_lines(file = file))) %>% 65 | mutate( 66 | line = row_number(), 67 | text = str_remove(.data$text, "#.*") # remove comments 68 | ) %>% 69 | filter(str_detect(.data$text, "input\\$[\\w\\._0-9]+")) 70 | 71 | if (nrow(df) > 0) { 72 | df <- 73 | df %>% 74 | mutate(input_name = str_extract_all(.data$text, "input\\$[\\w\\._0-9]+")) %>% 75 | unnest(.data$input_name) %>% 76 | distinct(.data$input_name, .data$line) %>% 77 | group_by(input_name = str_remove(.data$input_name, "input\\$")) %>% 78 | summarise( 79 | times_used = n(), 80 | lines = glue_collapse(.data$line, sep = ", ") 81 | ) %>% 82 | ungroup() 83 | } 84 | 85 | df 86 | } 87 | 88 | 89 | 90 | #' Validate demo input statement 91 | #' 92 | #' @param file file to evaluate 93 | #' 94 | #' @description Prints a statement about the inputs that are either listed or missing 95 | #' @importFrom stringr str_extract_all str_remove 96 | #' @importFrom readr read_lines 97 | #' @importFrom tibble tibble 98 | #' @importFrom dplyr mutate row_number filter distinct group_by summarise n select arrange 99 | #' @importFrom tidyr unnest 100 | #' @importFrom pander pandoc.table 101 | #' @importFrom glue glue glue_collapse 102 | #' @importFrom styler style_text 103 | #' @noRd 104 | #' @examples 105 | #' if (interactive()) { 106 | #' validate_inputs("inst/Rmd/test_dashboard_missing_inputs.Rmd") 107 | #' validate_inputs("inst/Rmd/test_dashboard_no_inputs.Rmd") 108 | #' validate_inputs("inst/shiny/server.R") 109 | #' } 110 | validate_inputs <- function(file) { 111 | input_code <- find_input_code(file) 112 | input_use <- input_usage(file) 113 | 114 | if (nrow(input_use) > 0) { 115 | input_demo_values <- 116 | input_code %>% 117 | str_extract_all("([\\w\\.\\_0:9]+)(?=\\s\\=)") %>% 118 | unlist() 119 | 120 | input_ref <- 121 | input_usage(file) %>% 122 | mutate( 123 | missing = (!.data$input_name %in% input_demo_values | length(input_demo_values) == 0), 124 | status = ifelse(missing, "missing", "have") 125 | ) 126 | 127 | 128 | if (nrow(input_ref) > 0 & sum(input_ref$missing) > 0) { # missing references 129 | message("Here are the inputs you have listed:\n") 130 | input_ref %>% 131 | select(.data$status, input = .data$input_name, .data$lines) %>% 132 | arrange(.data$status) %>% 133 | pander::pandoc.table(justify = "left", split.cells = 25) 134 | 135 | input_df <- 136 | input_ref %>% 137 | filter(missing == TRUE) 138 | 139 | input_add <- 140 | glue('{input_df$input_name} = ""') %>% 141 | glue_collapse(sep = ", \n") 142 | 143 | is_rmd <- str_detect(file, "[rR]md$") 144 | 145 | if (input_code == "") { # no input demo, create new list 146 | update_input_code <- glue("input <- list({input_add})") 147 | 148 | if (is_rmd) { 149 | message("\n# Add this code chunk to your Rmd:\n") 150 | message("```{r input_demo, eval = FALSE}") 151 | print(styler::style_text(update_input_code)) 152 | message("```") 153 | } else {# is R file 154 | message("\n# Add this code to your R file:\n") 155 | print(styler::style_text(glue("dummy_{update_input_code}"))) 156 | } 157 | } else { # append list 158 | message("Update code:") 159 | update_input_code <- glue("input <- list(\n..., \n{input_add}\n)") 160 | # str_replace(trimws(input_demo), "\\)$", glue("\n, {input_add})")) 161 | print(styler::style_text(update_input_code)) 162 | 163 | } 164 | } 165 | } 166 | input_code 167 | } 168 | 169 | 170 | 171 | -------------------------------------------------------------------------------- /.github/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 | -------------------------------------------------------------------------------- /docs/reference/code_to_df.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Convert R code to a data frame — code_to_df • shinysim 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 51 | 52 | 53 | 54 | 55 | 56 |
    57 |
    58 | 104 | 105 | 106 |
    107 | 108 |
    109 |
    110 | 115 | 116 |
    117 |

    Convert R code to a data frame

    118 |
    119 | 120 |
    code_to_df(code)
    121 | 122 |

    Arguments

    123 | 124 | 125 | 126 | 127 | 128 | 129 |
    code

    to evaluate

    130 | 131 | 132 |
    133 | 140 |
    141 | 142 |
    143 | 146 | 147 |
    148 |

    Site built with pkgdown 1.3.0.

    149 |
    150 |
    151 |
    152 | 153 | 154 | 155 | 156 | 157 | 158 | -------------------------------------------------------------------------------- /docs/reference/deparse_server.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Returns asignments only from expressions — deparse_server • shinysim 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 51 | 52 | 53 | 54 | 55 | 56 |
    57 |
    58 | 104 | 105 | 106 |
    107 | 108 |
    109 |
    110 | 115 | 116 |
    117 |

    Returns asignments only from expressions

    118 |
    119 | 120 |
    deparse_server(x)
    121 | 122 |

    Arguments

    123 | 124 | 125 | 126 | 127 | 128 | 129 |
    x

    expression from code stored as text

    130 | 131 | 132 |
    133 | 140 |
    141 | 142 |
    143 | 146 | 147 |
    148 |

    Site built with pkgdown 1.3.0.

    149 |
    150 |
    151 |
    152 | 153 | 154 | 155 | 156 | 157 | 158 | -------------------------------------------------------------------------------- /docs/reference/extract_from_app_fn.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Returns server code from shinyApp or runApp — extract_from_app_fn • shinysim 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 51 | 52 | 53 | 54 | 55 | 56 |
    57 |
    58 | 104 | 105 | 106 |
    107 | 108 |
    109 |
    110 | 115 | 116 |
    117 |

    Returns server code from shinyApp or runApp

    118 |
    119 | 120 |
    extract_from_app_fn(text)
    121 | 122 |

    Arguments

    123 | 124 | 125 | 126 | 127 | 128 | 129 |
    text

    code stored as text

    130 | 131 | 132 |
    133 | 140 |
    141 | 142 |
    143 | 146 | 147 |
    148 |

    Site built with pkgdown 1.3.0.

    149 |
    150 |
    151 |
    152 | 153 | 154 | 155 | 156 | 157 | 158 | -------------------------------------------------------------------------------- /docs/reference/find_all_assignments.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Find all libraries and assignments — find_all_assignments • shinysim 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 48 | 49 | 50 | 51 | 52 | 53 |
    54 |
    55 | 102 | 103 | 104 |
    105 | 106 |
    107 |
    108 | 113 | 114 |
    115 | 116 |

    A data frame of all assignments and libraries

    117 | 118 |
    119 | 120 |
    find_all_assignments(file)
    121 | 122 |

    Arguments

    123 | 124 | 125 | 126 | 127 | 128 | 129 |
    file

    to evaluate

    130 | 131 | 132 |
    133 | 140 |
    141 | 142 |
    143 | 146 | 147 |
    148 |

    Site built with pkgdown 1.3.0.

    149 |
    150 |
    151 |
    152 | 153 | 154 | 155 | 156 | 157 | 158 | -------------------------------------------------------------------------------- /docs/reference/find_all_assignments_r.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Find all libraries and assignments for R files — find_all_assignments_r • shinysim 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 51 | 52 | 53 | 54 | 55 | 56 |
    57 |
    58 | 104 | 105 | 106 |
    107 | 108 |
    109 |
    110 | 115 | 116 |
    117 |

    A data frame of all assignments and libraries

    118 |
    119 | 120 |
    find_all_assignments_r(x)
    121 | 122 |

    Arguments

    123 | 124 | 125 | 126 | 127 | 128 | 129 |
    x

    code to evaluate

    130 | 131 | 132 |
    133 | 140 |
    141 | 142 |
    143 | 146 | 147 |
    148 |

    Site built with pkgdown 1.3.0.

    149 |
    150 |
    151 |
    152 | 153 | 154 | 155 | 156 | 157 | 158 | -------------------------------------------------------------------------------- /docs/reference/find_all_assignments_rmd.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Find all libraries and assignments for rmd — find_all_assignments_rmd • shinysim 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 51 | 52 | 53 | 54 | 55 | 56 |
    57 |
    58 | 104 | 105 | 106 |
    107 | 108 |
    109 |
    110 | 115 | 116 |
    117 |

    A data frame of all assignments and libraries

    118 |
    119 | 120 |
    find_all_assignments_rmd(file)
    121 | 122 |

    Arguments

    123 | 124 | 125 | 126 | 127 | 128 | 129 |
    file

    to evaluate

    130 | 131 | 132 |
    133 | 140 |
    141 | 142 |
    143 | 146 | 147 |
    148 |

    Site built with pkgdown 1.3.0.

    149 |
    150 |
    151 |
    152 | 153 | 154 | 155 | 156 | 157 | 158 | -------------------------------------------------------------------------------- /docs/reference/inside_runapp.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Pulls the calls out of runApp and shinyApp — inside_runapp • shinysim 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 51 | 52 | 53 | 54 | 55 | 56 |
    57 |
    58 | 104 | 105 | 106 |
    107 | 108 |
    109 |
    110 | 115 | 116 |
    117 |

    Pulls the calls out of runApp and shinyApp

    118 |
    119 | 120 |
    inside_runapp(x)
    121 | 
    122 | inside_shinyapp(x)
    123 | 124 |

    Arguments

    125 | 126 | 127 | 128 | 129 | 130 | 131 |
    x

    expression containing runApp(...)

    132 | 133 | 134 |
    135 | 142 |
    143 | 144 |
    145 | 148 | 149 |
    150 |

    Site built with pkgdown 1.3.0.

    151 |
    152 |
    153 |
    154 | 155 | 156 | 157 | 158 | 159 | 160 | -------------------------------------------------------------------------------- /docs/reference/which_file.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Select file to use — which_file • shinysim 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 51 | 52 | 53 | 54 | 55 | 56 |
    57 |
    58 | 104 | 105 | 106 |
    107 | 108 |
    109 |
    110 | 115 | 116 |
    117 |

    If the file is not specified, a menu will appear asking the user if they want to use the active source file loaded in RStudio or if they want to select the file (opens a new window).

    118 |
    119 | 120 |
    which_file(file)
    121 | 122 |

    Arguments

    123 | 124 | 125 | 126 | 127 | 128 | 129 |
    file

    path to file.

    130 | 131 | 132 |
    133 | 140 |
    141 | 142 |
    143 | 146 | 147 |
    148 |

    Site built with pkgdown 1.3.0.

    149 |
    150 |
    151 |
    152 | 153 | 154 | 155 | 156 | 157 | 158 | -------------------------------------------------------------------------------- /docs/reference/clear_environment.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Clear all objects in environment — clear_environment • shinyloadr 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 48 | 49 | 50 | 51 | 52 | 53 |
    54 |
    55 | 102 | 103 | 104 |
    105 | 106 |
    107 |
    108 | 113 | 114 |
    115 | 116 |

    Clear all objects in environment

    117 | 118 |
    119 | 120 |
    clear_environment(keep = NULL, remove = NULL)
    121 | 122 |

    Arguments

    123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 |
    keep

    A regular expression of objects in environment to keep

    remove

    A regular expression of objects in environment to remove

    134 | 135 | 136 |
    137 | 144 |
    145 | 146 |
    147 | 150 | 151 |
    152 |

    Site built with pkgdown 1.3.0.

    153 |
    154 |
    155 |
    156 | 157 | 158 | 159 | 160 | 161 | 162 | -------------------------------------------------------------------------------- /docs/reference/find_input_code.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Look for input <- demo — find_input_code • shinysim 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 51 | 52 | 53 | 54 | 55 | 56 |
    57 |
    58 | 104 | 105 | 106 |
    107 | 108 |
    109 |
    110 | 115 | 116 |
    117 |

    Look for input <- demo

    118 |
    119 | 120 |
    find_input_code(file)
    121 | 122 |

    Arguments

    123 | 124 | 125 | 126 | 127 | 128 | 129 |
    file

    to evaluate

    130 | 131 | 132 |

    Examples

    133 |
    # NOT RUN {
    134 | find_input_code("inst/shiny/server.R")
    135 | find_input_code("inst/Rmd/flexdashboard_demo.Rmd")
    136 | # }
    137 |
    138 | 146 |
    147 | 148 |
    149 | 152 | 153 |
    154 |

    Site built with pkgdown 1.3.0.

    155 |
    156 |
    157 |
    158 | 159 | 160 | 161 | 162 | 163 | 164 | -------------------------------------------------------------------------------- /docs/authors.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Authors • shinyobjects 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 63 | 64 | 65 | 66 | 67 | 68 | 69 |
    70 |
    71 | 128 | 129 | 130 | 131 |
    132 | 133 |
    134 |
    135 | 138 | 139 |
      140 |
    • 141 |

      Jake Riley. Author, maintainer. 142 |

      143 |
    • 144 |
    145 | 146 |
    147 | 148 |
    149 | 150 | 151 | 152 |
    153 | 156 | 157 |
    158 |

    Site built with pkgdown 1.5.1.

    159 |
    160 | 161 |
    162 |
    163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | -------------------------------------------------------------------------------- /docs/reference/input_usage.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Look for input usage — input_usage • shinysim 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 51 | 52 | 53 | 54 | 55 | 56 |
    57 |
    58 | 104 | 105 | 106 |
    107 | 108 |
    109 |
    110 | 115 | 116 |
    117 |

    Prints a statement about the inputs that are either listed or missing

    118 |
    119 | 120 |
    input_usage(file)
    121 | 122 |

    Arguments

    123 | 124 | 125 | 126 | 127 | 128 | 129 |
    file

    file to evaluate

    130 | 131 | 132 |

    Examples

    133 |
    # NOT RUN {
    134 | input_usage(file = "inst/shiny/server.R")
    135 | input_usage(file = "inst/Rmd/flexdashboard_demo.Rmd")
    136 | # }
    137 |
    138 |
    139 | 147 |
    148 | 149 | 158 |
    159 | 160 | 161 | 162 | 163 | 164 | 165 | --------------------------------------------------------------------------------