From 4b1123c4e4eb3ea82099b535bb0dec805a005b27 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Fri, 29 Jun 2012 15:53:10 -0700 Subject: [PATCH] Simplify output API --- R/react.R | 20 ++++++++----- R/shiny.R | 51 ++++++++------------------------- R/shinywrappers.R | 37 ++++++++++++++++++++++++ examples/02_hash/app.R | 13 +++++---- examples/03_distributions/app.R | 14 ++++----- run.R | 1 + 6 files changed, 77 insertions(+), 59 deletions(-) create mode 100644 R/shinywrappers.R diff --git a/R/react.R b/R/react.R index ca47a0e7f..eb1f8d8e8 100644 --- a/R/react.R +++ b/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( diff --git a/R/shiny.R b/R/shiny.R index 5e27ebcb0..17c6753da 100644 --- a/R/shiny.R +++ b/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() diff --git a/R/shinywrappers.R b/R/shinywrappers.R new file mode 100644 index 000000000..4ef3af4c7 --- /dev/null +++ b/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) + }) +} \ No newline at end of file diff --git a/examples/02_hash/app.R b/examples/02_hash/app.R index 27d4cd39d..7aa8923ac 100644 --- a/examples/02_hash/app.R +++ b/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) -}) \ No newline at end of file diff --git a/examples/03_distributions/app.R b/examples/03_distributions/app.R index 9ba2fbb72..0e7c70ab9 100644 --- a/examples/03_distributions/app.R +++ b/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()) }) diff --git a/run.R b/run.R index 089c19002..51c379b94 100644 --- a/run.R +++ b/run.R @@ -1,5 +1,6 @@ source('R/react.R'); source('R/shiny.R'); +source('R/shinywrappers.R'); args <- commandArgs(trailingOnly=T)