Last active
September 7, 2021 05:43
-
-
Save jonocarroll/2f9490f1f5e7c82ef8b791a4b91fc9ca to your computer and use it in GitHub Desktop.
Implements @baptiste's much better method for making this work
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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 | |
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.
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
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
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())
`