github/shiny
1
1
Fork 0
mirror of https://github.com/rstudio/shiny.git synced 2026-04-07 03:00:20 -04:00
Code Issues Packages Projects Releases Wiki Activity

Clean up instances of reactive() and observe()

Browse Source
This commit is contained in:
Winston Chang
2013-02-07 15:34:15 -06:00
parent 6a34bbfddd
commit 2ea38d6ecc
11 changed files with 56 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
R/shiny.R
View File

@@ -62,7 +62,7 @@ ShinyApp <- setRefClass(
}
}
obs <- Observer$new(function() {
obs <- observe({
value <- try(func(), silent=FALSE)
@@ -78,7 +78,7 @@ ShinyApp <- setRefClass(
}
else
.invalidatedOutputValues$set(name, value)
}, label, suspended = TRUE)
}, label=label, suspended=TRUE)
obs$onInvalidate(function() {
showProgress(name)

2
inst/examples/02_text/server.R
View File

@@ -5,7 +5,7 @@ library(datasets)
shinyServer(function(input, output) {
# Return the requested dataset
datasetInput <- reactive(function() {
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,

2
inst/examples/03_reactivity/server.R
View File

@@ -13,7 +13,7 @@ shinyServer(function(input, output) {
# new result is compared to the previous result; if the two are
# identical, then the callers are not notified
#
datasetInput <- reactive(function() {
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,

2
inst/examples/04_mpg/server.R
View File

@@ -13,7 +13,7 @@ shinyServer(function(input, output) {
# Compute the forumla text in a reactive function since it is
# shared by the output$caption and output$mpgPlot functions
formulaText <- reactive(function() {
formulaText <- reactive({
paste("mpg ~", input$variable)
})

2
inst/examples/05_sliders/server.R
View File

@@ -4,7 +4,7 @@ library(shiny)
shinyServer(function(input, output) {
# Reactive function to compose a data frame containing all of the values
sliderValues <- reactive(function() {
sliderValues <- reactive({
# Compose data frame
data.frame(

2
inst/examples/06_tabsets/server.R
View File

@@ -6,7 +6,7 @@ shinyServer(function(input, output) {
# Reactive function to generate the requested distribution. This is
# called whenever the inputs change. The output functions defined
# below then all use the value computed from this function
data <- reactive(function() {
data <- reactive({
dist <- switch(input$dist,
norm = rnorm,
unif = runif,

2
inst/examples/07_widgets/server.R
View File

@@ -5,7 +5,7 @@ library(datasets)
shinyServer(function(input, output) {
# Return the requested dataset
datasetInput <- reactive(function() {
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,

2
inst/examples/08_html/server.R
View File

@@ -6,7 +6,7 @@ shinyServer(function(input, output) {
# Reactive function to generate the requested distribution. This is
# called whenever the inputs change. The output functions defined
# below then all used the value computed from this function
data <- reactive(function() {
data <- reactive({
dist <- switch(input$dist,
norm = rnorm,
unif = runif,

2
inst/examples/10_download/server.R
View File

@@ -1,5 +1,5 @@
shinyServer(function(input, output) {
datasetInput <- reactive(function() {
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,

75
inst/tests/test-reactivity.r
View File

@@ -59,16 +59,16 @@ test_that("Functions are not over-reactive", {
values <- reactiveValues(A=10)
funcA <- reactive(function() {
funcA <- reactive({
values$A
})
funcB <- reactive(function() {
funcB <- reactive({
funcA()
values$A
})
obsC <- observe(function() {
obsC <- observe({
funcB()
})
@@ -100,13 +100,13 @@ test_that("overreactivity2", {
observed_value2 <- NA
values <- reactiveValues(A=1)
funcB <- reactive(function() {
funcB <- reactive({
values$A + 5
})
obsC <- observe(function() {
obsC <- observe({
observed_value1 <<- funcB() * values$A
})
obsD <- observe(function() {
obsD <- observe({
observed_value2 <<- funcB() * values$A
})
@@ -135,15 +135,15 @@ test_that("overreactivity2", {
test_that("isolation", {
values <- reactiveValues(A=10, C=NULL)
obsB <- observe(function() {
obsB <- observe({
values$C <- values$A > 0
})
funcD <- reactive(function() {
funcD <- reactive({
values$C
})
obsE <- observe(function() {
obsE <- observe({
funcD()
})
@@ -163,15 +163,15 @@ test_that("laziness", {
values <- reactiveValues(A=10)
funcA <- reactive(function() {
funcA <- reactive({
values$A > 0
})
funcB <- reactive(function() {
funcB <- reactive({
funcA()
})
obsC <- observe(function() {
obsC <- observe({
if (values$A > 10)
return()
funcB()
@@ -203,10 +203,10 @@ test_that("order of evaluation", {
observed_value <- NA
values <- reactiveValues(A=1)
funcB <- reactive(function() {
funcB <- reactive({
values$A + 5
})
obsC <- observe(function() {
obsC <- observe({
observed_value <<- values$A * funcB()
})
@@ -230,10 +230,10 @@ test_that("order of evaluation", {
observed_value <- NA
values <- reactiveValues(A=1)
funcB <- reactive(function() {
funcB <- reactive({
values$A + 5
})
obsC <- observe(function() {
obsC <- observe({
observed_value <<- funcB() * values$A
})
@@ -259,18 +259,18 @@ test_that("isolate() blocks invalidations from propagating", {
obsD_value <- NA
values <- reactiveValues(A=1, B=10)
funcB <- reactive(function() {
funcB <- reactive({
values$B + 100
})
# References to valueB and funcB are isolated
obsC <- observe(function() {
obsC <- observe({
obsC_value <<-
values$A + isolate(values$B) + isolate(funcB())
})
# In contrast with obsC, this has a non-isolated reference to funcB
obsD <- observe(function() {
obsD <- observe({
obsD_value <<-
values$A + isolate(values$B) + funcB()
})
@@ -331,7 +331,7 @@ test_that("Circular refs/reentrancy in reactive functions work", {
values <- reactiveValues(A=3)
funcB <- reactive(function() {
funcB <- reactive({
# Each time fB executes, it reads and then writes valueA,
# effectively invalidating itself--until valueA becomes 0.
if (values$A == 0)
@@ -340,7 +340,7 @@ test_that("Circular refs/reentrancy in reactive functions work", {
return(values$A)
})
obsC <- observe(function() {
obsC <- observe({
funcB()
})
@@ -357,14 +357,14 @@ test_that("Circular refs/reentrancy in reactive functions work", {
test_that("Simple recursion", {
values <- reactiveValues(A=5)
funcB <- reactive(function() {
funcB <- reactive({
if (values$A == 0)
return(0)
values$A <- values$A - 1
funcB()
})
obsC <- observe(function() {
obsC <- observe({
funcB()
})
@@ -377,13 +377,13 @@ test_that("Non-reactive recursion", {
nonreactiveA <- 3
outputD <- NULL
funcB <- reactive(function() {
funcB <- reactive({
if (nonreactiveA == 0)
return(0)
nonreactiveA <<- nonreactiveA - 1
return(funcB())
})
obsC <- observe(function() {
obsC <- observe({
outputD <<- funcB()
})
@@ -395,7 +395,7 @@ test_that("Non-reactive recursion", {
test_that("Circular dep with observer only", {
values <- reactiveValues(A=3)
obsB <- observe(function() {
obsB <- observe({
if (values$A == 0)
return()
values$A <- values$A - 1
@@ -408,12 +408,12 @@ test_that("Circular dep with observer only", {
test_that("Writing then reading value is not circular", {
values <- reactiveValues(A=3)
funcB <- reactive(function() {
funcB <- reactive({
values$A <- isolate(values$A) - 1
values$A
})
obsC <- observe(function() {
obsC <- observe({
funcB()
})
@@ -431,17 +431,17 @@ test_that("names() and reactiveValuesToList()", {
values <- reactiveValues(A=1, .B=2)
# Dependent on names
depNames <- observe(function() {
depNames <- observe({
names(values)
})
# Dependent on all non-hidden objects
depValues <- observe(function() {
depValues <- observe({
reactiveValuesToList(values)
})
# Dependent on all objects, including hidden
depAllValues <- observe(function() {
depAllValues <- observe({
reactiveValuesToList(values, all.names = TRUE)
})
@@ -491,11 +491,11 @@ test_that("names() and reactiveValuesToList()", {
test_that("Observer pausing works", {
values <- reactiveValues(a=1)
funcA <- reactive(function() {
funcA <- reactive({
values$a
})
obsB <- observe(function() {
obsB <- observe({
funcA()
})
@@ -596,6 +596,10 @@ test_that("reactive() accepts quoted and unquoted expressions", {
fun <- reactive(q_expr, quoted = TRUE)
expect_equal(isolate(fun()), 2)
# If function is used, work, but print message
expect_message(fun <- reactive(function() { vals$A + 1 }))
expect_equal(isolate(fun()), 2)
# Check that environment is correct - parent environment should be this one
this_env <- environment()
@@ -633,6 +637,11 @@ test_that("observe() accepts quoted and unquoted expressions", {
flushReact()
expect_equal(valB, 4)
# If function is used, work, but print message
expect_message(observe(function() { valB <<- vals$A + 5 }))
flushReact()
expect_equal(valB, 5)
# Check that environment is correct - parent environment should be this one
this_env <- environment()

8
inst/tests/test-text.R
View File

@@ -35,22 +35,22 @@ test_that("reactive functions save visibility state", {
# Call each function twice - should be no change in state with second call
# invisible NULL
f <- reactive(function() invisible())
f <- reactive({ invisible() })
expect_identical(withVisible(isolate(f())), list(value=NULL, visible=FALSE))
expect_identical(withVisible(isolate(f())), list(value=NULL, visible=FALSE))
# visible NULL
f <- reactive(function() NULL)
f <- reactive({ NULL })
expect_identical(withVisible(isolate(f())), list(value=NULL, visible=TRUE))
expect_identical(withVisible(isolate(f())), list(value=NULL, visible=TRUE))
# invisible non-NULL value
f <- reactive(function() invisible(10))
f <- reactive({ invisible(10)})
expect_identical(withVisible(isolate(f())), list(value=10, visible=FALSE))
expect_identical(withVisible(isolate(f())), list(value=10, visible=FALSE))
# visible non-NULL value
f <- reactive(function() 10)
f <- reactive({ 10 })
expect_identical(withVisible(isolate(f())), list(value=10, visible=TRUE))
expect_identical(withVisible(isolate(f())), list(value=10, visible=TRUE))
})