I am fairly new to R Shiny and I've been working on an app with an interactive world map which shows each country's performance at the Olympics, using scale_fill_gradient. The app user gets to choose the performance indicator (total medals won, gold only, weighted score) and the year (1996 to 2020).
The problem is there's no more error shown, but the plot doesn't show either! I have tried to run the functions as normal R script and they worked fine there (the plot showed up in the viewer pane). I found a few others who have also run into problems with no plot or error showing, but their cases are different to mine (e.g. mismatch in Output and Render) so the resolutions don't work for me.
It's a massive dataset so I've not included it here, I thought I might check first if the error could be spotted from the code alone. Here's what I've used:
function
world_map1 <- function(WorldMap, year, performance) {
w_plot1 <- WorldMap %>%
filter(Year == year) %>%
select("long", "lat", "group", "region", all_of(performance)) %>%
replace(is.na(.), 0) %>%
rename_at(performance, ~ "Value") %>%
mutate(Value = as.numeric(as.character(Value)))
tooltip_css <- "background-color:#2E2E2E; font-family: Calibri; color:#F2F2F2;"
w_g1 <- ggplot() +
geom_polygon_interactive(data = subset(w_plot1, lat >= -60 & lat <= 90),
aes(x = long,
y = lat,
fill = Value,
group = group,
tooltip = sprintf("%s<br/>%s", region, Value))) +
scale_fill_gradient(name = "Medals /Score",
low = "lightgoldenrodyellow",
high = "goldenrod1",
na.value = "white")
return(
girafe(
ggobj = w_g1,
options = list(
opts_tooltip(
css = tooltip_css
)
))
)
}
ui
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
radioButtons(inputId = "performance", label = "Performance measure:",
choices = c("Total medals won" = "Total",
"Gold medals won" = "Gold",
"Weighted points system" = "Weighted"
)),
width = 3
),
mainPanel(
girafeOutput("mapPlot1"),
sliderInput(inputId = "year", label = "Year:",
min = 1996, max = 2020, step = 4, value = 1996, ticks = FALSE, sep = ""
)
)
)
)
server
server <- function(input, output) {
output$mapPlot1 <- renderGirafe({
ggiraph(code = print(world_map1(WorldMap, input$year, input$performance)))
}
)
}
run app
shinyApp(ui = ui, server = server)
Any help or insights appreciated!
I thought it was my theme() block so I removed that, as shown above. Also checked other cases on no plot showing here, couldn't find one with fixes that would work for me because it seems the underlying problem is different?
Related
I'm trying to make a flexdashboard using IMDb data, that has an interactive jitter plot where you can change the x and y for visualizing hierarchical clustering result. The code that I've already made can change only the x and number of k. I think I should use reactive function but I don't really understand in using that. I've already tried many other ways from youtube and some documentary but still can't change the y. Here is layout of my dashboard, The y stuck at the runtime variable
data=df %>%
select(Rating, Votes, Gross, Runtime, Metascore)
selectInput("x", label = "X : ",choices = names(data))
selectInput("y", label = "Y : ",choices = names(data))
sliderInput('k',"Cluster",min = 2,max = 10, value = 6)
selectedData=reactive({
data %>% select(input$x, input$y)
})
data_scaled=scale(data)
dist_data=dist(data_scaled, method='euclidean')
hc_data=hclust(dist_data, method = "average")
renderPlot({
ggplot(selectedData(),
aes(x=!!rlang::sym(input$x), y=!!rlang::sym(input$y),
col=factor(cutree(hc_data, k=input$k))))+
geom_jitter(size=5, alpha=0.5 )+
labs(col="Cluster")
})
Here is an alternative example that seems to work, using the diamonds dataset from ggplot2. My guess is that the scaling and clustering steps take so long to run that the the y reactive only appears not to work. I would suggest pre-processing your data if app run times are a problem.
data=diamonds[1:1e3,] %>%
dplyr::select(where(is.numeric))
selectInput("x", label = "X : ",choices = names(data))
selectInput("y", label = "Y : ",choices = names(data))
sliderInput('k',"Cluster",min = 2,max = 10, value = 6)
data_scaled=scale(data)
dist_data=dist(data_scaled, method='euclidean')
hc_data=hclust(dist_data, method = "average")
renderPlot({
ggplot(data,
aes(x=!!rlang::sym(input$x), y=!!rlang::sym(input$y),
col=factor(cutree(hc_data, k=input$k))))+
geom_jitter(size=5, alpha=0.5 )+
labs(col="Cluster")
})
I am trying to create a dashboard using R Shiny from NYC Tree Census 2015. The dashboard should look something like in the picture here > Dashboard in Shiny Picture
My code is mentioned below:
library(shiny)
library(tidyverse)
library(ggplot2)
my_data <- read.csv("/Users/abhikpaul/Documents/Documents/Github/Fiverr/2015_Street_Tree_Census_-_Tree_Data.csv")
ui <- fluidPage(
titlePanel("The Dashboard of Tree Distribution in New York City"),
sidebarLayout(
sidebarPanel(
# Description ----
helpText("In this page you can get information about the tree distribution, status, health conditions, and species rank in New York City. Please choose the borough that you want to check. It may take 10 seconds for the graphics to load. Thank you for your patience!"),
#Input: Check boxes for Boroughs ----
checkboxGroupInput("checkboxInput",
label = "Borough",
choices = list("Bronx",
"Brooklyn",
"Manhattan",
"Queens",
"Staten Island"),
selected = "Bronx"),
),
# Main panel for displaying outputs ----
mainPanel(
# Tabs panel for displaying outputs ----
tabsetPanel(type = "tabs",
#Output: About ----
tabPanel("About",
h3("About this dataset", align = "left"),
p("The dataset displays the information of trees (including health, status, species, etc.) within the five boroughs in New York City. The dataset is organized by NYC parks & Recreation and partner organizations."),
h3("How to make NYC an urban forest?", align = "left"),
p("As a group, we are concerned about planting tree and green environments. Therefore, we will focus on identifying the locations that require more taking care of trees, the top species that have the most number of trees in each borough, the health conditions of those species, and the distribution of trees in each borough."),
HTML("<p>For more information, visit: <a href='https://data.cityofnewyork.us/Environment/2015-Street-Tree-Census-Tree-Data/uvpi-gqnh'>2015 NYC Tree Census</a></p>")
),
#Output: Status ----
tabPanel("Status", plotOutput(outputId = "statusplot")),
)
)
)
)
)
server <- function(input, output) {
my_data <- as_tibble(my_data)
my_data <- my_data[my_data$borough %in% checkboxInput,]
my_data <- data.frame(table(my_data$borough,my_data$status))
my_data <- my_data[apply(my_data!=0, 1, all),]
my_data <- my_data %>%
group_by(Var1) %>%
mutate(Percent = (Freq/sum(Freq) * 100))
output$statusplot <- renderPlot({
ggplot(my_data, aes(fill = Var2, y = Percent, x = Var1)) +
geom_bar(position = "dodge", stat = "identity")
})
}
shinyApp(ui = ui, server = server)
However, while running the app, I am getting an error as mentioned below
Warning: Error in match: 'match' requires vector arguments 50: %in% 47: server [/Users/abhikpaul/Documents/Documents/GitHub/Fiverr/my_app.R#90]Error in match(x, table, nomatch = 0L) : 'match' requires vector arguments
Can someone help me fix this issue as I am a newbie in R Shiny?
Try this
server <- function(input, output) {
output$statusplot <- renderPlot({
my_data <- as_tibble(my_data)
my_data <- my_data[my_data$borough %in% input$checkboxInput,]
my_data <- data.frame(table(my_data$borough,my_data$status))
my_data <- my_data[apply(my_data!=0, 1, all),]
my_data <- my_data %>%
group_by(Var1) %>%
mutate(Percent = (Freq/sum(Freq) * 100))
ggplot(my_data, aes(fill = Var2, y = Percent, x = Var1)) +
geom_bar(position = "dodge", stat = "identity")
})
}
I am working on created a shiny app and I wrote a function to display a plotly. The function works fine and prints the plot when I run it in the console, but the ggplotly histogram will not render when I run the app. I do not receive any errors when running the function in the console nor when I try to run the app. The graphs just do not show up in the app. Here is the function, which I wrote in a helper file:
# making function to display simulated state-level pv2ps
pv2p_plot <- function(x) {
# filter based on input$state from ui.R
# getting text to specify the predicted pv2p and the chance of victory
pv2p <- sims %>%
drop_na() %>%
filter(state == x) %>%
mutate(d_pv2p = sim_dvotes_2020 / (sim_rvotes_2020 + sim_dvotes_2020),
r_pv2p = 1 - d_pv2p) %>%
summarise(d_pv2p = mean(d_pv2p) * 100,
r_pv2p = mean(r_pv2p) * 100)
win_prob <- sims %>%
mutate(biden_win = ifelse(sim_dvotes_2020 > sim_rvotes_2020, 1, 0)) %>%
group_by(state) %>%
summarise(pct_biden_win = mean(biden_win, na.rm = TRUE)) %>%
filter(pct_biden_win < 1 & pct_biden_win > 0) %>%
mutate(pct_trump_win = 1 - pct_biden_win) %>%
select(state, pct_biden_win, pct_trump_win) %>%
filter(state == x)
pv2p_lab <- paste0("Forecasted Two-Party Popular Vote: ", round(pv2p$d_pv2p, 2), "% for Biden and ", round(pv2p$r_pv2p, 2), "% for Trump")
win_lab <- paste0("Forecasted Probability of Electoral College Victory: ", round(win_prob$pct_biden_win * 100, 2), "% for Biden and ", round(win_prob$pct_trump_win * 100, 2), "% for Trump")
pv_plot <- sims %>%
filter(state == x) %>%
mutate(Democrat = sim_dvotes_2020 / (sim_dvotes_2020 + sim_rvotes_2020),
Republican = 1 - Democrat) %>%
pivot_longer(cols = c(Democrat, Republican), names_to = "party") %>%
ggplot(aes(value, fill = party)) +
geom_histogram(aes(y = after_stat(count / sum(count)),
text = paste0("Probability: ", round(after_stat(count / sum(count)), 5))), bins = 1000, alpha = 0.5, position = "identity") +
scale_fill_manual(breaks = c("Democrat", "Republican"),
labels = c("Biden", "Trump"),
values = c(muted("blue"), "red3")) +
labs(title = paste("Simulated Two-Party Popular Vote \nin", x),
x = "Predicted Share of the Two-Party Popular Vote",
y = "Probability",
fill = "Candidate",
subtitle = pv2p_lab) +
theme_hodp()
print(ggplotly(pv_plot, tooltip = "text"))
}
And this is my UI & server code from the app:
# loaded libraries, read in data, and created functions in other file to keep
# this script nice and clean
source("helper.R")
ui <- navbarPage(
# Application title
"Presidential Forecast in Retrospect",
tabPanel(
"About",
includeHTML(file.path("pages/about.html"))
),
navbarMenu("Forecast Simulations",
tabPanel("State-by-State Two-Party Popular Vote",
fluidPage(theme = "bootstrap.css",
tabsetPanel(
tabPanel("Estimated Vote Share",
selectInput("state",
"State:",
sims %>% pull(state) %>% unique() %>% sort()),
plotlyOutput("statesimPlotly")),
tabPanel("Probability of Victory",
selectInput("state_type",
"State Category:",
types %>% pull(type) %>% unique()),
plotlyOutput("statevictoryPlotly")
)
)
)
),
tabPanel("Predicted Vote Margin Map",
# creating this page to show the win margin
includeHTML(file.path("pages/margin_maps.html"))
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
output$statesimPlotly <- renderPlotly({
# calling function that I defined at the top of the app
pv2p_plot(input$state)
})
output$statevictoryPlotly <- renderPlotly(
# calling function from helper to make this plot
state_win_probs(input$state_type)
)
}
# Run the application
shinyApp(ui = ui, server = server)
As I said above, the function works fine in my console. Most people who have had issues with this online are not using the proper output/render functions (e.g. using renderPlot instead of renderPlotly), but I am not seeing what is wrong with my code. Thanks in advance!
I am attempting to use some public information to produce a heat-map of Canada for some labor statistics. Using the spacial files from the census, and data from Statistics Canada (these are large zip files that are not necessary to dig into). Below is a working example that illustrates both the problems I am having with little relative change between regions( though there may be a big absolute change between periods, and the slow draw time.To get this to work, you need to download the .zip file from the census link and unzip the files to a data folder.
library(shiny)
library(maptools)
library(ggplot2)
require(reshape2)
library(tidyr)
library(maptools)
library(ggplot2)
library(RColorBrewer)
ui <- fluidPage(
titlePanel("heatmap"),
# Sidebar with a slider input for year of interest
sidebarLayout(
sidebarPanel(
sliderInput("year",h3("Select year or push play button"),
min = 2000, max = 2002, step = 1, value = 2000,
animate = TRUE)
),
# Output of the map
mainPanel(
plotOutput("unemployment")
)
)
)
server <- function(input, output) {
#to get the spacial data: from file in link above
provinces<-maptools::readShapeSpatial("data/gpr_000a11a_e.shp")
data.p<- ggplot2::fortify(provinces, region = "PRUID")
data.p<-data.p[which(data.p$id<60),]
#dataframe with same structure as statscan csv after processing
unem <- runif(10,min=0,max=100)
unem1 <- unem+runif(1,-10,10)
unem2 <- unem1+runif(1,-10,10)
unemployment <- c(unem,unem1,unem2)
#dataframe with same structure as statscan csv after processing
X <- data.frame("id" = c(10,11,12,13,24,35,46,47,48,59,
10,11,12,13,24,35,46,47,48,59,
10,11,12,13,24,35,46,47,48,59),
"Unemployment" = unemployment,
"year" = c(rep(2000,10),rep(2001,10),rep(2002,10))
)
plot.data<- reactive({
a<- X[which(X$year == input$year),]
return(merge(data.p,a,by = "id"))
})
output$unemployment <- renderPlot({
ggplot(plot.data(),
aes(x = long, y = lat,
group = group , fill =Unemployment)) +
geom_polygon() +
coord_equal()
})
}
# Run the application
shinyApp(ui = ui, server = server)
Any help with either of the issues would be greatly appreciated
For this type of animation it is much faster to use leaflet instead of ggplot as leaflet allows you to only re-render the polygons, not the entire map.
I use two other tricks to speed up the animation:
I join the data outside of the reactive. Within the reactive it is just a simple subset. Note, the join could be done outside of the app and read in as a pre-processed .rds file.
I simplify the polygons with the rmapshaper package to reduce drawing time by leaflet. Again, this could be done outside the app to reduce loading time at the start.
The animation could likely be even more seamless if you use circles (i.e. centroid of each province) instead of polygons. Circle size could vary with Unemployment value.
Note, you need the leaflet, sf, dplyr and rmapshaper packages for this approach.
library(shiny)
library(dplyr)
library(leaflet)
library(sf)
library(rmapshaper)
ui <- fluidPage(
titlePanel("heatmap"),
# Sidebar with a slider input for year of interest
sidebarLayout(
sidebarPanel(
sliderInput("year",h3("Select year or push play button"),
min = 2000, max = 2002, step = 1, value = 2000,
animate = TRUE)
),
# Output of the map
mainPanel(
leafletOutput("unemployment")
)
)
)
server <- function(input, output) {
#to get the spacial data: from file in link above
data.p <- sf::st_read("input/gpr_000a11a_e.shp") %>%
st_transform(4326) %>%
rmapshaper::ms_simplify()
data.p$PRUID <- as.character(data.p$PRUID) %>% as.numeric
data.p <- data.p[which(data.p$PRUID < 60),]
lng.center <- -99
lat.center <- 60
zoom.def <- 3
#dataframe with same structure as statscan csv after processing
unem <- runif(10,min=0,max=100)
unem1 <- unem+runif(1,-10,10)
unem2 <- unem1+runif(1,-10,10)
unemployment <- c(unem,unem1,unem2)
#dataframe with same structure as statscan csv after processing
X <- data.frame("id" = c(10,11,12,13,24,35,46,47,48,59,
10,11,12,13,24,35,46,47,48,59,
10,11,12,13,24,35,46,47,48,59),
"Unemployment" = unemployment,
"year" = c(rep(2000,10),rep(2001,10),rep(2002,10))
)
data <- left_join(data.p, X, by = c("PRUID"= "id"))
output$unemployment <- renderLeaflet({
leaflet(data = data.p) %>%
addProviderTiles("OpenStreetMap.Mapnik", options = providerTileOptions(opacity = 1), group = "Open Street Map") %>%
setView(lng = lng.center, lat = lat.center, zoom = zoom.def) %>%
addPolygons(group = 'base',
fillColor = 'transparent',
color = 'black',
weight = 1.5) %>%
addLegend(pal = pal(), values = X$Unemployment, opacity = 0.7, title = NULL,
position = "topright")
})
get_data <- reactive({
data[which(data$year == input$year),]
})
pal <- reactive({
colorNumeric("viridis", domain = X$Unemployment)
})
observe({
data <- get_data()
leafletProxy('unemployment', data = data) %>%
clearGroup('polygons') %>%
addPolygons(group = 'polygons',
fillColor = ~pal()(Unemployment),
fillOpacity = 0.9,
color = 'black',
weight = 1.5)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I didn't find the drawing time to be unreasonably long at ~2-3 seconds, which for a 2.4mb shapefile seems about right. It takes just as long outside shiny as it does in the app on my machine, anyway.
To hold a constant colour gradient you can specify limits in scale_fill_gradient which will hold the same gradient despite changes to your maps:
output$unemployment <- renderPlot({
ggplot(plot.data(),
aes(x = long, y = lat,
group = group , fill =Unemployment)) +
geom_polygon() +
scale_fill_gradient(limits=c(0,100)) +
coord_equal()
})
I am new in R. now I am creating shiny app. R can read my dataset. with the comand myData <- read.csv("myData.csv"). however shinyServer file cannot read my data. and list no observation.
Could you guys help me what is the problem?
The Shinyapp provides interactive visulization for production of raw material in the world since 1900 to 2010 for every 10 years.
Also I keep getting this error:
"ERROR: 'breaks' are not unique"
The Code is here:
shinyUI(fluidPage(
checkboxInput("type", "Please Select production type:",
c("Aluminium", "Gold",
"Iron", "Silver", "Zinc")
),
sliderInput("year","Choose a Year",
min = 1910,
max = 2010,
value= 2010),
checkboxInput("Economy", "Please Select Economy Factor:",
c("Income Inequallity", "labourers Real Wage", "GDP", "Inflation")),
plotOutput("thisPlot"),
leafletOutput("myMap")
)
)
shinyServer:
myData <- read.csv("myData.csv")
shinyServer<- function(input,output){
output$myMap <- renderLeaflet({
temp <- which(myData$type == input$type &
myData$year == input$year)
myData <- myData[temp,]
pal <- colorQuantile("YlGn", myData$production, n = 9)
country_popup <- paste0("<strong>Estado: </strong>", myData$Country)
leaflet(data = myData) %>%
setView(46.227638, 2.213749, zoom = 2) %>%
addTiles() %>%
addPolygons( lng = ~myData$Long, lat = ~myData$Lat,
fillColor = ~pal(myData$production),
fillOpacity = 0.8,
color = "#BDBDC3",
weight = 1,
popup = country_popup)
})
}
the data is:
Names = c("id",
"Country", "type", "year", "production", "GDP", "Income", "Inflation",
"Laborer", "Lat", "Long"), class = "data.frame", row.names = c(NA,
-10670L))
head(myData)
id Country type year production GDP Income Inflation Laborer Lat
Long
1 1 Guyana Gold 1910 0.000000 0 42.43048 0 154.45527 4.860416
-58.9301
it seems that it does read the data but it does not show it. and i have a problem with creating the choropleth map. which it does not work now in my shiny.
Yeah, leaflet is finicky. I didn't have to make a lot of changes, you almost had it. One of the main problems was that your filter was usually yielding an empty dataframe which caused the markers not to show (of course).
This empty dataframe problem is also the cause for the "ERROR: 'breaks' are not unique" message since colorQuantile is getting a null input for its domain argument, which means it is doing an empty quantile, and all the breaks are zero and thus "not unique". This can also happen with highly skewed data. You should avoid calling it in that case - maybe fallback on colorBin, although detecting that can be a bit complicated.
The following changes were made.
Added some fake data.
Changed addPolygons to addCircleMarkers as addPolygons is for adding arbitray shapes that you specify.
Changed your checkBoxInput to checkBoxGroupInput as you didn't want a checkbox, you wanted a group of them.
Changed the filter clause to use myData$type %in% input$type instead of myData$type == input$type as you probably wanted membership.
truncated the input$year value as it might not give back an integer, but your year values are definitely integers.
Changed the border color to "black" so you could see it on the circle.
Note that the popup does not come on hover, you have to click on the circle.
removed the myData on the marker input as you have specified it on the leaflet call.
commented out the plotOutput as I don't know what you want to plot.
Here is the code - this should get you started:
library(shiny)
library(leaflet)
# fake-up some data
n <- 10000
countrylist <- c("Guyana","Venezuela","Columbia")
typelist <- c("Aluminium", "Gold","Iron", "Silver", "Zinc")
types <- sample(typelist,n,replace=T)
cntrs <- sample(countrylist,n,replace=T)
lat <- 2.2 + 50*runif(n)
long <- -46 + 50*runif(n)
year <- sample(1910:2010,n,replace=T)
prd <- 100*runif(n)
myData <- data.frame(Country=cntrs,type=types,year=year,production=prd,Long=long,Lat=lat)
u <- shinyUI(fluidPage(
checkboxGroupInput("type", "Please Select production type:",
c("Aluminium", "Gold","Iron", "Silver", "Zinc"),
selected=c("Gold","Silver")
),
sliderInput("year","Choose a Year",
min = 1910,
max = 2010,
value= 2010),
checkboxGroupInput("Economy", "Please Select Economy Factor:",
c("Income Inequallity", "labourers Real Wage", "GDP", "Inflation")),
# plotOutput("thisPlot"),
leafletOutput("myMap")
)
)
s <- function(input,output){
output$myMap <- renderLeaflet({
temp <- which(myData$type %in% input$type &
myData$year == trunc(input$year))
print(nrow(myData))
myData <- myData[temp,]
print(nrow(myData))
pal <- colorQuantile("YlGn", myData$production, n = 9)
country_popup <- paste0("<strong>Estado: </strong>", myData$Country)
leaflet(data = myData) %>%
setView(-46.227638, 2.213749, zoom = 2) %>%
addTiles() %>%
addCircleMarkers( lng = ~Long, lat = ~Lat,
fillColor = ~pal(myData$production),
radius = 6, # pixels
fillOpacity = 0.8,
color = "black",
weight = 1,
popup = country_popup)
})
}
shinyApp(u,s)
And this is the result: