データ穴リストのブログ

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()を消してください。まぁそうすると関数の意味殆ど無い気もするけど。

ということで、大量データでもこうした対処で簡単に時間感覚が計算出来るようになりました。

これで

対エンジニア氏：え？計算に時間がかかる？したら生データでいいから早めにデータください（ドヤァ

対Excel氏：（………フッ、表計算ソフトめ）

というコトが可能になるわけです。

ライフハックですねぇ。

今回は以上です*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氏に感謝、ということです