I am trying to create a graph where I am can view total flights by year, filtered by origin and its destination.
Picture1: What I envision VS Picture2: The result.
Problem 1: Graph unable to appear on shinyApp.
Problem 2: When the graph appears, the graph does not change even when I select a different Origin from the dropdown box
I am quite new to shiny, any help would be greatly appreciated! The data I am using is from Harvard database- data expo 2009, Airline on time data.
library(DBI)
library(ggplot2)
library(dplyr)
library(RSQLite)
#q3 data from sql
q3m <- dbGetQuery(conn, "
SELECT Year, Origin, Dest, COUNT(FlightNum) AS Total
FROM ontime
WHERE Cancelled = 0 AND Diverted = 0
GROUP BY Origin,Dest,Year
")
q3m
#ggplot
q3plot <- ggplot(q3m) +
geom_col(aes(x= Year, y = Total))+
scale_x_discrete(limits = c(2000,2001)) +
facet_wrap(~Dest) +
labs(title = paste(q3m$Origin , "to" ) , x = "Year", y = "Total Flights") +
geom_text(aes(x = Year, y = Total, label = Total), vjust = 1.5, size = 3.5, color = "white")
q3plot
SHINY
library(shiny)
server <- function(input,output, session) {
#data
data <- reactive({
req(input$sel_q3)
q3m
})
#plot
output$plot <- renderPlot({
q3plot <- ggplot(data(),aes(x= Year, y = Total)) + scale_x_discrete(limits = c(2000,2001)) +
facet_wrap(~Dest) +
geom_col()
})
#update dynamically
observe({
updateSelectInput(session, "sel_q3", choices = q3m$Origin)
})
}
ui <- fluidPage(
h1("Comparison of total flights of airport"),
selectInput(inputId = "sel_q3",
label = "Select your airport",
"Names"),
plotOutput("plot")
)
shinyApp(ui=ui, server = server)
SHINY shows graph but the graph does not change
What i did was just put q3plot into output$plot instead of retyping ggplot
server <- function(input,output, session) {
#data
data <- reactive({
req(input$sel_q3)
q3m
})
#plot
output$plot <- renderPlot({
q3plot
})
#update dynamically
observe({
updateSelectInput(session, "sel_q3", choices = q3m$Origin)
})
}
ui <- fluidPage(
h1("Comparison of total flights of airport"),
selectInput(inputId = "sel_q3",
label = "Select your airport",
"Names"),
plotOutput("plot")
)
shinyApp(ui=ui, server = server)
Thanks to #MrFlick
The solution if anyone faces the same issue is basically adding the proper filtering
#data
data <- reactive({
req(input$sel_q3)
df <- q3m %>% filter(Origin %in% inputsel_q3) # <- this is the fix
})
#plot
output$plot <- renderPlot({
ggplot(data(),aes(x,y)) + geomcol()
})
For the first time I really can't find this answer here already, so I hope you all can help me, I'm sure there is a pretty easy fix.
I am making a Shiny volcano plot with clickable points to give me a table with the data about that point. If I use a trans function (that I found here, thank you helpful stranger) within scale_y_continuous() in my plot, points in the scaled region are no longer clickable. How can I scale the axis this way and still be able to have the clickable points?
My code, with some fake data that has the same problem:
## Read in necessary libraries, function, and data
library(shiny)
library(ggplot2)
library(dplyr)
library(scales)
reverselog_trans <- function(base = exp(1)) {
trans <- function(x) -log(x, base)
inv <- function(x) base^(-x)
trans_new(paste0("reverselog-", format(base)), trans, inv,
log_breaks(base = base),
domain = c(1e-100, Inf))
}
pretend_data <- tibble(data=1:5, estimate = runif(5, min = -1, max = 2), plot = c(1e-50, 2e-35, 5e-1, 1, 50))
# Define UI for application that draws a volcano plot
ui <- fluidPage(
# Application title
titlePanel("Pretend Plot"),
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
# Define server logic required to draw a volcano plot
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(data = pretend_data, aes(x=estimate, y=plot)) +
geom_vline(xintercept=c(-1, 1), linetype=3) +
geom_hline(yintercept=0.01, linetype=3) +
geom_point() +
scale_y_continuous(trans = reverselog_trans(10))
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
nearPoints(pretend_data, input$plot_click)
})
}
# Run the application
shinyApp(ui = ui, server = server)
The problem is that input$plot_click returns the coordinates on the transformed scale. nearPoints tries then to match those to the original scale which does not work.
You have a couple of options though:
Transform the data yourself and adapt y axis ticks via scale_y_continuous
Adapt pretend_data in the nearPoints call.
Option 1
This requires that you control y axis tick marks yourself and would need some more fiddling to get the exact same reuslts as in your example.
pretend_data_traf <- pretend_data %>%
mutate(plot = reverselog_trans(10)$transform(plot))
# Define UI for application that draws a volcano plot
ui <- fluidPage(
# Application title
titlePanel("Pretend Plot"),
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
# Define server logic required to draw a volcano plot
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(data = pretend_data_traf, aes(x=estimate, y=plot)) +
geom_vline(xintercept=c(-1, 1), linetype=3) +
geom_hline(yintercept=0.01, linetype=3) +
geom_point() +
## would need to define breaks = to get same tick mark positions
scale_y_continuous(labels = reverselog_trans(10)$inverse)
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
nearPoints(pretend_data_traf, input$plot_click)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Option 2
pretend_data_traf <- pretend_data %>%
mutate(plot = reverselog_trans(10)$transform(plot))
# Define UI for application that draws a volcano plot
ui <- fluidPage(
# Application title
titlePanel("Pretend Plot"),
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
# Define server logic required to draw a volcano plot
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(data = pretend_data, aes(x=estimate, y=plot)) +
geom_vline(xintercept=c(-1, 1), linetype=3) +
geom_hline(yintercept=0.01, linetype=3) +
geom_point() +
scale_y_continuous(trans = reverselog_trans(10))
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
nearPoints(pretend_data_traf, input$plot_click) %>%
mutate(plot = reverselog_trans(10)$inverse(plot))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am teaching myself r and shiny and trying to make an interactive bar chart where the user can change the chart based on columns. I keep getting errors with this code. Any help would be appreciated! My data has four columns: v, one, two, three. The first column is characters and the last three are numbers. I want to change the bar chart based on the y axis (columns: one, two and three). Right now, the error I am getting is: missing value where TRUE/FALSE needed.
library(shiny)
library(readr)
library(ggplot2)
data <- read.csv('scoring.csv')
data$v <- as.character(data$v)
ui <- fluidPage(
titlePanel("Scoring"),
sidebarPanel(
selectInput(inputId = "scoring", label = "Select a score:", c("Scoring Method 1", "Scoring Method 2", "Scoring Method 3"))),
mainPanel(
plotOutput(outputId = "bar")
)
)
#browser()
server <- function(input, output) {
new_data <- reactive({
selected_score = as.numeric(input$"scoring")
if (selected_score == "Scoring Method 1"){(data[data$one])}
if (selected_score == "Scoring Method 2"){(data[data$two])}
if (selected_score == "Scoring Method 3"){(data[data$three])}
})
#browser()
output$bar <- renderPlot({
newdata <- new_data()
p <- ggplot(newdata, aes(x=reorder(v, -selected_score), selected_score, y = selected_score, fill=v)) +
geom_bar(stat = 'identity', fill="darkblue") +
theme_minimal() +
ggtitle("Sports")
barplot(p, height = 400, width = 200)
})
}
Run the application
shinyApp(ui = ui, server = server)
You have a few errors in your code. In the server part, please use input$scoring, instead of input$"scoring".
First, in ui selectInput could be defined as
selectInput(inputId = "scoring", label = "Select a score:", c("Scoring Method 1"="one",
"Scoring Method 2"="two",
"Scoring Method 3"="three")))
Second, your reactive dataframe new_data() could be defined as shown below:
new_data <- reactive({
d <- data %>% mutate(selected_score = input$scoring)
d
})
Third, ggplot could be defined as
output$bar <- renderPlot({
newdata <- new_data()
p <- ggplot(newdata, aes(x=v, y = newdata[[as.name(selected_score)]], fill=v)) +
geom_bar(stat = 'identity', position = "dodge", fill="blue") +
theme_bw() +
#scale_fill_manual(values=c("blue", "green", "red")) +
scale_y_continuous(limits=c(0,10)) +
ggtitle("Sports")
p
})
Please note that you had an extra selected_score variable within aes. My suggestion would be to play with it to reorder x, and review some online or youtube videos on R Shiny.
I'm teaching myself Shiny and I am stuck on my ggplot2 graph not being able to use the reactive dateRangeInput as my x-axis. I have a few questions:
Is there a way to use my data frame to grab the min, max values for date range input instead of having to hardcode them in so that when I add more tweets to the data frame I don't have to hardcode the values each time?
I am getting the error: Aesthetics must be either length 1 or the same as the data (33108): x, y when I try to use input$date as my aes(x = input$date...
library(shiny)
library(tidyr)
library(ggplot2)
tweets <- read.csv(file.choose())
colnames(tweets)[1] <- "Content"
tweets <- separate(tweets, created_at, c("Date", "Time"), sep = " ")
tweets$Date <-as.Date(tweets$Date, "%m/%d/%Y")
ui <- fluidPage(
dateRangeInput(inputId = "date",
strong("Date Range"),
start = "2009-05-04", end = "2018-02-28",
min = "2009-05-04", max ="2018-02-28" ),
plotOutput("Graph")
)
server <- function(input, output) {
output$Graph <- renderPlot({
ggplot(tweets, aes(x = input$date, y = count)) +
geom_bar(stat = "identity", position = "stack") +
#scale_y_continuous(name = "Retweet Count", limits = c(0,370000), breaks=seq(0,370000,10000)) +
theme(panel.background = element_rect(fill = "white", colour = "grey50"))
})
}
shinyApp(ui = ui, server = server)
#Pete900's answer summarizes the use of updateDateRangeInput well, for further information you can refer to this part of the shiny documentation.
About your second problem: input$date will return a vector of length 2 with the first element beeing the lower and the second being the upper part of the selected range. You will most likely not use this directly as x-aesthetics but rather subset your data with this and then plot the newly subsettet data. You can e.g. write
library(dpylr) # alternatevly library(tidyverse)
newtweets <- reactive({
filter(tweets, between(date ,input$date[1], input$date[2]))
})
then, in your ggplot, use newtweets() as your data.
Update
The functions filter and between() (which is a shortcut for x is greater than ... and lesser then ...) come fromt the package dplyr, which is great for working with dataframes and part of a collection of packages that play very nicely with each other called tidyverse (see here).
When you refer to the newly created reactive object newtweets(), make sure to not forget the paranthesis because it is now a function call, that enables shiny to update the dataframe should the input change.
Update
A full working example in which I create some artificial data:
library(shiny)
library(tidyverse)
library(lubridate)
# tweets <- read.csv(file.choose())
st <- ymd("2009-05-01")
en <- ymd("2018-02-28")
dates <- seq.Date(from = st, to = en, by = 1)
tweets <- tibble(date = dates, count = rnorm(length(dates), mean = 5, sd = 3))
ui <- fluidPage(
dateRangeInput(inputId = "date",
strong("Date Range"),
start = "2009-05-04", end = "2018-02-28",
min = "2009-05-04", max ="2018-02-28" ),
plotOutput("Graph")
)
server <- function(input, output) {
newtweets <- reactive({
filter(tweets, between(date ,input$date[1], input$date[2]))
})
output$Graph <- renderPlot({
ggplot(newtweets(), aes(x = date, y = count)) +
geom_bar(stat = "identity", position = "stack") +
#scale_y_continuous(name = "Retweet Count", limits = c(0,370000), breaks=seq(0,370000,10000)) +
theme(panel.background = element_rect(fill = "white", colour = "grey50"))
})
}
shinyApp(ui = ui, server = server)
For the first question you can use updateDateRangeInput see here. So you would find your min and max dates in tweets outside of the server function then pass them to the input. Make sure to add session to your function:
server <- function(input, output, session) {
observe({
updateDateRangeInput(session, "date", min = myMinDate, max = myMaxDate)
})
}
For the second question you need to use aes_string to pass variables to ggplot, see here or here.
R Gugus,
Is there any way to sub-set and view data in data.table by clicking on an interactive plotly or googlevis chart in shiny app?
For example, I would like to see the highlighted row in the picture when I click on the related part on plotly chart generated by the following code:
library(shiny)
library(plotly)
library(DT)
library(dplyr)
shinyApp(
ui = shinyUI(fluidPage(
titlePanel("Movie Ratings!"),
mainPanel(
plotlyOutput("chart", width = "100%"),
dataTableOutput("DToutput")
)
)),
server = function(input, output, session) {
df <- structure(c(106487,495681,1597442,2452577,2065141,2271925,4735484,3555352,8056040,4321887,
2463194,347566,621147,1325727,1123492,800368,761550,1359737,1073726,36,53,141,
41538,64759,124160,69942,74862,323543,247236,112059,16595,37028,153249,427642,
1588178,2738157,2795672,2265696,11951,33424,62469,74720,166607,404044,426967,
38972,361888,1143671,1516716,160037,354804,996944,1716374,1982735,3615225,
4486806,3037122,17,54,55,210,312,358,857,350,7368,8443,6286,1750,7367,14092,
28954,80779,176893,354939,446792,33333,69911,53144,29169,18005,11704,13363,
18028,46547,14574,8954,2483,14693,25467,25215,41254,46237,98263,185986),
.Dim=c(19,5),.Dimnames=list(c("1820-30","1831-40","1841-50","1851-60","1861-70",
"1871-80","1881-90","1891-00","1901-10","1911-20",
"1921-30","1931-40","1941-50","1951-60","1961-70",
"1971-80","1981-90","1991-00","2001-06"),
c("Europe","Asia","Americas","Africa","Oceania")))
df.m <- melt(df)
df.m <- rename(df.m, c(Var1 = "Period", Var2 = "Region"))
output$chart <- renderPlotly({
a <- ggplot(df.m, aes(x = Period, y = value/1e+06,fill = Region)) +
ggtitle("Migration to the United States by Source Region (1820-2006), In Millions")
b <- a + geom_bar(stat = "identity", position = "stack")
p <- ggplotly(b)
p
})
output$DToutput <- renderDataTable({df.m})
})
Ultimate aim is to produce an app where the user can navigate easily by between data and charts anywhere in the app. I have a similar app but written in a different code: http://mqasim.me/sw1000/
Current click events in Plotly return all data in the trace so it will be difficult to isolate elements in the stack. Also, will need to build the plot with plot_ly(). One way to deal with the selected table rows being on a different page is to eliminate the need for pagination.
curveNumber: for mutiple traces, information will be returned in a stacked fashion
See this Plotly tutorial for coupled events and section 2.3 of the Shiny page of DT for selecting rows.
library(shiny)
library(plotly)
library(DT)
library(dplyr)
library(reshape2)
shinyApp(
ui = shinyUI(fluidPage(
titlePanel("Movie Ratings!"),
mainPanel(
plotlyOutput("chart", width = "100%"),
DT::dataTableOutput("DToutput")
)
)),
server = function(input, output, session) {
df <- structure(c(106487,495681,1597442,2452577,2065141,2271925,4735484,3555352,8056040,4321887,
2463194,347566,621147,1325727,1123492,800368,761550,1359737,1073726,36,53,141,
41538,64759,124160,69942,74862,323543,247236,112059,16595,37028,153249,427642,
1588178,2738157,2795672,2265696,11951,33424,62469,74720,166607,404044,426967,
38972,361888,1143671,1516716,160037,354804,996944,1716374,1982735,3615225,
4486806,3037122,17,54,55,210,312,358,857,350,7368,8443,6286,1750,7367,14092,
28954,80779,176893,354939,446792,33333,69911,53144,29169,18005,11704,13363,
18028,46547,14574,8954,2483,14693,25467,25215,41254,46237,98263,185986),
.Dim=c(19,5),.Dimnames=list(c("1820-30","1831-40","1841-50","1851-60","1861-70",
"1871-80","1881-90","1891-00","1901-10","1911-20",
"1921-30","1931-40","1941-50","1951-60","1961-70",
"1971-80","1981-90","1991-00","2001-06"),
c("Europe","Asia","Americas","Africa","Oceania")))
df.m <- melt(df)
df.m <- rename(df.m, Period = Var1, Region = Var2)
output$chart <- renderPlotly({
plot_ly(data = df.m, x = Period, y = value/1e+06, color = Region, type = "bar", source = "select") %>%
layout(title = "Migration to the United States by Source Region (1820-2006), In Millions",
xaxis = list(type = "category"),
barmode = "stack")
})
output$DToutput <- DT::renderDataTable({
datatable(df.m, selection = list(target = "row+column"),
options = list(pageLength = nrow(df.m), dom = "ft"))
})
proxy = dataTableProxy('DToutput')
# highlight rows that are selected on plotly output
observe({
event.data = plotly::event_data("plotly_click", source = "select")
if(is.null(event.data)) {
rowNums <- NULL
} else {
rowNums <- row.names(df.m[df.m$Period %in% event.data$x,])
}
proxy %>% selectRows(as.numeric(rowNums))
})
})