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")
})
Related
Brand new to R so wondering if someone can help me understand where I'm going wrong here. Apologies if I've butchered the format or handed you terrible code to work from.
My goal is to get dashboard out containing a plot, whereby I can choose a column from my data and group_by that selected column, then calculate the mean of a different column for each bin in the selected column. Giving me a graph with the column selected across the x-axis and the average calculated up the y. Hopefully the code I've tried so far will shed more light on this:
library(tidyverse)
library(shiny)
library(shinydashboard)
df <-
data.frame(Car_Col = c("Red","Blue","Red","Black","white","Black","Black","White","Red","Blue"),
Car_Type = c("E","G","D","G","G","D","G","D","E","G"),
Sold = (c(1,0,1,0,0,0,1,1,0,0)))
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(fluidRow(selectInput(inputId = "x",
label = "Select variable",
choices = c("Car_Col","Car_Type", selected = "Car_Col"))),
plotOutput("graph1")
)
)
server <- function(input, output) {
output$graph1 <- renderPlot({
df_summarise <-
df %>%
group_by(get(input$x)) %>%
summarise(Avg_Sold = mean(Sold)) %>%
ungroup() >%>
ggplot(df, mapping = aes(x=get(input$x), y=Avg_Sold, group=1) +geom_point(size=2)) +geom_line()
})
}
shinyApp(ui, server)
So for instance I want a plot where the user can select if they want to see the average sold across Car_Col, or across Car_Type - obviously wanting them calculated uniquely to the selection.
So for example the mean value of sold cars across colour I'd want Red, Blue, Black and White across the x-axis, with their respective means (so red having 2 sold and 3 cars should be at 0.67, etc)
Currently the error I'm getting is this:
Warning: Error in group_by: Problem adding computed columns.
Caused by error in `mutate()`:
! Problem while computing `..1 = get(input$x)`.
Caused by error in `get()`:
! invalid first argument
...
...
Warning: Error in ggplot: Mapping should be created with `aes()` or `aes_()`.
I believe from what I can find from other similar questions that I'm treating the input$x incorrectly and the error is stemming, as above, from the get(input$x), but whenever I try to do it outside of the plot then it's outside of a reactive environment - and I can't make that work either (though I only tried something like using var = reactive({input$x)} and referencing var() in place of get(input$x) but that didn't work either).
Any help would be appreciated, thank you!
There are several issues with your code. First you placed several closing parentheses in the wrong place. Second, you pipe your data into ggplot but additionally pass df to the data argument. Third, there is a typo in one of the pipes, i.e. you use >%> instead of %>%. Finally group_by(get(input$x)) will not work. Use e.g. group_by(across(input$x)) or group_by(data[[input$x]]) as I do below.
Additionally, while x=get(input$x) works I would still suggest to use x = .data[[input$x]].
library(tidyverse)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(selectInput(
inputId = "x",
label = "Select variable",
choices = c("Car_Col", "Car_Type"), selected = "Car_Col"
)),
plotOutput("graph1")
)
)
server <- function(input, output) {
output$graph1 <- renderPlot({
df %>%
group_by(.data[[input$x]]) %>%
summarise(Avg_Sold = mean(Sold)) %>%
ungroup() %>%
ggplot(mapping = aes(x = .data[[input$x]], y = Avg_Sold, group = 1)) +
geom_point(size = 2) +
geom_line()
})
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:5153
library(tidyverse)
library(shiny)
library(shinydashboard)
df <-
data.frame(Car_Col = c("Red","Blue","Red","Black","white","Black","Black","White","Red","Blue"),
Car_Type = c("E","G","D","G","G","D","G","D","E","G"),
Sold = (c(1,0,1,0,0,0,1,1,0,0)))
## app.R ##
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(fluidRow(selectInput(inputId = "x",
label = "Select variable",
choices = c("Car_Col","Car_Type", selected = "Car_Col"))),
plotOutput("graph1")
)
)
server <- function(input, output) {
output$graph1 <- renderPlot({
req(input$x)
df %>%
group_by_at(input$x) %>%
summarise(Avg_Sold = mean(Sold)) %>%
ungroup() %>%
ggplot(mapping = aes_string(x=input$x, y='Avg_Sold', group=1)) +
geom_point(size=2) +
geom_line()
})
}
shinyApp(ui, server)
value in input$x is a string, you need to use group_by_at which accepts a character vector. In aes, it needs column name without quotes, so we use the string version aes_string.
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 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 have a ggvis plot in an app that needs to modify its axis title based on a user input. I do this in the way I show below: by putting ggvis object inside a reactive block
server.R
library(shiny)
library(ggvis)
shinyServer(function(input, output, session) {
frame = data.frame(a=c(1,2,3), b=c(1,2,3))
title = reactive({
input$userInput
})
reactive({
frame %>%
ggvis(~a, ~b) %>%
add_axis('y', title = title()) %>%
layer_points()
}) %>% bind_shiny('plot')
})
ui.R
library(shiny)
library(ggvis)
shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel(
textInput(inputId = 'userInput',
label = 'y axis title')
),
mainPanel(
ggvisOutput('plot')
))))
I don't want to do this because this resets the entire plot at every change (which resets the size, prevents you from having the nice sliding effect that ggvis has and have other downsides). Is there a way to have ggvis only change the only property I want it to change in this context?
I want to add tooltip containing all variables.
But when I use this code I get following error:
Error in handlers$add(handler, key, tail) : Key / already in use
If I don't use add_tooltip the plot is created without any problem.
(The add_tooltip is near the bottom of server.R)
Please help, I am really frustrated.
I am creating a Shiny application with following ui and server:
ui.R:
library(ggplot2)
library(ggvis)
library(shiny) # load shiny at beginning at both scripts
shinyUI(fluidPage( # standard shiny layout, controls on the
# left, output on the right
titlePanel("Relative Velocity vs Distance Gap"), # give the interface a title
sidebarLayout(position="right",
sidebarPanel( # all the UI controls go in here
radioButtons(inputId = 'dfid', label = h4("Select Data:"),
choices = c("Coordinate Approach",
"Sum Approach")),
selectInput(inputId="vid", label=h4("Select Vehicle ID:"), choices = vehid)
),
mainPanel( # all of the output elements go in here
h3("Plot"), # title with HTML helper
plotOutput("plot") # this is the name of the output
# element as defined in server.R
)
)
))
server.R:
library(ggvis)
library(shiny) # load shiny at beginning at both scripts
shinyServer(function(input, output) { # server is defined within
# these parentheses
new.data <- reactive({switch(input$dfid, "Coordinate Approach"=df1, "Sum Approach"=df2)})
output$plot <- renderPlot({
new.data <- subset(new.data(), new.data()$Vehicle.ID==input$vid)
tittle <- unique(new.data$Vehicle.class)
mtc <- new.data
mtc$id <- 1:nrow(mtc)
all_values <- function(x) {
if(is.null(x)) return(NULL)
row <- mtc[mtc$id == x$id, ]
paste0(names(row), ": ", format(row), collapse = "<br />")
}
mtc %>% ggvis(x = ~relative.v, y = ~gap.dist, key:=~id) %>%
layer_points() %>%
add_tooltip(all_values, "hover")
#ggplot(data= new.data, mapping = aes(x=relative.v, y=gap.dist, color=as.factor(p))) +
# geom_point() + ggtitle(tittle) + labs(x='Relative Velocity (ft/s)', y='Gap (feet)') + theme_bw() #+ my.theme()
})
})
Another unrelated problem is that when I run the app, the shiny app runs in a window but ggvis plot is created in Viewer pane.
How can I render the plot in window within the Shiny app?