do breed bump chart - new

dog-ranks-2019.R

library(purrr)
library(dplyr)
library(here)
library(magick)
library(fs)
library(stringr)
library(ggplot2)
library(ggimage)
library(tidyr)
library(hrbrthemes)

# paths for reading and writing images
pathin <- dir_ls(here("pups"))
pathout <- str_replace(pathin, ".png$", "_small.png")

# batch resizing and export
reduce_image <- function(pathin) {
  image_read(pathin) %>%
    image_resize("132x132") %>%
    image_contrast() %>%
    image_enhance()
}

# to disk
pathin %>%
  map(reduce_image) %>%
  walk2(pathout, image_write)

# set up the data
dogranks <-
  tibble(
    Breed = c(
      "Retrievers (Labrador)", "German Shepherd Dogs",
      "Retrievers (Golden)", "French Bulldogs", "Bulldogs",
      "Beagles", "Poodles", "Rottweilers", "Yorkshire Terriers",
      "Pointers (German Shorthaired)"
    ),
    r2018 = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 10L, 9L),
    r2017 = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L),
    r2016 = c(1L, 2L, 3L, 6L, 4L, 5L, 7L, 8L, 9L, 11L),
    r2015 = c(1L, 2L, 3L, 6L, 4L, 5L, 8L, 9L, 7L, 11L),
    r2014 = c(1L, 2L, 3L, 9L, 4L, 5L, 7L, 10L, 6L, 12L),
    r2013 = c(1L, 2L, 3L, 11L, 5L, 4L, 8L, 9L, 6L, 13L)
  )

# reorder years
dogranks <- dogranks %>% select(Breed, rev(everything()))

# image names for variable (already ordered for 2018)
imgfiles <- dir_ls(here("pups"), regexp = "small.png$") %>% basename()
imgpaths <- here("pups", imgfiles)

# variable with corresponding image filenames
dogranks <- dogranks %>% mutate(drawing = imgpaths)

# reshape
rankslong <- dogranks %>% gather(year, Rank, -Breed, -drawing)
# clean up
rankslong$year <- gsub("r", "", rankslong$year)
# labels
dogranks$Breed_lab <- gsub(dogranks$Breed, pattern = "\\(", replacement = "\n(")

# puppers <-
ggplot(data = rankslong, aes(x = year, y = Rank, group = Breed)) +
  geom_line(aes(color = Rank), size = 1, show.legend = FALSE) +
  geom_point(aes(color = Rank), size = 0.5, show.legend = FALSE) +
  scale_color_gradient(low = "black", high = "#C38345") +
  scale_y_reverse(breaks = 1:nrow(rankslong)) +
  theme_ipsum_tw(grid = "X", base_size = 16, axis_title_size = 16, axis_title_just = "ct") +
  labs(
    x = "Year",
    y = "Rank",
    title = "American Kennel Club most popular breeds",
    caption = "source: AKC registration statistics in the USA\n https://www.akc.org/expert-advice/news/most-popular-dog-breeds-of-2018/
       by @LuisDVerde (www.liomys.mx)"
  ) +
  scale_x_discrete(expand = expand_scale(add = c(2.5, 0.9))) +
  geom_image(data = dogranks, aes(
    y = 1:10,
    x = 6.4,
    image = drawing
  ), by = "height", size = 0.08) +
  geom_text(data = dogranks, aes(y = r2013, x = 0.9, label = Breed_lab, family = "Titillium Web"), hjust = "right", size = 4.5, color = "black")

# to disk
ggsave(filename = "akcranks2019.png", width = 8, height = 7, units = "in", dpi = 200)


# dog collage
no_rows <- 2
no_cols <- 5

make_column <- function(i, files, no_rows) {
  filename <- paste0("col", i, ".png")

  magick::image_read(files[(i * no_rows + 1):((i + 1) * no_rows)]) %>%
    magick::image_background("white") %>%
    magick::image_append(stack = TRUE) %>%
    magick::image_write(filename)

  filename
}

purrr::map_chr(0:(no_cols - 1), make_column,
  files = pathout,
  no_rows = no_rows
) %>%
  magick::image_read() %>%
  magick::image_append(stack = FALSE) %>%
  magick::image_border("#665cb2", "10x10") %>%
  magick::image_write("doggos.png")