From 0898fed224ec1dc4f52b32ad2ca207076fd4688d Mon Sep 17 00:00:00 2001 From: Karan Gathani Date: Tue, 17 Oct 2023 14:29:44 -0700 Subject: [PATCH 1/4] Create a R script to look up shiny examples in a package --- R/run_example.R | 153 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 153 insertions(+) create mode 100644 R/run_example.R diff --git a/R/run_example.R b/R/run_example.R new file mode 100644 index 0000000000..736d2b344c --- /dev/null +++ b/R/run_example.R @@ -0,0 +1,153 @@ +example_api <- function(package = NULL, name = NULL, edit = FALSE) { + # arg checking + if (is.null(package)) { + if (is.null(name)) { + # neither package nor name is specified + return(available_examples(package = NULL)) + } else { + stop("Please provide a package name when specifying an example name.") + } + } else { + stopifnot(length(package) == 1 && is.character(package)) + # Search for a Shiny example with a given name in a package + if (!is.null(name)) { + examples <- available_examples(package = package) + example_path <- examples[examples$name == name, "source_directory"] + if (length(example_path) > 0) { + return( + example_path + ) + } else { + stop("No matching example found within the package") + } + } + # only package is specified + return(available_examples(package = package)) + } +} + + +available_examples <- function(package = NULL) { + info <- + if (is.null(package)) { + all_available_examples() + } else { + available_examples_for_package(package) + } + if (!is.null(info$error)) { + stop(info$error, call. = FALSE) + } + examples <- info$examples + return(examples) +} + + +available_examples_for_package <- function(package) { + an_error <- function(...) { + list( + examples = NULL, + error = paste0(...) + ) + } + + if (!nzchar(system.file(package = package))) { + return(an_error( + "No package found with name: \"", package, "\"" + )) + } + + examples_dir <- system.file("shiny-examples", package = package) + if (!nzchar(examples_dir)) { + return(an_error( + "No Shiny examples found for package: \"", package, "\"" + )) + } + + example_folders <- list.dirs( + examples_dir, + full.names = TRUE, + recursive = FALSE + ) + names(example_folders) <- basename(example_folders) + + example_info <- lapply(example_folders, function(example_dir) { + data.frame( + package = package, + name = basename(example_dir), + source_directory = example_dir, + stringsAsFactors = FALSE, + row.names = FALSE + ) + }) + + + examples <- do.call(rbind, example_info) + class(examples) <- c("shiny_available_examples", class(examples)) + # remove the row names from the data frame which comes by default + # rownames(examples) <- NULL + + + list( + examples = examples, + error = NULL + ) +} + + +all_available_examples <- function() { + ret <- list() + all_pkgs <- installed.packages()[, "Package"] + + for (pkg in all_pkgs) { + info <- available_examples_for_package(pkg) + if (!is.null(info$examples)) { + ret[[length(ret) + 1]] <- info$examples + } + } + + # combines the data frames into a single data frame + examples <- do.call(rbind, ret) + + list( + examples = examples, # will maintain class + error = NULL + ) +} + +#' @export +format.shiny_available_examples <- function(x, ...) { + examples <- x + split_examples <- split(examples, examples$package) + + pkg_examples <- vapply( + split_examples, + function(examples_sub) { + paste0( + "* ", examples_sub$package[1], "\n", + paste0(" - ", examples_sub$name, collapse = "\n") + ) + }, + character(1) + ) + + paste0( + "Available Shiny examples:\n", + paste0(pkg_examples, collapse = "\n") + ) +} + + +#' @export +print.shiny_available_examples <- function(x, ...) { + cat(format(x, ...), "\n", sep = "") +} + +# example_api() +# example_api(package = "shiny") +# example_api(package = "tidyverse") + +# example_api(package = c("shiny", "tidyverse")) +# example_api(package = "shuny") +# example_api(name = "01_hello") +example_api(package = "shiny", name = "01_hello") +# example_api(package = "shiny", name = "05_hello") From 6a1b5aba6f21c97b12afe575623ef2317ee2079f Mon Sep 17 00:00:00 2001 From: Karan Gathani Date: Thu, 19 Oct 2023 10:23:00 -0700 Subject: [PATCH 2/4] add some relevant comments and remove edit param --- R/run_example.R | 51 ++++++++++++++++++++++++++++++++++++------------- 1 file changed, 38 insertions(+), 13 deletions(-) diff --git a/R/run_example.R b/R/run_example.R index 736d2b344c..7097336a83 100644 --- a/R/run_example.R +++ b/R/run_example.R @@ -1,11 +1,21 @@ -example_api <- function(package = NULL, name = NULL, edit = FALSE) { +#' Function to get the path of a Shiny example in a package +#' +#' @param package A character string specifying the name of the package +#' @param name A character string specifying the name of the example +#' +#' @return A character string specifying the path of the example +#' OR a data frame containing information about all available Shiny examples +#' +#' @export +example_api <- function(package = NULL, name = NULL) { # arg checking if (is.null(package)) { if (is.null(name)) { # neither package nor name is specified return(available_examples(package = NULL)) } else { - stop("Please provide a package name when specifying an example name.") + stop("Please provide a package name + when specifying an example name.") } } else { stopifnot(length(package) == 1 && is.character(package)) @@ -14,9 +24,11 @@ example_api <- function(package = NULL, name = NULL, edit = FALSE) { examples <- available_examples(package = package) example_path <- examples[examples$name == name, "source_directory"] if (length(example_path) > 0) { - return( - example_path - ) + if (edit) { + # open the example in an editor + rstudioapi::navigateToFile(example_path) + } + return(example_path) } else { stop("No matching example found within the package") } @@ -26,7 +38,14 @@ example_api <- function(package = NULL, name = NULL, edit = FALSE) { } } - +#' Function to get a data frame of all available Shiny examples +#' +#' @param package A character string specifying the name of the package +#' +#' @return A data frame containing information +#' about all available Shiny examples +#' +#' @export available_examples <- function(package = NULL) { info <- if (is.null(package)) { @@ -41,7 +60,13 @@ available_examples <- function(package = NULL) { return(examples) } - +#' Function to get a data frame of all available Shiny examples for a package +#' +#' @param package A character string specifying the name of the package +#' +#' @return A data frame containing information about all +#' available Shiny examples for the package +#' available_examples_for_package <- function(package) { an_error <- function(...) { list( @@ -80,12 +105,8 @@ available_examples_for_package <- function(package) { ) }) - examples <- do.call(rbind, example_info) class(examples) <- c("shiny_available_examples", class(examples)) - # remove the row names from the data frame which comes by default - # rownames(examples) <- NULL - list( examples = examples, @@ -93,7 +114,12 @@ available_examples_for_package <- function(package) { ) } - +#' Function to get a data frame of all available Shiny examples +#' for all installed packages +#' +#' @return A data frame containing information about +#' all available Shiny examples for all installed packages +#' all_available_examples <- function() { ret <- list() all_pkgs <- installed.packages()[, "Package"] @@ -136,7 +162,6 @@ format.shiny_available_examples <- function(x, ...) { ) } - #' @export print.shiny_available_examples <- function(x, ...) { cat(format(x, ...), "\n", sep = "") From 3999221c839e59d038e45a36d25fe5cbcb05d545 Mon Sep 17 00:00:00 2001 From: Karan Gathani Date: Thu, 19 Oct 2023 13:13:37 -0700 Subject: [PATCH 3/4] Remove export from function and add noRd instead --- DESCRIPTION | 1 + NAMESPACE | 3 +++ R/run_example.R | 28 ++++++++++++---------------- man/available_examples.Rd | 18 ++++++++++++++++++ 4 files changed, 34 insertions(+), 16 deletions(-) create mode 100644 man/available_examples.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 0d6555ffb9..bde484beaf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -177,6 +177,7 @@ Collate: 'render-plot.R' 'render-table.R' 'run-url.R' + 'run_example.R' 'runapp.R' 'serializers.R' 'server-input-handlers.R' diff --git a/NAMESPACE b/NAMESPACE index d13edda0f7..99e73808e6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -43,11 +43,13 @@ S3method(bindEvent,reactiveExpr) S3method(bindEvent,shiny.render.function) S3method(format,reactiveExpr) S3method(format,reactiveVal) +S3method(format,shiny_available_examples) S3method(names,reactivevalues) S3method(print,reactive) S3method(print,reactivevalues) S3method(print,shiny.appobj) S3method(print,shiny.render.function) +S3method(print,shiny_available_examples) S3method(print,shiny_runtests) S3method(str,reactivevalues) export("conditionStackTrace<-") @@ -65,6 +67,7 @@ export(addResourcePath) export(animationOptions) export(appendTab) export(as.shiny.appobj) +export(available_examples) export(basicPage) export(bindCache) export(bindEvent) diff --git a/R/run_example.R b/R/run_example.R index 7097336a83..0af9dc5060 100644 --- a/R/run_example.R +++ b/R/run_example.R @@ -6,8 +6,8 @@ #' @return A character string specifying the path of the example #' OR a data frame containing information about all available Shiny examples #' -#' @export -example_api <- function(package = NULL, name = NULL) { +#' @noRd +run_example_app_dir <- function(package = NULL, name = NULL) { # arg checking if (is.null(package)) { if (is.null(name)) { @@ -24,10 +24,6 @@ example_api <- function(package = NULL, name = NULL) { examples <- available_examples(package = package) example_path <- examples[examples$name == name, "source_directory"] if (length(example_path) > 0) { - if (edit) { - # open the example in an editor - rstudioapi::navigateToFile(example_path) - } return(example_path) } else { stop("No matching example found within the package") @@ -66,7 +62,7 @@ available_examples <- function(package = NULL) { #' #' @return A data frame containing information about all #' available Shiny examples for the package -#' +#' @noRd available_examples_for_package <- function(package) { an_error <- function(...) { list( @@ -119,7 +115,7 @@ available_examples_for_package <- function(package) { #' #' @return A data frame containing information about #' all available Shiny examples for all installed packages -#' +#' @noRd all_available_examples <- function() { ret <- list() all_pkgs <- installed.packages()[, "Package"] @@ -167,12 +163,12 @@ print.shiny_available_examples <- function(x, ...) { cat(format(x, ...), "\n", sep = "") } -# example_api() -# example_api(package = "shiny") -# example_api(package = "tidyverse") +# run_example_app_dir() +# run_example_app_dir(package = "shiny") +# run_example_app_dir(package = "tidyverse") -# example_api(package = c("shiny", "tidyverse")) -# example_api(package = "shuny") -# example_api(name = "01_hello") -example_api(package = "shiny", name = "01_hello") -# example_api(package = "shiny", name = "05_hello") +# run_example_app_dir(package = c("shiny", "tidyverse")) +# run_example_app_dir(package = "shuny") +# run_example_app_dir(name = "01_hello") +# run_example_app_dir(package = "shiny", name = "01_hello") +# run_example_app_dir(package = "shiny", name = "05_hello") diff --git a/man/available_examples.Rd b/man/available_examples.Rd new file mode 100644 index 0000000000..6febbed12b --- /dev/null +++ b/man/available_examples.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/run_example.R +\name{available_examples} +\alias{available_examples} +\title{Function to get a data frame of all available Shiny examples} +\usage{ +available_examples(package = NULL) +} +\arguments{ +\item{package}{A character string specifying the name of the package} +} +\value{ +A data frame containing information +about all available Shiny examples +} +\description{ +Function to get a data frame of all available Shiny examples +} From e0d67873830e09465f05925970abc81fb129ca90 Mon Sep 17 00:00:00 2001 From: Karan Gathani Date: Thu, 19 Oct 2023 20:23:14 -0700 Subject: [PATCH 4/4] Add function in pkgdown and rename method --- DESCRIPTION | 2 +- NAMESPACE | 2 +- R/{run_example.R => run-example.R} | 36 +++++++++---------- ...lable_examples.Rd => availableExamples.Rd} | 8 ++--- tools/documentation/pkgdown.yml | 1 + 5 files changed, 25 insertions(+), 24 deletions(-) rename R/{run_example.R => run-example.R} (82%) rename man/{available_examples.Rd => availableExamples.Rd} (73%) diff --git a/DESCRIPTION b/DESCRIPTION index bde484beaf..e621a7c031 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -176,8 +176,8 @@ Collate: 'render-cached-plot.R' 'render-plot.R' 'render-table.R' + 'run-example.R' 'run-url.R' - 'run_example.R' 'runapp.R' 'serializers.R' 'server-input-handlers.R' diff --git a/NAMESPACE b/NAMESPACE index 99e73808e6..62d03890aa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -67,7 +67,7 @@ export(addResourcePath) export(animationOptions) export(appendTab) export(as.shiny.appobj) -export(available_examples) +export(availableExamples) export(basicPage) export(bindCache) export(bindEvent) diff --git a/R/run_example.R b/R/run-example.R similarity index 82% rename from R/run_example.R rename to R/run-example.R index 0af9dc5060..c9ce975e4c 100644 --- a/R/run_example.R +++ b/R/run-example.R @@ -7,12 +7,12 @@ #' OR a data frame containing information about all available Shiny examples #' #' @noRd -run_example_app_dir <- function(package = NULL, name = NULL) { +runExampleAppDir <- function(package = NULL, name = NULL) { # arg checking if (is.null(package)) { if (is.null(name)) { # neither package nor name is specified - return(available_examples(package = NULL)) + return(availableExamples(package = NULL)) } else { stop("Please provide a package name when specifying an example name.") @@ -21,7 +21,7 @@ run_example_app_dir <- function(package = NULL, name = NULL) { stopifnot(length(package) == 1 && is.character(package)) # Search for a Shiny example with a given name in a package if (!is.null(name)) { - examples <- available_examples(package = package) + examples <- availableExamples(package = package) example_path <- examples[examples$name == name, "source_directory"] if (length(example_path) > 0) { return(example_path) @@ -30,7 +30,7 @@ run_example_app_dir <- function(package = NULL, name = NULL) { } } # only package is specified - return(available_examples(package = package)) + return(availableExamples(package = package)) } } @@ -42,12 +42,12 @@ run_example_app_dir <- function(package = NULL, name = NULL) { #' about all available Shiny examples #' #' @export -available_examples <- function(package = NULL) { +availableExamples <- function(package = NULL) { info <- if (is.null(package)) { - all_available_examples() + allAvailableExamples() } else { - available_examples_for_package(package) + availableExamplesForPackage(package) } if (!is.null(info$error)) { stop(info$error, call. = FALSE) @@ -63,7 +63,7 @@ available_examples <- function(package = NULL) { #' @return A data frame containing information about all #' available Shiny examples for the package #' @noRd -available_examples_for_package <- function(package) { +availableExamplesForPackage <- function(package) { an_error <- function(...) { list( examples = NULL, @@ -116,12 +116,12 @@ available_examples_for_package <- function(package) { #' @return A data frame containing information about #' all available Shiny examples for all installed packages #' @noRd -all_available_examples <- function() { +allAvailableExamples <- function() { ret <- list() all_pkgs <- installed.packages()[, "Package"] for (pkg in all_pkgs) { - info <- available_examples_for_package(pkg) + info <- availableExamplesForPackage(pkg) if (!is.null(info$examples)) { ret[[length(ret) + 1]] <- info$examples } @@ -163,12 +163,12 @@ print.shiny_available_examples <- function(x, ...) { cat(format(x, ...), "\n", sep = "") } -# run_example_app_dir() -# run_example_app_dir(package = "shiny") -# run_example_app_dir(package = "tidyverse") +# runExampleAppDir() +# runExampleAppDir(package = "shiny") +# runExampleAppDir(package = "tidyverse") -# run_example_app_dir(package = c("shiny", "tidyverse")) -# run_example_app_dir(package = "shuny") -# run_example_app_dir(name = "01_hello") -# run_example_app_dir(package = "shiny", name = "01_hello") -# run_example_app_dir(package = "shiny", name = "05_hello") +# runExampleAppDir(package = c("shiny", "tidyverse")) +# runExampleAppDir(package = "shuny") +# runExampleAppDir(name = "01_hello") +# runExampleAppDir(package = "shiny", name = "01_hello") +# runExampleAppDir(package = "shiny", name = "05_hello") diff --git a/man/available_examples.Rd b/man/availableExamples.Rd similarity index 73% rename from man/available_examples.Rd rename to man/availableExamples.Rd index 6febbed12b..5b49f81937 100644 --- a/man/available_examples.Rd +++ b/man/availableExamples.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_example.R -\name{available_examples} -\alias{available_examples} +% Please edit documentation in R/run-example.R +\name{availableExamples} +\alias{availableExamples} \title{Function to get a data frame of all available Shiny examples} \usage{ -available_examples(package = NULL) +availableExamples(package = NULL) } \arguments{ \item{package}{A character string specifying the name of the package} diff --git a/tools/documentation/pkgdown.yml b/tools/documentation/pkgdown.yml index 5af6a2e919..8292b23c53 100644 --- a/tools/documentation/pkgdown.yml +++ b/tools/documentation/pkgdown.yml @@ -144,6 +144,7 @@ reference: - viewer - isRunning - loadSupport + - availableExamples - title: Bookmarking state desc: Functions that are used for bookmarking and restoring state. contents: