Simplify output API

R/react.R

@@ -225,13 +225,13 @@ Values <- setRefClass(
   return(values)
 }
 
-make.values.accessor <- function(values) {
+.createValuesReader <- function(values) {
   acc <- list(impl=values)
-  class(acc) <- 'ValuesAccessor'
-  acc
+  class(acc) <- 'reactvaluesreader'
+  return(acc)
 }
-`$.ValuesAccessor` <- function(acc, name) {
-  acc[['impl']]$get(name)
+`$.reactvaluesreader` <- function(x, name) {
+  x[['impl']]$get(name)
 }
 
 Observable <- setRefClass(
@@ -286,8 +286,14 @@ Observable <- setRefClass(
   )
 )
 
-observable <- function(func) {
-  Observable$new(func)
+reactive <- function(x) {
+  UseMethod("reactive")
+}
+reactive.function <- function(func) {
+  return(Observable$new(func)$get.value)
+}
+reactive.default <- function(x) {
+  stop("Don't know how to make this value reactive!")
 }
 
 Observer <- setRefClass(

R/shiny.R

@@ -23,32 +23,6 @@ ShinyApp <- setRefClass(
     define.output = function(name, func) {
       .outputs$set(name, func)
     },
-    define.plot.output = function(name, func, ...) {
-      .outputs$set(name, function() {
-        png.file <- tempfile(fileext='.png')
-        png(filename=png.file, ...)
-        func()
-        dev.off()
-
-        bytes <- file.info(png.file)$size
-        if (is.na(bytes))
-          return(NULL)
-        
-        b64 <- base64encode(readBin(png.file, 'raw', n=bytes))
-        return(paste("data:image/png;base64,", b64, sep=''))
-      })
-    },
-    define.table.output = function(name, func, ...) {
-      .outputs$set(name, function() {
-        data <- func()
-        return(paste(
-          capture.output(
-            print(xtable(data, ...), 
-                  type='html', 
-                  html.table.attributes='class="data"')),
-          collapse="\n"))
-      })
-    },
     instantiate.outputs = function() {
       lapply(.outputs$keys(),
              function(key) {
@@ -71,6 +45,16 @@ ShinyApp <- setRefClass(
   )
 )
 
+.createOutputWriter <- function(shinyapp) {
+  ow <- list(impl=shinyapp)
+  class(ow) <- 'shinyoutput'
+  return(ow)
+}
+`$<-.shinyoutput` <- function(x, name, value) {
+  x[['impl']]$define.output(name, value)
+  return(invisible(x))
+}
+
 statics <- function(root, sys.root=NULL) {
   root <- normalizePath(root, mustWork=T)
   if (!is.null(sys.root))
@@ -145,19 +129,8 @@ start.app <- function(app, www.root, sys.www.root=NULL, port=8101L) {
         shinyapp$session$mset(msg$data)
         flush.react()
         local({
-          define.output <- function(name, func) {
-            shinyapp$define.output(name, func)
-          }
-          define.plot <- function(name, func, ...) {
-            shinyapp$define.plot.output(name, func, ...)
-          }
-          define.table <- function(name, func, ...) {
-            shinyapp$define.table.output(name, func, ...)
-          }
-          get.input <- function(name) {
-            shinyapp$session$get(name)
-          }
-          input <- make.values.accessor(shinyapp$session)
+          input <- .createValuesReader(shinyapp$session)
+          output <- .createOutputWriter(shinyapp)
           
           if (is.function(app))
             app()

R/shinywrappers.R

@@ -0,0 +1,37 @@
+reactivePlot <- function(func, ...) {
+  reactive(function() {
+    png.file <- tempfile(fileext='.png')
+    png(filename=png.file, ...)
+    func()
+    dev.off()
+    
+    bytes <- file.info(png.file)$size
+    if (is.na(bytes))
+      return(NULL)
+    
+    b64 <- base64encode(readBin(png.file, 'raw', n=bytes))
+    return(paste("data:image/png;base64,", b64, sep=''))
+  })
+}
+
+reactiveTable <- function(func, ...) {
+  reactive(function() {
+    data <- func()
+    return(paste(
+      capture.output(
+        print(xtable(data, ...), 
+              type='html', 
+              html.table.attributes='class="data"')),
+      collapse="\n"))
+  })
+}
+
+reactiveText <- function(func, ...) {
+  reactive(function() {
+    x <- withVisible(func())
+    if (x$visible)
+      return(paste(capture.output(print(x$value)), collapse="\n"))
+    else
+      return(x)
+  })
+}

examples/02_hash/app.R

@@ -1,15 +1,16 @@
 library(digest)
 
-text <- observable(function() {
+text <- reactive(function() {
   str <- input$input1
   if (input$addnewline)
     str <- paste(str, "\n", sep='')
   return(str)
 })
 
-define.output('md5_hash', function() {
-  digest(text$get.value(), algo='md5', serialize=F)
+output$md5_hash <- reactive(function() {
+  digest(text(), algo='md5', serialize=F)
+})
+
+output$sha1_hash <- reactive(function() {
+  digest(text(), algo='sha1', serialize=F)
 })
-define.output('sha1_hash', function() {
-  digest(text$get.value(), algo='sha1', serialize=F)
-})

examples/03_distributions/app.R

@@ -1,4 +1,4 @@
-data <- observable(function() {
+data <- reactive(function() {
   # Choose a distribution function
   dist <- switch(input$dist,
                  norm = rnorm,
@@ -11,18 +11,18 @@ data <- observable(function() {
   dist(as.integer(input$n))
 })
 
-define.plot('plot1', function() {
+output$plot1 <- reactivePlot(function() {
   dist <- input$dist
   n <- input$n
   
-  hist(data$get.value(), 
+  hist(data(), 
        main=paste('r', dist, '(', n, ')', sep=''))
 }, width=600, height=300)
 
-define.table('table1', function() {
-  data.frame(x=data$get.value())
+output$table1 <- reactiveTable(function() {
+  data.frame(x=data())
 })
 
-define.output('summary1', function() {
-  paste(capture.output(print(summary(data$get.value()))), collapse="\n")
+output$summary1 <- reactiveText(function() {
+  summary(data())
 })

run.R

@@ -1,5 +1,6 @@
 source('R/react.R');
 source('R/shiny.R');
+source('R/shinywrappers.R');
 
 args <- commandArgs(trailingOnly=T)