Animated Bar plot not working/displaying on R shiny Web App - r

I want to display my animated bar plot in R shiny web app. I am getting my animated plot in the Rstudio viewer pane but unfortunately, it is not working in app
CODE:
# LIBRARIES
library(ggplot2)
library(shiny)
library(gganimate)
# LOADING CSV
undergradDATA <- read.csv(file="1-10 Undergraduates.csv", head=TRUE, sep=",")
# UI
ui <- fluidPage (
mainPanel(
plotOutput("myplot")
)
)
# SERVER
server <- function(input, output) {
output$plot <- renderPlot({
undergrad_plot <- ggplot(data=undergradDATA , aes(x=HEI, y=Undergrad), height = 461, width = 644) +
geom_bar(stat='identity', fill="darkolivegreen3", colour="white")
undergrad_plot + ggtitle("Ranking of Top 10 HEI's w.r.t Undergraduates") +
theme(
plot.title = element_text(hjust = 0.5,
colour = "darkolivegreen",
size = 17,
family = "courier"
) )
undergrad_plot + transition_states(Undergrad, wrap = FALSE) +
shadow_mark() +
enter_grow() +
enter_fade()
})
}
# RUNNING APP
shinyApp(UI, server)

Besides some minor flaws in your code (it should be "plot" instead of "myplot" and "ui" instead of "UI" the main issue is that you can't render and output an animated plot via renderPlot and plotOutput. Instead you have to make use of renderImage and imageOutput.
Adapting this answer and making use of some example data created from ggplot2::mpg:
library(ggplot2)
library(shiny)
library(gganimate)
library(dplyr)
## Example data
undergradDATA <- mpg %>%
count(class, sort = TRUE) %>%
mutate(class = reorder(class, n)) %>%
rename(Undergrad = class, HEI = n)
ui <- fluidPage(
mainPanel(imageOutput("plot"))
)
server <- function(input, output) {
output$plot <- renderImage(
{
undergrad_plot <- ggplot(data = undergradDATA, aes(x = HEI, y = Undergrad), height = 461, width = 644) +
geom_bar(stat = "identity", fill = "darkolivegreen3", colour = "white")
undergrad_plot + ggtitle("Ranking of Top 10 HEI's w.r.t Undergraduates") +
theme(
plot.title = element_text(
hjust = 0.5,
colour = "darkolivegreen",
size = 17,
family = "mono"
)
)
anim <- undergrad_plot +
transition_states(Undergrad, wrap = FALSE) +
shadow_mark() +
enter_grow() +
enter_fade()
anim_save("outfile.gif", animate(anim)) # New
# Return a list containing the filename
list(src = "outfile.gif", contentType = "image/gif")
},
deleteFile = TRUE
)
}
shinyApp(ui, server)

Related

What's wrong with this Shiny code? Ggplot does not render, dropdown menu does

I am learning how to use Shiny, and I tried to create a very simple barchart in ggplot2, with a dropdown menu, that allows the user to select a class from a school using the dropdown, and it is supposed to create a barchart with exam result percentages on the y-axis and names on the x-axis. The code I have is as follows:
ui = fluidPage(selectInput(inputId = "Class", label = "Pick a Class", choices = levels(fulldata$Class), plotOutput("bar"), multiple = FALSE, selectize = FALSE))
server = function(input, output){
output$bar = renderPlot({
plotdata = reactive({data %>% filter(Class == input$Class)})
ggplot(plotdata(), aes(x = Name, y = Percent_full) + geom_bar())
})
}
shinyApp(ui = ui, server = server)
The end result correctly renders the dropdown menu, but it does not render the plot whatsoever. I have tried changing the ggplot call to a simple hist(rnorm(1000)) but it does not render either.
I solved the problem: the plotOutput function in the fluidPage function was defined as an argument of the input function, not as an argument of fluidPage. It works now!
It might be that your code needs to declare the reactive data before you create your ggplot.
Try this:
plotdata = reactive(
data %>% filter(Class == input$Class)
)
output$bar = renderPlot({
ggplot(plotdata(), aes(x = Name, y = Percent_full) + geom_bar())
})
Here is more example code from a functioning shiny app using reactive data for ggplot:
data <- reactive(
merged_clean_data %>% filter(between(date, as.POSIXct(input$dateRange[1]),
as.POSIXct(input$dateRange[2])))
)
#Output plot for any selected variable
output$timePlot <- renderPlot({
ggplot(data(), aes(x = date, !!input$selection)) +
theme_classic() + geom_line() +
coord_cartesian(xlim = as.POSIXct(ranges$x, origin = "1970-01-01"), expand = FALSE) +
theme(text = element_text(size = 16), axis.title.x=element_blank(), axis.text.y = element_text(angle=90, vjust=1, hjust=1)) + {if(input$hlineadd)geom_hline(yintercept = input$hline)} +
{if(input$smoothingadd)geom_smooth()}
}, res = 80)

I would like to change a ggplot entirely to another one through a SelectInput

Image Currently I have a selectInput with two options which I want to link to their own ggplots entirely. What I currently have is only seeming to show the second ggplot when its Input in the drop down is selected, but the first plot for "Ordered_Product_Sales" is not showing. Wondering where I am going wrong whether it is in the IF statements or just my structure entirely. I am very new (couple of days) to R and R shiny so be kind.
library(shiny)
library(plotly)
ui <- fluidPage(
# Application title
titlePanel("Metric Tracker"),
sidebarLayout(
sidebarPanel(
selectInput("value", "Select Value" , choices = c("Ordered_Product_Sales", "Units_Ordered"), selected = NULL , multiple = FALSE, selectize = TRUE)
),
# Show plot
mainPanel(
plotlyOutput("valuePlot"),
plotlyOutput("value2Plot")
)
)
)
# Define server
server <- function(input, output) {
output$valuePlot <- renderPlotly({
if (input$value == "Ordered_Product_Sales")
metric2 %>%
ggplot(aes(x=Date, y = Ordered_Product_Sales, title = "Sales")) + geom_point() + geom_line( ) + geom_smooth(method = 'lm') + facet_wrap( ~ Brand)
output$value2Plot <- renderPlotly({
if (input$value == "Units_Ordered")
metric2 %>%
ggplot(aes(x=Date, y = Units_Ordered)) + geom_point() + geom_line() + geom_smooth(method = 'lm') + facet_wrap( ~ Brand)
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
My Data is called metric2 where the ggplots are plotting the date against either the sales column or units column.
Thanks
Please try the below simplified version of your code. You might need to provide some dummy data if this still doesn't work.
library(shiny)
library(plotly)
ui <- fluidPage(
# Application title
titlePanel("Metric Tracker"),
sidebarLayout(
sidebarPanel(
selectInput("value", "Select Value" , choices = c("Ordered_Product_Sales", "Units_Ordered"), selected = NULL , multiple = FALSE, selectize = TRUE)
),
# Show plot
mainPanel(
plotlyOutput("valuePlot")
)
)
)
# Define server
server <- function(input, output) {
output$valuePlot <- renderPlotly({
if (input$value == "Ordered_Product_Sales") {
metric2 %>%
ggplot(aes(x=Date, y = Ordered_Product_Sales)) + geom_point() + geom_line( ) + geom_smooth(method = 'lm') + facet_wrap( ~ Brand) + ggtitle("Sales")
}
if (input$value == "Units_Ordered") {
metric2 %>%
ggplot(aes(x=Date, y = Units_Ordered)) + geom_point() + geom_line() + geom_smooth(method = 'lm') + facet_wrap( ~ Brand)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Update
Based on the image of the data, I created a small sample set:
metric2 = data.frame(Date = c(as.POSIXct('2019-07-06'), as.POSIXct('2019-07-07'), as.POSIXct('2019-07-08'), as.POSIXct('2019-07-06'), as.POSIXct('2019-07-06')), Brand = c('A', 'B', 'A', 'C', 'B'), Units_Ordered = c(710, 253, 185, 107, 727), Ordered_Product_Sales = c(6551, 7226, 9007, 6003, 5964), stringsAsFactors = FALSE)
And then updated the app as follows:
library(shiny)
library(plotly)
ui <- fluidPage(
# Application title
titlePanel("Metric Tracker"),
sidebarLayout(
sidebarPanel(
selectInput("value", "Select Value" , choices = c("Ordered_Product_Sales", "Units_Ordered"), selected = NULL , multiple = FALSE, selectize = TRUE)
),
# Show plot
mainPanel(
plotlyOutput("valuePlot")
)
)
)
# Define server
server <- function(input, output) {
output$valuePlot <- renderPlotly({
if (input$value == "Ordered_Product_Sales") {
metric2_plot <- metric2 %>%
ggplot(aes(x=Date, y = Ordered_Product_Sales)) + geom_point() + geom_line( ) + geom_smooth(method = 'lm') + facet_wrap( ~ Brand) + ggtitle("Sales")
}
if (input$value == "Units_Ordered") {
metric2_plot <- metric2 %>%
ggplot(aes(x=Date, y = Units_Ordered)) + geom_point() + geom_line() + geom_smooth(method = 'lm') + facet_wrap( ~ Brand)
}
metric2_plot
})
}
# Run the application
shinyApp(ui = ui, server = server)
The key is that renderPlotly() returns the last object created/value returned within it (as do all renders and reactives). The second if statement comes after the ggplot creation and, as it's FALSE, it returns NULL which can't be plotted. (There is an implicit ...else{NULL} after an if statement.) So your options are either the above where I created metric2_plot and then explicitly return it at the end of the renderPlotly()or to use an if...else so that the ggplot creation occurs after the only if statement is evaluated as below:
output$valuePlot <- renderPlotly({
if (input$value == "Ordered_Product_Sales") {
metric2 %>%
ggplot(aes(x=Date, y = Ordered_Product_Sales)) + geom_point() + geom_line( ) + geom_smooth(method = 'lm') + facet_wrap( ~ Brand) + ggtitle("Sales")
}
else {
metric2 %>%
ggplot(aes(x=Date, y = Units_Ordered)) + geom_point() + geom_line() + geom_smooth(method = 'lm') + facet_wrap( ~ Brand)
}
})
Finally, please replace , title = "Sales" in aes with + ggtitle("Sales").

Add trendline data to Shiny Plotly on hover

I'm creating a plot using ggplotly() and I'd like the Spearman's rank correlation [I'm storing here as the reactive value rho] to appear when hovering over the line created with geom_smooth. I found an article on the plotly website for doing this in python (https://plot.ly/python/linear-fits/) but I'm unsure how to achieve this in R. Any help or leads appreciated!!
library(shiny)
library(plotly)
ui <- fluidPage(
mainPanel(plotlyOutput("line_plot"),
verbatimTextOutput("rho"))
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# calculate rho to be printed over line
rho <- reactive({ cor.test(x = iris$Sepal.Length, y = iris$Sepal.Width, method='spearman')[[4]] })
output$rho <- renderText(paste0("rho: ", rho()))
output$line_plot <- renderPlotly({
p <- ggplotly(
ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
# would I add the tooltip text here?
# I know I need it to be:
# "<b> rho: </b>", rho(), "<br/>",
geom_smooth(method=lm, se=FALSE, color = "red") +
theme_minimal()
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
You can add the unoffical aesthetics text:
library(shiny)
library(plotly)
ui <- fluidPage(
mainPanel(plotlyOutput("line_plot"),
verbatimTextOutput("rho"))
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# calculate rho to be printed over line
rho <- reactive({ cor.test(x = iris$Sepal.Length, y = iris$Sepal.Width, method='spearman')[[4]] })
output$rho <- renderText(paste0("rho: ", rho()))
output$line_plot <- renderPlotly({
p <- ggplotly(
ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
geom_smooth(method=lm, se=FALSE, color = "red", aes(text = paste0("<b> rho: </b>", rho()))) +
theme_minimal()
)
})
}
# Run the application
shinyApp(ui = ui, server = server)

Error: Evaluation error: argument of length 0. R Shiny 1:nrow

My file is one set of game data and PitchNo tells the pitch of the game. I am trying to generate plots of each batter's pitches seen in a game and I have labeled the PitchNo in the ggplot function. I want my plot for each batter to label the pitches seen, say 1-10, but instead it is still labeling them as the PitchNo of the game.
I added Batter$PitchNo <- 1:nrow(Batter) in my reactive filter. That line of code works in normal R but I cannot seem to find a way to make in work in a Shiny app.
library(shiny)
library(tidyverse)
GameDataFile <- read_csv("GameDataFile.csv")
GameDataFile %>% group_by(PitchNo)
playerlist <- sort(unique(GameDataFile$Batter))
ui = fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
selectInput(
inputId="Batter1",
label="Player:",
choices = playerlist)
),
mainPanel(
plotOutput("myZone")
)))
server = function(input, output){
output$myZone <- renderPlot({
GameDataFile$PlateLocSide <- (GameDataFile$PlateLocSide * -1)
newdata <- reactive({
GameDataFile %>% filter(
Batter %in% c(input$Batter1),
Batter$PitchNo <- 1:nrow(Batter)) # Error is here
})
ggplot(data = newdata(), aes(x = PlateLocSide, y = PlateLocHeight)) +
xlim(-2.5,2.5) + ylim(0,5) + scale_fill_viridis_c() + geom_point() +
labs(x = "", y = "") + facet_wrap(~ Batter, ncol = 2) +
geom_text(aes(label = PitchNo), vjust = -0.5) + theme_bw() +
theme(strip.text = element_text(size=20, face="bold"))
}, width=400, height=500)
}
shinyApp(ui = ui, server = server)

RShiny text in plot updating, but not data

I have tried many data structure permutations to try to get the data updating in the plot (e.g., subset, preset matrices)
names(datar):
"Sex" "Age" "Year" "PercViewing.DIVORCED" "PercViewing.MARRIED" "PercViewing.NEVER MARRIED"
The desired plot is generated when run alone with input$select identified. However, input$select appears not to be passed from ui to the server script as written (below).
ui.r
library(shiny)
shinyUI(
fluidPage(
headerPanel("Have you seen an X-rated movie\nin the last year?"),
sidebarLayout(
sidebarPanel(selectInput("select","Select marital status to view",paste(choices=names(datar[4:6])))),
mainPanel(img(src="liberos.jpg", height = 200, width = 200),h2("Title here",align = "center"),plotOutput("densPlot"))
)
)
)
server.r
library(shiny)
library(ggplot2)
data<-read.table("/Users/nicole/Dropbox/Shiny/xmoviePerc.csv", sep=",",stringsAsFactors =FALSE
shinyServer(function(input, output){
output$densPlot <- renderPlot({
ggplot(datar, aes(x=input$select,fill=datar$Sex)) +
geom_density(alpha = 0.5,colour=c("yellow")) +
labs(title = "Percent who reported viewing\nsex films") +
ylab("Response density") +
xlab("Percent who report having viewed") +
theme(axis.title = element_text(family="Times", face="bold",colour="darkred", size=rel(1.3))) +
geom_text(data = NULL, x = 20, y = .015, label = input$select,aes(label=text,family="Times")) +
scale_fill_discrete(name="Gender reported") +
theme(legend.title = element_text(colour="black", size=16, face="bold"))
})
})
Try using aes_string() instead in your ggplot() call in server.r. aes() uses non-standard evaluation, and so it can't understand the text string that input$select evaluates to.

Resources