Rで名刺 ggplot2編
新しい職場で名刺を作る機会があったので、Rで作ることにしました。
Rで名刺を作成するというマニアックな知見は以前からありますが、これらはいずれも標準の作図機能を利用しているもので、せっかくなのでggplot2で作れないかと試行錯誤しました。
これはダミーですが、こんな感じの名刺が出来上がりました。よかったですね。「本物」の名刺はお会いした時に！（私は極度な人見知りなのでだいたい逃げ回ってます）
全部のコードはgistにあげています。ここでは、ggplot2を利用してRで名刺を作るための部分的な説明をします。
適当なx、yの値を入力したデータフレームを作って、やっていきます。自分の場合、なんとなくサイズ感が掴めるかなと思い名刺サイズに合わせてみました。また、あらかじめ利用する日本語フォントを指定しておくと文字化けせずにすみます。
ベースを作る
library(ggplot2) quartzFonts(sans = quartzFont(rep("IPAexGothic", 4)), serif = quartzFont(rep("IPAexMincho", 4))) df <- data.frame(x = 91, y = 55) p <- ggplot(df, aes(x, y)) p
どうみてもggplot2です。本当にありがとうございました。というわけでここから「名刺」として偽装する処理をします。まずは、切れてしまっている元の図を、0を基準として指定したサイズにします。これをしないとあとで加える文字などの要素の配置がうまくいかなくなります。
# 枠を固定する ------------------------------------------------------------------ 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"), axis.text = element_blank(), axis.title = element_blank(), axis.ticks = element_blank(), axis.line.x = element_blank(), axis.line.y = element_blank())
ここの画像を出力しても、真っ白なだけで何の面白みもないので貼っていませんが、上のコードを実行すると「枠」があるだけの白い図が出来上がります。やっていることはtheme()の各引数にelement_blank()を指定してデフォルトの要素を消してしまっているのと、theme_bw()でベースとなるフォント（最初に指定したやつ）とそのサイズを定義しているだけです。
文字を入れる
annotate()を使いました(geom_text()を使っても良いです)。文字の配置を引数で指定できて楽です。フォントの大きさや色、種類も指定可能です。
# 文字を入れる ------------------------------------------------------------------ # 要素となる名前などの情報をオブジェクトとしておきます first_name <- "真也" last_name <- "瓜生" first_name_en <- "Shinya" last_name_en <- stringr::str_to_upper("Uryu")
p + annotate(geom = "text", x = (df$x / 2), y = df$y / 2, label = glue::glue("{last_name} {first_name}"), size = 22, family = "sans", color = "black") + annotate("text", x = (df$x / 2), y = (df$y / 2) - 12, label = glue::glue("{last_name_en}, {first_name_en}"), family = "serif")
annotate()では位置とラベルの値などを除き、いくつか共通化できる引数の値があったのでpurrr::partial()による部分適用を利用しました。partial()を利用すると上のコードを次のように書き換えられます。
antt <- purrr::partial(annotate, geom = "text", family = "sans", color = "black") antt_en <- purrr::partial(annotate, geom = "text", family = "serif", color = "black") p + antt(x = (df$x / 2), y = df$y / 2, label = glue::glue("{last_name} {first_name}"), size = 22) + antt_en(x = (df$x / 2), y = (df$y / 2) - 12, label = glue::glue("{last_name_en}, {first_name_en}"))
あとは必要な情報を同様に追加していったり、線を引きたかったらgeom_segment()を実行するなりしてください。文字の配置を考えるのが面倒です。
ロゴを追加する
画像を追加する方法は色々あるみたいですがggimageを使うのが個人的には楽でした。ggplot2の関数と同じような引数が指定できます。
library(ggimage) p <- p + geom_image(aes(x = 10, y = 48, image = "r3_logo.png"), size = 0.072) + geom_image(aes(x = df$x - 8.4, y = 2), image = file.path(Sys.getenv("R_HOME"), "doc", "html", "logo.jpg" ), size = 0.0182) + geom_image(aes(x = df$x - 10, y = 28), image = "uryu.jpg", size = 0.182)
QRコードを追加する
完全におまけですが。
QRコードは、qrencoderというパッケージで生成・出力できます。やっていきましょう。といってもQRコードを生成してのっけるだけになります。
library(qrencoder) png("qr_code.png", bg = "transparent") par(mar = c(0,0,0,0)) image(qrencode_raster(website), asp = 1, col = c("#FFFFFF", "#19A757"), axes = FALSE, xlab = "", ylab = "") dev.off()
これをgeom_image()でこれまでの図に追加して完成です！
p + geom_image(aes(x = df$x - 10, y = 10), image = "qr_code.png", size = 0.10)
ここやgistにあげたコードではglueパッケージを使っているので、適当に値を変えたら同じデザインのものができます！
さあ、あなたもggplot2で名刺を作ろう！！
hex mapの決定版になりそうなhexmapr
以前、このような記事を書きました。
ここに書いた通り、私は簡単に六角形の地図を描画できるパッケージを探しています。
今回紹介するのは、前回のhexamapmakerとは別の方法で六角形を作るhexmaprパッケージです。geospatial polygonsを正方形や六角形に変換してくれます。
hexmaprこのパッケージはCRANには登録されていません。利用の際はGitHubからインストールします。
devtools::install_github("sassalley/hexmapr")
使い方
今回は神奈川県を例に、hexmaprを使った可視化をやってみましょう。hexmaprを使った作図の方法をまとめると次のような手順になります。
read_polygons()などの関数を使い、対象のgeom情報をもったSpatialPolygonDataFrameを作成- 作図する領域(グリッドの数)などを
get_shape_details()で算出する calculate_cell_size()で与えたポリゴンデータとget_shape_details()の情報を元に各ポリゴンのサイズと配置を決定する
library(ggplot2) library(viridis) library(dplyr) library(hexmapr)
まずは神奈川県のshapefileを国土数値情報の行政区域データ (平成28年)より取得することにします。ウェブからファイルをダウンロードしても良いのですが、ここではkokudosuuchiを利用してダウンロード先のURLを取得し、Rからファイルのダウンロード、圧縮ファイルの解凍を済ませます。
file.url <- kokudosuuchi::getKSJURL(identifier = "N03", prefCode = 14) %>% arrange(desc(year)) %>% slice(1L) %>% use_series(zipFileUrl) download.file(file.url, destfile = basename(file.url)) unzip(basename(file.url))
original_shapes <- read_polygons("N03-17_14_170101.shp")
original_details <- get_shape_details(original_shapes) original_details$nhex # [1] 1292 new_cells_hex <- calculate_cell_size(original_shapes, original_details, learning_rate = 0.03, grid_type = "hexagonal", seed = 72)
plot(new_cells_hex[[2]])
calculate_cell_size()は引数seedをもっています。これはポリゴンの算出に乱数を利用しているためで、乱数の値によりピリゴンの配置が異なるようになっています。そのため開発者は乱数を変えて、望ましい図を得ることを推奨しています。次のように良い感じの出力が得られる乱数を特定しておくと良いでしょう。
par(mfrow = c(2, 3), mar = c(0, 0, 2, 0)) for (i in 1:6){ new_cells <- calculate_cell_size(original_shapes, original_details,0.03, "hexagonal", i) plot(new_cells[[2]], main = paste("Seed", i)) }
上の例では、個人的にseed 5の結果を推したいところです。
sfオブジェクトから作成する場合
先ほど用いたhexmaprのread_polygons()はsfパッケージの読み込み関数をラップしているのですが、出力されるオブジェクトはSpatialPolygonsDataFrameオブジェクトです。sfオブジェクトからhexmaprを利用するには、この形式に変換する必要があります。
以下は既存のsfオブジェクトを利用したいという時のコードです。といっても、asを使って変換するだけです。
sf.pref14 <- st_read("N03-17_14_170101.shp", options = c("ENCODING=CP932"))
original_shapes <- sf.pref14 %>% as("Spatial")
残りのcalculate_cell_size()以下は先ほどと同じです。今度はhexではなくregular gridで作図してみましょう。
new_cells <- calculate_cell_size(original_shapes, original_details, 0.03, "regular", 5)
plot(new_cells[[2]])
一つの市区町村で一つのポリゴンに限定する
これまでの神奈川県を例にしたhexmaprによる出力では、市区町村のポリゴンごとに一つの六角形あるいは四角形を生成する、というものでした。なので、飛び地や島を含んだ市区町村は複数行にまたがって記録されるということになっています。
POLYGONをMULTIPOLYGONに変換することで対応します(これがベストな方法なのかは不安なところ)。
sf.pref14 %<>% mutate(city_name = paste( if_else(is.na(N03_003), "", paste(N03_003)), N03_004 )) sf.pref14 %>% # 市区町村ごとにポリゴンを結合する # (複数のPOLYGONをMULTIPOLYGONにする) group_by(city_name) %>% do(out = st_union(.) %>% st_buffer(dist = 0.0001)) -> df.tmp original_shapes <- df.tmp$out %>% purrr::reduce(c) %>% st_sf() original_shapes$city_name <- as.character(df.tmp$city_name) original_shapes %<>% mutate(area = st_area(.)) original_shapes %<>% as("Spatial") original_details <- get_shape_details(original_shapes) new_cells_hex <- calculate_cell_size(original_shapes, original_details, learning_rate = 0.03, grid_type = "hexagonal", seed = 5)
plot(new_cells_hex[[2]])
ggplot2による可視化
# 可視化のために利用 # 別な方法がありそうな shp_clean <- function(shape){ shape@data$id = rownames(shape@data) shape.points = ggplot2::fortify(shape, region = "id") shape.df = plyr::join(shape.points, shape@data, by = "id") }
result_df_hex <- assign_polygons(original_shapes, new_cells_hex) %>% shp_clean()
# quartzFonts(YuGo = quartzFont(rep("IPAexGothic", 4))) # theme_set(theme_gray(base_size = 12, base_family = "IPAexGothic")) ggplot(result_df_hex) + # 市区町村の面積に応じて色付けを行う geom_polygon(aes(x = long, y = lat, fill = as.numeric(area), group = group)) + geom_text(aes(V1, V2, label = city_name), size = 0.8, color = "white", family = "IPAexGothic") + coord_equal() + scale_fill_viridis() + guides(fill = FALSE)
なんだかんだで結構しんどいのでした...
Enjoy!
転職・転居しました: 大学→企業→研究機関
初めての転職 & 引越しエントリー
要約
10月末をもって株式会社ナイトレイを退職しました。また、次の職場となる国立環境研究所への勤務のために茨城県つくば市へ引越しを行いました。生態系サービスの評価や生物多様性の保全に関する実証研究の技術的補佐を主な業務内容とします。
転職・転居と、転々とすることもあまりない機会なので、amazon欲しいものリストを晒します。どうぞよろしくお願いします！
me
Rが好きでちょっとだけできるRおじさん。地理空間データの分析をぎょーむとしていました。Rの本を書いたり、Rについて講演したり、最近ではRラジオというのをやっています。
どこからどこへ?
あまりネットで書いたことがなかったかもしれませんが、昨年3月から株式会社ナイトレイにメンバーとして加わりました。Wantedly経由で応募し、すぐに面談、様子を見ながらやっていきましょう、という流れの速さに驚いた記憶があります。
当時の自分は大学の研究室にもいかず、自宅で腐りつつあったので、そこから抜け出せる環境を提供してくれたというだけでも感謝です。
地図や位置情報データをこねくり回すのが好きで、ナイトレイでも十分に位置情報データを扱うことができてよかったです。特に、位置情報だけでなく、テキストや画像、POIデータも分析対象とすることが可能なSNSデータを中心に業務を行えたのはとても良い経験だったと思います。環境も自由で、Shiny Serverを立ててShinyアプリケーションを作りまくりましたw
一方でデータ分析はメンバー数に限りがあったり協業先との関係もあったりで、なかなか自分の思うように進められず（自分の力不足もあるわけですが）、もやもやとしたものを感じていました。
メンバーは同年代が多く、インターンも優秀かつ誠実、入社当時は存在しなかったマネージャーも、今年から新たに加わり、良い環境なのは違いないのですが、このままで良いのかという気持ちを抑えきれず、転職に踏み切りました。
次の職場は企業ではないです。国立環境研究所という研究機関で働きます。研究者ではなく、あくまでも技術者というポジションです。前職でもそうでしたが、R言語をフルに活用して、研究者の技術的補佐を行う予定です。
もともと大学では植物生態学を専攻していたこともあり、国立環境研究所で働くということは一つの憧れだったのもあります。一度アカデミアから離脱して、このような形で加わるというのは自分でも驚きですが、とにかく嬉しいです。特に技能の部分を評価してもらって、エンジニアとしても、これまでの自分の活躍を誇りに思います（ブログやQiitaを書いたり、OSS活動をしていて本当によかった...）
転職活動
あまり良くないとは思いながらも、Twitterで「給与もっとくれるとこないかな」といった発言をしたら、たくさんの人が声をかけてくださりました。それだけで感謝ですが、実際に話を聞いてみないかという流れでお話を伺ったり、転職の相談に乗ってもらったりしていました。
勤めている会社以外の話を聞くことがあまりなかったので、それだけでも良い経験・勉強でした。自分の能力や企業の求めている人物像について考えることもできました。
お声がけいただいた方、お世話になった方々へ、この場を借りて感謝の気持ちを述べたいと思います。
引越し
東京から茨城へ。北関東に住むのは初めてです。まだ1週間も経っていませんが、つくば市は良いところっぽいです。公園がたくさんあります。完全に車社会です。自動車を所有していないので、おしゃれなチャリを買いました。家賃も都内に比べて安いし広いです。住まいが広いので、イキリたくなります。遊びに来てください。
いきり空間作成中 pic.twitter.com/1i36vpPFvl
— Uryu Shinya (@u_ribo) 2017年10月28日
何よりつくばには、日本のRコミュニティの先駆け的な存在、Tsukuba.Rを開催していた筑波大学があります。つくばに住むことになったからには、つくばにもう一度Rの熱気を取り戻したい。そんな気持ちをふつふつと沸かしています。やるぞ！
では、これからも頑張ってまいります。皆様今後ともよろしくお願いします。 例のものです！！
