Simple example of a Shiny app using ggvis. Trying to use a pulldown to filter a variable. So here I'm trying to filter by mtcars' gear (either 3, 4, or 5), then plotting x and y of mpg and hp for each of the unique values of gear.
I get the initial plot drawn with a default of '3' selected, but if I change the value via the pulldown nothing happens. I think I know where things are going wrong (commented in the code), but I've tried just about everything I can think of and have no idea what the actual mistake I'm making is.
Thanks
ui.R
# ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Car Thing"),
sidebarLayout(
sidebarPanel(
uiOutput("choose_gear")
),
mainPanel(
ggvisOutput("ggvis")
)
)
))
server.R
#server.R
library(shiny)
library(ggvis)
library(dplyr)
gear_nos <- sort(unique(mtcars$gear))
shinyServer(function(input, output, session) {
output$choose_gear <- renderUI({
selectInput("gears", "Choose Gear", gear_nos, selected="3")
})
# I'm pretty sure this is where I'm messing something up
pickedGear <- reactive({
mtcars %>% filter(gear == input$gears)
})
if(is.null(dim(pickedGear))){
pickedGear <- mtcars[mtcars$gear == 3,]
}
pickedGear %>% ggvis(~mpg, ~hp) %>% layer_points(fill := "green") %>% bind_shiny("ggvis")
})
I think this might be what you want.
Note that it took me quite awhile to figure out the validate piece that eliminates an extraneous error message (incorrect string: length(0) 32 expected) on startup initialization of the shinyServer code, but I will remember it for the future now I guess.
library(shiny)
library(ggvis)
library(dplyr)
# library(googleVis) # used observe instead now
u <- shinyUI(fluidPage(
titlePanel("Car Thing"),
sidebarLayout(
sidebarPanel(
uiOutput("choose_gear")
),
mainPanel(
ggvisOutput("ggvis")
)
)
))
gear_nos <- sort(unique(mtcars$gear))
s <- shinyServer(function(input, output, session) {
output$choose_gear <- renderUI({
selectInput("gears", "Choose Gear", gear_nos, selected="3")
})
pickedGear <- reactive({
shiny::validate(need(input$gears, message=FALSE))
mtcars %>% filter(gear == input$gears)
})
# could also replace "observe" with this from googlevis : "output$ggvis <- renderGvis({"
observe({
pickedGear() %>% ggvis(~mpg,~hp) %>% layer_points(fill:="green") %>% bind_shiny("ggvis")
})
})
shinyApp(u,s)
Yielding:
Related
I am an absolute beginner to Shiny, so I would appreciate your patience and any advice to my issue. Here's the server function that I'm using to output a ggplot, which works on its own, but doesn't change at all when I change the inputs:
server <- function(input, output) {
output$plooot<-renderPlot({
df = df %>%
group_by(input$Category,Type) %>%
summarise(Distribution=sum(Distribution))
ggplot(df,aes(input$Category,Distribution,fill=Type))+geom_bar(stat="identity",position="dodge")})
}
shinyApp(ui=ui,server=server)
Here's my ui function as well just for reference:
ui <- fluidPage(
titlePanel("chart"),
# Generate a row with a sidebar
sidebarLayout(
# Define the sidebar with one input
sidebarPanel(
selectInput("Category","Category:",choices=c("a","b","c","d","e","f")),
selectInput("a","a:", choices=unique(Table$a), selected="All"),
selectInput("b","b:", choices=unique(Table$b), selected="All"),
selectInput("c","c:", choices=unique(Table$c), selected="All"),
selectInput("d","d:", choices=unique(Table$d), selected="All"),
selectInput("e","e:", choices=unique(Table$e), selected="All"),
selectInput("f","f:", choices=unique(Table$f), selected="All")
),
# Create a spot for the barplot
mainPanel(
plotOutput("plooot")
)
)
)
Unfortunately, I can't post the data for legal reasons, but here are two plots of what I want vs. what I have:
This is probably a very rudimentary mistake, but I'm having trouble understanding what I'm doing wrong.
I agree with #AndS., re-assigning back to df = ... is not likely what you want/need but will almost certainly irreversibly reduce your data. Additionally, input$Category is a character and not a symbol that group_by is expecting. Try this:
library(shiny)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("chart"),
# Generate a row with a sidebar
sidebarLayout(
# Define the sidebar with one input
sidebarPanel(
selectInput("Category","Category:",choices=colnames(mtcars))
),
# Create a spot for the barplot
mainPanel(
plotOutput("plooot")
)
)
)
server <- function(input, output) {
output$plooot<-renderPlot({
req(input$Category)
icq <- sym(input$Category)
mtcars %>%
group_by(!!!icq, vs) %>%
summarise(disp=sum(disp)) %>%
ggplot(aes_string(input$Category, "disp", fill="vs")) +
geom_bar(stat="identity", position="dodge")
})
}
shinyApp(ui=ui,server=server)
Not knowing what your data looks like, see below. The best thing to do is for any data set that will be affected by a user input, is to put it in a reactive expression. Then use that reactive expression in your output plots. I also added an "ALL" to your choices and an if function in case you want to see them all together like you have in your picture.
ui <- fluidPage(
titlePanel("Chart"),
sidebarLayout(
sidebarPanel(
selectInput("Category","Category:",choices=c("All","a","b","c","d","e","f"))
),
mainPanel(
plotOutput("Plot")
)
)
)
server <- function(input, output) {
Distribution <- c(1,2,3,4,1,2,3,5,2,4)
Category <- c("a","b","c","e","f","a","b","c","e","f")
Type <- c("Blue","Blue","Blue","Blue","Blue","Red","Red","Red","Red","Red")
df <- data.frame(Distribution ,Category,Type)
df_subset <- reactive({
if (input$Category == "All") {df}
else{df[df$Category == input$Category,]}
})
output$Plot <- renderPlot({
dat <- df_subset()
dat <- dat %>%
group_by(Category,Type) %>%
summarise(Distribution=sum(Distribution))
plot <- ggplot(dat,aes(Category,Distribution,fill=Type))+geom_bar(stat="identity",position="dodge")
return(plot)
})
}
shinyApp(ui=ui,server=server)
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 use a ggvis barchart to filter values in shiny (as if it was a checkbox input). I am able to select as many checkboxes I want by clicking on any of the bars in the chart, but I cannot deselect them by clicking on the same bar again.
I tried writing an if statement (commented) but the checkbox keeps flickering, since barValue() enters and infinite loop. I suspect the issue is due to the reactivity of tblCar(), but I am not sure how to move further...maybe I should put tblCar within an observe?
ui.R
library(shiny)
a <- row.names(mtcars)
names(a) <- row.names(mtcars)
as.list(a)
shinyUI(fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
checkboxGroupInput("carModel", label = h3("Checkbox group"),
choices = as.list(a),
selected = 1)
),
# Show a plot of the generated distribution
mainPanel(
ggvisOutput('countBar'),
tableOutput('tblCar')
)
)
))
The if statement for deselecting is commented out.
server.R
library(shiny)
shinyServer(function(input, output) {
barValue <- function(data, location, session, ...) {
data$stack_lwr_ <- NULL
# if (data$x_ %in% input$carModel) {
# return( updateCheckboxGroupInput(session,'carModel',selected = input$carModel[! input$carModel %in% data$x_ ]) )
# } else {
print(paste(data$x_))
updateCheckboxGroupInput(session,'carModel',selected = c(data$x_,input$carModel))
#}
}
output$value <- renderPrint({ input$checkGroup })
#barchart-menu
tbl_df(mtcars) %>% mutate(cars=row.names(mtcars)) %>%
ggvis(~cars, ~mpg) %>% layer_bars() %>%
handle_click(barValue) %>%
bind_shiny('countBar', 'ui_countBar')
tblCar <- reactive({
req(input$carModel)
tbl_df(mtcars) %>% mutate(cars=row.names(mtcars)) %>%
filter(cars %in% input$carModel)
})
output$tblCar <- renderTable({
tblCar()
})
})
global.R
library(ggvis)
library(dplyr)
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) ).