Roxygenize

DESCRIPTION

@@ -16,6 +16,7 @@ Depends:
     RJSONIO,
     xtable
 Collate:
-    react.R
-    shiny.R
-    shinywrappers.R
+    'react.R'
+    'reactives.R'
+    'shiny.R'
+    'shinywrappers.R'

NAMESPACE

@@ -0,0 +1,7 @@
+S3method("$",reactvaluesreader)
+S3method("$<-",shinyoutput)
+S3method(reactive,"function")
+S3method(reactive,default)
+export(reactive)
+export(runApp)
+export(startApp)

R/react.R

@@ -87,13 +87,13 @@ Context <- setRefClass(
       .callbacks <<- list()
     },
     run = function(func) {
+      "Run the provided function under this context."
       env <- .getReactiveEnvironment()
-      old.ctx <- env$currentContext(warn=F)
-      env$set.currentContext(.self)
-      on.exit(env$set.currentContext(old.ctx))
-      func()
+      env$runWith(.self, func)
     },
     invalidate = function() {
+      "Schedule this context for invalidation. It will not actually be
+        invalidated until the next call to \\code{\\link{flushReact}}."
       if (.invalidated)
         return()
       .invalidated <<- T
@@ -101,6 +101,9 @@ Context <- setRefClass(
       NULL
     },
     onInvalidate = function(func) {
+      "Register a function to be called when this context is invalidated.
+        If this context is already invalidated, the function is called
+        immediately."
       if (.invalidated)
         func()
       else
@@ -108,6 +111,7 @@ Context <- setRefClass(
       NULL
     },
     executeCallbacks = function() {
+      "For internal use only."
       lapply(.callbacks, function(func) {
         tryCatch({
           func()
@@ -136,13 +140,16 @@ ReactiveEnvironment <- setRefClass(
       .nextId <<- .nextId + 1L
       return(as.character(.nextId))
     },
-    currentContext = function(warn=T) {
-      if (warn && is.null(.currentContext))
-        warning('No reactive context is active')
+    currentContext = function() {
+      if (is.null(.currentContext))
+        stop('No reactive context is active')
       return(.currentContext)
     },
-    set.currentContext = function(ctx) {
+    runWith = function(ctx, func) {
+      old.ctx <- .currentContext
       .currentContext <<- ctx
+      on.exit(.currentContext <<- old.ctx)
+      func()
     },
     addPendingInvalidate = function(ctx) {
       .pendingInvalidate <<- c(.pendingInvalidate, ctx)
@@ -160,162 +167,6 @@ ReactiveEnvironment <- setRefClass(
   )
 )
 
-Values <- setRefClass(
-  'Values',
-  fields = list(
-    .values = 'environment',
-    .dependencies = 'environment'
-  ),
-  methods = list(
-    initialize = function() {
-      .values <<- new.env(parent=emptyenv())
-      .dependencies <<- new.env(parent=emptyenv())
-    },
-    get = function(key) {
-      ctx <- .getReactiveEnvironment()$currentContext()
-      dep.key <- paste(key, ':', ctx$id, sep='')
-      if (!exists(dep.key, where=.dependencies, inherits=F)) {
-        assign(dep.key, ctx, pos=.dependencies, inherits=F)
-        ctx$onInvalidate(function() {
-          rm(list=dep.key, pos=.dependencies, inherits=F)
-        })
-      }
-      
-      if (!exists(key, where=.values, inherits=F))
-        NULL
-      else
-        base::get(key, pos=.values, inherits=F)
-    },
-    set = function(key, value) {
-      if (exists(key, where=.values, inherits=F)) {
-        if (identical(base::get(key, pos=.values, inherits=F), value)) {
-          return(invisible())
-        }
-      }
-      
-      assign(key, value, pos=.values, inherits=F)
-      dep.keys <- objects(
-        pos=.dependencies,
-        pattern=paste('^\\Q', key, ':', '\\E', '\\d+$', sep='')
-      )
-      lapply(
-        mget(dep.keys, envir=.dependencies),
-        function(ctx) {
-          ctx$invalidate()
-          NULL
-        }
-      )
-      invisible()
-    },
-    mset = function(lst) {
-      lapply(names(lst),
-             function(name) {
-               .self$set(name, lst[[name]])
-             })
-    }
-  )
-)
-
-`[.Values` <- function(values, name) {
-  values$get(name)
-}
-
-`[<-.Values` <- function(values, name, value) {
-  values$set(name, value)
-  return(values)
-}
-
-.createValuesReader <- function(values) {
-  acc <- list(impl=values)
-  class(acc) <- 'reactvaluesreader'
-  return(acc)
-}
-`$.reactvaluesreader` <- function(x, name) {
-  x[['impl']]$get(name)
-}
-
-Observable <- setRefClass(
-  'Observable',
-  fields = c(
-    '.func',         # function
-    '.dependencies', # Map
-    '.initialized',  # logical
-    '.value'         # any
-  ),
-  methods = list(
-    initialize = function(func) {
-      .func <<- func
-      .dependencies <<- Map$new()
-      .initialized <<- F
-    },
-    getValue = function() {
-      if (!.initialized) {
-        .initialized <<- T
-        .self$.updateValue()
-      }
-      
-      ctx <- .getReactiveEnvironment()$currentContext()
-      if (!.dependencies$containsKey(ctx$id)) {
-        .dependencies$set(ctx$id, ctx)
-        ctx$onInvalidate(function() {
-          .dependencies$remove(ctx$id)
-        })
-      }
-      return(.value)
-    },
-    .updateValue = function() {
-      old.value <- .value
-      
-      ctx <- Context$new()
-      ctx$onInvalidate(function() {
-        .self$.updateValue()
-      })
-      ctx$run(function() {
-        .value <<- .func()
-      })
-      if (!identical(old.value, .value)) {
-        lapply(
-          .dependencies$values(),
-          function(dep.ctx) {
-            dep.ctx$invalidate()
-            NULL
-          }
-        )
-      }
-    }
-  )
-)
-
-reactive <- function(x) {
-  UseMethod("reactive")
-}
-reactive.function <- function(func) {
-  return(Observable$new(func)$getValue)
-}
-reactive.default <- function(x) {
-  stop("Don't know how to make this value reactive!")
-}
-
-Observer <- setRefClass(
-  'Observer',
-  fields = list(
-    .func = 'function'
-  ),
-  methods = list(
-    initialize = function(func) {
-      .func <<- func
-      .self$run()
-    },
-    run = function() {
-      ctx <- Context$new()
-      ctx$onInvalidate(function() {
-        run()
-      })
-      ctx$run(.func)
-    }
-  )
-)
-
 .getReactiveEnvironment <- function() {
   if (!exists('.ReactiveEnvironment', envir=.GlobalEnv, inherits=F)) {
     assign('.ReactiveEnvironment', ReactiveEnvironment$new(), envir=.GlobalEnv)
@@ -323,26 +174,13 @@ Observer <- setRefClass(
   get('.ReactiveEnvironment', envir=.GlobalEnv, inherits=F)
 }
 
+#' Causes any pending invalidations to run.
 flushReact <- function() {
   .getReactiveEnvironment()$flush()
 }
 
-.test <- function () {
-  values <- Values$new()
-  obs <- Observer$new(function() {print(values$get('foo'))})
-  flushReact()
-  values$set('foo', 'bar')
-  flushReact()
-  
-  values$set('a', 100)
-  values$set('b', 250)
-  observable <- Observable$new(function() {
-    values$get('a') + values$get('b')
-  })
-  obs2 <- Observer$new(function() {print(paste0('a+b: ', observable$getValue()))})
-  flushReact()
-  values$set('b', 300)
-  flushReact()
-  values$mset(list(a = 10, b = 20))
-  flushReact()
+#' Retrieves the current reactive context, or errors if there is no reactive
+#' context active at the moment.
+getCurrentContext <- function() {
+  .getReactiveEnvironment()$currentContext()
 }

R/reactives.R

@@ -0,0 +1,195 @@
+Values <- setRefClass(
+  'Values',
+  fields = list(
+    .values = 'environment',
+    .dependencies = 'environment'
+  ),
+  methods = list(
+    initialize = function() {
+      .values <<- new.env(parent=emptyenv())
+      .dependencies <<- new.env(parent=emptyenv())
+    },
+    get = function(key) {
+      ctx <- .getReactiveEnvironment()$currentContext()
+      dep.key <- paste(key, ':', ctx$id, sep='')
+      if (!exists(dep.key, where=.dependencies, inherits=F)) {
+        assign(dep.key, ctx, pos=.dependencies, inherits=F)
+        ctx$onInvalidate(function() {
+          rm(list=dep.key, pos=.dependencies, inherits=F)
+        })
+      }
+      
+      if (!exists(key, where=.values, inherits=F))
+        NULL
+      else
+        base::get(key, pos=.values, inherits=F)
+    },
+    set = function(key, value) {
+      if (exists(key, where=.values, inherits=F)) {
+        if (identical(base::get(key, pos=.values, inherits=F), value)) {
+          return(invisible())
+        }
+      }
+      
+      assign(key, value, pos=.values, inherits=F)
+      dep.keys <- objects(
+        pos=.dependencies,
+        pattern=paste('^\\Q', key, ':', '\\E', '\\d+$', sep='')
+      )
+      lapply(
+        mget(dep.keys, envir=.dependencies),
+        function(ctx) {
+          ctx$invalidate()
+          NULL
+        }
+      )
+      invisible()
+    },
+    mset = function(lst) {
+      lapply(names(lst),
+             function(name) {
+               .self$set(name, lst[[name]])
+             })
+    }
+  )
+)
+
+`[.Values` <- function(values, name) {
+  values$get(name)
+}
+
+`[<-.Values` <- function(values, name, value) {
+  values$set(name, value)
+  return(values)
+}
+
+.createValuesReader <- function(values) {
+  acc <- list(impl=values)
+  class(acc) <- 'reactvaluesreader'
+  return(acc)
+}
+
+#' @S3method $ reactvaluesreader
+`$.reactvaluesreader` <- function(x, name) {
+  x[['impl']]$get(name)
+}
+
+Observable <- setRefClass(
+  'Observable',
+  fields = c(
+    '.func',         # function
+    '.dependencies', # Map
+    '.initialized',  # logical
+    '.value'         # any
+  ),
+  methods = list(
+    initialize = function(func) {
+      .func <<- func
+      .dependencies <<- Map$new()
+      .initialized <<- F
+    },
+    getValue = function() {
+      if (!.initialized) {
+        .initialized <<- T
+        .self$.updateValue()
+      }
+      
+      ctx <- .getReactiveEnvironment()$currentContext()
+      if (!.dependencies$containsKey(ctx$id)) {
+        .dependencies$set(ctx$id, ctx)
+        ctx$onInvalidate(function() {
+          .dependencies$remove(ctx$id)
+        })
+      }
+      return(.value)
+    },
+    .updateValue = function() {
+      old.value <- .value
+      
+      ctx <- Context$new()
+      ctx$onInvalidate(function() {
+        .self$.updateValue()
+      })
+      ctx$run(function() {
+        .value <<- .func()
+      })
+      if (!identical(old.value, .value)) {
+        lapply(
+          .dependencies$values(),
+          function(dep.ctx) {
+            dep.ctx$invalidate()
+            NULL
+          }
+        )
+      }
+    }
+  )
+)
+
+#' Wraps a normal function to create a reactive function.
+#' 
+#' A reactive function is a function that knows its result will change over
+#' time.
+#' 
+#' 
+#' 
+#' Reactive values are values that can change over time.
+#' 
+#' Reactive functions are functions that can read reactive values and call other
+#' reactive functions. Whenever a reactive value changes, any reactive functions
+#' that depended on it will re-execute.
+#' 
+#' @param x The value or function to make reactive.
+#' 
+#' @export
+reactive <- function(x) {
+  UseMethod("reactive")
+}
+#' @S3method reactive function
+reactive.function <- function(x) {
+  return(Observable$new(x)$getValue)
+}
+#' @S3method reactive default
+reactive.default <- function(x) {
+  stop("Don't know how to make this value reactive!")
+}
+
+Observer <- setRefClass(
+  'Observer',
+  fields = list(
+    .func = 'function'
+  ),
+  methods = list(
+    initialize = function(func) {
+      .func <<- func
+      .self$run()
+    },
+    run = function() {
+      ctx <- Context$new()
+      ctx$onInvalidate(function() {
+        run()
+      })
+      ctx$run(.func)
+    }
+  )
+)
+
+.test <- function () {
+  values <- Values$new()
+  obs <- Observer$new(function() {print(values$get('foo'))})
+  flushReact()
+  values$set('foo', 'bar')
+  flushReact()
+  
+  values$set('a', 100)
+  values$set('b', 250)
+  observable <- Observable$new(function() {
+    values$get('a') + values$get('b')
+  })
+  obs2 <- Observer$new(function() {print(paste0('a+b: ', observable$getValue()))})
+  flushReact()
+  values$set('b', 300)
+  flushReact()
+  values$mset(list(a = 10, b = 20))
+  flushReact()
+}

R/shiny.R

@@ -48,6 +48,8 @@ ShinyApp <- setRefClass(
   class(ow) <- 'shinyoutput'
   return(ow)
 }
+
+#' @S3method $<- shinyoutput
 `$<-.shinyoutput` <- function(x, name, value) {
   x[['impl']]$defineOutput(name, value)
   return(invisible(x))
@@ -105,6 +107,16 @@ statics <- function(root, sys.root=NULL) {
 
 shinyapp <- NULL
 
+#' Creates a new app with the given properties.
+#' 
+#' @param app Path to the R file that contains the server application logic.
+#' @param www.root Path to the root of the application-specific www files
+#'     (which should include index.html).
+#' @param sys.www.root Path to the system www root, that is, the assets that
+#'     are shared by all Shiny applications (shiny.css, shiny.js, etc.).
+#' @param port The TCP port that the application should listen on.
+#'
+#' @export
 startApp <- function(app, www.root, sys.www.root=NULL, port=8101L) {
   
   ws_env <- create_server(port=port, webpage=statics(www.root, sys.www.root))
@@ -153,6 +165,11 @@ startApp <- function(app, www.root, sys.www.root=NULL, port=8101L) {
   return(ws_env)
 }
 
+#' Run an application that was created by \code{\link{startApp}}. This
+#' function does not normally return.
+#' 
+#' @param ws_env The return value from \code{\link{startApp}}.
+#' @export
 runApp <- function(ws_env) {
   while (T)
     service(server=ws_env)

doc/intro.md

@@ -0,0 +1,88 @@
+<style type="text/css">
+p {font-size: 140%}
+</style>
+
+# Guide to Coding in Shiny
+
+The Shiny web framework is fundamentally about making it easy to wire up *input values* from a web page, making them easily available to you in R, and have the results of your R code be written as *output values* back out to the web page.
+
+    input values => R code => output values
+
+Since Shiny web apps are interactive, the input values can change at any time, and the output values need to be updated immediately to reflect those changes.
+
+Shiny comes with a **reactive programming** library that you will use to structure your application logic. By using this library, changing input values will naturally cause the right parts of your R code to be reexecuted, which will in turn cause any changed outputs to be updated.
+
+## Reactive Programming: The Basics
+
+Reactive programming is a coding style that starts with **reactive values**--values that change over time, or in response to the user--and builds on top of them with **reactive functions**--functions that access reactive values and execute other reactive functions.
+
+What's interesting about reactive functions is that whenever they execute, they automatically keep track of what reactive values they read and what reactive functions they called. If those "dependencies" become out of date, then they know that their own return value has also become out of date. Because of this dependency tracking, changing a reactive value will automatically instruct all reactive functions that directly or indirectly depended on that value to re-execute.
+
+The most common way you'll encounter reactive values in Shiny is using the `input` object. The `input` object, which is automatically in scope when your Shiny application's R code runs, lets you access the web page's user input fields using a list-like syntax. For example, if there was a text field named `foo` in your HTML, you would access it in your R code with `input$foo`. Code-wise, it looks like you're grabbing a value from a list or data frame, but you're actually reading a reactive value.
+
+That brings us to the first constraint of the reactive framework: **reactive values can only be read from inside a reactive function.** It doesn't need to be the currently executing function that's reactive; it can be the function that's calling the current function, or the function that's calling that one, and so on. But if none of the functions on the current call stack are reactive, then attempting to read a reactive value will give you an error telling you so.
+
+To create a reactive function, just take a regular function, and wrap it in a call to `reactive`:
+
+```r
+reactive(function() {
+  print(input$foo)
+})
+```
+
+This creates a reactive function that depends on `input$foo`. Whenever the value of `input$foo` changes, the function will execute and print the value.
+
+```r
+a.to.b <- reactive(function() {
+  input$a:input$b
+})
+```
+
+
+
+To explain how reactive programming works, let's step through a series of examples.
+
+## Example 1: Hello World
+
+Our simplest example app will present the user with a textbox; anything that is typed into the textbox will be echoed back to the user in uppercase.
+
+index.html (abridged):
+```html
+<p>
+  Input:<br/>
+  <input name="val" type="text" value="Hello World!"/>
+</p>
+
+<p>
+  You said:<br/>
+  <div id="valUpper" class="live-text"/>
+</p>
+```
+
+app.R:
+```r
+output$valUpper <- reactive(function() {
+  toupper(input$val)
+})
+```
+
+Lauch Example App 1 and try it out. [TODO: Directions for how to launch example app 1] You can see that as you type into the textbox, the output immediately updates.
+
+Take a look at app.R. You probably figured out that `input$val` is how we access the value of the `val` field in index.html, and assigning to `output$echo` is how we define what goes into the `valUpper` div.
+
+The only thing that needs explanation here is `reactive`. You pass it a function, and it returns to you a **reactive** version of that same function.
+
+Now it's time to explain what *reactive* actually means.
+
+* A **reactive value** is a value that may change in the future.
+* A **reactive function** is a function that accesses reactive values and/or executes other reactive functions. (It can also access regular, non-reactive values and execute regular, non-reactive functions; otherwise, it'd be hard to get them to do anything useful!)
+
+The unique thing about reactive values and functions is that they track their own dependencies. That is, when you execute a reactive function, it's actually doing two things:
+
+1. Evaluating the function body and returning a value (just like any other R function)
+2. Keeping track of what other reactive functions are being called and what reactive values are being accessed
+
+When a reactive value changes, any reactive functions that previously accessed this value (and thus "depended" on it) are notified that they are out of date and need to re-execute. Those reactive functions, in turn, will notify any reactive functions that depended on them, and so on.
+
+In this case, our function calls `input$val`, so that counts as one of the inputs. Whenever the user makes a change to `val`, this function notices the change and re-executes itself. And since the `output` data structure is designed to work with reactive functions, it'll notice when the re-execution happens and send the result back to the web page.
+

examples/01_allcaps/app.R

@@ -0,0 +1,3 @@
+output$valUpper <- reactive(function() {
+  toupper(input$val)
+})

examples/01_allcaps/www/index.html

@@ -0,0 +1,21 @@
+<html>
+<head>
+  <script src="shared/jquery-1.7.2.js" type="text/javascript"></script>
+  <script src="shared/shiny.js" type="text/javascript"></script>
+  <link rel="stylesheet" type="text/css" href="shared/shiny.css"/>
+</head>
+<body>
+  <h1>Example 1: All Caps</h1>
+
+  <p>
+    Input:<br/>
+    <input name="val" type="text" value="Hello World!"/>
+  </p>
+  
+  <p>
+    You said:<br/>
+    <div id="valUpper" class="live-text"/>
+  </p>
+
+</body>
+</html>

man/flushReact.Rd

@@ -0,0 +1,10 @@
+\name{flushReact}
+\alias{flushReact}
+\title{Causes any pending invalidations to run.}
+\usage{
+  flushReact()
+}
+\description{
+  Causes any pending invalidations to run.
+}
+

man/getCurrentContext.Rd

@@ -0,0 +1,12 @@
+\name{getCurrentContext}
+\alias{getCurrentContext}
+\title{Retrieves the current reactive context, or errors if there is no reactive
+context active at the moment.}
+\usage{
+  getCurrentContext()
+}
+\description{
+  Retrieves the current reactive context, or errors if
+  there is no reactive context active at the moment.
+}
+

man/reactive.Rd

@@ -0,0 +1,24 @@
+\name{reactive}
+\alias{reactive}
+\title{Wraps a normal function to create a reactive function.}
+\usage{
+  reactive(x)
+}
+\arguments{
+  \item{x}{The value or function to make reactive.}
+}
+\description{
+  A reactive function is a function that knows its result
+  will change over time.
+}
+\details{
+
+
+  Reactive values are values that can change over time.
+
+  Reactive functions are functions that can read reactive
+  values and call other reactive functions. Whenever a
+  reactive value changes, any reactive functions that read
+  that reactive value will re-execute.
+}
+

man/runApp.Rd

@@ -0,0 +1,17 @@
+\name{runApp}
+\alias{runApp}
+\title{Run an application that was created by \code{\link{startApp}}. This
+function does not normally return.}
+\usage{
+  runApp(ws_env)
+}
+\arguments{
+  \item{ws_env}{The return value from
+  \code{\link{startApp}}.}
+}
+\description{
+  Run an application that was created by
+  \code{\link{startApp}}. This function does not normally
+  return.
+}
+

man/startApp.Rd

@@ -0,0 +1,26 @@
+\name{startApp}
+\alias{startApp}
+\title{Creates a new app with the given properties.}
+\usage{
+  startApp(app, www.root, sys.www.root = NULL,
+    port = 8101L)
+}
+\arguments{
+  \item{app}{Path to the R file that contains the server
+  application logic.}
+
+  \item{www.root}{Path to the root of the
+  application-specific www files (which should include
+  index.html).}
+
+  \item{sys.www.root}{Path to the system www root, that is,
+  the assets that are shared by all Shiny applications
+  (shiny.css, shiny.js, etc.).}
+
+  \item{port}{The TCP port that the application should
+  listen on.}
+}
+\description{
+  Creates a new app with the given properties.
+}
+

run.R

@@ -1,4 +1,5 @@
 source('R/react.R');
+source('R/reactives.R');
 source('R/shiny.R');
 source('R/shinywrappers.R');