https://github.com/insightsengineering/hex-stickers
hex sticker archive
https://github.com/insightsengineering/hex-stickers
hex-stickers r
Last synced: about 1 year ago
JSON representation
hex sticker archive
- Host: GitHub
- URL: https://github.com/insightsengineering/hex-stickers
- Owner: insightsengineering
- Created: 2021-10-22T05:44:40.000Z (over 4 years ago)
- Default Branch: main
- Last Pushed: 2025-01-07T11:29:29.000Z (over 1 year ago)
- Last Synced: 2025-03-26T13:03:40.138Z (about 1 year ago)
- Topics: hex-stickers, r
- Language: R
- Size: 45.7 MB
- Stars: 8
- Watchers: 11
- Forks: 1
- Open Issues: 5
-
Metadata Files:
- Readme: README.Rmd
Awesome Lists containing this project
README
---
output: github_document
---
```{r getopenpharma, echo=FALSE,message=FALSE}
# reference PNGs
logos <- tools::file_path_sans_ext(dir("PNG", pattern = "\\.png$"))
# get it
library(magrittr)
openpharma_repos <- readRDS(url(
"https://github.com/openpharma/openpharma_log/blob/main/all-repos/data.rds?raw=true"
))
repositories <- tibble::tibble(
repo = logos
) %>%
dplyr::left_join(
openpharma_repos,
by = "repo"
) %>%
dplyr::mutate(
description = dplyr::case_when(
is.na(description) ~ "No description in github",
TRUE ~ description
),
Project = dplyr::case_when(
is.na(org) ~ as.character(glue::glue(
"{repo}
",
'
This project is not tracked by openpharma.github.io
'
)),
TRUE ~ as.character(glue::glue(
'{org}/{repo}
',
" {description}
"
))
)
)
```
# Hex Stickers
Projects where we are involved.
## Adding stickers
To add one, make sure to add your hex sticker under the format `EXACT_PACKAGE_NAME.FORMAT`
- where `EXACT_PACKAGE_NAME` is the exact name of your R package,
- and `FORMAT` is the file format of the hex sticker.
For example, if your package is called `BananaPudding`, and your hex sticker is an SVG, then add `BananaPudding.svg` to the [SVG](SVG) directory.
Then, simply run `rmarkdown::render("README.Rmd")` in R to render the `README.md` file, as it will also automatically generate the hexwall and the thumbnail(s) for your logo(s).
## Hex sticker wall
```{r, echo=FALSE,message=FALSE}
# from https://github.com/mitchelloharawild/hexwall/blob/master/hexwall.R
# Dependencies
library(magick)
library(purrr)
# path: The path to a folder of hexagon stickers
# sticker_row_size: The number of stickers in the longest row
# sticker_width: The width of each sticker in pixels
# remove_small: Should hexagons smaller than the sticker_width be removed?
# coords: A data.frame of coordinates defining the placement of hexagons
# scale_coords: Should the coordinates be scaled to the hexagon size?
# remove_size: Should hexagons of an abnormal size be removed?
# sort_mode: How should the files be sorted?
# background_color: The colour of the background canvas
# n_stickers: The number of hexagons to produce. Recycled in file order.
hexwall <- function(path,
sticker_row_size = 16,
sticker_width = 500,
remove_small = TRUE,
total_stickers = NULL,
remove_size = TRUE,
scale_coords = TRUE,
sort_mode = c("filename", "random", "color", "colour"),
background_color = "white",
n_stickers = NULL) {
sort_mode <- match.arg(sort_mode)
# Load stickers
sticker_files <- list.files(path)
if (is.null(n_stickers)) n_stickers <- length(sticker_files)
sticker_files <- rep_len(sticker_files, n_stickers)
stickers <- file.path(path, sticker_files) %>%
map(function(path) {
intermediate <- switch(tools::file_ext(path),
svg = image_read_svg(path),
pdf = image_read_pdf(path),
image_read(path)
)
# Scale down to avoid cache exhausted errors
result <- image_resize(intermediate, "400x400")
image_destroy(intermediate)
result
}) %>%
map(image_transparent, "white") %>%
map(image_trim) %>%
set_names(sticker_files)
# Low resolution stickers
low_res <- stickers %>%
map_lgl(~ remove_small && image_info(.x)$width < (sticker_width - 1) / 2 && image_info(.x)$format != "svg")
which(low_res)
stickers <- stickers %>%
map(image_scale, sticker_width)
# Incorrectly sized stickers
bad_size <- stickers %>%
map_lgl(
~ remove_size && with(
image_info(.x),
height < (median(height) - 2) | height > (median(height) + 2)
)
)
which(bad_size)
# Remove bad stickers
sticker_rm <- low_res | bad_size
stickers <- stickers[!sticker_rm]
if (any(sticker_rm)) {
message(sprintf(
"Automatically removed %i incompatible stickers: %s",
sum(sticker_rm), paste0(names(sticker_rm[sticker_rm]), collapse = ", ")
))
}
if (is.null(total_stickers)) {
total_stickers <- length(stickers)
}
# Coerce sticker sizes
sticker_height <- stickers %>%
map(image_info) %>%
map_dbl("height") %>%
median()
stickers <- stickers %>%
map(image_resize, paste0(sticker_width, "x", sticker_height, "!"))
# Repeat stickers sorted by file name
stickers <- rep_len(stickers, total_stickers)
if (sort_mode == "random") {
# Randomly arrange stickers
stickers <- sample(c(
stickers,
sample(
stickers,
total_stickers - length(stickers),
replace = TRUE
)
))
} else if (sort_mode %in% c("color", "colour")) {
# Sort stickers by colour
sticker_col <- stickers %>%
map(image_resize, "1x1!") %>%
map(image_data) %>%
map(~ paste0("#", paste0(.[, , 1], collapse = ""))) %>%
map(colorspace::hex2RGB) %>%
map(as, "HSV") %>%
map_dbl(~ .@coords[, 1]) %>%
sort(index.return = TRUE) %>%
.$ix
stickers <- stickers[sticker_col]
}
# Arrange rows of stickers into images
sticker_col_size <- ceiling(length(stickers) / (sticker_row_size - 0.5))
row_lens <- rep(c(
sticker_row_size,
sticker_row_size - 1
), length.out = sticker_col_size)
row_lens[
length(row_lens)
] <- row_lens[length(row_lens)] - (length(stickers) - sum(row_lens))
sticker_rows <- map2(
row_lens, cumsum(row_lens),
~ seq(.y - .x + 1, by = 1, length.out = .x)
) %>%
map(~ stickers[.x] %>%
exec(c, !!!.) %>%
image_append())
# Add stickers to canvas
canvas <- image_blank(
sticker_row_size * sticker_width,
sticker_height + (sticker_col_size - 1) * sticker_height / 1.33526, "white"
)
reduce2(sticker_rows, seq_along(sticker_rows),
~ image_composite(
..1, ..2,
offset = paste0(
"+",
(
(..3 - 1) %% 2) * sticker_width / 2, "+",
round((..3 - 1) * sticker_height / 1.33526)
)
),
.init = canvas
)
}
image <- hexwall("PNG",
sticker_row_size = 6, sticker_width = 120,
sort_mode = "colour",
)
image_write(image, path = "hexwall.png", format = "png")
```
Hex details.
```{r, echo = FALSE, message = FALSE}
library(magick)
png <- paste0("PNG/", logos, ".png")
svg <- paste0("SVG/", logos, ".svg")
thumb <- paste0("thumbs/", logos, ".png")
resize <- function(path_in, path_out) {
image <- image_read(path_in)
image <- image_resize(image, "278x")
image_write(image, path_out)
}
outdated <- !file.exists(thumb) | file.mtime(thumb) < file.mtime(png)
invisible(Map(resize, png[outdated], thumb[outdated]))
```
```{r, results = "asis", echo = FALSE}
img <- glue::glue(
'
'
)
png_link <- glue::glue('{logos}.png')
cell <- paste0(
"", img, "
",
repositories$Project,
png_link,
""
)
cols <- 3
rows <- ceiling(length(cell) / cols)
row_id <- rep(seq_len(rows), each = cols, length.out = length(cell))
row_cells <- split(cell, row_id)
cat("\n")
cat(paste0("", sapply(row_cells, paste, collapse = ""), ""), sep = "")
cat("\n")
```
## HTML
Generated HTML wall of hexes at https://insightsengineering.github.io/hex-stickers
```{r, include = FALSE}
input_data <- tibble::tibble(
package = logos,
png_link = png
) %>%
dplyr::left_join(
repositories,
by = c("package" = "repo")
) %>%
dplyr::select(package, png_link, full_name) %>%
dplyr::mutate(
repo_link = glue::glue(
'{full_name}'
),
png_link = glue::glue("https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/{png_link}")
)
hexes <- NULL
for (i in 1:nrow(input_data)){
i_row <- input_data[i,]
hexes <- paste0(
hexes,
"
",
glue::glue(
'
'
)
)
}
paste0(
'
',
hexes,
"
"
) %>% write(
file = "docs/index.html"
)
```
# Acknowledgements
Code for this repo has been forked from `rstudio/hex-stickers` and `mitchelloharawild/hexwall`.
Copyright of the images is defined by the sourced project (see source repo for hex-sticker)
## Stargazers
[](https://github.com/insightsengineering/hex-stickers/stargazers)
[](https://starchart.cc/insightsengineering/hex-stickers)
## Forkers
[](https://github.com/insightsengineering/hex-stickers/network/members)