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) | |
) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment