font embedding test in R graphics

cross-platform-font-test.R

require(tidyverse)

fonts_win = tibble::tribble(
  ~family,          ~name, ~group,          ~os,
  "Yu Mincho",          "游明朝",   "明朝", "windows 10",
  "游明朝",          "游明朝",   "明朝", "windows 10", # WSL
  "BIZ UDMincho",     "BIZ UD明朝",   "明朝", "windows 10",
  "BIZ UD明朝",     "BIZ UD明朝",   "明朝", "windows 10",
  "BIZ UDPMincho",    "BIZ UDP明朝",   "明朝", "windows 10",
  "BIZ UDP明朝",    "BIZ UDP明朝",   "明朝", "windows 10",
  "HGMinchoE",       "HG 明朝E",   "明朝", "windows 10",
  "HGPMinchoE",      "HG P明朝E",   "明朝", "windows 10",
  "MS Mincho",        "MS 明朝",   "明朝", "windows 10",
  "MS PMincho",       "MS P明朝",   "明朝", "windows 10",
  "Yu Gothic",        "游ゴシック", "ゴシック", "windows 10",
  "游ゴシック",        "游ゴシック", "ゴシック", "windows 10",  # WSL
  "UD Digi Kyokasho NK-R", "UDデジタル教科書体 NK-R", "ゴシック", "windows 10",
  "UDデジタル教科書体 NK-R", "UDデジタル教科書体 NK-R", "ゴシック", "windows 10",
  "Meiryo",         "メイリオ", "ゴシック", "windows 10",
  "ゴシック",         "メイリオ", "ゴシック", "windows 10",
  "HGGothicE",     "HG ゴシックE", "ゴシック", "windows 10",
  "HGPGothicE",    "HG PゴシックE", "ゴシック", "windows 10",
  "MS Gothic",      "MS ゴシック", "ゴシック", "windows 10",
  "ＭＳ ゴシック",      "MS ゴシック", "ゴシック", "windows 10",
  "MS PGothic",     "MS Pゴシック", "ゴシック", "windows 10",
  "ＭＳ Ｐゴシック",     "MS Pゴシック", "ゴシック", "windows 10",
  "Meiryo UI",    "Meiryo UI", "ゴシック", "windows 10",
  "Yu Gothic UI", "Yu Gothic UI", "ゴシック", "windows 10"
)

fonts_mac <- tibble::tribble(
  ~family,         ~name, ~group,   ~os,
  "Hiragino Mincho Pro",   "ヒラギノ明朝Pro",   "明朝", "Mac",
  "Hiragino Mincho ProN",  "ヒラギノ明朝ProN",   "明朝", "Mac",
  "YuMincho",         "游明朝",   "明朝", "Mac",
  "YuMincho +36p Kana",   "游明朝+36ポかな",   "明朝", "Mac",
  "Hiragino Sans",   "ヒラギノ角ゴシック", "ゴシック", "Mac",
  "Hiragino Maru Gothic ProN", "ヒラギノ丸ゴProN", "ゴシック", "Mac",
  "YuGothic",       "游ゴシック", "ゴシック", "Mac",
  "YuGothic +36p Kana", "游ゴシック+36ポかな", "ゴシック", "Mac",
  "Hiragino MaruGo",   "ヒラギノ丸ゴシック", "ゴシック", "Mac",
  "Tsukushi A Round Gothic", "筑紫A丸ゴシック", "ゴシック", "Mac",
  "Tsukushi B Round Gothic", "筑紫B丸ゴシック", "ゴシック", "Mac"
)

fonts_free <- tibble::tribble(
  ~family,               ~name, ~group,              ~os,
  "Noto Serif CJK JP", "Noto Serif CJK JP",   "明朝", "cross-platform",
  "Haranoaji Mincho",             "原ノ味明朝",   "明朝", "cross-platform",
  "Sagabonfont Prototype", "嵯峨本フォントプロトタイプ", "明朝", "cross-platform",
  "嵯峨本フォントプロトタイプ", "嵯峨本フォントプロトタイプ", "明朝", "cross-platform",
  "Noto Sans CJK JP",  "Noto Sans CJK JP", "ゴシック", "cross-platform",
  "IBM Plex Sans JP",  "IBM Plex Sans JP", "ゴシック", "cross-platform",
  "Haranoaji Gothic",           "原ノ味ゴシック", "ゴシック", "cross-platform",
  "BIZ UDP明朝",   "BIZ UDP明朝", "明朝", "cross-platform",
  "BIZ UDPMincho",   "BIZ UDP明朝", "明朝", "cross-platform",
  "BIZ UD明朝",   "BIZ UD明朝", "明朝", "cross-platform",
  "BIZ UDMincho",   "BIZ UD明朝", "明朝", "cross-platform",
  "BIZ UDPGothic",  "BIZ UDPゴシック", "ゴシック", "cross-platform",
  "BIZ UDPゴシック",  "BIZ UDPゴシック", "ゴシック", "cross-platform",
  "BIZ UDGothic",  "BIZ UDゴシック", "ゴシック", "cross-platform",
  "BIZ UDゴシック",  "BIZ UDゴシック", "ゴシック", "cross-platform",
  "IPAex明朝", "IPAex 明朝", "明朝", "cross-platform",
  "IPAexゴシック", "IPAex ゴシック", "ゴシック", "cross-platform",
  "IPAexMincho", "IPAex 明朝", "明朝", "cross-platform",
  "IPAexGothic", "IPAex ゴシック", "ゴシック", "cross-platform"
)

fonts_ubuntu <- tibble::tribble(
  ~ family, ~ name, ~ group, ~ os,
  "Noto Serif CJK JP", "Noto Serif CJK JP", "明朝", "cross-platform",
  "原ノ味明朝", "原ノ味明朝", "明朝", "cross-platform",
  "Takao P明朝", "Takao P明朝", "明朝", "cross-platform",
  "Noto Sans CJK JP", "Noto Sans CJK JP", "ゴシック", "cross-platform",
  "原ノ味ゴシック", "原ノ味ゴシック", "ゴシック", "cross-platform",
  "Takao Pゴシック", "Takao Pゴシック", "ゴシック", "cross-platform"
)

sysinfo <- Sys.info()
if(sysinfo["sysname"] == "Linux" & !str_detect(sysinfo["release"], "WSL2$")){
  print("as Ubuntu")
  base_family <- "Noto Sans CJK JP"
  d <-
    expand_grid(bind_rows(fonts_ubuntu, fonts_free) %>% unique,
                tibble(fonttype = 1:4, face = fct_inorder(
                  c("plain", "bold", "italic", "bold.italic")
                ))) 
} else if(sysinfo["sysname"] == "Darwin"){
  print("as MacOS")
  base_family <- "Hiragino Sans"
  d <-
    expand_grid(bind_rows(fonts_mac, fonts_free), tibble(fonttype = 1:4, face = fct_inorder(
      c("plain", "bold", "italic", "bold.italic")
    )))
} else {
  print("as Windows")
  base_family <- "Yu Mincho"
  d <-
    expand_grid(bind_rows(fonts_win, fonts_free), tibble(fonttype = 1:4, face = fct_inorder(
      c("plain", "bold", "italic", "bold.italic")
    )))
}

d <- d %>% inner_join(dplyr::select(systemfonts::system_fonts(), family) %>% unique, by = "family") %>%
  mutate(across(c(family, name), ~fct_inorder(as.character(.x))))

## base
# plot(0, xlim = c(1, 4), ylim = c(1, length(levels(d$family))),
#      xlab = "フォントフェース",
#      ylab = "フォントファミリ",
#      pch = NA, xaxt = "n", yaxt = "n")
# for(i in 1:NROW(d)){
#   text(d$fonttype[i], which(levels(d$family) == d$family[i]),
#        label = "Rで広がる可視化の世界",
#        family = as.character(d$family[i]), # まじで...なにこの挙動
#        font = d$fonttype[i])
# }
# axis(1, at = 1:4, labels = levels(d$face))
# axis(2, at = 1:length(levels(d$family)), labels = levels(d$name))

p <- ggplot(d, aes(
  x = face,
  y = name,
  family = family,
  fontface = face
)) +
  geom_text(label = "Rで広がる可視化の世界", size = 10/.pt, hjust = .5) +
  facet_wrap(~group, ncol = 1, scales = "free_y") +
  labs(x = "フォントフェース", y = "フォントファミリ") +
  scale_y_discrete(limits = rev) +
  theme_minimal(base_size = 32 /.pt, base_family = base_family) +
  theme(panel.grid = element_blank(), plot.background = element_rect(colour = "white"))
p
ggsave("gg-png.png", plot = p, device = png, width = 8, height = 12)  # Mac ならエラー
ggsave("gg-png-cairo.png", plot = p, device = png, width = 8, height = 12, type = "cairo")
ggsave("gg-ragg.png", device = ragg::agg_png, width = 8, height = 12)
ggsave("gg-ragg.jpg", device = ragg::agg_jpeg, width = 8, height = 12)
ggsave("gg-svglite.svg", device = svglite::svglite, width = 8, height = 12)
rsvg::rsvg_pdf("gg-svglite.svg", "gg-rsvg.pdf")
ggsave("gg-cairo.pdf", device = cairo_pdf, width = 8, height = 12, antialias = "default")  # WSL だとなぜかデフォルトで Cairo fonts が使われない?
ggsave("gg-cairo-noaa.pdf", device = cairo_pdf, width = 8, height = 12, antialias = "none")
ggsave("gg-cairo-gray.pdf", device = cairo_pdf, width = 8, height = 12, antialias = "gray")
ggsave("gg-cairo-subpixel.pdf", device = cairo_pdf, width = 8, height = 12, antialias = "subpixel")

p2 <- ggplot(data.frame(x = c(0, 0), y = 0:1, label = c("R で広がる可視化の世界", "あ")),
             aes(x, y, label = label)) + geom_text(size = 40/.pt) + coord_cartesian(ylim = c(-.5, 1))
p2 
ggsave("fallback-png.png", plot = p2, device = png, width = 8, height = 12) # Mac ならエラー
ggsave("fallback-png-cairo.png", plot = p2, device = png, type = "cairo", width = 8, height = 12)
ggsave("fallback-ragg.png", device = ragg::agg_png, width = 8, height = 12)
ggsave("fallback-ragg.jpg", device = ragg::agg_jpeg, width = 8, height = 12)
ggsave("fallback-svglite.svg", device = svglite::svglite, width = 8, height = 12)
rsvg::rsvg_pdf("fallback-svglite.svg", "fallback-rsvg.pdf")
ggsave("fallback-cairo.pdf", device = cairo_pdf, width = 8, height = 12)
ggsave("fallback-cairo2.pdf", device = cairo_pdf, width = 8, height = 12, family = "aaaa")

if(!"fontregisterer" %in% installed.packages()) remotes::install_github("gedevan-aleksizde/fontregisterer")
require(fontregisterer)
quartz_ <- function(filename, type = NULL, ...){
  return(quartz(file = filename, type = type, ...))
}
ggsave("ggsave-quartz.pdf", plot = p, device = quartz_, type = "pdf", height = 8, width = 12)
ggsave("ggsave-quartz.png", plot = p, device = quartz_, type = "png", height = 8, width = 12)

mac-gg-cairo.pdf

mac-gg-quartz.pdf

mac-gg-quartz.png

mac-gg-ragg.png

ubuntu-gg-cairo.pdf

ubuntu-gg-ragg.png

win-gg-cairo.pdf