I have a dataset, more especifically the Unicorn Company data set. I want to create an interactive choropleth that has countries with higher mean valuation would have darker color, that when user clicks on the country it would display the name + valuation of that country.
output$map_plot <- renderPlotly({
# Get the average valuation for each country
industry_investors_data <- unicorn_countries_clustering_cleaned %>%
group_by(Country) %>%
summarize(Valuation = mean(Valuation...B.))
world_map_data <- map_data("world2")
#print(sort(unique(ggplot2::map_data("world")$region)))
# Merge the map data with your data and fill in missing values
world_map_valuation <- world_map_data %>%
right_join(industry_investors_data, by = c("region" = "Country")) %>%
mutate(Valuation = coalesce(Valuation, 0.0))
plot_ly(data = world_map_valuation,
locations = ~region,
z = ~Valuation,
type = "choropleth",
locationmode = "country names",
color = ~Valuation,
colors = "Blues",
title = "Map of the world by country valuation",
showlegend = FALSE)
})
This shows a map on the worldly valuation however it takes very long to render and is not interactive in any way. Before I had left_join instead of right join the result was the same.
Related
I want to design a worldmap to show from which country and which city the participants to my survey come from. I used the highcharter package.
First part is : colour the countries --> it worked well ! A scale is created from 0 to 1.
Second part is : adding the cities --> the points are created but the countries colored in blue disappeared ! The scale has changed and is now induced from cities.
I try to change the order of my code but nothing is working.
library(dplyr)
library(maps)
library(magrittr)
# I use the dataset called iso3166 from the {maps} package and rename it date
dat <- iso3166
head(dat)
# I rename the variable a3 by iso-a3
dat <- rename(dat, "iso-a3" = a3)
head(dat)
# I create a vector with the countries I want to colour
part1X_countries <- c("CHE", "FRA", "USA", "GBR", "CAN", "BRA")
dat$part1X <- ifelse(dat$`iso-a3` %in% part1X_countries, 1, 0)
head(dat)
# I add the name of cities with geographical coordinates
cities <- data.frame(
name = c("St Gallen", "Fort Lauderdale", "Paris", "Nottingham", "Winnipeg", "Chicago", "Leeds", "Montréal", "New Rochelle", "São Paulo", "Saint-Genis-Pouilly", "Canterbury"),
lat = c(47.42391, 26.122438, 48.866667, 52.950001, 49.8955, 41.881832, 53.801277, 45.5016889, 40.9232, -23.5489, 46.24356, 51.279999),
lon = c(9.37477, -80.137314, 2.333333, -1.150000, -97.1383, -87.623177, -1.548567, -73.567256, -73.7793, -46.6388, 6.02119, 1.080000))
# I create my worldmap with countries and cities
worldmap <- hcmap(
map = "custom/world-highres3", # high resolution world map
data = dat, # name of dataset
value = "part1X",
joinBy = "iso-a3",
showInLegend = FALSE, # hide legend
download_map_data = TRUE
) %>%
hc_add_series(
data = cities,
type = "mappoint",
name = "Cities"
) %>%
hc_title(text = "Representation of participants by country")```
You need to define a colorkey and add a color axis for the hcmap. The below code keeps the colors from the countries and has the name of the countries added on top as black map points.
worldmap <- hcmap(
map = "custom/world-highres3", # high resolution world map
data = dat, # name of dataset
value = "part1X",
joinBy = "iso-a3",
colorKey = "value",
showInLegend = F, # hide legend
download_map_data = TRUE) %>%
hc_colorAxis(min = min(dat$part1X),
max = max(dat$part1X)) %>%
hc_add_series(
data = cities,
type = "mappoint",
name = "Cities",
dataLabels = list(enabled = TRUE, format = '{point.name}'),
latField = "lat",
longField = "lon",
# color = "color"
valueField = "part1X"
) %>%
hc_title(text = "Representation of participants by country")
worldmap
I am working on making a plotly map of the US with hover tooltips which I have gotten to work somewhat. However, I have multiple observations per state for each variable I would like to display in the tooltip and currently only the first observation for each state is displayed. Each observation is the performance of a candidate in the 1976 presidential election in a state, and I would like the hover tooltip to display each candidates performance in the state instead of just the first candidate listed in that state.
Here is the code I am using at the moment.
candidate denotes the name of the candidate , state_share and round_share denote the percent of the state popular vote and state electoral votes the candidate receives respectively.
library(plotly)
colorscale <- c("blue" , "purple" , "red")
l <- list(color = toRGB("white"), width = 2)
# specify some map projection/options
g <- list(
scope = 'usa',
projection = list(type = 'albers usa'),
showlakes = FALSE
)
threshold10$hover <- with(threshold10, paste(state, "<br>" , canvec ,':',
state_share ,",","Electoral Votes", round_share ))
fig <- plot_geo(subset(threshold10, year == 1976), locationmode = 'USA-states')
fig <- fig %>%
add_trace(
z = ~evotes, text = ~ hover , locations = ~state_po,
color = ~state_share , colors = colorscale) %>%
layout(title = '1976 Electoral Vote Allocation <br> 10% State Threshold',
geo = g)
fig
I'm also attaching an image of the dataset and the map produced by my code. I appreciate any help anyone has to offer. I am newish to working with plotly and mapping so if this is a simple question sorry about that. Thank you for your help.
dataframe:
map output:
My Set-up: I am currently trying to use an interactive map to show the different number of cases of SARS by country through a world map. Rather than trying on Shiny, I attempted to do it on a flexdashboard on R Markdown. Currently, I have a data set with two columns: "Country" and "total". Country shows which country it is while "total" shows the number of cases of SARS. "Country" is a factor object while "total" is numeric.
Now my question is: I have set-up and used the sample geojson world map, however none of the values of my data set is being inputted into the world map I used. How should I go about displaying my values on the maps? Is this because the "worldgeojson" map cannot correctly read the countries in my data set?
My code currently is:
highchart() %>%
hc_title(text = "Number of Cases of SARS in the World") %>%
hc_subtitle(text = "Source: SARS.csv") %>%
hc_add_series_map(worldgeojson, countries,
name = "Country",
value = "total",
joinBy = c("woename", "Country")) %>%
hc_mapNavigation(enabled = T)
Without your data, it is unclear what the problem might be.
However, here is a working example you could use.
library(highcharter)
countries <- data.frame(
Country = c("Canada", "China", "France"),
Total = c(251, 5327, 7)
)
highchart() %>%
hc_title(text = "Number of Cases of SARS in the World") %>%
hc_subtitle(text = "Source: SARS.csv") %>%
hc_add_series_map(worldgeojson, countries,
name = "SARS Cases",
value = "Total",
joinBy = c("name", "Country")) %>%
hc_mapNavigation(enabled = T)
Map
I am looking to replicate one of those maps where you can guesstimate the state-level results of the next presidential election and have the results of your scenario shown to you by way of changing color backgrounds. An example of what I mean can be found here.
The first step is to provide a default setting as a starting point for the user's input. One way to achieve this would be:
library(maps)
library(tidyverse)
usa <- map_data("state")
probs <- c(0.30,0.40,0.30)
results <- c("Rep", "Dem", "Toss-Up")
usa %>%
group_by(region) %>%
mutate(result = sample(results, size = n(), prob = probs, replace = T)) > electoral_map
ggplot() +
geom_map(data = electoral_map, map = usa, aes(long, lat, map_id = region,
fill = result), color = "black") +
scale_fill_manual(values=c("blue", "red", "grey"))
The next - and most crucial - step would be to make this map interactive by letting the result column change with a click of a button. For instance, a click on California would switch the fill color to blue and the resultcoding to Dem.
Obvious candidates for this for me were the plotly and leaflet packages, but neither of them seem to offer the functionality I require for this case. I got the closest using the selectFeatures function from mapedit, but this only lets me select regions, not change their associated coding.
For subsequent calculations, it is important that changes made by the user are recorded for further use. The end goal is to have shiny app akin to the link provided above, with inputs by the user changing the overall count of electoral college votes secured by each side.
Does anyone have pointers on a possible solution?
(For the record, my actual objective has nothing to do with elections, but I figured this was the most understandable way to communicate my problem)
I fabricated a simple shiny app for you as a starting point for your project.
You can test it at:
https://wietze314.shinyapps.io/stackoverflow-rig-the-election/
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(maps)
library(ggplot2)
library(dplyr)
library(sp)
# Define UI for application that draws a map
ui <- fluidPage(
# Application title
titlePanel("Rig the election of the USA"),
# Show a plot of the generated distribution
mainPanel(
plotOutput("usaPlot", click = "usaPlot_click"),
textOutput("debug")
)
)
usa <- map_data("state")
probs <- c(0.30,0.40,0.30)
results <- c("Rep", "Dem", "Toss-Up")
start_map <- usa
# Define server logic required to change the election results
server <- function(input, output) {
# make a variable to store the election results in
electoral_map <- reactiveValues(
regions = start_map %>% select(region) %>%
distinct() %>% mutate(result = sample(results, size = n(), prob = probs, replace = T))
)
# render the map
output$usaPlot <- renderPlot({
# generate bins based on input$bins from ui.R
ggplot() +
geom_map(data = start_map %>% inner_join(electoral_map$regions, by = 'region'),
map = usa,
aes(long, lat, map_id = region, fill = result), color = "black") +
scale_fill_manual(values=c("blue", "red", "grey"))
})
# find the region that was clicked (point.in.polygon)
# change the result of the election
observeEvent(input$usaPlot_click,{
x <- input$usaPlot_click$x
y <- input$usaPlot_click$y
selectedregion <- usa %>%
group_by(region) %>%
mutate(selected = point.in.polygon( x,y,long,lat)) %>%
filter(selected == 1) %>%
select(region) %>% distinct() %>% unlist()
if(length(selectedregion)==1){
currentresult <- electoral_map$regions[electoral_map$regions == selectedregion,'result']
nextresult <- if_else(currentresult == "Dem","Rep","Dem")
electoral_map$regions[electoral_map$regions == selectedregion,'result'] <- nextresult
# report what you have done
output$debug <- renderText(paste0("You visited at ",
round(x),", ",round(y),
" and rigged the election results of ",selectedregion, " and changed it to ",
nextresult))
} else {
# if no region has been selected
output$debug <- renderText("Fish don't vote!!!")
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have a dataset that includes both a date and a species for each bird observed in a county. I've mapped them using leaflet, but want to use two AddLayersControl to control for both the date and the species. Right now I can only control for the year or the species. I would like the second group of checkboxes so I can control the species as well. I want the marker to go away if either its year group is unchecked or its species group is unchecked.
What I think I need to do is to assign each marker to two different groups that I could control independently. I don't think I am able to assign certain markers as base layers because I don't want a certain subset of them always available. I have also tried just adding another AddLayersControl - sadly the second one will always win and it doesn't seem like you can have two on the same map.
library(leaflet)
library(magrittr)
library(dplyr)
library(htmltools)
# Data
birds <- data.frame(observed_on = c("4/4/2009",
"4/1/2009",
"3/6/2016",
"2/9/2016"),
url = c("http://www.inaturalist.org/observations/2236",
"http://www.inaturalist.org/observations/2237",
"http://www.inaturalist.org/observations/2778201",
"https://www.inaturalist.org/observations/9796150"),
latitude = c(43.08267975,
43.0844841,
43.055512,
43.0180932),
longitude = c(-89.43265533,
-89.43793488,
-89.314878,
-89.52836138),
scientific_name = c("Agelaius phoeniceus",
"Bubo virginianus",
"Quiscalus quiscula",
"Strix varia"),
common_name = c("Red-winged Blackbird",
"Great Horned Owl",
"Common Grackle",
"Barred Owl"),
taxon_order_name = c("Passeriformes",
"Strigiformes",
"Passeriformes",
"Strigiformes"),
taxon_species_name = c("Agelaius phoeniceus",
"Bubo virginianus",
"Quiscalus quiscula",
"Strix varia" ),
year = c("2009", "2009", "2016", "2016"))
# Leaflet Chart Formatting --------------------------------------------------------
palette <- colorFactor(palette = rainbow(length(unique(birds$taxon_order_name))),
domain = birds$taxon_order_name)
# Leaflet Chart -------------------------------------------------------------------
mymap <- leaflet(birds) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
setView(lng = -89.398721,
lat = 43.071580,
zoom = 13)
for (t in unique(birds$year)){
sub <- birds[birds$year == t,]
labels <- mapply(function(x, y, z, a) {
HTML(sprintf("%s<br><em>%s</em><br>%s<br><a href=%s>link</a>",
htmlEscape(x),
htmlEscape(y),
htmlEscape(z),
htmlEscape(a)))},
sub$common_name,
sub$taxon_species_name,
sub$observed_on,
sub$url,
SIMPLIFY = FALSE)
mymap <- mymap %>%
addCircleMarkers(data = sub,
lng = ~longitude,
lat = ~latitude,
fillOpacity = 0.6,
radius = 8,
fillColor = ~palette(taxon_order_name),
color = "black",
weight = 1,
opacity = 0.5,
popup = labels,
group = as.character(t))
}
mymap %>%
addLegend(pal = palette,
values = ~taxon_order_name,
title = "Taxon Order") %>%
addLayersControl(overlayGroups = as.character(unique(birds$year)),
options = layersControlOptions(collapsed = FALSE))
# addLayersControl(overlayGroups = unique(birds$taxon_order_name), options = layersControlOptions(collapsed = FALSE))
map showing points with both year and species info but layers control for the only year
does this work?
addLayersControl(overlayGroups = as.character(c(unique(birds$year),unique(birds$taxon_order_name)), options = layersControlOptions(collapsed = FALSE))