Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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
You can’t perform that action at this time.