| 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