initial commit

Author: Sebastiaan Vandewoude

.Rbuildignore

@@ -0,0 +1,3 @@
+^.*\.Rproj$
+^\.Rproj\.user$
+^LICENSE.md

.gitignore

@@ -0,0 +1,4 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata

DESCRIPTION

@@ -0,0 +1,34 @@
+Package: reactflush
+Type: Package
+Title: Shiny Code Reactivity Visualizer
+Version: 0.1.0
+Authors@R: c(person("Rawat", "Vimal", email = "vimal.rawat@basf.com", role = c("aut")),
+ person("Vandewoude", "Sebastiaan", email = "sebastiaan.vandewoude@basf.com", role = c("aut","cre")),
+ person("Kawalia", "Amit", email = "amit.kawalia@basf.com", role = c("ctb")),
+ person("BASF SE", role = "cph"))
+Description: Compute and display all shiny reactive inputs and output in a network visualization by analyzing your code.
+Depends:
+ R (>= 3.0.2)
+Imports:
+ assertthat,
+ DiagrammeR,
+ dplyr,
+ fs,
+ glue,
+ magrittr,
+ purrr,
+ readr,
+ rlang,
+ rstudioapi,
+ stringr,
+ tibble,
+ tidyr
+Suggests:
+ shiny (>= 1.2.0.9001),
+ testthat
+License: GPL-3
+Encoding: UTF-8
+LazyData: true
+RoxygenNote: 6.1.1
+URL: https://github.com/svdwoude/reactflush
+BugReports: https://github.com/svdwoude/reactflush/issues

LICENSE.md

@@ -0,0 +1,20 @@
+# Generated by roxygen2: do not edit by hand
+
+export(convert_to_mermaid_connection)
+export(convert_to_mermaid_node)
+export(parse_shiny_app)
+export(parse_shiny_server)
+export(plot_mermaid)
+export(reactflush)
+export(reactflush_markdown)
+export(render_mermaid)
+import(DiagrammeR)
+import(dplyr)
+import(fs)
+import(purrr)
+import(readr)
+import(stringr)
+import(tibble)
+importFrom(magrittr,"%>%")
+importFrom(rlang,.data)
+importFrom(stats,setNames)

NAMESPACE

@@ -0,0 +1,174 @@
+#' annotate all inputs/reactives for each code block
+#'
+#' @description identify and annotate all inputs/reactives referenced in code block.
+#' Take isolated inputs/reactives into account
+#'
+#' @param blocks \code{data.frame} all code blocks in server.R code
+#' @param inpts \code{vector} of all inputs/reactives
+#' @param type \code{string} which type to annotate: inputs or reactives
+#'
+#' @importFrom rlang .data
+#' @import dplyr purrr
+annotate_type <- function(blocks, inpts, type = c("inputs","reactives")){
+ type <- rlang::arg_match(type)
+
+ blocks <- blocks %>%
+ mutate(
+ type_expr = map(expr, list_matches, matches = inpts),
+ type_opts = map(options, list_matches, matches = inpts),
+ type_islt = map(isolate, list_matches, matches = inpts),
+ type_deps = pmap(
+ list(type, type_expr, type_opts),
+ determine_invalidators
+ )
+ ) %>%
+ rename(
+ !! sep_(type, "expr") := .data$type_expr,
+ !! sep_(type, "opts") := .data$type_opts,
+ !! sep_(type, "islt") := .data$type_islt,
+ !! sep_(type, "deps") := .data$type_deps
+ )
+
+ return(blocks)
+}
+
+
+#' annotate all side effects for each code block
+#'
+#' @description identify and annotate all side effects triggered in code block.
+#' Take both reactiveVal() and values$reactiveValues into account
+#'
+#' @param blocks \code{data.frame} all code blocks in server.R code
+#' @param reactives \code{vector} of all reactives, both reactiveVal() and values$reactiveValues
+#'
+#' @importFrom rlang .data
+#' @import dplyr purrr
+annotate_side_effects <- function(blocks, reactives) {
+ # extract the name of the reactiveValues
+ reactive_value <- blocks %>%
+ filter(.data$type == "reactiveValues") %>%
+ pull(.data$name)
+
+ # match code with reactive side effects
+ blocks <- blocks %>%
+ mutate(
+ side_effects_deps = map(body, list_side_effects, matches = reactives, reactive_value = reactive_value)
+ )
+
+ return(blocks)
+}
+
+
+#' annotate all input defentions in code blocks WIP
+#'
+#' @description identify and annotate all defenitions within code block. WIP
+annotate_definitions <- function() {
+ #(?:Input|Box)\([^)]*['"]timepoint_analysis['"]
+}
+
+
+#' list all occuring matches in code block
+#'
+#' @description list all occuring matches in code block
+#'
+#' @param code \code{string} code of code block
+#' @param matches \code{vector} of all inputs/reactives
+#'
+#' @importFrom magrittr "%>%"
+#' @import dplyr stringr
+list_matches <- function(code, matches) {
+ code %>%
+ str_extract(pattern = fixed(matches)) %>%
+ enframe() %>%
+ filter(!is.na(value)) %>%
+ pull(value) %>%
+ str_replace("\\(\\)","") %>%
+ str_trim()
+}
+
+
+#' list all occuring side effects in code block
+#'
+#' @description list all occuring matches in code block
+#'
+#' @param code \code{string} code of code block
+#' @param matches \code{vector} of all reactives, both reactiveVal() and values$reactiveValues
+#' @param reactive_value \code{string} name of reactiveValues() object, defautls to "values"
+#' @param regex_assgn \code{string} regex to detect assignments
+#' @param regex_braces \code{string} regex to detect assignment in braces
+#'
+#' @importFrom magrittr "%>%"
+#' @import dplyr tibble stringr
+list_side_effects <- function(code, matches, reactive_value = "values", regex_assgn = regex_pattern()$assignment, regex_braces = regex_pattern()$braces_start) {
+ # if there are no reactives, we will not find side effects
+ if(identical(matches, character(0))) {
+ return(character())
+ }
+
+ no_r_name <- "[^a-zA-Z0-9._]"
+ # seperate reactiveValues values$<name> from reactiveVals <name>(..)
+ # also remove last two () characters from reactiveVals
+ reactive_vals <- matches[!str_detect(matches, paste0(reactive_value, "\\$"))] %>% str_sub(end = -3)
+ reactive_values <- matches[str_detect(matches, paste0(reactive_value, "\\$"))] %>% str_replace(fixed("$"), fixed("\\$"))
+
+ # concate <name> with assignemnt pattern: (...
+ # add to no_r_name part to avoid selected_values(...) being matched as values(...)
+ regex_reactiveVals_assgn <- paste0(no_r_name, "(", reactive_vals, ")", regex_braces)
+
+ matches <- code %>%
+ str_extract(pattern = regex_reactiveVals_assgn) %>%
+ enframe() %>%
+ filter(!is.na(value))
+
+ if(nrow(matches) == 0) {
+ matches <- character()
+ } else {
+ matches <- matches %>%
+ mutate(value = str_split(value, "\\(", n = 2, simplify = TRUE)[,1]) %>%
+ pull(value)
+ }
+
+ # if no reactiveValues are detected, skip this step
+ if(!identical(reactive_value, character(0))) {
+ # concate values$<name> with assignemnt pattern: values$<name> <- or =
+ regex_reactiveValues_assgn <- paste0("(",reactive_values, ")", regex_assgn)
+
+ matches <- code %>%
+ str_match(pattern = regex_reactiveValues_assgn) %>%
+ .[,2] %>%
+ enframe() %>%
+ filter(!is.na(value)) %>%
+ pull(value) %>%
+ c(matches)
+
+ }
+
+ return(matches)
+}
+
+
+#' determine reactive invalidators
+#'
+#' @description list all reactive invalidators in code block, depending on type and where
+#' within the code the inputs/reactives are used
+#'
+#' @param type \code{string} type of code block (reactive, observeEvent, ...)
+#' @param expr \code{vector} inputs/reactives referenced in main expression
+#' @param opts \code{vector} inputs/reactives referenced in options accompanying expression
+#'
+#' @importFrom magrittr "%>%"
+#' @import stringr
+determine_invalidators <- function(type, expr, opts) {
+ # depending on the type the block is invalidated either expr, opts or both or none
+ if(str_detect(type, fixed("event", ignore_case=TRUE))) {
+ # observeEvent & eventReactive only are only invalidated by options, not
+ # their expression
+ return(opts)
+ } else if(type == "function"){
+ # functions do not get invalidated
+ return(character())
+ } else {
+ # reactive, observe & renders are invalidated by both expr and opts
+ return(c(expr, opts) %>% unique())
+ }
+}