Skip to content

Commit b2d4524

Browse files
whitwortwhitwort
committed
Updated app to use ggvis instead of gplot visualizations
1 parent 0dace4a commit b2d4524

5 files changed

Lines changed: 115 additions & 80 deletions

File tree

‎global.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,3 @@
11
# Currently this environment doesn't get reloaded when it's dirty
2-
# See https://github.com/rstudio/shiny/issues/74
2+
# See https://github.com/rstudio/shiny/issues/74
3+

‎model.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8,10 +8,10 @@ solver <- ode
88
headerText <- "Binding Model"
99

1010
# Sidebar header with instructions. (this is markdown code)
11-
sidebarHeader <- "The simulation will update as you change the parameters below. The summary tab records results across multiple runs of the simulation."
11+
sidebarHeader <- " "
1212

1313
# Footer with some extra text. (this is markdown code)
14-
sidebarFooter <- "Version 0.3. [Source code](https://github.com/whitwort/bindingModel) available on github."
14+
sidebarFooter <- "Version 0.4. [Source code](https://github.com/whitwort/bindingModel) available on github."
1515

1616
# Kinetic parameters; don't duplicate names with the state vector
1717
parameters <- c(

‎scripts/dirtify.R‎

Lines changed: 2 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,2 @@
1-
# This is a total hack that dirties ui.R and server.R so that they are reloaded
2-
# by the framework.
3-
dirtify <- function(files = c("./ui.R", "./server.R")) {
4-
for (file in files) {
5-
system( paste("touch", file) )
6-
}
7-
}
8-
9-
dirtify()
1+
# Useful because the server only restarts is UI.r, server.r or restart.ext have changed
2+
system("touch restart.txt")

‎server.R‎

Lines changed: 70 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,14 @@
11
library(shiny)
22
library(ggplot2)
3+
library(ggvis)
34
library(reshape)
45

56
# Load model into the local environment
67
source("model.R", local = TRUE)
78

89
# Define server logic required to generate the plot
9-
shinyServer(function(input, output) {
10-
10+
shinyServer(function(input, output, session) {
11+
1112
#Session store is a reactive values ~list
1213
store <- reactiveValues()
1314
store$summaryData <- data.frame()
@@ -17,15 +18,15 @@ shinyServer(function(input, output) {
1718

1819
# Bind initial state and parameter inputs
1920
return(list(
20-
state = vapply( names(state)
21-
, function(name) { input[[name]] }
22-
, FUN.VALUE = numeric(1)
23-
)
21+
state = vapply( names(state)
22+
, function(name) { input[[name]] }
23+
, FUN.VALUE = numeric(1)
24+
)
2425

25-
, parameters = vapply( names(parameters)
26-
, function(name) { input[[name]] }
27-
, FUN.VALUE = numeric(1)
28-
)
26+
, parameters = vapply( names(parameters)
27+
, function(name) { input[[name]] }
28+
, FUN.VALUE = numeric(1)
29+
)
2930

3031
))
3132
})
@@ -36,20 +37,22 @@ shinyServer(function(input, output) {
3637
args <- runArgs()
3738

3839
# Run the simulation; convert result to a data.frame
39-
result <- data.frame(solver(
40+
data.frame(solver(
4041
y = args$state
41-
, times = seq(time["start"], input$time.end, by = abs(input$time.end - time["start"]) / 100)
42+
, times = seq( time["start"]
43+
, input$time.end
44+
, by = abs(input$time.end - time["start"]) / 100
45+
)
4246
, func = model
4347
, parms = args$parameters
4448
))
4549

46-
return(result)
47-
4850
})
4951

5052
# Observers: these are run agressively
51-
updateSummary <- observe({
52-
53+
# updateSummary <- observe({
54+
updateSummary <- observe({
55+
5356
# Update with run updates
5457
args <- runArgs()
5558
result <- runModel()
@@ -76,7 +79,7 @@ shinyServer(function(input, output) {
7679
}
7780

7881
})
79-
82+
8083
})
8184

8285
clearSummary <- observe({
@@ -85,38 +88,65 @@ shinyServer(function(input, output) {
8588
resetNow <- input$resetSummary
8689

8790
# Reset summary table, capturing current model result as first row of data
88-
isolate({ store$summaryData <- store$summaryData[nrow(store$summaryData),names(store$summaryData)] })
91+
isolate({
92+
store$summaryData <- store$summaryData[nrow(store$summaryData),names(store$summaryData)]
93+
})
8994

9095
})
9196

9297
# Simulation plot
93-
output$modelPlot <- renderPlot({
94-
95-
p <- ggplot(melt(runModel(), id = "time")) +
96-
geom_line( aes(time, value, colour = variable) ) +
97-
ylab("[variable]") +
98-
ylim(0, input$ymax)
99-
100-
print(p)
98+
modelTable <- reactive({ melt(runModel(), id = "time") })
99+
modelPlot <- reactive({
100+
101+
# p <- ggplot( +
102+
# geom_line( aes(time, value, colour = variable) ) +
103+
# ylab("[variable]") +
104+
# ylim(0, input$ymax)
105+
#
106+
# print(p)
107+
108+
ggvis( modelTable
109+
, props(x = ~time, y = ~value, fill = ~variable)
110+
) + mark_point() +
111+
dscale( "y"
112+
, "numeric"
113+
, domain = c(0, state[[input$yScale]])
114+
, nice = FALSE
115+
, clamp = TRUE
116+
)
101117

102118
})
103-
119+
observe_ggvis(modelPlot, 'modelPlot', session)
120+
output$modelPlotUI <- renderControls(modelPlot, session)
121+
104122
# Summary plot
105-
output$summaryPlot <- renderPlot({
106-
107-
p <- ggplot( data.frame( x = store$summaryData[[input$summaryX]]
108-
, y = store$summaryData[[input$summaryY]]
109-
)
110-
, aes(x, y)
111-
) +
112-
geom_point() +
113-
geom_line( colour = "green" ) +
114-
ylab(input$summaryY) +
115-
xlab(input$summaryX)
116-
117-
print(p)
123+
summaryTable <- reactive({
124+
data.frame( x = store$summaryData[[input$summaryX]]
125+
, y = store$summaryData[[input$summaryY]]
126+
)
127+
})
128+
# output$summaryPlot <- renderPlot({
129+
summaryPlot <- reactive({
130+
131+
# p <- ggplot( data.frame( x = store$summaryData[[input$summaryX]]
132+
# , y = store$summaryData[[input$summaryY]]
133+
# )
134+
# , aes(x, y)
135+
# ) +
136+
# geom_point() +
137+
# geom_line( colour = "green" ) +
138+
# ylab(input$summaryY) +
139+
# xlab(input$summaryX)
140+
#
141+
# print(p)
142+
143+
ggvis( summaryTable()
144+
, props (x = ~x, y = ~y)
145+
) + mark_point()
118146

119147
})
148+
observe_ggvis(summaryPlot, 'summaryPlot', session)
149+
output$summaryPlotUI <- renderControls(summaryPlot, session)
120150

121151
# Summary download link
122152
output$downloadSummaryData <- downloadHandler(

‎ui.R‎

Lines changed: 39 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,15 @@
11
library(shiny)
2+
library(ggvis)
23
library(plyr)
34
library(markdown)
45

56
# Load model into the local environment
67
source("model.R", local = TRUE)
78

89
# Build an input UI from the model
10+
stateNames <- names(state)
11+
names(stateNames) <- stateFormat(stateNames)
12+
913
modelInputs <- list(
1014

1115
# Sidebar header text
@@ -31,18 +35,30 @@ modelInputs <- list(
3135
)
3236
})
3337

34-
# Time scale adjustment
38+
# Y-axis scaling
39+
# , sliderInput( 'yMax'
40+
# , 'Y-axis scale'
41+
# , min = min(state)
42+
# , max = max(state)
43+
# , value = state[['A']]
44+
# )
45+
, selectInput( 'yScale'
46+
, "Scale y-axis to"
47+
, choices = stateNames
48+
)
49+
, br()
50+
51+
# Time scale adjustment
3552
, sliderInput( "time.end"
3653
, "Time scale"
37-
, min = 0
38-
, max = time["end"] * 10
54+
, min = time["end"] * 0.1
55+
, max = time["end"] * 5
3956
, value = time["end"]
4057
, step = time["end"] * 0.1
4158
)
42-
43-
# Save to summary button
59+
4460
, br()
45-
61+
4662
# Sidebar footer text
4763
, helpText(HTML(markdownToHTML(text = sidebarFooter, fragment.only = TRUE)))
4864

@@ -63,15 +79,8 @@ shinyUI(pageWithSidebar(
6379
tabsetPanel(
6480

6581
tabPanel( "Simulation"
66-
, plotOutput("modelPlot")
67-
, wellPanel(
68-
sliderInput( "ymax"
69-
, "Y-axis scale:"
70-
, min = 0
71-
, max = max(state)
72-
, value = 0.1 * max(state)
73-
)
74-
)
82+
, ggvis_output("modelPlot")
83+
, uiOutput("modelPlotUI")
7584
)
7685

7786
, tabPanel( "Summary"
@@ -80,26 +89,28 @@ shinyUI(pageWithSidebar(
8089
, wellPanel( class = "well container-fluid"
8190
, div( class = "row-fluid"
8291
, div( class = "span5"
83-
, selectInput( "summaryY"
84-
, "Summarize:"
85-
, choices = names(state.summary)
86-
)
92+
, selectInput( "summaryY"
93+
, "Summarize:"
94+
, choices = names(state.summary)
95+
)
8796
)
8897
, div( class = "span5"
89-
, selectInput("summaryX"
90-
, "As a function of:"
91-
, choices = c( stateFormat(names(state))
92-
, parameterFormat(names(parameters))
93-
)
94-
)
98+
, selectInput("summaryX"
99+
, "As a function of:"
100+
, choices = c( stateFormat(names(state))
101+
, parameterFormat(names(parameters))
102+
)
103+
)
104+
)
95105
)
96-
)
97106
)
98107

99-
, plotOutput('summaryPlot')
108+
, ggvis_output('summaryPlot')
109+
, uiOutput('summaryPlotUI')
110+
# , plotOutput('summaryPlot')
100111
, actionButton("resetSummary", "Clear data")
101112
, downloadButton('downloadSummaryData', 'Download Data')
102113
)
103-
)
114+
)
104115
)
105116
))

0 commit comments

Comments
 (0)