# 13章 lubridateによる日付と時刻

# 「nhn-techorus.datascienceteam / bookreading · GitLab」 https://gitlab.com/nhn-techorus.datascienceteam/bookreading
# 「personal/sakai · master · nhn-techorus.datascienceteam / bookreading · GitLab」 https://gitlab.com/nhn-techorus.datascienceteam/bookreading/tree/master/personal/sakai

# 「R for Data Science」 http://r4ds.had.co.nz/dates-and-times.html

# 「r4ds-exercise-solutions/datetimes.Rmd at master · jrnold/r4ds-exercise-solutions」 https://github.com/jrnold/r4ds-exercise-solutions/blob/master/datetimes.Rmd
# 「R for Data Science Solutions」 https://jrnold.github.io/r4ds-exercise-solutions/dates-and-times.html

# 「RPubs - r4ds_ch13」 http://rpubs.com/tocci36/r4ds_ch13

# p207~224(18)

# 13.1 はじめに
# ● 1年はいつも365日か。
# ● 1日はいつも24時間か。
# ● 1分はいつも60秒か。

# 13.1.1 用意するもの
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 3.3.3
## -- Attaching packages ---------------------------------- tidyverse 1.2.1 --
## √ ggplot2 2.2.1     √ purrr   0.2.4
## √ tibble  1.3.4     √ dplyr   0.7.4
## √ tidyr   0.7.2     √ stringr 1.2.0
## √ readr   1.1.1     √ forcats 0.2.0
## Warning: package 'tibble' was built under R version 3.3.3
## Warning: package 'tidyr' was built under R version 3.3.3
## Warning: package 'readr' was built under R version 3.3.3
## Warning: package 'purrr' was built under R version 3.3.3
## Warning: package 'dplyr' was built under R version 3.3.3
## Warning: package 'stringr' was built under R version 3.3.3
## Warning: package 'forcats' was built under R version 3.3.3
## -- Conflicts ------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(lubridate)
## Warning: package 'lubridate' was built under R version 3.3.3
## 
## Attaching package: 'lubridate'
## The following object is masked from 'package:base':
## 
##     date
library(nycflights13)
## Warning: package 'nycflights13' was built under R version 3.3.3
# 13.2 日付/時刻の作成
# 日付      tibbleでは<date>
# 1日の時刻 tibbleでは<time>
# 日付時刻  瞬間を(通常は一番近い秒を)一意に表す。tibbleでは<dttm>

today()
## [1] "2018-03-20"
now()
## [1] "2018-03-20 16:53:37 JST"
# 13.2.1 文字列から作成
ymd("2017-01-31")
## [1] "2017-01-31"
mdy("January 31st, 2017")
## [1] "2017-03-01"
dmy("31-Jan-2017")
## [1] "2017-01-31"
ymd(20170131)
## [1] "2017-01-31"
ymd_hms("2017-01-31 20:11:59")
## [1] "2017-01-31 20:11:59 UTC"
mdy_hm("01/31/2017 08:01")
## [1] "2017-01-31 08:01:00 UTC"
# /は?-> ok
ymd("2017/01/31")
## [1] "2017-01-31"
# .は?-> ok
ymd("2017.01.31")
## [1] "2017-01-31"
#?ymd
ymd_hms("20170131 201159")
## [1] "2017-01-31 20:11:59 UTC"
#ymd_hms("20170131 2011")
# [1] NA
# Warning message:
# All formats failed to parse. No formats found. 
ymd_hm("20170131 2011")
## [1] "2017-01-31 20:11:00 UTC"
# ymd_h("20170131 2011")
# [1] NA
# Warning message:
# All formats failed to parse. No formats found. 

# 13.2.2 個別要素から作成
flights %>%
  select(year, month, day, hour, minute)
## # A tibble: 336,776 x 5
##     year month   day  hour minute
##    <int> <int> <int> <dbl>  <dbl>
##  1  2013     1     1     5     15
##  2  2013     1     1     5     29
##  3  2013     1     1     5     40
##  4  2013     1     1     5     45
##  5  2013     1     1     6      0
##  6  2013     1     1     5     58
##  7  2013     1     1     6      0
##  8  2013     1     1     6      0
##  9  2013     1     1     6      0
## 10  2013     1     1     6      0
## # ... with 336,766 more rows
flights %>%
  select(year, month, day, hour, minute) %>%
  mutate(
    departure = make_datetime(year, month, day, hour, minute)
  )
## Warning: package 'bindrcpp' was built under R version 3.3.3
## # A tibble: 336,776 x 6
##     year month   day  hour minute           departure
##    <int> <int> <int> <dbl>  <dbl>              <dttm>
##  1  2013     1     1     5     15 2013-01-01 05:15:00
##  2  2013     1     1     5     29 2013-01-01 05:29:00
##  3  2013     1     1     5     40 2013-01-01 05:40:00
##  4  2013     1     1     5     45 2013-01-01 05:45:00
##  5  2013     1     1     6      0 2013-01-01 06:00:00
##  6  2013     1     1     5     58 2013-01-01 05:58:00
##  7  2013     1     1     6      0 2013-01-01 06:00:00
##  8  2013     1     1     6      0 2013-01-01 06:00:00
##  9  2013     1     1     6      0 2013-01-01 06:00:00
## 10  2013     1     1     6      0 2013-01-01 06:00:00
## # ... with 336,766 more rows
make_datetime_100 <- function(year, month, day, time) {
  make_datetime(year, month, day, time %/% 100, time %% 100)
}

flights_dt <- flights %>%
  filter(!is.na(dep_time), !is.na(arr_time)) %>%
  mutate(
    dep_time = make_datetime_100(year, month, day, dep_time),
    arr_time = make_datetime_100(year, month, day, arr_time),
    sched_dep_time = make_datetime_100(
      year, month, day, sched_dep_time
    ),
    sched_arr_time = make_datetime_100(
      year, month, day, sched_arr_time
    )
  ) %>%
  select(origin, dest, ends_with("delay"), ends_with("time"))
flights_dt
## # A tibble: 328,063 x 9
##    origin  dest dep_delay arr_delay            dep_time
##     <chr> <chr>     <dbl>     <dbl>              <dttm>
##  1    EWR   IAH         2        11 2013-01-01 05:17:00
##  2    LGA   IAH         4        20 2013-01-01 05:33:00
##  3    JFK   MIA         2        33 2013-01-01 05:42:00
##  4    JFK   BQN        -1       -18 2013-01-01 05:44:00
##  5    LGA   ATL        -6       -25 2013-01-01 05:54:00
##  6    EWR   ORD        -4        12 2013-01-01 05:54:00
##  7    EWR   FLL        -5        19 2013-01-01 05:55:00
##  8    LGA   IAD        -3       -14 2013-01-01 05:57:00
##  9    JFK   MCO        -3        -8 2013-01-01 05:57:00
## 10    LGA   ORD        -2         8 2013-01-01 05:58:00
## # ... with 328,053 more rows, and 4 more variables: sched_dep_time <dttm>,
## #   arr_time <dttm>, sched_arr_time <dttm>, air_time <dbl>
flights_dt %>%
  ggplot(aes(dep_time)) +
  geom_freqpoly(binwidth = 86400) # 86400秒 = 1日

flights_dt %>%
  filter(dep_time < ymd(20130102)) %>%
  ggplot(aes(dep_time)) +
  geom_freqpoly(binwidth = 600) # 600 s = 10 minutes

# 13.2.3 他の型から作成
as_datetime(today())
## [1] "2018-03-20 UTC"
as_date(now())
## [1] "2018-03-20"
as_datetime(60 * 60 * 10)
## [1] "1970-01-01 10:00:00 UTC"
as_date(365 * 10 + 2)
## [1] "1980-01-01"
# 練習問題p212 (15.2.1 Exercise 1)
# 1. 不当な日付を含む文字列をパースするとどうなるか。
ymd(c("2010-10-10", "bananas"))
## Warning: 1 failed to parse.
## [1] "2010-10-10" NA
ret <- ymd(c("2010-10-10", "bananas"))
## Warning: 1 failed to parse.
#> Warning: 1 failed to parse.
print(class(ret))
## [1] "Date"
#> [1] "Date"
ret
## [1] "2010-10-10" NA
# 2. today()のtzone引数は何をするか。なぜ重要なのか。

# It determines the time-zone of the date. Since different time-zones can have different dates,
# the value of today() can vary depending on the time-zone specified.

# 3. 適切なlubridate関数を使って次のような日付をパースしなさい。
d1 <- "January 1, 2010"
d2 <- "2015-Mar-07"
d3 <- "06-Jun-2017"
d4 <- c("August 19 (2015)", "July 1 (2015)")
d5 <- "12/30/14" # Dec 30, 2014

mdy(d1)
## [1] "2010-01-20"
ymd(d2)
## [1] "2015-03-07"
dmy(d3)
## [1] "2017-06-06"
mdy(d4)
## [1] "2015-01-09" "2015-01-20"
mdy(d5)
## [1] "2014-12-30"
# 13.3 日付時刻の要素

# 13.3.1 要素を取得する
datetime <- ymd_hms("2016-07-08 12:34:56")
year(datetime)
## [1] 2016
month(datetime)
## [1] 7
mday(datetime)
## [1] 8
yday(datetime)
## [1] 190
wday(datetime)
## [1] 6
month(datetime, label = TRUE)
## [1] 7
## Levels: 1 < 2 < 3 < 4 < 5 < 6 < 7 < 8 < 9 < 10 < 11 < 12
wday(datetime, label = TRUE, abbr = FALSE)
## [1] 金曜日
## 7 Levels: 日曜日 < 月曜日 < 火曜日 < 水曜日 < 木曜日 < ... < 土曜日
flights_dt %>%
  mutate(wday = wday(dep_time, label = TRUE)) %>%
  ggplot(aes(x = wday)) +
  geom_bar()

flights_dt %>%
  mutate(minute = minute(dep_time)) %>%
  group_by(minute) %>%
  summarize(avg_delay = mean(dep_delay, na.rm = TRUE), n = n()) %>%
  ggplot(aes(minute, avg_delay)) +
  geom_line()

sched_dep <- flights_dt %>%
  mutate(minute = minute(sched_dep_time)) %>%
  group_by(minute) %>%
  summarize(
    avg_delay = mean(dep_delay, na.rm = TRUE),
    n = n())
ggplot(sched_dep, aes(minute, avg_delay)) +
  geom_line()

ggplot(sched_dep, aes(minute, n)) +
  geom_line()

# 13.3.2 丸めるp215
flights_dt %>%
  count(week = floor_date(dep_time, "week")) %>%
  ggplot(aes(week, n)) +
  geom_line()

# 13.3.3 要素を設定する
(datetime <- ymd_hms("2016-07-08 12:34:56"))
## [1] "2016-07-08 12:34:56 UTC"
year(datetime) <- 2020
datetime
## [1] "2020-07-08 12:34:56 UTC"
month(datetime) <- 01
datetime
## [1] "2020-01-08 12:34:56 UTC"
hour(datetime) <- hour(datetime) + 1
datetime
## [1] "2020-01-08 13:34:56 UTC"
update(datetime, year = 2020, month = 2, mday = 2, hour = 2)
## [1] "2020-02-02 02:34:56 UTC"
ymd("2015-02-01") %>%
  update(mday = 30)
## [1] "2015-03-02"
ymd("2015-02-01") %>%
  update(hour = 400)
## [1] "2015-02-17 16:00:00 UTC"
flights_dt %>%
  mutate(dep_hour = update(dep_time, yday = 1)) %>%
  ggplot(aes(dep_hour)) +
  geom_freqpoly(binwidth = 300)

# 練習問題 p217 ()
# 1. 1日のうちのフライトの時刻分布が1年間でどのように変化しているか。
flights_dt %>%
  mutate(time = hour(dep_time) * 100 + minute(dep_time),
         mon = as.factor(month(dep_time))) %>%
  ggplot(aes(x = time, group = mon, color = mon)) +
  geom_freqpoly(binwidth = 100)

flights_dt %>%
  mutate(time = hour(dep_time) * 100 + minute(dep_time),
         mon = as.factor(month(dep_time))) %>%
  ggplot(aes(x = time, y = ..density.., group = mon, color = mon)) +
  geom_freqpoly(binwidth = 100)

# 2. dep_time, sched_dep_time, dep_delayを比較しなさい。一貫した関係にあるか。何がわかった
# か説明しなさい。
flights_dt %>%
  mutate(dep_time_ = sched_dep_time + dep_delay * 60) %>%
  filter(dep_time_ != dep_time) %>%
  select(dep_time_, dep_time, sched_dep_time, dep_delay)
## # A tibble: 1,205 x 4
##              dep_time_            dep_time      sched_dep_time dep_delay
##                 <dttm>              <dttm>              <dttm>     <dbl>
##  1 2013-01-02 08:48:00 2013-01-01 08:48:00 2013-01-01 18:35:00       853
##  2 2013-01-03 00:42:00 2013-01-02 00:42:00 2013-01-02 23:59:00        43
##  3 2013-01-03 01:26:00 2013-01-02 01:26:00 2013-01-02 22:50:00       156
##  4 2013-01-04 00:32:00 2013-01-03 00:32:00 2013-01-03 23:59:00        33
##  5 2013-01-04 00:50:00 2013-01-03 00:50:00 2013-01-03 21:45:00       185
##  6 2013-01-04 02:35:00 2013-01-03 02:35:00 2013-01-03 23:59:00       156
##  7 2013-01-05 00:25:00 2013-01-04 00:25:00 2013-01-04 23:59:00        26
##  8 2013-01-05 01:06:00 2013-01-04 01:06:00 2013-01-04 22:45:00       141
##  9 2013-01-06 00:14:00 2013-01-05 00:14:00 2013-01-05 23:59:00        15
## 10 2013-01-06 00:37:00 2013-01-05 00:37:00 2013-01-05 22:30:00       127
## # ... with 1,195 more rows
# 3. air_timeを出発時刻と到着時刻との時間差と比較しなさい。わかったことを説明しなさい(ヒ
# ント:空港の位置を考慮すること)。
flights_dt %>%
  mutate(flight_duration = as.numeric(arr_time - dep_time),
         air_time_mins = air_time,
         diff = flight_duration - air_time_mins) %>%
  select(origin, dest, flight_duration, air_time_mins, diff)
## # A tibble: 328,063 x 5
##    origin  dest flight_duration air_time_mins  diff
##     <chr> <chr>           <dbl>         <dbl> <dbl>
##  1    EWR   IAH             193           227   -34
##  2    LGA   IAH             197           227   -30
##  3    JFK   MIA             221           160    61
##  4    JFK   BQN             260           183    77
##  5    LGA   ATL             138           116    22
##  6    EWR   ORD             106           150   -44
##  7    EWR   FLL             198           158    40
##  8    LGA   IAD              72            53    19
##  9    JFK   MCO             161           140    21
## 10    LGA   ORD             115           138   -23
## # ... with 328,053 more rows
# 4. 平均遅延時間が一日の内でどのように変化するか。dep_timeとsched_dep_timeのどちらを使
# うべきか。それはなぜか。
flights_dt %>%
  mutate(sched_dep_hour = hour(sched_dep_time)) %>%
  group_by(sched_dep_hour) %>%
  summarise(dep_delay = mean(dep_delay)) %>%
  ggplot(aes(y = dep_delay, x = sched_dep_hour)) +
  geom_point() +
  geom_smooth()
## `geom_smooth()` using method = 'loess'

# 5. 遅延の可能性をできるだけ少なくするには何曜日に出発すべきか。
flights_dt %>%
  mutate(dow = wday(sched_dep_time)) %>%
  group_by(dow) %>%
  summarise(dep_delay = mean(dep_delay),
            arr_delay = mean(arr_delay, na.rm = TRUE))
## # A tibble: 7 x 3
##     dow dep_delay arr_delay
##   <dbl>     <dbl>     <dbl>
## 1     1 11.495974  4.820024
## 2     2 14.734220  9.653739
## 3     3 10.591532  5.388526
## 4     4 11.699198  7.051119
## 5     5 16.064837 11.740819
## 6     6 14.660643  9.070120
## 7     7  7.620118 -1.448828
# 6. diamonds$caratとflights$sched_dep_timeの分布が似ているのは何が原因だろうか。
ggplot(diamonds, aes(x = carat)) + 
  geom_density()

ggplot(diamonds, aes(x = carat %% 1 * 100)) +
  geom_histogram(binwidth = 1)

ggplot(flights_dt, aes(x = minute(sched_dep_time))) +
  geom_histogram(binwidth = 1)

# 7. 1時間のうち20–30分と50–60分に出発する便の出発遅延が少ないことについての、それより早
# い時刻に予定されている便によるという私の仮説が正しいことを確認しなさい(ヒント:便が遅
# 延したかどうかを示すバイナリ変数を作る)。
flights_dt %>%
  mutate(early = dep_delay < 0,
         minute = minute(sched_dep_time)) %>%
  group_by(minute) %>%
  summarise(early = mean(early)) %>%
  ggplot(aes(x = minute, y = early)) +
  geom_point()

flights_dt %>%
  mutate(early = dep_delay < 0, minute = minute(sched_dep_time) %% 10) %>%
  group_by(minute) %>%
  summarise(early = mean(early)) %>%
  ggplot(aes(x = minute, y = early)) +
  geom_point()

# 13.4 タイムスパン p218

# 13.4.1 duration(期間)
# Hadleyは何歳か?
h_age <- today() - ymd(19791014)
h_age
## Time difference of 14037 days
as.duration(h_age)
## [1] "1212796800s (~38.43 years)"
# tocciは
t_age <- today() - ymd(19740306)
t_age
## Time difference of 16085 days
as.duration(t_age)
## [1] "1389744000s (~44.04 years)"
dseconds(15)
## [1] "15s"
dminutes(10)
## [1] "600s (~10 minutes)"
dhours(c(12, 24))
## [1] "43200s (~12 hours)" "86400s (~1 days)"
ddays(0:5)
## [1] "0s"                "86400s (~1 days)"  "172800s (~2 days)"
## [4] "259200s (~3 days)" "345600s (~4 days)" "432000s (~5 days)"
dweeks(3)
## [1] "1814400s (~3 weeks)"
dyears(1)
## [1] "31536000s (~52.14 weeks)"
2 * dyears(1)
## [1] "63072000s (~2 years)"
dyears(1) + dweeks(12) + dhours(15)
## [1] "38847600s (~1.23 years)"
tomorrow <- today() + ddays(1)
last_year <- today() - dyears(1)

one_pm <- ymd_hms(
  "2016-03-12 13:00:00",
  tz = "America/New_York"
)
one_pm
## [1] "2016-03-12 13:00:00 EST"
one_pm + ddays(1)
## [1] "2016-03-13 14:00:00 EDT"
one_pm <- ymd_hms(
  "2016-03-12 13:00:00"
)
one_pm
## [1] "2016-03-12 13:00:00 UTC"
one_pm + ddays(1)
## [1] "2016-03-13 13:00:00 UTC"
# 13.4.2 period(時期)
one_pm
## [1] "2016-03-12 13:00:00 UTC"
one_pm + days(1)
## [1] "2016-03-13 13:00:00 UTC"
seconds(15)
## [1] "15S"
minutes(10)
## [1] "10M 0S"
hours(c(12, 24))
## [1] "12H 0M 0S" "24H 0M 0S"
days(7)
## [1] "7d 0H 0M 0S"
months(1:6)
## [1] "1m 0d 0H 0M 0S" "2m 0d 0H 0M 0S" "3m 0d 0H 0M 0S" "4m 0d 0H 0M 0S"
## [5] "5m 0d 0H 0M 0S" "6m 0d 0H 0M 0S"
weeks(3)
## [1] "21d 0H 0M 0S"
years(1)
## [1] "1y 0m 0d 0H 0M 0S"
10 * (months(6) + days(1))
## [1] "60m 10d 0H 0M 0S"
days(50) + hours(25) + minutes(2)
## [1] "50d 25H 2M 0S"
# うるう年
ymd("2016-01-01") + dyears(1)
## [1] "2016-12-31"
ymd("2016-01-01") + years(1)
## [1] "2017-01-01"
# 夏時間
one_pm + ddays(1)
## [1] "2016-03-13 13:00:00 UTC"
one_pm + days(1)
## [1] "2016-03-13 13:00:00 UTC"
# フライトの日付に関する問題をperiodを使って解決
flights_dt %>%
  filter(arr_time < dep_time)
## # A tibble: 10,633 x 9
##    origin  dest dep_delay arr_delay            dep_time
##     <chr> <chr>     <dbl>     <dbl>              <dttm>
##  1    EWR   BQN         9        -4 2013-01-01 19:29:00
##  2    JFK   DFW        59        NA 2013-01-01 19:39:00
##  3    EWR   TPA        -2         9 2013-01-01 20:58:00
##  4    EWR   SJU        -6       -12 2013-01-01 21:02:00
##  5    EWR   SFO        11       -14 2013-01-01 21:08:00
##  6    LGA   FLL       -10        -2 2013-01-01 21:20:00
##  7    EWR   MCO        41        43 2013-01-01 21:21:00
##  8    JFK   LAX        -7       -24 2013-01-01 21:28:00
##  9    EWR   FLL        49        28 2013-01-01 21:34:00
## 10    EWR   FLL        -9       -14 2013-01-01 21:36:00
## # ... with 10,623 more rows, and 4 more variables: sched_dep_time <dttm>,
## #   arr_time <dttm>, sched_arr_time <dttm>, air_time <dbl>
flights_dt <- flights_dt %>%
  mutate(
    overnight = arr_time < dep_time,
    arr_time = arr_time + days(overnight * 1),
    sched_arr_time = sched_arr_time + days(overnight * 1)
  )

flights_dt %>%
  filter(overnight, arr_time < dep_time)
## # A tibble: 0 x 10
## # ... with 10 variables: origin <chr>, dest <chr>, dep_delay <dbl>,
## #   arr_delay <dbl>, dep_time <dttm>, sched_dep_time <dttm>,
## #   arr_time <dttm>, sched_arr_time <dttm>, air_time <dbl>,
## #   overnight <lgl>
# 13.4.3 interval(間隔)

dyears(1) / ddays(365)
## [1] 1
years(1) / days(1)
## estimate only: convert to intervals for accuracy
## [1] 365.25
# より正確な測定結果が欲しいなら、intervalを使う必要があります。intervalは開始時点つきのdurationです。
next_year <- today() + years(1)
(today() %--% next_year) / ddays(1)
## [1] 365
(today() %--% next_year) %/% days(1)
## Note: method with signature 'Timespan#Timespan' chosen for function '%/%',
##  target signature 'Interval#Period'.
##  "Interval#ANY", "ANY#Period" would also be valid
## [1] 365
# (today() - next_year) / days(1)
# Error in (today() - next_year)/days(1) : Incompatible timespan classes:
# change class with as.duration() or as.period()

# 13.4.4 まとめ


# 図13-1 日付時間クラス間で可能な算術演算 http://r4ds.had.co.nz/diagrams/datetimes-arithmetic.png
#install.packages("magick")
library(magick)
## Warning: package 'magick' was built under R version 3.3.3
## Linking to ImageMagick 6.9.9.14
## Enabled features: cairo, freetype, fftw, ghostscript, lcms, pango, rsvg, webp
## Disabled features: fontconfig, x11
image_read("http://r4ds.had.co.nz/diagrams/datetimes-arithmetic.png")

# 練習問題 p222
# 1. months()があるのにdmonths()がないのはなぜか。

# There is no direct unambiguous value of months in seconds since months have differing numbers of days.
# 31 days: January, March, May, July, August, October
# 30 days: April, Jun, September, November, December
# 28 or 29 days: February
# Though in the past, in the pre-computer era, for arithmetic convenience, bankers adopted a 360 day year with 30 day months.

# 月が異なる日数を持つので、月の直接的な明白な値はありません。
# 31日間:1月、3月、5月、7月、8月、10月
# 30日間:4月、6月、9月、11月、12月
# 28日または29日:2月
# 過去にはコンピュータ時代の前計算機の利便性のために、銀行は360日の年を30日の月間で採用しました。

# 2. Rを学び始めたばかりの人にdays(overnight * 1)を説明する。どのように計算するか。

# The variable overnight is equal to TRUE or FALSE. If it is an overnight flight,
# this becomes 1 day, and if not, then overnight = 0, and no days are added to the date.

# 変数overnightはTRUEまたはに等しいFALSE。翌日運航の場合は1日になり、それ以外の場合は翌日= 0になり、日に日が加算されません。

# 3. 2015年の毎月の初日を与える日付ベクトルを作りなさい。今年の毎月の初日を与える日付ベク
# トルを作りなさい。
ymd("2015-01-01") + months(0:11)
##  [1] "2015-01-01" "2015-02-01" "2015-03-01" "2015-04-01" "2015-05-01"
##  [6] "2015-06-01" "2015-07-01" "2015-08-01" "2015-09-01" "2015-10-01"
## [11] "2015-11-01" "2015-12-01"
floor_date(today(), unit = "year") + months(0:11)
##  [1] "2018-01-01" "2018-02-01" "2018-03-01" "2018-04-01" "2018-05-01"
##  [6] "2018-06-01" "2018-07-01" "2018-08-01" "2018-09-01" "2018-10-01"
## [11] "2018-11-01" "2018-12-01"
#ymd("2015-01-31") + months(0:11) # 31日の月以外はNA

# 4. (日付で)誕生日を与えると何歳かを年で返す関数を書きなさい。
age <- function(bday) {
  (bday %--% today()) %/% years(1)
}
age(ymd("1990-10-12"))
## [1] 27
age(ymd("1974-03-06"))
## [1] 44
# 5. (today() %--% (today() + years(1)) /months(1)はなぜうまく働かないのか。
# It appears to work. Today is a date. Today + 1 year is a valid endpoint for an interval.
# And months is period that is defined in this period.
# それは動作するようです。今日はデートです。今日+ 1年はある区間の有効な終点です。月はこの期間に定義された期間です。
#(today() %--% (today() + years(1)) / months(1)
(today() %--% (today() + years(1))) %/% months(1)
## [1] 12
(today() %--% (today() + years(1))) / months(1)
## [1] 12
# かっこは足りないような。

# 13.5 タイムゾーン

# 第1の課題は、タイムゾーンの通常の呼び名が曖昧なことです。
# Rでは混乱を避けるために、国際標準IANAタイムゾーンを用います。名前付けは、「/」を使って通常「<大陸
# >/<都市>」という形式で表します(すべての国が大陸にあるわけではないので例外もある)。例えば、
# 「America/New_York」、「Europe/Paris」および「Pacific/Auckland」です。

# タイムゾーンは、国または国の一部地域に対応すると思っていたら、なぜこのタイムゾーンに都市
# 名を使うか不思議に思うかもしれません。これは、IANAデータベースに何十年にもわたる価値ある
# タイムゾーン規則の記録が残されているからです。これまでの何十年でも、国は名前を頻繁に変え、
# 分裂を繰り返してきましたが、都市名は比較的変わりませんでした。別の問題は、名前が現在の振
# る舞いだけでなく、完全な歴史を反映しないといけないことです。例えば、「America/New_York」
# と「America/Detroit」という2つのタイムゾーンがあります。両都市は現在ESTを使っていますが、
# 1969–1972には(Detroitのある)ミシガン州は夏時間を採用しなかったので異なる名前が必要なので
# す。タイムゾーンデータベース(http://www.iana.org/time-zonesから取得可能)でこれらのお話を
# 読むだけでも価値があります。
# 「IANA — Time Zone Database」 https://www.iana.org/time-zones
Sys.timezone()
## [1] "Asia/Tokyo"
length(OlsonNames())
## [1] 589
head(OlsonNames())
## [1] "Africa/Abidjan"     "Africa/Accra"       "Africa/Addis_Ababa"
## [4] "Africa/Algiers"     "Africa/Asmara"      "Africa/Asmera"
tail(OlsonNames())
## [1] "US/Samoa" "UTC"      "VERSION"  "W-SU"     "WET"      "Zulu"
(x1 <- ymd_hms("2015-06-01 12:00:00", tz = "America/New_York"))
## [1] "2015-06-01 12:00:00 EDT"
(x2 <- ymd_hms("2015-06-01 18:00:00", tz = "Europe/Copenhagen"))
## [1] "2015-06-01 18:00:00 CEST"
(x3 <- ymd_hms("2015-06-02 04:00:00", tz = "Pacific/Auckland"))
## [1] "2015-06-02 04:00:00 NZST"
x1 - x2
## Time difference of 0 secs
x1 - x3
## Time difference of 0 secs
x4 <- c(x1, x2, x3)
x4
## [1] "2015-06-02 01:00:00 JST" "2015-06-02 01:00:00 JST"
## [3] "2015-06-02 01:00:00 JST"
# タイムゾーンを変えるには2つの方法があります。
# ● 時刻はそのままにして表示方法を変える。時刻は正しいが、より自然な表示を求める場合に有効だ。
(x4a <- with_tz(x4, tzone = "Australia/Lord_Howe"))
## [1] "2015-06-02 02:30:00 LHST" "2015-06-02 02:30:00 LHST"
## [3] "2015-06-02 02:30:00 LHST"
x4a - x4
## Time differences in secs
## [1] 0 0 0
# (これは、タイムゾーンの別の課題も示している。いつも整数時間異なるわけではない。)
# ● 基盤となる時刻を変更する。時刻に間違ったタイムゾーンが与えられ修正したい場合にこれを用いる。
(x4b <- force_tz(x4, tzone = "Australia/Lord_Howe"))
## [1] "2015-06-02 01:00:00 LHST" "2015-06-02 01:00:00 LHST"
## [3] "2015-06-02 01:00:00 LHST"
x4b - x4
## Time differences in hours
## [1] -1.5 -1.5 -1.5
ymd_hms("2015-06-01 12:00:00", tz = "UTC")
## [1] "2015-06-01 12:00:00 UTC"
ymd_hms("2015-06-01 12:00:00", tz = "GMT")
## [1] "2015-06-01 12:00:00 GMT"
#ymd_hms("2015-06-01 12:00:00", tz = "JST")
# Error in C_force_tz(time, tz = tzone, roll) : 
#   CCTZ: Unrecognized output timezone: "JST"

ymd_hms("2015-06-01 12:00:00", tz = "Asia/Tokyo")
## [1] "2015-06-01 12:00:00 JST"
ymd_hms("2015-06-01 12:00:00", tz = "Japan")
## [1] "2015-06-01 12:00:00 JST"
# ymd_hms("2015-06-01 12:00:00", tz = "Asia/Nayoro")
# Error in C_force_tz(time, tz = tzone, roll) : 
#   CCTZ: Unrecognized output timezone: "Asia/Nayoro"
# ymd_hms("2015-06-01 12:00:00", tz = "Asia/Osaka")

Sys.time()
## [1] "2018-03-20 16:53:52 JST"
# 「日付、時間関数Tips大全 - RjpWiki」 http://www.okadajp.org/RWiki/?%E6%97%A5%E4%BB%98%E3%80%81%E6%99%82%E9%96%93%E9%96%A2%E6%95%B0Tips%E5%A4%A7%E5%85%A8
# 「[R] タイムゾーン変換 - ill-identified diary」 http://ill-identified.hatenablog.com/entry/2015/01/13/211024

# ~p224
Sys.getlocale("LC_TIME")
## [1] "Japanese_Japan.932"