Related
On this page, I found an interesting plot:
Is it possible to do something similar or exactly? (Combination between treemap and ggraph library).
You can get a similar appearance with the voronoiTreemap package:
library(voronoiTreemap)
vor <- data.frame(h1 = 'World',
h2 = c('Europe', 'Europe', "Europe",
'America', 'America', 'America', 'America',
'Asia', 'Asia', 'Asia', 'Asia', 'Asia', 'Asia',
'Africa', 'Africa', 'Africa'),
h3 = c("UK", "France", "Germany",
"USA", "Mexico", "Canada", "Brazil",
"China", "India", "S Korea", "Japan", "Thailand",
"Malaysia", "Egypt", "South Africa", "Nigeria"),
color = rep(c("pink", "steelblue", "#96f8A0", "yellow"),
times = c(3, 4, 6, 3)),
weight = c(12, 10, 15, 40, 5, 7, 9, 45, 30, 20, 20, 6, 9,
8, 10, 5),
codes = c("UK", "France", "Germany",
"USA", "Mexico", "Canada", "Brazil",
"China", "India", "S Korea", "Japan", "Thailand",
"Malaysia", "Egypt", "South Africa", "Nigeria"))
vt <- vt_input_from_df(vor)
vt_d3(vt_export_json(vt))
I plotted a few European countries on a map, but there are some outliers which I don't need. I tried to remove them from my spatial df using different ways suggested in similar questions but they didn't work for this case. Could you please give me your ideas on removing them? I appreciate it. The shape file is available here
EDIT: I need to remove these areas not only from the map, but also from the spatial data frame.
library(rgdal)
library(raster)
myCountries <- c("Austria", "Belgium", "Czech Republic", "Denmark", "Estonia", "Finland",
"France", "Germany", "Latvia", "Hungary", "Iceland", "Ireland", "Italy",
"Netherlands", "Norway", "Portugal", "Poland", "Spain", "Sweden", "Switzerland",
"Turkey", "United Kingdom")
countries <- readOGR('ne_110m_admin_0_countries.shp')
eurcountries <- countries[countries$NAME_EN %in% myCountries ,]
eurcountries2<-spTransform(eurcountries, CRS("+proj=longlat +datum=NAD83"))
plot(eurcountries2)
Here is how you can do that with terra (the replacement for raster):
myCountries <- c("Austria", "Belgium", "Czech Republic", "Denmark", "Estonia", "Finland",
"France", "Germany", "Latvia", "Hungary", "Iceland", "Ireland", "Italy",
"Netherlands", "Norway", "Portugal", "Poland", "Spain", "Sweden", "Switzerland",
"Turkey", "United Kingdom")
library(terra)
countries <- vect('ne_110m_admin_0_countries.shp')
eur <- countries[countries$NAME_EN %in% myCountries ,]
e <- ext(c(-28, 48, 35, 76)))
x <- crop(eur, e)
plot(x, "NAME_EN")
You can interactively find the extent you need for cropping by doing
plot(eur)
e <- draw()
# now click on the map twice
Or subset interactively, like this:
d <- disagg(eur)
plot(d)
s <- sel(d) # now draw a bounding box on the plot
a <- aggregate(s, "NAME_EN")
plot(a, "NAME_EN")
And you can coerce the SpatVector objects to sp or sf types like this:
sf <- sf::st_as_sf(x)
library(raster)
sp <- as(x, "Spatial")
Or vice versa with:
y <- vect(sf)
Instead of using the SP package, I find the SF package is better as it plays well with ggplot2. Then limiting the canvas is straightforward and adds the ability to colour the countries.
library(rgdal)
library(ggplot2)
myCountries <- c("Austria", "Belgium", "Czech Republic", "Denmark", "Estonia", "Finland",
"France", "Germany", "Latvia", "Hungary", "Iceland", "Ireland", "Italy",
"Netherlands", "Norway", "Portugal", "Poland", "Spain", "Sweden", "Switzerland",
"Turkey", "United Kingdom")
countries <- readOGR("C:/R/projects/ne_110m_admin_0_countries/ne_110m_admin_0_countries.shp")
eurcountries <- countries[countries$NAME_EN %in% myCountries, ]
eurcountries3 <- sf::st_as_sf(eurcountries)
ggplot(eurcountries3) +
geom_sf(aes(fill = ADMIN)) +
lims(x = c(50,-40), y = c(30, 74)) +
guides(fill = "none") +
theme_void()
SA = c("Argentina", "Bolivia", "Brazil", "Chile", "Colombia", "Ecuador", "Paraguay", "Peru", "Uruguay", "Venezuela")
AF1 = gapminder %>%
mutate(
country,
continent == case_when(
country == SA ~ "South America",
TRUE ~ as.character(continent)
)
)
I am trying to rename the country in SA to South America, but it does not work.
I think I understand what you're looking for. I'm not sure why 'country' is in the mutate because you're not actually changing it. For the continent, you are looking to see if the value is in SA, not equal to SA. Does this work?
SA = c("Argentina", "Bolivia", "Brazil", "Chile", "Colombia", "Ecuador", "Paraguay", "Peru", "Uruguay", "Venezuela")
AF1 = gapminder %>%
mutate(
continent = case_when(
country %in% SA ~ "South America",
TRUE ~ continent
)
)
I am trying to build a web app in shiny that would allow for different user input and then plot graphs/output data tables accordingly. I am using WHO's data about suicide rates and there are two possible types of graphs: bar plot and line graph.
The user is given a choice between plotting the graph in which the x axis is either the age group (barplot) or year (line graph). They are also given the choice of plotting the graph separately for males and females and different countries as well.
The code below works fine for everything except when the user chooses x axis = year with gender = 'gender neutral'. The error says that the object rate is not found. However, the block of code which includes the object rate works perfectly fine in other places.
library(shiny)
library(dplyr)
library(ggplot2)
setwd("C:\\Users\\Lenovoi7\\Shrewsbury School\\IT\\Coursework")
who<-data.frame(read.csv("who.csv", stringsAsFactors = TRUE))
dput(head(who))
countries<-sort(unique(who$country))
countries<-union(countries, c("World"))
ui<-fluidPage(
titlePanel("Suicide statistics"),
sidebarLayout(
sidebarPanel(
selectInput(
inputId="x",
label="Please choose the x variable",
choices=c("",
"Age group"="age",
"Year"="year")),
conditionalPanel(
condition = "input.x == 'age' || input.x == 'year'",
selectInput(
inputId = "gender",
label = "Please specify the gender characteristics",
choices = c("", "Gender neutral" = "gender_neutral",
"Gender specific" = "gender_specific"),
selected = NULL),
#nested conditional panel
#only show this panel if the input is gender_specific
conditionalPanel(
condition = "input.gender == 'gender_specific'",
selectInput(
inputId = "country",
label = "Select a country:",
choices = countries,
selected = "Bosnia and Herzegovina")),
conditionalPanel(
condition = "input.gender == 'gender_neutral'",
selectInput(
inputId = "country",
label = "Select a country:",
choices = countries,
selected = "Bosnia and Herzegovina")))),
mainPanel(
plotOutput("graph")
)))
server <- function(input, output) {
x<-reactive({input$x})
gender<-reactive({input$gender})
country<-reactive({input$country})
output$graph <- renderPlot(
#x axis = age group
if (x()=="age"){
if (gender()=="gender_neutral"){
if (country()=="World"){
ggplot(data=who, aes(x=age)) + geom_bar(aes(weights=suicides_no), position="dodge")}
else {
#create a new subset of data that will be used??
who_subset<-subset(who, country == input$country)
ggplot(data=who_subset, aes(x=age)) + geom_bar(aes(weights=suicides_no))}}
else if (gender()=="gender_specific"){
if (country()=="World"){
ggplot(data=who, aes(x=age)) + geom_bar(aes(weights=suicides_no, fill=sex), position="dodge")}
else {
#create a new subset of data that will be used??
who_subset<-subset(who, country==input$country)
ggplot(data=who_subset, aes(x=age)) + geom_bar(aes(weights=suicides_no, fill=sex), position="dodge")}}}
else if (x()=="year"){
if (gender()=="gender_neutral"){
if (country()=="World"){
who_all <- who %>%
group_by(year) %>%
summarize(suicides_no = sum(suicides_no),
population = sum(population)) %>%
mutate(rate = 100000 * suicides_no/population)
ggplot() +
geom_line(data = who_all, aes(year, rate))
}
else {
who_subset<-subset(who, country==input$country)
who_sub_sex <- who_subset %>%
group_by(year) %>%
summarize(suicides_no = sum(suicides_no),
population = sum(population)) %>%
mutate(rate = 100000 * suicides_no/population)
ggplot() +
geom_line(data = who_subset, aes(year, rate))
}}
else if (gender()=="gender_specific"){
if (country()=="World"){
who_all <- who %>%
group_by(year) %>%
summarize(suicides_no = sum(suicides_no),
population = sum(population)) %>%
mutate(rate = 100000 * suicides_no/population)
ggplot() +
geom_line(data = who_all, aes(year, rate))
}
else {
#create a new subset of data that will be used??
who_subset<-subset(who, country==input$country)
who_sub_sex <- who_subset %>%
group_by(year, sex) %>%
summarize(suicides_no = sum(suicides_no),
population = sum(population)) %>%
mutate(rate = 100000 * suicides_no / population)
ggplot() +
geom_line(data = who_sub_sex, aes(year, rate, color = sex))}
}
}
)}
# Create a Shiny app object
shinyApp(ui = ui, server = server)
dput(head(who))
structure(list(country = structure(c(1L, 1L, 1L, 1L, 1L, 1L),
.Label = c("Albania",
"Anguilla", "Antigua and Barbuda", "Argentina", "Armenia", "Aruba",
"Australia", "Austria", "Azerbaijan", "Bahamas", "Bahrain", "Barbados",
"Belarus", "Belgium", "Belize", "Bermuda", "Bolivia",
"Bosnia and Herzegovina",
"Brazil", "British Virgin Islands", "Brunei Darussalam", "Bulgaria",
"Cabo Verde", "Canada", "Cayman Islands", "Chile", "Colombia",
"Costa Rica", "Croatia", "Cuba", "Cyprus", "Czech Republic",
"Denmark", "Dominica", "Dominican Republic", "Ecuador", "Egypt",
"El Salvador", "Estonia", "Falkland Islands (Malvinas)", "Fiji",
"Finland", "France", "French Guiana", "Georgia", "Germany", "Greece",
"Grenada", "Guadeloupe", "Guatemala", "Guyana", "Haiti", "Honduras",
"Hong Kong SAR", "Hungary", "Iceland", "Iran (Islamic Rep of)",
"Iraq", "Ireland", "Israel", "Italy", "Jamaica", "Japan", "Jordan",
"Kazakhstan", "Kiribati", "Kuwait", "Kyrgyzstan", "Latvia", "Lithuania",
"Luxembourg", "Macau", "Malaysia", "Maldives", "Malta", "Martinique",
"Mauritius", "Mayotte", "Mexico", "Monaco", "Mongolia", "Montenegro",
"Montserrat", "Morocco", "Netherlands", "Netherlands Antilles",
"New Zealand", "Nicaragua", "Norway", "Occupied Palestinian Territory",
"Oman", "Panama", "Paraguay", "Peru", "Philippines", "Poland",
"Portugal", "Puerto Rico", "Qatar", "Republic of Korea",
"Republic of Moldova",
"Reunion", "Rodrigues", "Romania", "Russian Federation",
"Saint Kitts and Nevis",
"Saint Lucia", "Saint Pierre and Miquelon",
"Saint Vincent and Grenadines",
"San Marino", "Sao Tome and Principe", "Saudi Arabia", "Serbia",
"Seychelles", "Singapore", "Slovakia", "Slovenia", "South Africa",
"Spain", "Sri Lanka", "Suriname", "Sweden", "Switzerland",
"Syrian Arab Republic",
"Tajikistan", "TFYR Macedonia", "Thailand", "Trinidad and Tobago",
"Tunisia", "Turkey", "Turkmenistan", "Turks and Caicos Islands",
"Ukraine", "United Arab Emirates", "United Kingdom",
"United States of America",
"Uruguay", "Uzbekistan", "Venezuela (Bolivarian Republic of)",
"Virgin Islands (USA)", "Zimbabwe"), class = "factor"),
year = c(1985L, 1985L, 1985L, 1985L, 1985L, 1985L),
sex = structure(c(1L, 1L, 1L, 1L, 1L, 1L),.
Label = c("female", "male"), class = "factor"),
age = structure(1:6, .Label = c("15-24 years", "25-34 years",
"35-54 years", "5-14 years", "55-74 years", "75+ years"),
class = "factor"),
suicides_no = c(NA_integer_, NA_integer_, NA_integer_, NA_integer_,
NA_integer_, NA_integer_), population = c(277900L, 246800L,
267500L, 298300L, 138700L, 34200L)),
row.names = c(NA, 6L), class = "data.frame")
Is there any chance somebody knows a way out of this problem? Again I want the web app to output line graph when the user chooses x axis = year and gender = gender_neutral.
Try out with this server code.
The changes are already described in my comments. Since I dont have the who data.frame I could not test it.
server <- function(input, output) {
output$graph <- renderPlot({
if (input$x == "age") {
if (input$gender=="gender_neutral"){
if (input$country=="World"){
ggplot(data = who, aes(x = age)) + geom_bar(aes(weights = suicides_no), position="dodge")}
else {
#create a new subset of data that will be used??
who_subset <- subset(who, country == input$country)
ggplot(data=who_subset, aes(x=age)) + geom_bar(aes(weights=suicides_no))
}
} else if (input$gender=="gender_specific") {
if (input$country=="World"){
ggplot(data=who, aes(x=age)) + geom_bar(aes(weights=suicides_no, fill=sex), position="dodge")}
else {
#create a new subset of data that will be used??
who_subset <- subset(who, country==input$country)
ggplot(data = who_subset, aes(x=age)) + geom_bar(aes(weights=suicides_no, fill=sex), position="dodge")
}
}
} else if (input$x=="year"){
if (input$gender=="gender_neutral"){
if (input$country=="World"){
who_all <- who %>%
group_by(year) %>%
summarize(suicides_no = sum(suicides_no),
population = sum(population)) %>%
mutate(rate = 100000 * suicides_no/population)
ggplot() +
geom_line(data = who_all, aes(year, rate))
} else {
who_subset <- subset(who, country==input$country)
who_sub_sex <- who_subset %>%
group_by(year) %>%
summarize(suicides_no = sum(suicides_no),
population = sum(population)) %>%
mutate(rate = 100000 * suicides_no/population)
ggplot() +
geom_line(data = who_sub_sex, aes(year, rate))
}
} else if (input$gender=="gender_specific"){
if (input$country=="World"){
who_all <- who %>%
group_by(year) %>%
summarize(suicides_no = sum(suicides_no),
population = sum(population)) %>%
mutate(rate = 100000 * suicides_no/population)
ggplot() +
geom_line(data = who_all, aes(year, rate))
} else {
#create a new subset of data that will be used??
who_subset <- subset(who, country==input$country)
who_sub_sex <- who_subset %>%
group_by(year, sex) %>%
summarize(suicides_no = sum(suicides_no),
population = sum(population)) %>%
mutate(rate = 100000 * suicides_no / population)
ggplot() +
geom_line(data = who_sub_sex, aes(year, rate, color = sex))}
}
}
})
}
I would like to generate a set of maps in R with all of them having the same background (a focus on Europe) BUT each of them having one EU country highlighted in another color. And I can't seem to figure out how to write the for loop to get that...
Here is my code:
require(rgdal)
setwd(...) #where I have my GIS shapefile
world <- readOGR(dsn = ".", layer = "TM_WORLD_BORDERS-0.2")
#Subset European countries
#List of "european" countries + shapefile
europe <- c("Russia", "Isle of Man", "Channel Islands", "Faroe Islands",
"France", "Denmark", "Iceland", "Germany", "Romania", "Poland", "Portugal",
"United Kingdom", "Spain", "Sweden", "Lithuania", "Ireland", "Italy",
"Netherlands", "Norway", "Ukraine", "Latvia", "Estonia", "Finland",
"Bulgaria", "Belgium", "Montenegro", "Serbia and Montenegro", "Slovenia",
"Albania", "Greece", "Croatia", "Malta")
europe <- subset(world, NAME %in% europe)
#List of countries in the EU + shapefile
EU <- c("Isle of Man", "Channel Islands", "Faroe Islands", "France",
"Denmark", "Germany", "Romania", "Poland", "Portugal", "Spain", "Sweden",
"Lithuania", "Ireland", "Italy", "Netherlands", "Ukraine", "Latvia", "Estonia",
"Finland", "Bulgaria", "Belgium", "Montenegro", "Serbia and Montenegro",
"Slovenia", "Albania", "Greece", "Croatia", "Malta")
EU <- subset(europe, NAME %in% EU)
#Generate one map per highlighted country
eucountries <- unique(europe$NAME)
for(i:length(eucountries))
{
print(i)
png(paste(i,".png",sep=""), 200, 200)
map("world", ylim=c(35,70), xlim=c(-20,45), col="#BFBFBF", fill=TRUE)
plot(eucountries, add=TRUE, col="#769EB2", namesonly=TRUE)
dev.off()
}
I want to produce one png per country. Each png will have one specific country highlighted with a different color. The full map will be plotted each time.
Thanks to vpipkt's comment that indicated that map()$names does provide a list of names of the things (polygons I suspect) that are plotted I could come up with a much more elgant solution:
building an index of for those polygons that are named like countries
using that information to build a color vector to color the countries
Note: the borders provided by the maps packae seem a litle outdated, e.g. Yugoslavia
# library
library(maps)
# options
old <- par()$mar
par("mar"=c(0,0,0,0))
YLIM <- c(35,70)
XLIM <- c(-20,45)
# plotting
for(country in c("Germany", "Ireland", "Spain", "Greece", "Denmark", "Yugoslavia") )
{
polygon_names <- map("world", ylim=YLIM, xlim=XLIM)$names
index <- grep(country, polygon_names)
colvec <- rep("white", length(polygon_names))
colvec[index] <- "red"
png(paste0(country,".png"))
map("world", ylim=YLIM, xlim=XLIM, col=colvec, fill=TRUE)
dev.off()
}
# resetting options
par("mar"=old)
Inside your loop, try
plot(eucountries[i], add=TRUE, col="#769EB2", namesonly=TRUE)
in place of your current plot call. Note the subset of eucountries.