gghighlightがステキすぎることをポエむ。
こんにちは。先日、Tokyo.R#72に参加しました。
報告内容に「穴lytics」なるタイトルの方がいらして、
ヤバい、ライバル出現か！？などとひとり戦慄を覚えた訳ですが、
中身を拝見したら「（人としての、能力的な）欠損」の意味ではなく、
「データの特徴量をTDA（位相的データ分析）で見てみよう」という、
大変高度で私には全くもって手の届かない雲上の層にあらせられる方の報告で、
何をライバル出現などとおこがましいことを考えているんだ
この能力欠損野郎はと、改めて襟を正す思いでした。
普段Ｔシャツばっか着てるから襟無いんだけどな！
ダメ中年ざまぁ！！
gghighlightの話、あまり無い？
ところで本題なんですが、Tokyo.Rでも散々
- gghighlightはすご過ぎる
- gghighlightは神
- gghighlightと結婚したい
という話が出たり出なかったりだと認識しているんですが、
肝心のgghighlightに関する記述はユタニさんの公式系資料とブログのみで、
なかなか他を見つけられないでいます。
こういうものって製作者に配慮して書かないものなのか？
とかよく分かっていないので、
とにかく愛しのgghighlightについてポエみたい、それが本記事です。
基本のキは本家へどうぞ
もちろんながら、
基本的な使い方についてはユタニさんのブログ等を見ていただくとして、
「こんなこと言ってたからこんな風にしてみたよ！」
ってなことを紹介していきたいと思います。
まぁとりあえず
見本を作ってみる
require(tidyverse) require(lubridate) require(gghighlight) # データを作る（スマートじゃないね…） dat <- data.frame(hiduke = today() %m-% days(0:364), x1 = cumsum(c(sample(1:1000,1), sample(-100:100,364, replace = TRUE))), x2 = cumsum(c(sample(1:1000,1), sample(-100:100,364, replace = TRUE))), x3 = cumsum(c(sample(1:1000,1), sample(-100:100,364, replace = TRUE))), x4 = cumsum(c(sample(1:1000,1), sample(-100:100,364, replace = TRUE))), x5 = cumsum(c(sample(1:1000,1), sample(-100:100,364, replace = TRUE))), x6 = cumsum(c(sample(1:1000,1), sample(-100:100,364, replace = TRUE))) ) %>% gather(product, val, -hiduke) p <- ggplot(dat, aes(hiduke, val, colour = product))+ geom_line() # 基本 p + gghighlight(max(val) > 1500)
特に素晴らしいのはラベル
はい、ラベルです。これがgghighlightをハイライトしたいところです。
なにがいいって、ラベルの自由度の高さだと思っています。
このラベル、複数の変数を重ねられるんですよね。
ggrepelからそうなのかもしれないけど、
正直ggrepelってテキストズラすだけで使いづらいなーと思ってたので、
こんな感じだと万々歳です*1。
ということを利用すると、こんな事が出来るわけです。
# 見出しを選択（複数選択＆文字列可） p + gghighlight(max(val) > 1500, label_key = paste0(month(hiduke), "/", day(hiduke), "現在\n", product,":", val, "pt"))
…分かりますか…？
「グラフの見て欲しい部分を丸で囲ったりして数値を上から書く」とか言う
チマチマした作業が入らなくなるの！！
何というお手軽！何という幸せ！
Excelでも何でも分析結果を人に伝える際には大体皆さん経験あると思いますが、
観測データの定期報告に今まではイチイチ作ったグラフに対して
「ココがこうだ。んだもんで良い／悪い」とかを言葉に変換する作業が必要で、
早い話がくそ面倒なわけです。
僕は、出来ないなりに以下のようなステップで少しずつ進化させて来たのだけれど、
- Excelグラフ作成。丸とか四角とかで囲う。んで吹き出しとかつけて説明…
- Rでグラフ作成。画像ファイル化してPPT等に貼付けてその後丸以下略
- Rmarkdownでダッシュボード自動作成。で、図をPPTに貼り付けて以下略
- Rmarkdownでグラフ＆スライド一括作成。結果をコメントとして記載
「次はanotateとか使って気になるデータとか強調しようかなー
でもハイライトしたいトコ選ぶとかだるいなー」とか思ってたので、
このタイミングで出会えたことはまさに僥倖！！！だったわけです。
はい、ほぼコレで言いたいことは大体終わった。 あとは色々試したのを載せ…ようかと思ったけど無駄に長くなるのでそちらはQiitaで。
あ、ちなみにここで「書かなくてよくなった」のは、あくまでも
「結果が（とりあえず観測できた事実として）どうだったか」までであって、
そのあとの洞察（解釈）は別物です。
そんなん流石に自動化できないしそれがあったら僕は用済みだ。
でもこのコメントさえあれば、あとはまぁグラフ見ながら考えられるしなんならその場で解釈してもごまかせる大丈夫！！！*2
あとよくわからないもの
- use_group_by()：コレはggplotの段階でグループ指定してあげなきゃなやつで使う？それともgrouped_dfとかに使う？
- facetしようとするとしばしばものすごい時間かかってエラーになるかなんなら落ちたりする。やり方がまずいのか、ちょっとケースを整理しなきゃ。
以上ですよ！
バブルチャートではなく四角でグラフ化～geom_rect()ってなんだ
バブルチャートもしくはバブルプロットは、 天下のExcel様でも作れますし、 「イケてるグラフ2008*1」にもノミネートされるほど便利なグラフで有名ですが、 残念なのはX軸、Y軸にZ軸を含めた3次元までしか表せないってところです。
ggplotであれば*2、 colour、shapeや、geom_path()なんかも含めると５次元まではいけます*3
ただ、size指定じゃ物足りない！ もっと次元欲しい！
ってことで、これはついに自作geomの作成必要か…？ と思ったら、フツーにありました。 geom_rect github.com
色んな説明にね、「矩形（くけい）」って書いてあったの。
読 め な い ★
コレ長方形ってことだったのね〜
お父さん３５歳になって初めて知ったよ〜
長方形って書いて！！！（書いてあった）
とりあえずまずは公式の例をコピーして書いてみたけど、
なんかしっくりこない。
コレでやりたいこと出来るのか全くピンと来ない。
大体、geom_rectで検索して出てくる画像、コレだよ？
「geom_rect」の検索結果 - Yahoo!検索（画像）
anotateの進化版？みたいな。いや実際そういうことがしたかったんだけど、geom_barみたいなものと同じように思ってた。
まぁ何はともあれやってみる。
require(tidyverse) require(lubridate) require(plotly) df <- data.frame( x = sample(10, 10, replace = TRUE), x_range = sample(5, 10, replace = TRUE), y = sample(10, 10, replace = TRUE), y_range = sample(5, 10, replace = TRUE), pd = letters[1:10] ) # geom_rectってなんだ？ g <- ggplot(df, aes(xmin = x, xmax = x + x_range, ymin = y, ymax = y + y_range, color = pd, fill = pd, alpha = .3)) + geom_rect()+ xlim(0,15) + ylim(0,15)+ geom_text(aes(x=x + x_range/2, y=y + y_range/2, label = pd, alpha = 1))
欲しかったのは、各描画要素が要素ごとに異なる範囲を示す二次元グラフで、
グラフ要素同士は重なってて良い（ってか重なって欲しかった）ものなので、コレピッタリ。
出来上がったのが、はい、こんな感じです
引数は当然ながらいつものx、yだけではないんだけど、
「始点と長さ」ということではなく、あくまで２つの座標を示すものらしいです。
んだもんで、座標が同じだとただの点。
# xmax・ymaxはあくまで座標を表すらしい。 # 線分の長さではないから長さデータがあるなら各minに足さないといけないので注意 # 以下だとただのgeom_textと同じになっちゃう g0 <- ggplot(df, aes(xmin = x, xmax = x + 0, ymin = y, ymax = y + 0, color = pd, fill = pd, alpha = .3)) + geom_rect()+ xlim(0,15) + ylim(0,15)+ geom_text(aes(x=x + x_range/2, y=y + y_range/2, label = pd, alpha = 1)) # あと大好きplotlyで変換すると値がよくわからん ggplotly(g, width = 800, height = 600)
コレで例えば、以下のような期間データを二次元に示したわけのわからん動きをするグラフをイイカンジにしたいのです*4、
# 時系列っぽい複数次元データでやってみる df1 <- data.frame( hiduke = ymd("2015-01-01") %m+% months(c(0:36)), product1 = cumsum(rnorm(37)), product2 = cumsum(rnorm(37)), product3 = cumsum(rnorm(37)), product4 = cumsum(rnorm(37)) ) %>% gather(product, val1, -hiduke) %>% na.omit() %>% mutate(val2 = cumsum(round(val1 * rnorm(1), digits = 0)))
例えば、「その要素の最小値-最大値」の範囲を示す
みたいなことが出来ますね。
ggplot(df1, aes(val2, val1, colour = product)) + geom_path() df2 <- df1 %>% group_by(product) %>% summarise_if(is.numeric, funs(min, max)) ggplot(df2, aes(xmin = val1_min, xmax = val1_min + val1_max, ymin = val2_min, ymax = val2_min + val2_max, fill = product, colour = product))+ geom_rect(alpha = .1)+ geom_text(aes(x=val1_min + val1_max/2, y=val2_min + val2_max/2, label = product))
お分かりいただけるだろうか…？
コレって、データ整理にものすごく役立つんですよね。
１つ１つの次元を１つずつグラフにしていってもちっとも分からないしアタマが追いつかないんですが、
まとめてみるとアラ不思議！
ということで、geom_rect、
この夏、オススメのグラフですよ………！？
※ちなみに当初やりたかったのはひし形でxy軸と関係のない別の二次元を付けたかったんですが、
それは流石に分かりづらいですかね…（今のgeom_rectでも書けるけど）。
dplyrで平均年齢を計算する。
はい、もうなんでもいいから小出しで記事更新を試みます。 まず書く。
ということで、世のデータサイエンティストさんとは縁遠い、「平均年齢の求め方」を書きます。 dplyrで。
しかも割とこう、スマートではない感じです。
↓こういう数表があったとき、意外と結構な人が そのまま人数合計しちゃったりするわけですが（いや意味わからんけども）、 じゃぁそれをdplyrでやるとどうなるかをちょっとやってみました （単に仕事で計算したからネタにしただけです）。
| 年齢 | 人数 |
|---|---|
| 20代 | 150 |
| 30代 | 15 |
| 40代 | 1500 |
| 50代 | 1 |
require(tidyverse) # 平均年齢を計算する（加重平均） df <- data.frame(kind = letters[1:5], age = c(11,12,13,14,15,16,17,18,19,20, NA), uniq_count = sample(x = c(1:1000), size = 55)) df %>% group_by(kind) %>% mutate(sum_ageuniq = age * uniq_count) %>% summarise_at(.vars = 4, funs(ave_age = sum(sum_ageuniq, na.rm = TRUE) / sum(uniq_count, na.rm = TRUE), total_user = sum(uniq_count, na.rm = TRUE)))
mutate部分をsummariseの中でやりゃ一発かしらね。
まぁ、とりあえず。
cronRで自動化にちゃれんじ
アイがなくてもエーねん*1。
そもそも僕がRをちゃんと頑張ろうと決心したのは、世の中のエンジニア氏たちはみんな、 ぱそこん君と対話的だけでなく、パシリのようにこき使えていいな、という思いから始まりました。
やりたいこと、やらないといけないことはいっぱいあるのに、 - そろそろ月末だからアレださなきゃ！ - …またこの季節か。。またあの人に頭下げて作業お願いしなきゃ。。 - 前回と同じでいいから、あのファイルはコピーぺして使おう
…とか、そういうの、ストレスでした。 考える時間が欲しい。 考えなくてよい手作業は極力やりたくない。 人に作業振ってもやれ今は他の仕事がだの、やれメンドくさいだの、そういう心のケアばかりにはいい加減付き合ってられない！
ということで、タスクスケジューラを使いたかったのです。
- cronとは 世のエンジニア氏たちには今更ですね。 非エンジニアの僕と同じような皆さんにはコチラが分かったような分からないような気になってちょうどよろしいかと思います。
Error 403 (Forbidden)｜「分かりそう」で「分からない」でも「分かった」気になれるIT用語辞典
で、crontabがどうとかbin/crontabとかetc/crontabとか色々書いてあるけど結局我々はどこに、どう書いたらパシられてくれるのか、それが知りたいのだよ。
そゆこと、前提のないヒト向けの資料はなかなかないですね。
書き方とかは書いてあるんだけどね。
- cronRとは
そんな痒いところにもうちょっと届きそうで届かない、けどちょっと届くネット社会ですが、 cronRはじゃあなんなのかというと、
これらの2つのパッケージを使用すると、RプロセスをRから直接スケジュールすることができます。これは、基本的なLinux / Unixジョブスケジューリングユーティリティであるcronに直接コマンドを渡すか、Windowsのタスクスケジューラを使用して行います。パッケージはRのスクリプトは、非対話的に実行することができ、できることその事実を知らないRのユーザー始まるために開発された自動化を。
Scheduling R scripts and processes on Windows and Unix/Linux ※Chromeさんの翻訳のまま引用
相変わらずちょっとカタコトだけどそこは愛嬌ということで。 ちなみに「２つの」といってるのはまぁ書いてありますがWindowsの場合は別なタスクスケジューラというのがあるのでパッケージは別だよ、というだけですね。 今回はそっちはムシです。 もうWindowsでRstudioほとんどいじってないんだもの。
cronの設定、しなきゃしなきゃ…とは思ってたんだけど、腰が重くてなかなかたどり着かず状態だったので、Rstudio内でこの操作を完結できるのはとてつもなくありがたかったですね。 無論、ちゃんとしたLinuxユーザにはどうでもいいパッケージだというのはよく分かるけど。
あと、このパッケージはRstudioAddinもあって、今回初めてRstudioAddinを使ってみました。
- 導入
スクショとか入れると親切でしょうけど面倒なのでいれません。
- RstudioのAddinボタンをポチるのもいいけど、
install.package("Addinslist")がステキ - Addinlistでアドイン一覧を眺める。
- cronRをインストール
ちなみにAddinslistの紹介はこちら www.karada-good.net
…さあ！これで使えるのかな？と思ったら「ShinyFilesがないよ」とエラーが出る。 パッケージを入れようにもできない。
なんだこりゃ？と思っていたら、先の開発者さんのgithubを見たら、 どうやらアドインを使うには更に別のパッケージも必要だとか。 ということで下記を実行
install.packages('miniUI') install.packages('shiny') install.packages('shinyFiles')
これで準備が出来ました。
- いざ、スクリプトの自動実行したら…
結論からいうと、Rスクリプトファイルが消えました。
ポチッ！
としたら、同名の空のファイルの出来上がり。
ふぁ！？！？！？！？！？！？！？！？！？！？！？
どうしようどうしよう…
そういえばバックアップとか全然とってない…
git管理もしようと思ってたけど全然理解してない…
指定したスクリプトはかなり前に作って定期的にポチポチ実行していた 自分の中では割と重宝しているものだったので、頭真っ白。
ああ、イチからコード書き直さなきゃなのか…金曜の夜に…もうムリ… と思ったら、Dropboxさんが復元してくれた。…ギリギリセーフ。。。
なにがいけなかったって、 リポジトリのパスを設定する際に、元ファイルと同じ場所に指定なんかしたもんだから*2、 まっさらなファイルを上書き保存してくれたってだけだった。。。
というわけで、今一度上記の引用先*3の動画を見て、 リポジトリ用のディレクトリを作って、ようやく自動化できた。
あの時の衝撃をぼくはわすれない。
バックアップもそうだけど、まずテストスクリプトで試せよってね。
とにもかくにも、これでパソコン君をパシらせることが出来るようになりました。
さぁどんどんパシらせよう。
*1:AI、つまりインテリジェンスがなくたってA、AIだと人工的ってなるけどここではAutomationだったらいいんだよ、というユーモアです。それを説明するというね。
*2:結果のlogファイルが出来る場所くらいに思ってたので…
*3:http://www.bnosac.be/index.php/blog/64-scheduling-r-scripts-and-processes-on-windows-and-unix-linux
lubridateで年齢計算（Excelのアレ)
lubridateーーそれは愛しい、時間概念とのアバンチュール
今宵のステキな刻（とき）を彩る、珠玉のLovely date.....
…と、外で書いててかなり恥ずかしい。
■今回はlubridateパッケージについてです。
lubridate、とても便利！という声は聞きつつも、あんまり他のブログに書かれてないんだもの。
他の記事といえば以下のあたりを参考にさせていただきました。
estrellita.hatenablog.com
www.karada-good.net
この辺りのブログはもうアレですね。
私にとっての貴重な情報源です。
もうホント、毎日のように仕事もしないで参考にさせていただいてます！
■そうなんだけど
だけど、そこから先の、日付データの、次の処理がない。
会員情報とか扱ってるようなお仕事をしてる方だったら、生年月日とか持ってますよね？
年齢とか計算したくないですか……！？
ましてや、学生等々、その１学年だったり、世代の観点が重要な分析テーマとか、
需要ありますよね！？！？
僕は欲しかったんです。
そういう処理方法のヒント。
無かったから試行錯誤しながら泣いてたんです。
全国のＲおじさんの皆様、そういうことなんです！
■Ｒ以外でやればいいじゃん
…そりゃね、他の言語でなさる方はそうでしょうね。
あるいは我らが神、excel様でも便利な関数ありますよね。
そう、datedif()。
えぇ、よくお世話になりました。
なぜあんな便利な関数が隠しコマンド的な扱いになってるのか、未だにナゾです。
でもね
数百万レコードを一気に計算したいっつったらExcel無理じゃんね
感覚的には、Excelは５万行超えたらもう無理。
計算とかしてフリーズしたりイライラしたくない。
他言語？できるだけ１つのツール内で完結したいですぅ
エンジニア氏に任せればいい？
時間がかかるならその部分未処理でいいからデータ早よクレ。
という訳でやっちまいましょう。
…と思ったんですが、ビギナーの僕にはやや荷が重かった。
■そこで天使のおわすサンクチュアリ、r-wakalangへ
いつも悩める子羊である僕の低レベルな質問にもすんなり答えてくださる先人たち、本当にありがとうございます！
みんなも困ったらココへ！！
qiita.com
で、何か時間間隔を計算できないかなーと思っていたら、日本R界の天使*1が広大なRの海の中から探し出してくださいました、
time_length()
この関数は、２つの日付データの間隔を割り出して返してくれるもので、unitに単位を指定すればその単位の間隔を出力してくれるすぐれもの！
…あれ？これどっかで見たことあるぞ？
そう、まんまこれ、Excel様のdatedifなんですね。
■細かな挙動は少々異なる
とはいえまぁ、単なる表のExcel野郎 Excel様と違って、
Rだし、ちゃんとベクトル単位で計算可能です。
x <- "2000-04-02" y <- "2016-04-01" x2 <- c("2000-03-31","2000-04-01","2000-04-02","2000-04-05","2000-04-06","NA","2016-04-01","2016-04-02","1916-04-01","1916-04-02") dif <- as.Date(y) - as.Date(x) dif2 <- as.Date(y) - as.Date(x2) time_length(dif,"year") # unitで指定した年単位の値が返ってくる time_length(dif2,"year") # ベクトルの長さが違っても出来る
■では、年齢計算してみます
先に以下のサイトを参考にしてたのもあって、関数に初挑戦してみました。
blog.goo.ne.jp
calc_age <- function(birthday, obsdate){ dif <- as.Date(obsdate) - as.Date(birthday) trunc(lubridate::time_length(dif,"year")) } # あれ…？ calc_age(x, y) calc_age(x2, y)
よしよし、出来た。と思いきや、どうも日付が微妙にズレてる。。
原因は、データ型の問題でした。
元々あるdifftime型だとうるう年を考慮してくれないようなので、lubridateにあるinterval型にします。
# こっちだとNG class(dif <- as.Date(y) - as.Date(x)) # interval型にする class(dif <- interval(as.Date(y)), as.Date(x))) calc_age <- function(birthday, obsdate){ dif <- interval(as.Date(birthday), as.Date(obsdate)) trunc(lubridate::time_length(dif,"year")) }
できたできた。
仕事柄、「学年」でまとめたい時には4/1時年齢とかで計算したいから、観測日年齢のズレは困っちゃうので、interval型大変便利です*2。
ついでに上限・下限も決めちゃっておかしな元データは計算しないことにする。
calc_age_limits <- function(birthday, obsdate, lower = 0, upper = 100){ dif <- as.Date(obsdate) - as.Date(birthday) check <- trunc(lubridate::time_length(dif,"year")) check1 <- replace(check,which(check>=upper),values = NA) replace(check1,which(check1<lower),values = NA) } calc_age_limits(x2, y) #デフォルトでは0歳未満、100歳以上をエラーとする、ということにしてます
■欠損値が２回続くとダメ？
と、ココまで来て満足していたら、いざ実データでやってみるとエラーが出て動かない。。
なんでか全然分からずに、色々テストしてみたら、どうもNAが２個以上ベクトル内にあるとダメっぽい。
x3 <- c("2000-03-31","2000-04-01","2000-04-02","2000-04-05","2000-04-06","NA","2016-04-01","2016-04-02","1916-04-01","1916-04-02", "NA") calc_age_limits(x3, y) # エラーになる
なんぞこれ…バグじゃないんすか。。。
なんか解法があるんすか。。。
タスケテ！R-wakalang！
ということでまた相談したら、またも天使が確認してくださるしバグ報告してくださるしとりあえずの対処法を示してくださるという。。。
まさにAngel of Angels！*3
■修正すると*4
こんな感じです
calc_age_limits2 <- function(birthday, obsdate, lower = 0, upper = 100){ diff <- interval(as.Date(birthday), as.Date(obsdate)) na_idx <- is.na(diff) result <- vector("numeric", length(na_idx)) result[na_idx] <- NA result[!na_idx] <- lubridate::time_length(diff[!na_idx],"year") result2 <- replace(result,which(result>=upper),values = NA) result2 <- replace(result2,which(result2<lower),values = NA) trunc(result2) } # result2って…ダメな書き方ですよね。。。すみません。。 calc_age_limits2(x3, y)
ということで、NAがあっても大丈夫な関数になりました。*5
別にtime_length()のままでも使用には支障はないんだけど、整数で結果が出ないしinterval型にしないと正しく返らないので、
「コレ叩いたらすぐできるよ」ってドヤ顔する為に関数の方がいいかなということで、関数をご紹介しておきます。
これを応用すると（応用でもないけど）、
まんまExcelのdatedif()がRでできます。
datedif <- function(startdate, enddate, Units = "year", lower = NA, upper = NA){ diff <- interval(as.Date(startdate), as.Date(enddate)) na_idx <- is.na(diff) result <- vector("numeric", length(na_idx)) result[na_idx] <- NA result[!na_idx] <- lubridate::time_length(diff[!na_idx], unit = Units) result2 <- replace(result,which(result>=upper),values = NA) result2 <- replace(result2,which(result2<lower),values = NA) trunc(result2) } # テスト (１行目はcalc_age_limitsと同じになります) datedif(startdate = x2, enddate = y, Units = "year", lower = 0, upper = 100) datedif(startdate = x2, enddate = y, Units = "year") datedif(startdate = x2, enddate = y, Units = "month") datedif(startdate = x2, enddate = y, Units = "day") datedif(startdate = x2, enddate = y, Units = "hour") datedif(startdate = x2, enddate = y, Units = "minute") datedif(startdate = x2, enddate = y, Units = "second")
こちらはUnitsを変えられるようにしてあるので*6、upperとlowerはそれぞれデフォルトはNAにしときました。
※小数点以下を知りたいときはtrunc()を消してください。まぁそうすると関数の意味殆ど無い気もするけど。
ということで、大量データでもこうした対処で簡単に時間感覚が計算出来るようになりました。
これで
- 対エンジニア氏：え？計算に時間がかかる？したら生データでいいから早めにデータください（ドヤァ
というコトが可能になるわけです。
ライフハックですねぇ。
今回は以上です*7。
*1:@yutannihilation氏にはいつも大変お世話になっております…！というか今回の内容、ほとんどが@yutannihilation氏に教えていただいたものを記事化しただけです。。。
*2: ズレて良いってことはまぁ大概ないですね
*3:聖yutani氏を讃えよ！
*4:実は、天使が調べてくださった情報では、lubridateのバージョンを1.6.0にあげたら解決するということがgithubにも書いてあったのですが、バージョンあげてもなぜか出来なかったので、以降は天使が授けてくれた対処法を元にしています
*5:ちなみにNAの連続でエラーになるのはこのissueらしいですが、ちょっとコレわからない…github.com
*6:って元々time_lengthの仕様ですけどね
*7:とにかく言いたいのは、R-wakalangありがとうということと、中でもいつも回答くださるyutani氏に感謝、ということです
