README.Rmd

---
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} <br />",
        '<p style="color:grey">This project is not tracked by openpharma.github.io</p>'
      )),
      TRUE ~ as.character(glue::glue(
        '<a href="https://github.com/{org}/{repo}">{org}/{repo}</a> <br />',
        "<p> {description} </p>"
      ))
    )
  )
```

# 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")
```

![](hexwall.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(
  '<img alt="Logo for {logos}" src="{thumb}" height="139">'
)
png_link <- glue::glue('<a href="{png}">{logos}.png</a>')
cell <- paste0(
  "<td>", img, "<br />",
  repositories$Project,
  png_link,
  "</td>"
)
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("<table>\n")
cat(paste0("<tr>", sapply(row_cells, paste, collapse = ""), "</tr>"), sep = "")
cat("</table>\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(
      '<a href="https://github.com/{full_name}">{full_name}</a>'
    ),
    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(
     '<li class="hex">
        <div class="hexIn">
          <a class="hexLink" href="https://github.com/{i_row$full_name}">
            <img src="{i_row$png_link}" alt="" >
          </a>
        </div>
      </li>

     '
    )
  )
}

paste0(
  '
  <!doctype html>
<html>
  <head>
    <meta charset="utf-8">
    <title></title>
    <meta name="viewport" content="width=device-width, initial-scale=1">
    <link rel="stylesheet" type="text/css" href="hex.css">
    <link href="https://fonts.googleapis.com/css?family=Raleway:300" rel="stylesheet" type="text/css">
  </head>
  <body>
    <ul id="hexGrid">
  ',
  hexes,
  "
      </ul>
  </body>
</html>
  "
) %>% 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

[![Stargazers repo roster for @insightsengineering/hex-stickers](https://reporoster.com/stars/dark/insightsengineering/hex-stickers)](https://github.com/insightsengineering/hex-stickers/stargazers)

[![Stargazers over time](https://starchart.cc/insightsengineering/hex-stickers.svg)](https://starchart.cc/insightsengineering/hex-stickers)

## Forkers

[![Forkers repo roster for @insightsengineering/hex-stickers](https://reporoster.com/forks/dark/insightsengineering/hex-stickers)](https://github.com/insightsengineering/hex-stickers/network/members)