備忘ログ

チラシの裏的備忘録&メモ

Rでランダムな年月日を作る＆年月日から年齢を作る

R メモ 小ネタ

Rでランダムな年月日を作る方法はダミーデータを作るときにたまに使うがいつも忘れるし、作った関数をどこに保存したのか忘れてしまうので自分用のメモ。

あわせて、年月日から年齢を計算する関数もメモしておく。

ランダムな年月日を作る

startで指定した年月日からendで指定した年月日の範囲でsizeで指定した大きさのランダムな年月日をベクトルで返す関数。replaceをTRUEにすると同じ年月日もだせる。byをweekやmonth、yearとすると週毎や月ごと、年ごとのデータから抽出できる。sizeを指定しないと、指定範囲のデータの数だけ年月日が作られる。

random.Date <- function(start, end , size, replace = FALSE, prob = NULL, by = "day"){
  sample(seq(as.Date(start), as.Date(end), by = by), size = size, replace = replace, prob = prob)
}

# 1989/1/8から、2019/4/30まで（平成期間）から10個、ランダムに日付を同一値を含めて抽出する。
x <- random.Date("1989/1/8", "2019/4/30", size = 10, replace = TRUE)
x

##  [1] "2009-04-20" "1996-10-12" "1992-07-12" "2013-05-12" "2013-12-23"
##  [6] "1997-01-02" "1990-04-05" "2003-01-07" "2001-06-15" "2006-07-11"

年月日から年齢を計算する

年月日から年齢を計算する。startに計算する年月日を入力し、endに年齢を計算したいタイミング（今日ならsys.Date()のまま）を入力する。byがyearのままなら年齢、monthなら月齢、dayならstartからendまでの日数を計算する。

age.cal <- function(start, end = Sys.Date(), by = "year"){
  unname(sapply(start, function(x){length(seq(as.Date(x), as.Date(end), by = by)) - 1}))
}

# 先程作ったランダムな年月日のベクトルxから今日の年齢を計算する。
age <- age.cal(x)
age

##  [1] 11 24 28  7  7 24 30 18 19 14

年齢以外でも、とあるイベントから今日まで何年なのか、何ヶ月目なのか、何日目なのか計算できる。

参考

GitHub - jknowles/eeptools: Educational Evaluation and Policy Tools for Rでage_calc()という関数があるが、

age_calc(dob = as.Date('1995-01-15'), enddate = as.Date('2003-02-16'), 
         units = "years")

## [1] 8.087671

と小数点以下まで計算される様子（上記はREADMEからのコピー）。round()で丸めればいいのかもしれないが……。しかも入力した日付っぽい値を日付とみなして計算しているのではなく、日付型のデータを入力しなければならないのでその点もちょっと制約があって微妙。

雑感

Rでの日付型の取り扱いはちょっと注意が必要で、as.*()系の関数で例えば、as.numeric()などは不正な値として文字列を入力されると、NAを返すのに、as.Date.character()だと不適切な値（日付型にできない形の値）を入力するとエラーでストップしてしまう。

as.Date.character(1)

## charToDate(x) でエラー: 
## 文字列は標準的な曖昧さのない書式にはなっていません

他のas.*()と同じようにNAを返す仕様のほうが個人的には嬉しいのだが……

as.Date.character()は

as.Date.character <- function (x, format, tryFormats = c("%Y-%m-%d", "%Y/%m/%d"), 
    optional = FALSE, ...) 
{
    charToDate <- function(x) {
        is.na(x) <- !nzchar(x)
        xx <- x[1L]
        if (is.na(xx)) {
            j <- 1L
            while (is.na(xx) && (j <- j + 1L) <= length(x)) xx <- x[j]
            if (is.na(xx)) 
                f <- "%Y-%m-%d"
        }
        if (is.na(xx)) 
            strptime(x, f)
        else {
            for (ff in tryFormats) if (!is.na(strptime(xx, ff, 
                tz = "GMT"))) 
                return(strptime(x, ff))
            if (optional) 
                as.Date.character(rep.int(NA_character_, length(x)), 
                  "%Y-%m-%d")
            else stop("character string is not in a standard unambiguous format")
        }
    }
    res <- if (missing(format)) 
        charToDate(x)
    else strptime(x, format, tz = "GMT")
    as.Date(res)
}

でできており、このstop("character string is not in a standard unambiguous format") をwarning("character string is not in a standard unambiguous format") retrun(NA)にすれば似たような結果が返ってきそうだが……。

2021/04/07追記：パッケージ化した

今までブログ上で書き散らかした関数（以外もある）を少し関数名や細かい挙動を調整して、上記の関数もまとめたものをパッケージ化してGitHubからインストールできるようにした（GitHubでソースコードを管理したいだけ）。

GitHub - indenkun/infun: This is a collection of R utilities functions for me, but maybe also for you.

install.packages("remotes")
remotes::install_github("indenkun/infun")

でインストールできる。詳しくはないが関数の紹介はREADMEに書いたつもり。

自分で使いたい関数をパッケージ化した感じで今後も適当に自分で使いたい関数があれば適宜入れていく。自作関数であっても汎用性があるものは適宜パッケージ化したほうが名前空間的にいいし、Rスクリプトファイルの紛失が防げる。

：追記終了