I am new to Shiny/ggvis and I want to create a scatter plot that allows the user to select from an X and Y dropdown. I have attempted this feat may times to no avail and would greatly appreciate some help. Please see the code below.
library(shiny)
library(ggvis)
library(dplyr)
# Define the user interface
shinyUI(pageWithSidebar(
# Add a title to this page
headerPanel(
h1("Test the Header Panel!")),
sidebarPanel(
uiOutput("ggvis_ui"),
sliderInput(inputId = "size",label = "Area",10, 1000, value = c(10)),
selectInput(inputId = "yAxis",label = "Y variable", c("wt","drat")),
selectInput(inputId = "xAxis",label = " X variable", c("cyl", "am","gear"))),
mainPanel(
h1("Please review the chart below showing nothing!"),
ggvisOutput("ggvis")
)
)
)
Server.r
# Create server.R
shinyServer(function(input, output, session) {
# A reactive expression wrapper for input$size
input_size <- reactive(input$size)
input_xAxis <- reactive(input$xAxis)
input_yAxis <- reactive(input$yAxis)
# A reactive expression wrapper for input$size
mtcars %>%
ggvis(x =input_xAxis, y = input_yAxis, size := input_size) %>%
layer_points() %>%
bind_shiny("ggvis", "ggvis_ui")
})
The two things you are missing is making the plot reactive and using prop for setting properties when the variables names are strings.
The following change to the server code returns a reactive graphic:
plot = reactive({
mtcars %>%
ggvis(prop("x", as.name(input_xAxis())),
prop("y", as.name(input_yAxis())),
size := input_size) %>%
layer_points()
})
plot %>%
bind_shiny("ggvis", "ggvis_ui")
Related
I have a problem with my code. Every time I click a button my plot (built with ggvis) is showing up but vanishes immediately. Since my code is very long, the following code reproduces my problem. I want to reuse the reactive data frame test0 in my render function and I guess this is exactly what causes my problem. But this is essential to me. The three steps (reactive, observe, render) are the same than in my code. I would very much appreciate your help!
server.R
library(shiny)
library(ggvis)
library(dplyr)
data(mtcars)
shinyServer(function(input, output) {
test0 <- reactive({
df <- mtcars %>% select(mpg, wt)
(input$NextCounter + 1)*df
})
observe({
df <- test0()
if (!is.null(df)) {
ggvis(df, x = ~wt, y = ~mpg) %>% bind_shiny("plotggvis")
}
})
output$test1 <- renderUI({
df <- test0()
ggvisOutput("plotggvis")
})
})
ui.R
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("NextCounter", "Next")
),
mainPanel(
uiOutput("test1")
)
)
))
this one working for me
library(shiny)
library(ggvis)
library(dplyr)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("NextCounter", "Next")
),
mainPanel(
ggvisOutput("plotggvis")
)
)
))
server <- shinyServer(function(input, output) {
data(mtcars)
test0 <- reactive({
df <- mtcars %>% select(mpg, wt)
(input$NextCounter + 1)*df
})
my_graph <- reactive({
df <- test0()
ggvis(df, x = ~wt, y = ~mpg)
})
my_graph %>% bind_shiny("plotggvis")
})
})
shinyApp(ui = ui, server = server)
You don't need to have a ggvisOutput in the UI to solve your problem. Actually the problem in your code is having the bind_shiny function inside an observer that will be executed again every time your test0 data changes. It is expected to bind your ggvis only once, otherwise it will have that behavior of showing up and vanishes immediately. Also, one great feature of ggvis is having a nice transitions when data is changing, so you don't need to create a ggvis object every time your data changes, just make sure that you only bind that ggvis object once in your UI.
Below is a modified version of your code to solve your problem and show the animated transition of data.
library(shiny)
library(ggvis)
library(dplyr)
data(mtcars)
ui <- fluidPage(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("NextCounter", "Next")
),
mainPanel(
uiOutput("test1")
)
)
))
server <- function(input, output) {
test0 <- reactive({
input$NextCounter
df <- mtcars %>% select(mpg, wt)
df[sample(nrow(df),nrow(df)/2), ]
})
output$test1 <- renderUI({
# bind the ggvis only once
test0 %>% ggvis(x = ~wt, y = ~mpg) %>% bind_shiny("plotggvis")
ggvisOutput("plotggvis")
})
}
shinyApp(ui, server)
You can also modify some ggvis parameters using input widgets by putting the ggvis inside of a reactive expression.
I am trying to create a simple ggvis plot in a shiny application. The dropdown has two choices: mpv and mpc. Both options are two column data frames with the first column as V1 and the second column as V2. I'd like to be able to select mpc or mpv and have the ggvis plot to the right update. I have the following ui and server r code:
# ui.R
shinyUI(fluidPage(
titlePanel("Barcelona"),
sidebarLayout(
sidebarPanel(
helpText("Display information about the selected variable"),
selectInput("var",
label = "Choose a variable to display",
choices = c("mpc", "mpv"),
selected = "mpc")),
mainPanel(
ggvisOutput("meanpc")))))
# server.R
shinyServer(
function(input, output) {
mpc <- mean.price.country
mpv <- mean.price.vintage
selection <- reactive({
as.numeric(input$var)
})
selection() %>%
ggvis(~V1, ~V2) %>%
layer_bars() %>%
bind_shiny("meanpc")
})
I get the following error:
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Any idea what the error is? Thank you.
You need to pack it in an observe statement like this:
library(shiny)
library(ggvis)
library(dplyr)
# ui.R
u <- shinyUI(fluidPage(
titlePanel("Barcelona"),
sidebarLayout(
sidebarPanel(
helpText("Display information about the selected variable"),
selectInput("var",
label = "Choose a variable to display",
choices = c("mpc", "mpv"),
selected = "mpc")),
mainPanel(
ggvisOutput("meanpc")))))
# server.R
s <- shinyServer(
function(input, output) {
n <- 200
set.seed(1234)
wine <- data.frame( vintage=sample(c(2000:2015),n,replace=T),
price=runif(n,10,150),
stock=runif(n,100,1500),
country=sample(c("Country-1","Country-2","Country-3"),n,replace=T)
)
mpc <- wine %>% group_by(country) %>% summarize( V1=mean(stock), V2=mean(price) )
mpv <- wine %>% group_by(country) %>% summarize( V1=mean(stock), V2=mean(vintage) )
selection <- reactive({ifelse (input$var=="mpc",return(mpc),return(mpv))})
observe({
selection() %>%
ggvis(~V1, ~V2) %>%
layer_bars() %>%
bind_shiny("meanpc")
})
})
shinyApp(u,s)
Yielding:
I am trying to plot 4 different graphs on the same page, using shiny+ggvis. The sidebar has 3 selectizeInput controls where one sets the parameters and a button which triggers the plotting. All data is fetched from a mysql database, and the selectize inputs are also generated based on the content of the database (each one depends on the previous).
Now, I would like to add a checkbox, which, when ticked, would make all 4 plots to have the same maximum. However, when I try to do that, I get something like:
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
What should I do to get the same maximums (which I will not know a priori until I get the filtered data, that is, maximums are data dependent) on all plots?
The skeleton of my code follows:
ui.R
shinyUI(fluidPage(
fluidRow(column(2,
wellPanel(
selectizeInput('ci_select', '1. Instance:', choices = cis,
options = list(
placeholder = 'Please select a instance below',
onInitialize = I('function() { this.setValue(""); }')
)),
## two more selectizeInput, for 'runid_select' and 'setup_select'
...
checkboxInput('maximums', 'Use same maximum', TRUE),
actionButton("go_button", "Plot"))),
column(10,
fluidRow(
column(6, ggvisOutput('tl')),
column(6, ggvisOutput('tr'))),
fluidRow(
column(6, ggvisOutput('bl')),
column(6, ggvisOutput('br')))))))
server.R
shinyServer(function(input, output, clientData, session) {
observe({
if (input$ci_select != "") {
# ... query db and fill runids
updateSelectInput(session, "runid_select", choices = runids)
}
})
# ... similar to the above for runid and setup
plot_data <- reactive({
input$go_button
ci <- isolate(input$ci_select)
# ... some checks ...
# ... extract values from input$setup in num_machines, num_volumes, vol_size ...
r <- data %>%
filter(ci == local(ci), runid == local(runid)) %>%
# ... and a lot of other filtering
collect()
})
max_read_bandwidth <- reactive({
maxx <- read_data %>% summarise(maxx=max(read_bandwidth))
maxx[1]$maxx
})
max_write_bandwidth <- reactive({
maxx <- read_data %>% summarise(maxx=max(write_bandwidth))
maxx[1]$maxx
})
max_bandwidth <- reactive({
max(max_read_bandwidth, max_write_bandwidth)
})
plot_data %>%
filter(fio_type=='read') %>%
ggvis(~fio_bs, ~read_bandwidth) %>%
layer_points() %>%
scale_numeric("y", domain=c(0, ifelse(input$maximums, max_bandwidth(), max_read_bandwidth()))) %>%
bind_shiny("tl")
plot_data %>%
filter(fio_type=='randread') %>%
ggvis(~fio_bs, ~read_bandwidth) %>%
layer_points() %>%
scale_numeric("y", domain=c(0, ifelse(input$maximums, max_bandwidth(), max_read_bandwidth()))) %>%
bind_shiny("tr")
I am having a problem getting a ggvis graph to display using reactive elements. Here is the error I am getting: Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
I looked at other posts so I think I need to use observe({}) somewhere, but I am not sure where. I tried
observe({ df <- CreateDF(input$PMNT, input$Periods, input$Rate) )}
When I did that, the graph displayed, but when I changed the input values, the graph did not update.
Thanks for any insight you may be able to provide.
Here is the relevant code:
server.R:
library(ggvis)
library(dplyr)
source("functions.R")
shinyServer(function(input, output) {
input_PMNT <- reactive(input$PMNT)
input_Periods <- reactive(input$Periods)
input_Rate <- reactive(input$Rate)
observe(
df <- CreateDF(input$PMNT, input$Periods, input$Rate)
)
df %>% ggvis(x = ~time, y = ~pv) %>% layer_bars(width=1, fill := "#fff8dc") %>%
add_axis("x", title = "Period") %>%
add_axis("y", title = "Value") %>%
bind_shiny("AnPlot", "AnPlot_ui")
})
ui.R:
library(shiny)
library(ggvis)
library(dplyr)
shinyUI(fluidPage(
titlePanel("Annuity Calculator"),
sidebarLayout(
sidebarPanel(
radioButtons("AnType",
"Annuity Type:",
list("Level", "Geometric", "Arithmetic"),
selected="Level")
),
mainPanel(
numericInput("PMNT", "Enter the regular payment:", min=0, value=100),
numericInput("Periods", "Enter the number of periods:", min=0, value=10),
numericInput("Rate", "Enter the interest rate, as a decimal:", value=0.07),
ggvisOutput("AnPlot"),
uiOutput("AnPlot_ui")
)
)
))
The expression observe({ df <- CreateDF(input$PMNT, input$Periods, input$Rate) )} does not make much sense to me since df is visible only inside the observer, and observers don't return anything. Instead, you can try df <- reactive( CreateDF(input$PMNT, input$Periods, input$Rate) ).
I'm trying to create a shiny app that allows the user to select certain groups to plot on a ggvis graph. The problem I'm having is that if I map reactive data to properties of the points (like the point fill, shape, etc.), the scale resets every time the user updates the groups. So the mapping of group identity to fill color does not remain constant. I tried to fix this by hard coding group id to fill color in a reactive element, but then I start getting difficult to interpret errors when the app starts to load.
Here's the code of my first attempt:
ui.R
#ui.R
library(shiny)
library(ggvis)
shinyUI(fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
checkboxGroupInput("gear", label = "Gears", choices = c("3","4","5"))
),
# Show a plot of the generated distribution
mainPanel(
uiOutput("ggvis_ui"),
ggvisOutput("ggvis"),
textOutput("jawn"))
)
))
server.R
#server.R
library(shiny)
library(ggvis)
library(dplyr)
shinyServer(function(input, output) {
selected <- reactive(input$gear)
selectedData <- reactive({
mtcars %>%
filter(gear %in% selected())%>%
mutate(gear = as.character(gear))
})
colorRange <- reactive({
c(`3` = "red", `4` = "blue", `5` = "green")[sort(selected())]
})
output$jawn <- renderText(colorRange())
mtcars%>%
ggvis(~wt, ~mpg)%>%
layer_points()%>%
layer_points(data = selectedData, fill = ~gear)%>%
scale_ordinal("fill", range = colorRange) %>%
bind_shiny("ggvis", "ggvis_ui")
})
When I run this I get the error:
Error : x is not a numeric or integer vector
I've also got a github repository with one of my other attempts at a solution, which gets a different error, and the code that works, but has the remapping problem: https://github.com/JoFrhwld/ggvis_scales
Edit: I should say this is with ggvis v0.3, dplyr v0.3, and shiny v0.10
The answer, thanks to the ggvis google group
hardcode the range and domain of the scale, but not reactively.
group_by() the categorizing data, to inhibit meaningless animations.
The new server.R code is thus
# server.R
library(shiny)
library(ggvis)
library(dplyr)
shinyServer(function(input, output) {
selected <- reactive(input$gear)
selectedData <- reactive({
mtcars %>%
filter(gear %in% selected())%>%
mutate(gear = as.character(gear))%>%
group_by(gear)
})
fill_domain = c("3","4","5")
fill_range = c("red","blue","green")
mtcars%>%
ggvis(~wt, ~mpg)%>%
layer_points()%>%
layer_points(data = selectedData, fill = ~gear)%>%
scale_ordinal("fill", range = fill_range, domain = fill_domain)%>%
bind_shiny("ggvis", "ggvis_ui")
})