Start implementing process reactives #15, adding sankey

The whole concept of grabbing a reactive and being able to evaluate it outside of shiny so that it can be tested. Not sure it's a good idea.

Also, added a sankey output to ShinyHierarchy, which shows hierarchical relationships b/w reactive blocks smarterly. Closes #16

Author: DataStrategist

DESCRIPTION

@@ -1,15 +1,15 @@
 Package: ShinyTester
 Type: Package
 Title: Functions to Minimize Bonehead Moves While Working with 'shiny'
-Version: 0.1.5
-Author: Amit Kohli
+Version: 0.1.6
+Author: Amit Kohli, Joshua Kunst
 Maintainer: Amit Kohli <amit@amitkohli.com>
 BugReports:	https://github.com/mexindian/ShinyTester/issues
 Description: It's my experience that working with 'shiny' is intuitive once you're
     into it, but can be quite daunting at first. Several common mistakes are fairly
     predictable, and therefore we can control for these. The functions in this
-    package help match up the assets listed in the UI and the SERVER files, and
-    Visualize the ad hoc structure of the 'shiny' App.
+    package help match up the assets listed in the UI and the SERVER files, 
+    Visualize the ad hoc structure of the 'shiny' App, and run all the reactives.
 License: GPL-2
 URL: https://github.com/mexindian/ShinyTester
 Imports: 
@@ -18,7 +18,8 @@ Imports:
   readr,
   stringr,
   tidyr,
-  visNetwork
+  visNetwork,
+  networkD3
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 6.0.1

NAMESPACE

@@ -12,6 +12,7 @@ importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,select)
 importFrom(dplyr,slice)
+importFrom(networkD3,sankeyNetwork)
 importFrom(purrr,map)
 importFrom(purrr,map_chr)
 importFrom(purrr,map_df)

NEWS.md

@@ -2,5 +2,11 @@
 
 * Initial release
 
+# ShinyTester 0.2.0 (in development)
+
+* Added parameters to ShinyHierarchy: showInternalFunctions, showCommentedOutChunks parameters, and fixed a bug in Chunking
+* ShinyHierarchy now is able to ouptut a Sankey Chart as well
+* Added new function: ProcessReactives... not operational yet.
+
 
 

R/ShinyTester.R

@@ -143,7 +143,7 @@ ShinyDummyCheck <- function(directory = ".", ui = "ui.R", server = "server.R"){
 #' @param showInternalFunctions a boolean that specifies whether to show the functions internal to each node. These are shown
 #' on mouse_over in the hierarchy chart. FALSE by default.
 #' @param showCommentedOutChunks a boolean that specifies whether to show the chunks that have been commented out. FALSE by default.
-#'
+#' @param output a character string that specifies what kind of plot should be outputted: either "network" or "sankey" are accepted.
 #'
 #' @return
 #' It returns a very very nice network chart with BASICALLY three-ish ROWS of nodes.
@@ -163,10 +163,11 @@ ShinyDummyCheck <- function(directory = ".", ui = "ui.R", server = "server.R"){
 #' @importFrom tidyr unnest separate
 #' @importFrom stats setNames runif
 #' @importFrom visNetwork visNetwork visEdges visLegend visHierarchicalLayout visOptions
+#' @importFrom networkD3 sankeyNetwork
 #' @export
 ShinyHierarchy <- function(directory=getwd(),ui="ui.R",server="server.R",
                            offsetReactives=T,showInternalFunctions=F,
-                           showCommentedOutChunks=F){
+                           showCommentedOutChunks=F,output="network"){
 
   ## Get input again
   a <- read_file(paste(directory,"/",server,sep=""))
@@ -335,39 +336,78 @@ ShinyHierarchy <- function(directory=getwd(),ui="ui.R",server="server.R",
   edges <- data.frame(to=nodes$id[match(x = BofDF$ChunkName,table = nodes$Thingie)],
                       from=nodes$id[match(x = BofDF$Input,table = nodes$Thingie)])
 
-  visNetwork(nodes,edges) %>% visEdges(arrows = 'to') %>%
+  ## Now output network or sankey
+  if(output=="network"){
+    visNetwork(nodes,edges) %>% visEdges(arrows = 'to') %>%
     visLegend() %>% visHierarchicalLayout()  %>%
     visOptions(highlightNearest = list(enabled = T, degree = 1, hover = T))
+  } else if (output=="sankey"){
+    ## make links unique
+    edges <- edges %>%
+      group_by(from,to) %>%
+      summarize(value=n())
+    ## zero indexing
+    edges$from <- edges$from-1
+    edges$to <- edges$to-1
+
+    sankeyNetwork(Links=edges,Nodes = nodes,Source = 'from',NodeID = 'Thingie',
+                  Target = 'to', Value = 'value',NodeGroup = 'group',fontSize = 15)
 
+  } else {
+    stop("Only 'network' or 'sankey' are accepted as outputs")
+  }
 }
 
 
-ProcessReactives <- function(directory=getwd(),ui="ui.R",server="server.R",
-                            showCommentedOutChunks=F){
-  
-  ## Get input again
-  a <- read_file(paste(directory,"/",server,sep=""))
-  b <- gsub("\r?\n","",a)
-  ## Identify code chunks, basically each little shiny minifunction
-  Chunks <- str_extract_all(b, "[a-zA-Z0-9\\._]+ *\\<\\- *[a-zA-Z0-9\\._]+?\\(\\{.+?\\}\\)",
-                            simplify = F) %>% .[[1]]
-  if (length(Chunks)==0) stop("Hrm, I can't detect any chunks. I expect assignments to use '<-'... so if
-                              you're using '=' or '->' assignments or 'source'ing stuff in, then that would be why.")
-  
-  ## Identify only the reactive chunks
-  Chunks <- Chunks[grep("reactive\\(",Chunks)]
-  
-  ## get only the guts
-  Chunks2 <- str_extract(string = Chunks,"(?<=\\(\\{).+(?=\\}\\))")
-  
-  ## And make stuff evaluatable by replacing multiple space w/ semicolon, however, except the first one.
-  Chunks3 <- gsub("   +","; ",str_trim(Chunks2),perl=T)
-  
-  ## But deal w/ pipes
-  Chunks4 <- gsub("\\%;","\\%",Chunks3)
-  
-  for(i in 1:length(Chunks4)){
-      # eval(parse(text = Chunks4[i]))
-    eval(parse(text = str_split(Chunks4[i],";")[[1]]))
-  }
-}
+#' #' ProcessReactives
+#' #'
+#' #' This function runs all the guts from reactive blocks in console (for local testing/debugging).
+#' #'
+#' #' For now, it only works where the server and ui files are seperate (ie, it doesn't work for `app.R` yet)
+#' #'
+#' #' @param directory the directory or website containing the files for the Shiny App. Defaults to current working directory
+#' #' @param ui a character vector size 1 containing the name of the UI files. defaults to "ui.R"
+#' #' @param server a character vector size 1 containing the names of the SERVER file. defaults to "server.R"
+#' #' @param inputs a 1 row dataframe containing values for all the inputs that would be required by the reactive scripts (so as to simulate a live version of the Shiny app)
+#' #'
+#' #' @return
+#' #' Returns nothing, but loads all items into memory
+#'
+#' #' @examples
+#' #' ProcessReactives(directory = system.file("example2", package = "ShinyTester"))
+#' #'
+#' #' @details You can test with your own app, go to your shiny app, make that your
+#' #'  working directory, and then type `ProcessReactives()`
+#' #' @importFrom stringr str_extract_all str_extract str_trim str_split
+#' #' @importFrom readr read_file
+#' #' @export
+#'
+#' ProcessReactives <- function(directory=getwd(),ui="ui.R",server="server.R",
+#'                             inputs=inputs){
+#'
+#'   ## Get input again
+#'   a <- read_file(paste(directory,"/",server,sep=""))
+#'   b <- gsub("\r?\n","",a)
+#'   ## Identify code chunks, basically each little shiny minifunction
+#'   Chunks <- str_extract_all(b, "[a-zA-Z0-9\\._]+ *\\<\\- *[a-zA-Z0-9\\._]+?\\(\\{.+?\\}\\)",
+#'                             simplify = F) %>% .[[1]]
+#'   if (length(Chunks)==0) stop("Hrm, I can't detect any chunks. I expect assignments to use '<-'... so if
+#'                               you're using '=' or '->' assignments or 'source'ing stuff in, then that would be why.")
+#'
+#'   ## Identify only the reactive chunks
+#'   Chunks <- Chunks[grep("reactive\\(",Chunks)]
+#'
+#'   ## get only the guts
+#'   Chunks2 <- str_extract(string = Chunks,"(?<=\\(\\{).+(?=\\}\\))")
+#'
+#'   ## And make stuff evaluatable by replacing multiple space w/ semicolon, however, except the first one.
+#'   Chunks3 <- gsub("   +","; ",str_trim(Chunks2),perl=T)
+#'
+#'   ## But deal w/ pipes
+#'   Chunks4 <- gsub("\\%;","\\%",Chunks3)
+#'
+#'   for(i in 1:length(Chunks4)){
+#'       # eval(parse(text = Chunks4[i]))
+#'     eval(parse(text = str_split(Chunks4[i],";")[[1]]))
+#'   }
+#' }

inst/example2/server.R

@@ -0,0 +1,28 @@
+# RStudio example based on: http://rstudio.github.io/shiny/tutorial/#reactivity
+
+library(shiny)
+library(dplyr)
+
+# Define server logic required to summarize and view the selected dataset
+shinyServer(function(input, output) {
+
+  # By declaring datasetInput as a reactive expression we ensure that:
+  #
+  #  1) It is only called when the inputs it depends on changes
+  #  2) The computation and result are shared by all the callers (it
+  #     only executes a single time)
+  #
+  datasetInput <- reactive({
+    # iris %>% filter(Species == input$dataset)
+    iris[iris$Species == input$dataset,]
+  })
+
+
+  # The output$view depends on both the databaseInput reactive expression
+  # and input$obs, so will be re-executed whenever input$dataset or
+  # input$obs is changed.
+  output$view <- renderTable({
+    datasetInput <- datasetInput()
+    datasetInput
+  })
+})

inst/example2/ui.R

@@ -0,0 +1,26 @@
+# based on RStudio example from: http://rstudio.github.io/shiny/tutorial/#reactivity
+
+library(shiny)
+
+# Define UI for dataset viewer application
+shinyUI(pageWithSidebar(
+
+  # Application title
+  headerPanel("Reactivity"),
+
+  # Sidebar with controls to select a dataset, and
+  # specify the number of observations to view. Note that changes made
+  # to the caption in the textInput control are updated in the output
+  # area immediately as you type
+  sidebarPanel(
+    selectInput("dataset", "Choose a Species:",
+                choices = c("setosa","versicolor","virginica" ))
+  ),
+
+
+  # Show the caption, a summary of the dataset and an HTML table with
+  # the requested number of observations
+  mainPanel(
+    tableOutput("view")
+  )
+))