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")
Related
I'm creating a Shiny app where I'd like the user to be able to select a column and condition, resulting in the input$COLUMN input$CONDITION input$VALUE which can be used to filter a dataframe.
Desired Output
iris %>% filter(input$COLUMN input$CONDITION input$VALUE) == iris %>% filter(Sepal.Length > 4.7)
For this to work I need to use rlang for the input$COLUMN, I need to eval the input$CONDITION and I need the input$VALUE to be converted to a numeric when appropriate. (I'm attempting this in my verbatimTextOutput)
What is the best approach for achieving this? I thought making the whole expression a string to be parsed within a tidy pipeline may be the way to go but I am open to alternate suggestions!!
library(shiny)
library(tidyverse)
ui <- fluidPage(
# Sidebar with an input for column
# boolean input
# and value input
sidebarLayout(
sidebarPanel(
fluidRow(column(4, selectInput("COLUMN", "Filter By:", choices = colnames(iris))),
column(4, selectInput("CONDITION", "Boolean", choices = c("==", "!=", ">", "<"))),
column(4, uiOutput("COL_VALUE")))
),
# Show text generated by sidebar
# use text in tidy pipeline to create subsetted dataframe
mainPanel(
verbatimTextOutput("as_text"),
tableOutput("the_data")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$COL_VALUE <- renderUI({
x <- iris %>% select(!!sym(input$COLUMN))
selectInput("VALUE", "Value", choices = x)
})
filtering_string <- reactive ({
paste0("!!sym(", input$COLUMN, ") ", input$CONDITION, " ", input$VALUE)
})
output$as_text <- renderText({
filtering_string()
})
output$the_data <- renderTable({
iris %>%
eval(parse(text = filtering_string()))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am not too familiar with !!sym but you could do:
output$the_data <- renderTable({
# To hide error when no value is selected
if (input$VALUE == "") {
my_data <- ""
} else {
my_data <- iris %>%
filter(eval(parse(text = paste0(input$COLUMN, input$CONDITION, input$VALUE))))
}
return(my_data)
})
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")
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 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 add a dynamic ggvis plot to a Shiny app. First, user picks a dimension, and then adds items from that dimension.
For global.R and sample data, see https://gist.github.com/tts/a41c8581b9d77f131b31
server.R:
shinyServer(function(input, output, session) {
# Render a selectize drop-down selection box
output$items <- renderUI({
selectizeInput(
inputId = 'items',
label = 'Select max 4. Click to delete',
multiple = TRUE,
choices = aalto_all[ ,names(aalto_all) %in% input$dim],
options = list(maxItems = 4, placeholder = 'Start typing')
)
})
selected <- reactive({
if (is.null(input$items)) {
return(aalto_all)
}
df <- aalto_all[aalto_all[[input$dim]] %in% input$items, ]
df$keys <-seq(1, nrow(df))
df
})
selected %>%
ggvis(~WoS, ~NrOfAuthors, fill = ~School, key := ~keys) %>%
layer_points() %>%
add_tooltip(show_title) %>%
bind_shiny("gv")
show_title <- function(x=NULL) {
if(is.null(x)) return(NULL)
key <- x["keys"][[1]]
selected()$Title20[key]
}
})
ui.R:
shinyUI(fluidPage(
titlePanel('Some (alt)metric data for articles published since 2010'),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "dim",
label = "Dimension",
choices = dimensions,
selected = c("Title")),
uiOutput("items")
),
mainPanel(
tabsetPanel(
# I'll add more tabs
tabPanel("Plot with ggvis", ggvisOutput("gv"))
)
)
)
))
This is OK
in the beginning, when there are no items selected, and all data is plotted. This is a hack because the ggvis object throws an error if there is no data served.
when all selected items are deleted (which is the same as 1.) and another dimension is chosen
But when I try to switch to another dimension without deleting the items first, I get this:
Error in `$<-.data.frame`(`*tmp*`, "keys", value = c(1L, 0L)) :
replacement has 2 rows, data has 0
I understand that ggvis is very new and constantly developing, but I suspect that there is merely something in Shiny reactive values that is out of sync. If anyone could point out what I'm doing wrong, thanks a lot!
The error is caused because you have a data.frame with zero rows and have a resulting 1:0.
You can change your selected function to:
selected <- reactive({
if (is.null(input$items)) {
return(aalto_all)
}
df <- aalto_all[aalto_all[[input$dim]] %in% input$items, ]
df$keys <-seq_along(df[,1])
if(nrow(df) == 0){
return(aalto_all)
}
df
})