Skip to content

Instantly share code, notes, and snippets.

@jonocarroll
Last active September 7, 2021 05:43
Show Gist options
  • Save jonocarroll/2f9490f1f5e7c82ef8b791a4b91fc9ca to your computer and use it in GitHub Desktop.
Save jonocarroll/2f9490f1f5e7c82ef8b791a4b91fc9ca to your computer and use it in GitHub Desktop.
Implements @baptiste's much better method for making this work
library(ggplot2) ## devtools::install_github("hadley/ggplot2)
library(grid) ## rasterGrob
library(EBImage) ## readImage (alternatively: magick::image_read)
library(ggthemes) ## theme_minimal
## ##########
## INDEPENDENT CODE TO BE SOURCED:
## ##########
# user-level interface to the element grob
my_axis = function(img, angle = 90) {
structure(
list(img=img, angle=angle),
class = c("element_custom", "element_blank", "element_text", "element") # inheritance test workaround
)
}
# returns a gTree with two children: the text label, and a rasterGrob below
element_grob.element_custom <- function(element, x, ...) {
stopifnot(length(x) == length(element$img))
tag <- names(element$img)
# add vertical padding to leave space
g1 <- textGrob(paste0(tag, "\n\n\n\n\n"), x=x, rot = element$angle, vjust=0.6)
g2 <- mapply(rasterGrob, x=x, image=element$img[tag],
MoreArgs=list(vjust=0.7, interpolate=FALSE,
height=unit(3,"lines")),
SIMPLIFY=FALSE)
gTree(children=do.call(gList, c(g2, list(g1))), cl="custom_axis")
}
# gTrees don't know their size and ggplot would squash it, so give it room
grobHeight.custom_axis = heightDetails.custom_axis = function(x, ...)
unit(6, "lines")
## ##########
## END
## ##########
## ##########
## OBTAIN FLAGS:
## ##########
library(rvest)
## GDP per capita, top 10 countries
url <- "https://en.wikipedia.org/wiki/List_of_countries_by_GDP_(nominal)_per_capita"
html <- read_html(url)
gdppc <- html_table(html_nodes(html, "table")[3])[[1]][1:10,]
## clean up; remove non-ASCII and perform type conversions
gdppc$Country <- gsub("Â ", "", gdppc$Country)
gdppc$Rank <- iconv(gdppc$Rank, "latin1", "ASCII", sub="")
gdppc$Country <- iconv(gdppc$Country, "latin1", "ASCII", sub="")
gdppc$`US$` <- as.integer(sub(",", "", gdppc$`US$`))
## flag images (yes, this processing could be done neater, I'm sure)
## get the 200px versions
flags_img <- html_nodes(html_nodes(html, "table")[3][[1]], "img")[1:10]
flags_url <- paste0('http://', sub('[0-9]*px', '200px', sub('\\".*$', '', sub('^.*src=\\"//', '', flags_img))))
flags_name <- sub('.*(Flag_of)', '\\1', flags_url)
if(!dir.exists("flags")) dir.create("flags")
for(flag in seq_along(flags_url)) {
switch(Sys.info()[['sysname']],
Windows= {download.file(flags_url[flag], destfile=file.path("flags", paste0(flag,"_", flags_name[flag])), method="auto", mode="wb")},
Linux = {download.file(flags_url[flag], destfile=file.path("flags", paste0(flag,"_", flags_name[flag])))},
Darwin = {print("Not tested on Mac. Use one of the above and find out?")})
}
## ##########
## END
## ##########
## load the images from filenames
pics <- vector(mode="list", length=npoints)
image.file <- dir("flags", full.names=TRUE)
image.file <- image.file[order(as.integer(sub("_.*","",sub("flags/","",image.file))))]
for(i in 1:npoints) {
pics[[i]] <- magick::image_read(image.file[i])
# pics[[i]] <- EBImage::readImage(image.file[i])
}
names(pics) <- sub(".svg.png","",sub(".*Flag_of_","",image.file))
## create a dummy dataset
npoints <- length(flags_name)
y <- gdppc$`US$`
x <- names(pics)
dat <- data.frame(x=factor(x, levels=names(pics)), y=y)
## create the graph, as per normal now with @baptiste's adapted grob processing
## NB: #85bb65 is the color of money in the USA apparently.
gg <- ggplot(dat, aes(x=x, y=y/1e3L, group=1))
gg <- gg + geom_bar(col="black", fill="#85bb65", stat="identity")
gg <- gg + scale_x_discrete()
gg <- gg + theme_minimal()
gg <- gg + scale_fill_discrete(guide=FALSE)
gg <- gg + theme(plot.background = element_rect(fill="grey90"))
gg <- gg + labs(title="GDP per capita",
subtitle="Top 10 countries",
x="", y="$US/1000",
caption=paste0("Source: ",url))
gg <- gg + theme(axis.text.x = my_axis(pics, angle = 0), ## that's much better
axis.text.y = element_text(size=14),
axis.title.x = element_blank())
gg
@jonocarroll
Copy link
Author

I'm not sure about the magick issues you're both having but I have an updated method for achieving this here: https://jcarroll.com.au/2019/08/13/ggtext-for-images-as-x-axis-labels/

@loscialer
Copy link

Thank you very much for your quick reply.
However the new method does not work for me.
I tried to run your script but when i run the line
gdppc$Country <- gsub("Â ", "", gdppc$Country)
the following error appears
Error: Assigned data gsub("Â ", "", gdppc$Country) must be compatible with existing data.
x Existing data has 11 rows.
x Assigned data has 0 rows.
i Only vectors of size 1 are recycled.
Run rlang::last_error() to see where the error occurred.
In addition: Warning message:
Unknown or uninitialised column: Country.

In my case I have named list of 4 images and when i run
scale_x_discrete(name = NULL, labels = image_list_cor) I get the following erro
Error: gridtext has encountered a tag that isn't supported yet: pointer:
Only a very limited number of tags are currently supported.

Here is my code

Load images

`vp_cor <- image_read("C:/Users/jc448892/Desktop/Images/vp_cor.png")
p_cor <- image_read("C:/Users/jc448892/Desktop/Images/p_cor.png")
g_cor <- image_read("C:/Users/jc448892/Desktop/Images/g_cor.png")
vg_cor <- image_read("C:/Users/jc448892/Desktop/Images/vg_cor.png")

image_list_cor <- list(vg_cor, g_cor, p_cor,vp_cor)
names(image_list_cor) <- c("Very good", "Good", "Poor", "Very poor")

create a dummy dataset

status_cor <- pp_df %>% group_by(coral_image) %>% count
sum(status_cor$n)
status_cor <- status_cor %>% mutate(prop = round(n/73, 2))
y_cor <- status_cor$prop
x_cor <- names(image_list_cor)
dat_cor <- data.frame(x = factor(x_cor, levels=names(image_list_cor)), y=y_cor)

Make the plot

ggplot(dat_cor, aes(x= x, y=y)) +
geom_bar(col="black", fill="coral1", stat="identity") +
scale_x_discrete(name = NULL, labels = image_cor_list) +
theme(plot.background = element_rect(fill="grey90")) +
labs(title="What is the image the best represents the corals you see in the GBR?",
x="", y="Proportion") +
theme(axis.text.x = element_markdown(color = 'black, size = 7),
axis.text.y = element_text(size=14),
axis.title.x = element_blank())
`

@jonocarroll
Copy link
Author

I can't debug files from your desktop, but the Wikipedia table has changed so that code no longer applies. You'll need this change to make that part work

url      <- "https://en.wikipedia.org/wiki/List_of_countries_by_GDP_(nominal)_per_capita"
html     <- xml2::read_html(url)
gdppc    <- html_table(html_nodes(html, "table")[2])[[1]][2:12,]

## clean up; remove non-ASCII and perform type conversions
gdppc$Country <- sub(" (more)", "",  gdppc$`Country/Territory`, fixed = TRUE)
gdppc$Country <- gsub("Â ", "", gdppc$Country)
gdppc$Country <- iconv(gdppc$Country, "latin1", "ASCII", sub="")
gdppc$Country[10] <- "United States of America"
gdppc$Country[2] <- "Liechtenshein"
gdppc$`US$`   <- as.integer(sub(",", "", gdppc$`World Bank[5]`))

but even then, there's something wrong with the flag images and readPNG is complaining.

The idea of using element_markdown() should be solid, though.

@loscialer
Copy link

Thank you for that
I m just not sure how to store my images that are not online but on a normal directory
Should I just put the file paths as values of the character vector labels ?
for example
labels <- setNames(c("C:/Users/jc448892/Desktop/Images/very_poor.png", "C:/Users/jc448892/Desktop/Images/poor.png", "C:/Users/jc448892/Desktop/Images/good.png", "C:/Users/jc448892/Desktop/Images/very_good.png"), c("Very good", "Good", "Poor", "Very poor"

Sorry I am pretty new to R

@loscialer
Copy link

All good I managed to do it!
Thank you very much for your patience

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment