Skip to content

Commit 9e6a65f

Browse files
skranzskranz
committed
Use shiny with event handlers instead of reactivity
0 parents  commit 9e6a65f

13 files changed

+414
-0
lines changed

‎.Rbuildignore

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
^.*\.Rproj$
2+
^\.Rproj\.user$

‎.gitignore

+3
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
.Rproj.user
2+
.Rhistory
3+
.RData

‎DESCRIPTION

+13
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
Package: shinyEvents
2+
Type: Package
3+
Title: Use shiny with event handlers instead of reactivity
4+
Version: 0.0
5+
Date: 2014-11-11
6+
Author: Sebastian Kranz
7+
Maintainer: Sebastian Kranz <[email protected]>
8+
Description: Shiny is a great package. Yet, for more complex
9+
projects, I find it hard to write clean code with
10+
its reactivity paradigm. This package wraps shiny
11+
into more traditional event handlers. Not yet working.
12+
License: GPL >= 2.0
13+
Depends: stringtools, shiny, restorepoint

‎NAMESPACE

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
exportPattern("^[[:alpha:]]+")

‎R/add_handler.r

+91
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,91 @@
1+
# Manually trigger shiny events when some value changes
2+
# While this is also the key idea of reactive programming
3+
# Shiny (at least in current versions as of October 2014)
4+
# tends to trigger events too often.
5+
6+
# What we need:
7+
# 1. Call a function or render output when a button is clicked
8+
# 2. Call a function or render output when an input value has changed
9+
# 3. Update input values when an input value or variable has changed without triggering further events
10+
11+
12+
reset.event.handlers = function(app = get.app()) {
13+
app$values=list()
14+
}
15+
16+
add.handlers.to.session = function(handlers, session.env=app$session.env, app=get.app()) {
17+
for (el in handlers) {
18+
call = el$call
19+
eval(call, session.env)
20+
}
21+
}
22+
23+
add.handler = function(id, call, type="unknown", app = get.app()) {
24+
if (app$is.running) {
25+
eval(app$handler.env, call)
26+
} else {
27+
app$handlers[[length(app$handlers)+1]] = list(id=id, call=call, type=type)
28+
}
29+
}
30+
31+
add.change.handler = function(id, fun,...,app=get.app(), on.create=FALSE) {
32+
fun = substitute(fun)
33+
# Create dynamic observer
34+
args = list(...)
35+
ca = substitute(env=list(s_id=id, s_fun=fun,s_args=args, s_on.create=on.create),
36+
observe({
37+
display("called event handler for ",s_id)
38+
input[[s_id]]
39+
if (has.widget.value.changed(s_id, input[[s_id]], on.create=s_on.create)) {
40+
display("run event handler for ",s_id)
41+
do.call(s_fun, c(list(id=s_id, value=input[[s_id]], session=session),s_args))
42+
}
43+
})
44+
)
45+
add.handler(id=id,call=ca,type="change",app=app)
46+
}
47+
48+
49+
50+
add.button.handler = function(id, fun,..., app = get.app()) {
51+
52+
fun = substitute(fun)
53+
args = list(...)
54+
55+
ca = substitute(env=list(s_id=id, s_fun=fun,s_args=args),
56+
observe({
57+
if (has.button.counter.increased(s_id, input[[s_id]])) {
58+
display(s_id, " has been clicked...")
59+
do.call(s_fun, c(list(id=s_id, value=input[[s_id]], session=session),s_args))
60+
}
61+
})
62+
)
63+
add.handler(id=id,call=ca,type="button",app=app)
64+
}
65+
66+
has.widget.value.changed = function(id, new.value,on.create=FALSE, app = get.app()) {
67+
restore.point("has.widget.value.changed")
68+
if (!id %in% names(app$values)) {
69+
app$values[[id]] = new.value
70+
changed = on.create
71+
} else {
72+
changed = !identical(app$values[[id]],new.value)
73+
if (changed) {
74+
app$values[[id]] = new.value
75+
}
76+
}
77+
return(changed)
78+
}
79+
80+
81+
has.button.counter.increased = function(id, counter, app=get.app()) {
82+
restore.point("has.widget.counter.increased")
83+
if (isTRUE(counter == 0) | is.null(counter) | isTRUE(counter<=app$values[[id]])) {
84+
app$values[[id]] = counter
85+
cat("\nno counter increase: ", id, " ",counter)
86+
return(FALSE)
87+
}
88+
app$values[[id]] = counter
89+
cat("\ncounter has increased: ", id, " ",counter)
90+
return(TRUE)
91+
}

‎R/app.r

+65
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
1+
# Manually trigger shiny events when some value changes
2+
# While this is also the key idea of reactive programming
3+
# Shiny (at least in current versions as of October 2014)
4+
# tends to trigger events too often.
5+
6+
# What we need:
7+
# 1. Call a function or render output when a button is clicked
8+
# 2. Call a function or render output when an input value has changed
9+
# 3. Update input values when an input value or variable has changed without triggering further events
10+
11+
events.env = new.env()
12+
13+
shiny.app = function() {
14+
app = new.env()
15+
app$is.running = FALSE
16+
app$handlers = list()
17+
app$values = list()
18+
app$run.event.handlers=FALSE
19+
app$do.update = list()
20+
app$server = function(session, input, output) {
21+
app = get.app()
22+
set.app.session(session,app)
23+
add.handlers.to.session(app$handlers, app)
24+
#add.renderer.to.session(app$renderer, app)
25+
}
26+
app
27+
}
28+
29+
set.app = function(app) {
30+
events.env$app = app
31+
}
32+
33+
get.app = function() {
34+
events.env$app
35+
}
36+
37+
set.app.session = function(session, app=get.app()) {
38+
app$session = session
39+
app$input = session$input
40+
app$output = session$output
41+
42+
session.env = new.env()
43+
session.env$session = session
44+
session.env$input = session$input
45+
session.env$output = session$output
46+
47+
app$session.env = session.env
48+
}
49+
50+
run.app = function(app=get.app(),...) {
51+
#add.ui.renderer(app=app)
52+
runApp(list(ui=app$ui, server=app$server),...)
53+
}
54+
55+
display = function(...) {
56+
57+
}
58+
59+
updater.exists = function(id, app=get.app()) {
60+
id %in% names(app$do.update)
61+
}
62+
63+
perform.update = function(id, app=get.app()) {
64+
app$do.update[[id]]$counter = isolate(app$do.update[[id]]$counter+1)
65+
}

‎R/examples.r

+106
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,106 @@
1+
2+
example.how.it.should.look.like = function() {
3+
library(shiny)
4+
5+
6+
app = shiny.app()
7+
set.app(app)
8+
9+
# Main page
10+
ui = fluidPage(
11+
actionButton("textBtn", "text"),
12+
actionButton("plotBtn", "plot"),
13+
actionButton("uiBtn", "ui"),
14+
selectInput("varInput", "Variable:",
15+
c("Cylinders" = "cyl",
16+
"Transmission" = "am",
17+
"Gears" = "gear")
18+
),
19+
textOutput("myText"),
20+
plotOutput("myPlot"),
21+
uiOutput('dynUI')
22+
)
23+
app$ui=ui
24+
25+
# user changes value of an input
26+
add.change.handler("varInput",on.create=!TRUE, function(id, value,...) {
27+
updateText("myText",paste0(value," ", sample(1:1000,1)))
28+
})
29+
30+
button.handlers = function(id, value, ...) {
31+
updateText("myText", paste0("Hello world :",id," ", value," ", sample(1:1000,1)))
32+
}
33+
add.button.handler("textBtn", button.handlers)
34+
add.button.handler("plotBtn", button.handlers)
35+
36+
37+
38+
num = 1
39+
# Dynamical UI that will be shown
40+
dynUI= fluidRow(
41+
actionButton("dynBtn", paste0("dynamic ", num))
42+
)
43+
44+
45+
46+
# user presses a key
47+
#add.hotkey.handler("varInput", fun_name)
48+
49+
run.app(app,launch.browser=rstudio::viewer)
50+
51+
}
52+
53+
54+
55+
example.how.it.should.look.like = function() {
56+
library(shiny)
57+
58+
59+
app = shiny.app()
60+
set.app(app)
61+
62+
# Main page
63+
ui = fluidPage(
64+
actionButton("staticBtn", "static button"),
65+
uiOutput('dynUI')
66+
)
67+
app.main.ui(ui)
68+
69+
# Dynamical UI that will be shown
70+
dynUI= fluidRow(
71+
actionButton("dynBtn", paste0("dynamic ", num)),
72+
selectInput("varInput", "Variable:",
73+
c("Cylinders" = "cyl",
74+
"Transmission" = "am",
75+
"Gears" = "gear")
76+
),
77+
textOutput("varOutput"),
78+
plotOutput("myPlot")
79+
)
80+
81+
# user clicks
82+
add.click.handler("dynBtn", function(...) {
83+
update.ui("dynUI", dynUI)
84+
})
85+
86+
87+
88+
# user changes value of an input
89+
add.change.handler("varInput",varInput.handler)
90+
91+
varInput.handler = function(id, value,..., app=get.app()) {
92+
val = ui.value(id) # get value of an ui element
93+
if (!identical(val,value))
94+
stop("Values should be equal.")
95+
96+
update.ui("varOutput", value)
97+
}
98+
99+
# user presses a key
100+
#add.hotkey.handler("varInput", fun_name)
101+
102+
runApp(app,launch.browser=rstudio::viewer)
103+
104+
}
105+
106+
#example1.noevents()

‎R/make_renderer.r

+59
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
get.renderer.table = function() {
2+
mat = matrix(ncol=2,byrow=TRUE, c(
3+
"renderPlot","shiny-plot-output",
4+
"renderText","shiny-text-output"
5+
))
6+
colnames(mat) = c("renderer","class")
7+
as.data.frame(mat, stringsAsFactors=FALSE)
8+
}
9+
10+
find.ui.renderer = function(ui) {
11+
library(stringtools)
12+
txt = sep.lines(as.character(ui))
13+
14+
class = str.between(txt,'class="','"', not.found=NA)
15+
id = str.between(txt,'id="','"', not.found=NA)
16+
17+
tab = get.renderer.table()
18+
renderer = tab$renderer[match(class,tab$class)]
19+
rows = which(!is.na(renderer))
20+
21+
data.frame(id=id[rows], renderer=renderer[rows], stringsAsFactors=FALSE)
22+
}
23+
24+
examples.make.renderer = function() {
25+
# Dynamical UI that will be shown
26+
num = 1
27+
dynUI= fluidRow(
28+
actionButton("dynBtn", paste0("dynamic ", num)),
29+
selectInput("varInput", "Variable:",
30+
c("Cylinders" = "cyl",
31+
"Transmission" = "am",
32+
"Gears" = "gear")
33+
),
34+
textOutput("varOutput"),
35+
plotOutput("myPlot")
36+
)
37+
ui = dynUI
38+
39+
ir = find.ui.renderer(ui)
40+
ir
41+
42+
call = substitute()
43+
44+
}
45+
46+
add.renderText = function(id, app=get.app()) {
47+
if (!id %in% names(app$do.update)) {
48+
app$do.update[[id]] = reactiveValues(counter=0)
49+
app$output[[id]] <- renderText({
50+
#cat("\ndo.update[['",id,"'']]$counter = ", app$do.update[[id]]$counter)
51+
app$do.update[[id]]$counter
52+
app$text
53+
})
54+
}
55+
}
56+
57+
add.renderer = function(id, app=get.app()) {
58+
# nothing done yet
59+
}

‎R/shinyEvents.R

Whitespace-only changes.

‎R/updateRendered.r

+7
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
updateText = function(id, text, app=get.app()) {
2+
if (!updater.exists(id,app)) {
3+
add.renderText(id, app)
4+
}
5+
app$text = text
6+
perform.update(id, app)
7+
}

‎Read-and-delete-me

+9
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
* Edit the help file skeletons in 'man', possibly combining help files for
2+
multiple functions.
3+
* Edit the exports in 'NAMESPACE', and add necessary imports.
4+
* Put any C/C++/Fortran code in 'src'.
5+
* If you have compiled code, add a useDynLib() directive to 'NAMESPACE'.
6+
* Run R CMD build to build the package tarball.
7+
* Run R CMD check to check the package tarball.
8+
9+
Read "Writing R Extensions" for more information.

0 commit comments

Comments
 (0)