meishi.R

require(ggplot2)
require(purrr)
require(stringr)
require(glue)
require(qrencoder)
require(png)
require(gridExtra)

# given_name 必須. 名
# family_name 任意. 姓
# given_name_en 任意. ローマ字名
# family_name_en 任意. ローマ字姓
# job_title 職名
# personal_title 任意. 称号 (学位とか爵位とか)
# mail 任意.メールアドレス
# website 任意. ウェブサイト
# note 任意. 注意書き, その他特記事項
# portrait_path 任意. 顔写真あるいは何らかのロゴマーク画像のパス. pngのみ対応
# qr_string 任意. QRコード化する文字列
# sans 任意. ゴシック体フォント
# serif 任意. セリフフォント

plot_card <- function(given_name, family_name="",
                      given_name_en="", family_name_en="",
                      job_title="無職", personal_title=NULL,
                      mail=NULL, website=NULL, note=NULL, 
                      portrait_path=NULL, qr_string=NULL,
                      sans="TakaoExGothic", serif="TakaoExMincho"){
  if(qr_string == T){
    qr_string <- website
  }
  if(qr_string == F){
    qr_string <- NULL
  }
  given_name_en <- stringr::str_to_title(given_name_en)
  family_name_en <- stringr::str_to_upper(family_name_en)
  df <- data.frame(x = 91, y = 55)
  R_note <- paste("この名刺は R", paste(R.version$major, R.version$minor, sep="."), "で作成されました。")
  
  p <- ggplot(df, aes(x, y))
  p <- p + xlim(0, df$x) + ylim(0, df$y)
  p <- p + 
    theme_bw(base_size = 12, base_family = "sans") +
    theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
          panel.background = element_blank(), axis.line = element_line(colour = "black", size=1),
          axis.text = element_blank(), axis.title = element_blank(), axis.ticks.length = grid::unit(rep(0, 4), "points"),
          axis.ticks = element_blank(), axis.line.x = element_blank(),
          axis.line.y = element_blank(), plot.margin=grid::unit(rep(0, 4), "points")) +
    coord_fixed()
  antt <- purrr::partial(annotate, geom = "text", family = "sans", color = "black")
  antt_en <- purrr::partial(annotate, geom = "text", family = "serif", color = "black")
  p <- p + 
    antt(x = 45.5, y = 50, label = job_title, size = 4, hjust = .5) +
    antt(x = (df$x / 2), y = (df$y / 2) + 4, 
         label = glue::glue("{family_name} {given_name}"),
         size = 8) +
    antt_en(x = (df$x / 2), y = (df$y / 2) - 4, label = glue::glue("{family_name_en}, {given_name_en}"),
            size = 4)
    if(!is.null(personal_title)){
      p <- p + antt(x = (df$x / 2) - 32, y = df$y / 2, label = personal_title, size = 4)
    }
    p <- p + geom_segment(aes(x = 10, xend = df$x, y = 20, yend = 20))
    
  cnt <- 0
  if(!is.null(mail)){
    p <- p + antt_en(x = 10, y = (df$y / 2) - 15, label = glue::glue("E-mail: {mail}"), size = 2.5, hjust = 0)
    cnt <- cnt + 1
  }
  if(!is.null(website)){
    p <- p + antt_en(x = 10, y = (df$y / 2) - 15 - cnt * 3, label = glue::glue("URL: {website}"), size = 2.5, hjust = 0)
    cnt <- cnt + 1
  }
  if(!is.null(note)){
    p <- p + antt_en(x = 10, y = (df$y / 2) - 15 - cnt * 3, label = glue::glue("{note}"), size = 2.5, hjust = 0)
  }
  p <- p + antt(x = df$x - 30, y = 2, label = R_note, size = 1.5, hjust = 0)
  if(!is.null(portrait_path)){
    portrait <- readPNG(portrait_path)
    portrait_height <- 20 * dim(portrait)[1]/dim(portrait)[2]
    p <- p + annotation_raster(portrait, xmin = df$x - 21, xmax = df$x - 1, ymin = 21, ymax = 21 + portrait_height)
  }
  if(!is.null(qr_string)){
    png(file.path(tempdir(), "qr_code.png"), bg = "transparent")
    par(mar = c(0,0,0,0))
    image(qrencode_raster(qr_string), 
          asp = 1, 
          col = c("#FFFFFF", "#000000"), axes = FALSE, 
          xlab = "", ylab = "")
    dev.off()
    p <- p + annotation_raster(readPNG(file.path(tempdir(), "qr_code.png")),
                               xmin = df$x - 15, ymin = 5, xmax=df$x - 5, ymax = 15)
  }
  return(p + scale_size_identity())
}

# Rlogo.png は https://www.r-project.org/logo/ からダウンロードしたもの
p <- plot_card(given_name = "おじさん", family_name = "R", given_name_en = "Ojisan", family_name_en = "R",
               personal_title = "市民", job_title = "R の妖精",
               mail = "foo@bar.jp", website = "https://www.google.co.jp", note = "ここに注意書き",
               portrait_path="Rlogo.png", qr_string = T,
               sans="TakaoExGothic", serif="TakaoExMincho")

# 単体で保存. png or pdf
ggsave(filename = "sample.png", device = "png", width = 91, height = 55, units = "mm", dpi = 350, plot = p)
ggsave("sample.pdf", device = cairo_pdf, width = 91, height = 55, units = "mm", dpi = 350, plot = p)


# ケチりたいのでA4にまとめて印刷するための画像作成

ggsave("samples.pdf", device=cairo_pdf, width = 91 * 3, height = 55 * 3, unit = "mm", dpi = 350,
       plot = grid.arrange(grobs = lapply(replicate(9, p, F), "+",
                                          theme(plot.margin = grid::unit(rep(0, 4), "mm"),
                                          axis.ticks.length = grid::unit(rep(0, 4), "mm"))
                                          ),
                           ncol=3)
       )